module Handler.Board where

import           Import
import qualified Data.Text       as T
import           Handler.Common  (deletePosts)
import           Handler.Posting
import           Handler.Captcha (checkCaptcha)
import           Handler.EventSource (sendNewPostES)
import           Handler.Captcha (captchaWidget)
import           Utils.File            (insertFiles)
import           Utils.YobaMarkup      (doYobaMarkup)
import           Data.Digest.OpenSSL.MD5 (md5sum)
import qualified Data.ByteString.UTF8    as B
--------------------------------------------------------------------------------------------------------- 
getBoardNoPageR :: Text -> Handler TypedContent
getBoardNoPageR board = getBoardR board 0

postBoardNoPageR :: Text -> Handler Html
postBoardNoPageR board = postBoardR board 0
--------------------------------------------------------------------------------------------------------- 
selectThreadsAndPreviews :: Text  -> -- ^ Board name
                           Int   -> -- ^ Page
                           Int   -> -- ^ Threads per page
                           Int   -> -- ^ Previews per thread
                           Text  -> -- ^ posterId
                           [Permission] ->
                           [Int] -> -- ^ Hidden threads
                           Handler ThreadsAndPreviews
selectThreadsAndPreviews board page threadsPerPage previewsPerThread posterId permissions hiddenThreads =
  let selectThreadsAll = selectList [PostBoard ==. board, PostParent ==. 0, PostDeleted ==. False, PostLocalId /<-. hiddenThreads]
                                    [Desc PostSticked, Desc PostBumped, LimitTo threadsPerPage, OffsetBy $ page*threadsPerPage]
      selectThreadsHB  = selectList ( [PostBoard ==. board, PostParent ==. 0, PostDeleted ==. False, PostLocalId /<-. hiddenThreads, PostHellbanned ==. False] ||.
                                      [PostBoard ==. board, PostParent ==. 0, PostDeleted ==. False, PostLocalId /<-. hiddenThreads, PostHellbanned ==. True, PostPosterId ==. posterId]
                                    ) [Desc PostSticked, Desc PostBumped, LimitTo threadsPerPage, OffsetBy $ page*threadsPerPage]
      selectThreads = if elem HellBanP permissions then selectThreadsAll else selectThreadsHB
      --------------------------------------------------------------------------------------------------
      selectFiles  pId = selectList [AttachedfileParentId ==. pId] []
      --------------------------------------------------------------------------------------------------
      selectPreviews   = if elem HellBanP permissions then selectPreviewsAll else selectPreviewsHB
      selectPreviewsHB t
        | previewsPerThread > 0 = selectList ( [PostDeletedByOp ==. False, PostBoard ==. board, PostDeleted ==. False, PostParent ==. postLocalId t, PostHellbanned ==. False] ||.
                                               [PostDeletedByOp ==. False, PostBoard ==. board, PostDeleted ==. False, PostParent ==. postLocalId t, PostHellbanned ==. True, PostPosterId ==. posterId]
                                             ) [Desc PostDate, LimitTo previewsPerThread]
        | otherwise             = return []
      selectPreviewsAll t
        | previewsPerThread > 0 = selectList [PostDeletedByOp ==. False, PostBoard ==. board, PostDeleted ==. False, PostParent ==. postLocalId t] [Desc PostDate, LimitTo previewsPerThread]
        | otherwise             = return []
      --------------------------------------------------------------------------------------------------
      countPostsAll t = [PostDeletedByOp ==. False, PostDeleted ==. False, PostBoard ==. board, PostParent ==. postLocalId t]
      countPostsHB  t = [PostDeletedByOp ==. False, PostDeleted ==. False, PostBoard ==. board, PostParent ==. postLocalId t, PostHellbanned ==. False] ||. 
                        [PostDeletedByOp ==. False, PostDeleted ==. False, PostBoard ==. board, PostParent ==. postLocalId t, PostHellbanned ==. True, PostPosterId ==. posterId]
      countPosts t = if elem HellBanP permissions then countPostsAll t else countPostsHB t
  in runDB $ selectThreads >>= mapM (\th@(Entity tId t) -> do
       threadFiles      <- selectFiles tId
       previewsAndFiles <- selectPreviews t >>= mapM (\pr -> do
         previewFiles <- selectFiles $ entityKey pr
         return (pr, previewFiles))
       postsInThread <- count (countPosts t)
       return $ (PostAndFiles (th, threadFiles)
                , reverse $ map (\(post, files) -> PostAndFiles (post, files)) previewsAndFiles
                , postsInThread - previewsPerThread)) >>= (\posts -> return $ ThreadsAndPreviews posts)
