module Handler.Users where

import Import

import Jobs
-- import Data.Text
import Handler.Utils

import Utils.Lens

import qualified Data.CaseInsensitive as CI

import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

import Handler.Profile (makeProfileData)


hijackUserForm :: CryptoUUIDUser -> Form ()
hijackUserForm cID csrf = do
  (uidResult, uidView) <- mforced hiddenField "" (cID :: CryptoUUIDUser)
  (btnResult, btnView) <- mreq (buttonField BtnHijack) "" Nothing
  return (() <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView])

-- In case of refactoring, use this:
-- instance HasEntity (DBRow (Entity User)) User where
--    hasEntity = _dbrOutput
-- instance HasUser   (DBRow (Entity USer)) where
--    hasUser = _entityVal

getUsersR :: Handler Html
getUsersR = do
  let
    dbtColonnade = dbColonnade . mconcat $
      [ dbRow
      , sortable (Just "name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
          (AdminUserR <$> encrypt uid)
          (nameWidget userDisplayName userSurname)
      , sortable (Just "matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
          (AdminUserR <$> encrypt uid)
          (toWidget . display $ userMatrikelnummer)
--       , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
--           (AdminUserR <$> encrypt uid)
--           (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)
      , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
          schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
            E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool
            E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
            E.orderBy [E.asc $ school E.^. SchoolShorthand]
            return $ school E.^. SchoolShorthand
          return [whamlet|
            $newline never
            <ul .list--inline .list--comma-separated>
              $forall (E.Value sh) <- schools
                <li>#{sh}
            |]
      , sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
          schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userLecturer) -> do
            E.on $ school E.^. SchoolId E.==. userLecturer E.^. UserLecturerSchool
            E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
            E.orderBy [E.asc $ school E.^. SchoolShorthand]
            return $ school E.^. SchoolShorthand
          return [whamlet|
            $newline never
            <ul .list--inline .list--comma-separated>
              $forall (E.Value sh) <- schools
                <li>#{sh}
            |]
      , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity uid _ } -> cell $ do
          cID <- encrypt uid
          mayHijack <- (== Authorized) <$> evalAccess (AdminHijackUserR cID) True
          myUid <- liftHandlerT maybeAuthId
          when (mayHijack && Just uid /= myUid) $ do
            (hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm cID
            wrapForm hijackView FormSettings
              { formMethod   = POST
              , formAction   = Just . SomeRoute $ AdminHijackUserR cID
              , formEncoding = hijackEnctype
              , formAttrs    = []
              , formSubmit   = FormNoSubmit
              , formAnchor   = Nothing :: Maybe Text
              }
      ]
    psValidator = def
      & defaultSorting [SortAscBy "name", SortAscBy "display-name"]

  ((), userList) <- runDB $ do
    schoolOptions <- map (CI.original . schoolName . entityVal &&& CI.original . unSchoolKey . entityKey)
      <$> selectList [] [Asc SchoolName]

    dbTable psValidator DBTable
      { dbtSQLQuery  = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
      , dbtRowKey = (E.^. UserId)
      , dbtColonnade
      , dbtProj      = return
      , dbtSorting   = Map.fromList
          [ ( "name"
            , SortColumn $ \user -> user E.^. UserSurname
            )
          , ( "display-name"
            , SortColumn $ \user -> user E.^. UserDisplayName
            )
          , ( "matriculation"
            , SortColumn $ \user -> user E.^. UserMatrikelnummer
            )
          ]
      , dbtFilter    = Map.fromList -- OverloadedLists does not work with the templates
          [ ( "user-search", FilterColumn $ \user criterion ->
              if Set.null criterion then E.true else -- TODO: why is this condition not needed?
                  -- Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text)
                  E.any (user E.^. UserDisplayName `E.hasInfix`) criterion
            )
          , ( "matriculation", FilterColumn $ \user (criterion :: Set.Set Text) -> if
                 | Set.null criterion -> E.true -- TODO: why can this be eFalse and work still?
                 | otherwise          -> E.any (user E.^. UserMatrikelnummer `E.hasInfix`) criterion
            )
          , ( "school", FilterColumn $ \user criterion -> if
                | Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool)
                | otherwise          -> let schools = E.valList (Set.toList criterion) in
                      E.exists ( E.from $ \ulectr -> do
                        E.where_ $ ulectr E.^. UserLecturerUser    E.==. user E.^. UserId
                        E.where_ $ ulectr E.^. UserLecturerSchool `E.in_` schools
                    ) E.||.
                      E.exists ( E.from $ \uadmin -> do
                        E.where_ $ uadmin E.^. UserAdminUser       E.==. user E.^. UserId
                        E.where_ $ uadmin E.^. UserAdminSchool    `E.in_` schools
                    )
            )
          ]
      , dbtFilterUI  = \mPrev -> mconcat
          [ prismAForm (singletonFilter "user-search")    mPrev $ aopt textField  (fslI MsgName)
          -- , prismAForm (singletonFilter "matriculation" ) mPrev $ aopt textField (fslI MsgMatrikelNr)
          , prismAForm (singletonFilter "matriculation" ) mPrev $ aopt matriculationField  (fslI MsgMatrikelNr)

          , prismAForm (singletonFilter "school" )        mPrev $ aopt (lift `hoistField` selectFieldList schoolOptions) (fslI MsgCourseSchool)
          ]
      , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
      , dbtParams    = def
      , dbtIdent     = "users" :: Text
      }

  defaultLayout $ do
    setTitleI MsgUserListTitle
    $(widgetFile "users")

postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent
postAdminHijackUserR cID = do
  uid <- decrypt cID
  ((hijackRes, _), _) <- runFormPost $ hijackUserForm cID

  ret <- formResultMaybe hijackRes $ \() -> Just <$> do
    User{userIdent} <- runDB $ get404 uid
    setCredsRedirect $ Creds "dummy" (CI.original userIdent) []

  maybe (redirect UsersR) return ret


getAdminUserR, postAdminUserR :: CryptoUUIDUser -> Handler Html
getAdminUserR = postAdminUserR
postAdminUserR uuid = do
    adminId <- requireAuthId
    uid <- decrypt uuid
    let fromSchoolList = Set.fromList . map (userAdminSchool . entityVal)
    let unValueRights (school, E.Value isAdmin, E.Value isLecturer) = (school,isAdmin,isLecturer)
    (user@User{..}, fromSchoolList -> adminSchools, fmap unValueRights -> userRights) <- runDB $ (,,)
        <$> get404 uid
        <*> selectList [UserAdminUser ==. adminId] []
        <*> E.select ( E.from $ \school -> do
              E.orderBy [E.asc $ school E.^. SchoolName]
              let schAdmin    = E.exists $ E.from $ \userAdmin    -> do
                    E.where_ $ userAdmin    E.^. UserAdminSchool    E.==. school E.^. SchoolId
                    E.where_ $ userAdmin    E.^. UserAdminUser      E.==. E.val uid
              let schLecturer = E.exists $ E.from $ \userLecturer -> do
                    E.where_ $ userLecturer E.^. UserLecturerSchool E.==. school E.^. SchoolId
                    E.where_ $ userLecturer E.^. UserLecturerUser   E.==. E.val uid
              return (school,schAdmin,schLecturer)
            )
    -- above data is needed for both form generation and result evaluation
    let userRightsForm :: Form [(SchoolId, Bool, Bool)]
        userRightsForm = identifyForm FIDuserRights $ \csrf -> do
          boxRights <- forM userRights $ \(school@(Entity sid _), isAdmin, isLecturer) ->
            if Set.member sid adminSchools
              then do
                cbAdmin    <- mreq    checkBoxField "" (Just isAdmin)
                cbLecturer <- mreq    checkBoxField "" (Just isLecturer)
                return (school, cbAdmin, cbLecturer)
              else do
                cbAdmin    <- mforced checkBoxField ""       isAdmin
                cbLecturer <- mforced checkBoxField ""       isLecturer
                return (school, cbAdmin, cbLecturer)
          let result = forM boxRights $ \(Entity sid _, (resAdmin,_), (resLecturer, _)) ->
                        (,,) <$> pure sid <*> resAdmin <*> resLecturer
          return (result,$(widgetFile "widgets/user-rights-form/user-rights-form"))
    let userRightsAction changes = do
          void . runDB $
            forM changes $ \(sid, userAdmin, userLecturer) ->
              if Set.notMember sid adminSchools
                then return ()
                else do
                  if userAdmin
                    then void . insertUnique $ UserAdmin uid sid
                    else deleteBy $ UniqueUserAdmin uid sid
                  if userLecturer
                    then void . insertUnique $ UserLecturer uid sid
                    else deleteBy $ UniqueSchoolLecturer uid sid
                -- Note: deleteWhere would not work well here since we filter by adminSchools
          queueJob' . JobQueueNotification $ NotificationUserRightsUpdate uid (over _1 (schoolShorthand . entityVal) <$> userRights) -- original rights to check for difference
          addMessageI Info MsgAccessRightsSaved
    ((result, formWidget),formEnctype) <- runFormPost userRightsForm
    let form = wrapForm formWidget def
          { formAction = Just . SomeRoute $ AdminUserR uuid
          , formEncoding = formEnctype
          }
    formResult result userRightsAction
    let heading =
          [whamlet|_{MsgAccessRightsFor} ^{nameWidget userDisplayName userSurname}|]
    -- Delete Button needed in data-delete
    (btnWgt, btnEnctype) <- generateFormPost (identifyForm FIDUserDelete buttonForm :: Form ButtonDelete)
    let btnForm = wrapForm btnWgt def
          { formAction   = Just $ SomeRoute $ AdminUserDeleteR uuid
          , formEncoding = btnEnctype
          , formSubmit   = FormNoSubmit
          }
    userDataWidget <- runDB $ makeProfileData $ Entity uid user
    siteLayout heading $ do
      let deleteWidget   = $(widgetFile "widgets/data-delete/data-delete")
      $(widgetFile "adminUser")