--------------------------------------------------------------------------------------------------------- 
getBoardR :: Text -> Int -> Handler TypedContent
getBoardR board page = do
  muser    <- maybeAuth
  mgroup   <- getMaybeGroup muser
  boardVal <- getBoardVal404 board
  checkViewAccess mgroup boardVal
  let hasAccessToNewThread = checkAccessToNewThread mgroup boardVal
      hasAccessToReply     = checkAccessToReply mgroup boardVal
      permissions          = getPermissions mgroup
  ------------------------------------------------------------------------------------------------------- 
  numberOfThreads <- runDB $ count [PostBoard ==. board, PostParent ==. 0, PostDeleted ==. False, PostHellbanned ==. False]
  posterId        <- getPosterId
  hiddenThreads   <- map fst <$> getHiddenThreads board
  cleanBoardStats board
  -- let numberFiles       = boardNumberFiles       boardVal
  let maxMessageLength  = boardMaxMsgLength      boardVal
      threadsPerPage    = boardThreadsPerPage    boardVal
      previewsPerThread = boardPreviewsPerThread boardVal
      title             = boardTitle             boardVal
      summary           = boardSummary           boardVal
      geoIpEnabled      = boardEnableGeoIp       boardVal
      showPostDate      = boardShowPostDate      boardVal
      enablePM          = boardEnablePM          boardVal
      pages             = listPages threadsPerPage numberOfThreads
  threadsAndPreviewsJson <- selectThreadsAndPreviews board page threadsPerPage previewsPerThread posterId permissions hiddenThreads
  let threadsAndPreviews = (\(ThreadsAndPreviews x) -> x) threadsAndPreviewsJson
  ------------------------------------------------------------------------------------------------------- 
  adaptiveCaptcha <- getConfig configAdaptiveCaptcha
  pc <- lookupSession "post-count"
  let isCaptchaEnabled = boardEnableCaptcha boardVal && maybe True (\x -> tread x <= adaptiveCaptcha) pc && isNothing muser
  captchaImg <- if isCaptchaEnabled  then Just <$> widgetToPageContent captchaWidget else return Nothing
  ------------------------------------------------------------------------------------------------------- 
  (postFormWidget, formEnctype) <- generateFormPost $ postForm True boardVal muser
  (editFormWidget, _)           <- generateFormPost $ editForm permissions
  msgrender       <- getMessageRender
  AppSettings{..} <- appSettings <$> getYesod
  mBanner         <- if appRandomBanners then randomBanner else takeBanner board
  ((_, searchWidget), _) <- runFormGet $ searchForm $ Just board
  let pageTitle = if page > 0 then T.concat [" (", tshow page, ") "] else ""
  selectRep $ do
    provideRep $ defaultLayout $ do
      setUltDestCurrent
      defaultTitleReverse (title <> pageTitle)
      $(widgetFile "board")
    provideJson $ object [ "threads" .= threadsAndPreviewsJson
                         , "banner" .= mBanner
                         , "board" .= boardVal
                         , "title" .= (T.concat $ reverse [appSiteName, appTitleDelimiter, pageTitle])
                         , "can_reply" .= hasAccessToReply
                         , "can_post"  .= hasAccessToNewThread
                         , "page" .= page
                         ]
    
postBoardR :: Text -> Int -> Handler Html
postBoardR board _ = do
  muser    <- maybeAuth
  mgroup   <- getMaybeGroup muser
  boardVal <- getBoardVal404 board
  checkViewAccess mgroup boardVal
  unless (checkAccessToNewThread mgroup boardVal) notFound
  -------------------------------------------------------------------------------------------------------   
  let msgRedirect msg  = setMessageI msg >> redirect (BoardNoPageR board)
      defaultName      = boardDefaultName   boardVal
      allowedTypes     = boardAllowedTypes  boardVal
      thumbSize        = boardThumbSize     boardVal
      opFile           = boardOpFile        boardVal
      forcedAnon       = boardEnableForcedAnon boardVal
      enableCaptcha    = boardEnableCaptcha boardVal
  -------------------------------------------------------------------------------------------------------       
  ((result, _),   _) <- runFormPost $ postForm True boardVal muser
  case result of
    FormFailure []                     -> msgRedirect MsgBadFormData
    FormFailure xs                     -> msgRedirect $ MsgError $ T.intercalate "; " xs
    FormMissing                        -> msgRedirect MsgNoFormData
    FormSuccess (name, title, message, captcha, pswd, files, ratings, goback, _, _)
      | isNothing title && boardRequiredThreadTitle boardVal -> msgRedirect MsgThreadTitleIsRequired
      | opFile == "Disabled"&& not (noFiles files)      -> msgRedirect MsgOpFileIsDisabled
      | opFile == "Required"&& noFiles files          -> msgRedirect MsgNoFile
      | noMessage message  && noFiles files          -> msgRedirect MsgNoFileOrText
      | not $ all (isFileAllowed allowedTypes) files  -> msgRedirect MsgTypeNotAllowed
      | otherwise                                   -> do
        -------------------------------------------------------------------------------------------------------
        setSession "message"    (maybe     "" unTextarea message)
        setSession "post-title" (fromMaybe "" title)
        -------------------------------------------------------------------------------------------------------
        ip       <- pack <$> getIp
        now      <- liftIO getCurrentTime
        country  <- getCountry ip
        posterId <- getPosterId
        pc <- lookupSession "post-count"
        -------------------------------------------------------------------------------------------------------
        checkBan (tread ip) board $ \(Left m) -> setMessageI m >> redirect (BoardNoPageR board)
        -------------------------------------------------------------------------------------------------------
        adaptiveCaptcha <- getConfig configAdaptiveCaptcha
        when (maybe True (\x -> tread x < adaptiveCaptcha) pc && enableCaptcha && isNothing muser) $ 
          checkCaptcha captcha (setMessageI MsgWrongCaptcha >> redirect (BoardNoPageR board))
        -------------------------------------------------------------------------------------------------------
        checkTooFastPosting (PostParent ==. 0) ip now $ setMessageI MsgPostingTooFast >> redirect (BoardNoPageR board)
        ------------------------------------------------------------------------------------------------------
        checkWordfilter (Textarea <$> title) board $ \(Right m) -> setMessage (toHtml m) >> redirect (BoardNoPageR board)
        checkWordfilter message board $ \(Right m) -> setMessage (toHtml m) >> redirect (BoardNoPageR board)
        ------------------------------------------------------------------------------------------------------
        globalHB <- getConfig configGlobalHellban
        when (globalHB && maybe True ((==0).tread) pc) $
          void $ runDB $ insert $ Hellban { hellbanUid = posterId, hellbanIp = "" }
        hellbannedUID <- (>0) <$> runDB (count [HellbanUid ==. posterId])
        hellbannedIP  <- (>0) <$> runDB (count [HellbanIp ==. ip])
        ------------------------------------------------------------------------------------------------------
        nextId <- maybe 1 ((+1) . postLocalId . entityVal) <$> runDB (selectFirst [PostBoard ==. board] [Desc PostLocalId])
        newMsg <- lookupSession "filtered-message"
        messageFormatted  <- doYobaMarkup (maybe message (Just . Textarea) newMsg) board 0
        AppSettings{..}   <- appSettings <$> getYesod
        let newPost = Post { postBoard        = board
                           , postLocalId      = nextId
                           , postParent       = 0
                           , postParentTitle  = ""
                           , postMessage      = messageFormatted
                           , postRawMessage   = fromMaybe (maybe "" unTextarea message) newMsg
                           , postTitle        = maybe ("" :: Text) (T.take appMaxLenOfPostTitle) title
                           , postName         = if forcedAnon then defaultName else maybe defaultName (T.take appMaxLenOfPostName) name
                           , postDate         = now
                           , postPassword     = pack $ md5sum $ B.fromString $ unpack pswd
                           , postBumped       = Just now
                           , postIp           = ip
                           , postCountry      = (\(code,name') -> GeoCountry code name') <$> country
                           , postLocked       = False
                           , postSticked      = False
                           , postAutosage     = False
                           , postDeleted      = False
                           , postDeletedByOp  = False
                           , postOwner        = userGroup . entityVal <$> muser
                           , postOwnerUser    = userName . entityVal <$> muser
                           , postHellbanned   = hellbannedUID || hellbannedIP
                           , postPosterId     = posterId
                           , postLastModified = Nothing
                           , postLockEditing  = False
                           , postDestUID      = Nothing
                           }
        postKey <- runDB (insert newPost)
        void $ insertFiles files ratings thumbSize postKey (boardOnion boardVal)
        hb <- lookupSession "hide-this-post"
        when (isJust hb) $ do
          void $ runDB $ update postKey [PostHellbanned =. True]
          deleteSession "hide-this-post"
        -- delete old threads
        let tl = boardThreadLimit boardVal
          in when (tl >= 0) $
               flip deletePosts False =<< runDB (selectList [PostBoard ==. board, PostParent ==. 0] [Desc PostBumped, OffsetBy tl])
        -------------------------------------------------------------------------------------------------------
        case name of
          Just name' -> setSession "name" name'
          Nothing    -> deleteSession "name"
        deleteSession "filtered-message"
        deleteSession "message"
        deleteSession "post-title"
        cleanBoardStats board
        unless (hellbannedUID || hellbannedIP) $ sendNewPostES board
        incPostCount
        case goback of
          ToBoard  -> setSession "goback" "ToBoard"  >> redirect (BoardNoPageR board )
          ToThread -> setSession "goback" "ToThread" >> redirect (ThreadR      board nextId)
          ToFeed   -> setSession "goback" "ToFeed"   >> trickyRedirect "ok" (Left MsgPostSent) FeedR