postAdminUserDeleteR :: CryptoUUIDUser -> Handler Html
postAdminUserDeleteR uuid = do
  uid <- decrypt uuid
  ((btnResult,_), _) <- runFormPost (identifyForm FIDUserDelete buttonForm :: Form ButtonDelete)
  case btnResult of
    (FormSuccess BtnDelete) -> do
      User{..}  <- runDB $ get404 uid
      -- clearCreds False -- Logout-User
      ((deletedSubmissions,groupSubmissions),deletedSubmissionGroups) <- runDB $ deleteUser uid
      -- addMessageIHamlet
      $(addMessageFile Success "templates/deletedUser.hamlet") -- USE THIS ONE
      -- addMessageI Success $ MsgDeleteUser deletedSubmissions
      -- when (groupSubmissions > 0) $ addMessageI Info $ MsgDeleteUserGroupSubmissions groupSubmissions
      defaultLayout
        $(widgetFile "deletedUser")

    -- (FormSuccess BtnAbort ) -> do
    --   addMessageI Info MsgAborted
    --   redirect ProfileDataR
    _other -> getAdminUserR uuid



deleteUser :: UserId -> DB ((Int,Int),Int64) -- TODO: Restrict deletions for lecturers, tutors and students in course that won't allow deregistration
deleteUser duid = do
    -- E.deleteCount for submissions is not cascading, hence we first select and then delete manually
    -- We delete all files tied to submissions where the user is the lone submissionUser

    -- Do not deleteCascade submissions where duid is the corrector:
    updateWhere [SubmissionRatingBy ==. Just duid] [SubmissionRatingBy =. Nothing]

    groupSubmissions  <- selectSubmissionsWhere (\numBuddies -> numBuddies E.>.  E.val (0::Int64))
    singleSubmissions <- selectSubmissionsWhere (\numBuddies -> numBuddies E.==. E.val (0::Int64))
    deleteCascade duid
    forM_ singleSubmissions $ \(E.Value submissionId) -> do
      deleteFileIds  <- map E.unValue <$> getSubmissionFiles submissionId
      deleteCascade submissionId
      deleteCascadeWhere [FileId <-. deleteFileIds] -- TODO: throws exception for de-duplicated files

    deletedSubmissionGroups <- deleteSingleSubmissionGroups
    return ((length singleSubmissions, length groupSubmissions),deletedSubmissionGroups)
  where
    selectSubmissionsWhere :: (E.SqlExpr (E.Value Int64) -> E.SqlExpr (E.Value Bool)) -> DB [E.Value (Key Submission)]
    selectSubmissionsWhere whereBuddies = E.select $ E.from $ \(submission `E.InnerJoin` suser) -> do
        E.on $ submission E.^. SubmissionId E.==. suser E.^. SubmissionUserSubmission
        let numBuddies = E.sub_select $ E.from $ \subUsers -> do
                E.where_ $ subUsers E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
                    E.&&.  subUsers E.^. SubmissionUserUser E.!=. E.val duid
                return E.countRows
        E.where_ $ suser E.^. SubmissionUserUser E.==. E.val duid
             E.&&. whereBuddies numBuddies
        return $ submission E.^. SubmissionId

    getSubmissionFiles :: SubmissionId ->  DB [E.Value (Key File)]
    getSubmissionFiles subId = E.select $ E.from $ \file -> do
      E.where_ $ E.exists $ E.from $ \submissionFile ->
          E.where_ $ submissionFile E.^. SubmissionFileSubmission E.==. E.val subId
              E.&&.  submissionFile E.^. SubmissionFileFile E.==. file E.^. FileId
      return $ file E.^. FileId

    deleteSingleSubmissionGroups = E.deleteCount $ E.from $ \submissionGroup -> do
      E.where_ $ E.exists $ E.from $ \subGroupUser ->
          E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
               E.&&. subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
      E.where_ $ E.notExists $ E.from $ \subGroupUser ->
          E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
               E.&&. subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid