{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}

module Handler.Users where

import Import
-- import Data.Text
import Handler.Utils

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

import qualified Database.Esqueleto as E


hijackUserForm :: UserId -> Form UserId
hijackUserForm uid csrf = do
  cID <- encrypt uid
  (uidResult, uidView) <- mforced hiddenField "" (cID :: CryptoUUIDUser)
  (btnResult, btnView) <- mreq (buttonField BtnHijack) "" Nothing 

  return (uid <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView])

getUsersR :: Handler Html
getUsersR = do
  let
    colonnadeUsers = dbColonnade . mconcat $
      [ dbRow
      , sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
          (AdminUserR <$> encrypt uid)
          (toWidget . display $ userDisplayName)
      , 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 _ } -> mempty
          { dbCellContents = do
              schools <- 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|
                  <ul .list--inline .list--comma-separated>
                    $forall (E.Value sh) <- schools
                      <li>#{sh}
                |]
          }
      , sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
          { dbCellContents = do
              schools <- 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|
                  <ul .list--inline .list--comma-separated>
                    $forall (E.Value sh) <- schools
                      <li>#{sh}
                |]
          }
      , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity uid _ } -> cell $ do
          (hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm uid
          cID <- encrypt uid
          [whamlet|
            <form method=POST action=@{AdminHijackUserR cID} enctype=#{hijackEnctype}>
              ^{hijackView}
          |]
      ]
    psValidator = def
      & defaultSorting [("display-name", SortAsc)]
  
  userList <- dbTable psValidator $ DBTable
    { dbtSQLQuery  = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
    , dbtColonnade = colonnadeUsers
    , dbtProj      = return
    , dbtSorting   = Map.fromList
        [ ( "display-name"
          , SortColumn $ \user -> user E.^. UserDisplayName
          )
        , ( "matriculation"
          , SortColumn $ \user -> user E.^. UserMatrikelnummer
          )
--         , ( "last-name"
--           , SortColumn $ \user -> (last . impureNonNull . words) <$> (user E.^. UserDisplayName)
--           )
        ]
    , dbtFilter    = mempty
    , dbtStyle     = def
    , dbtIdent     = "users" :: Text
    }
  
  defaultLayout $ do
    setTitleI MsgUserListTitle
    $(widgetFile "users")

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

  case hijackRes of
    FormSuccess uid'
      | uid' == uid -> do
          myUid <- requireAuthId
          User{..} <- runDB $ do
            otherSchoolsAdmin <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] []
            otherSchoolsLecturer <- Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] []
            mySchools <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. myUid] []
            when (not $ (otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) $
              permissionDenied "Cannot escalate admin status to additional schools"

            get404 uid
          setCredsRedirect $ Creds "dummy" (userPlugin <> ":" <> userIdent) []
      | otherwise -> error "This should be impossible by definition of `hijackUserForm`"
    FormFailure errs -> toTypedContent <$> mapM_ (addMessage "error" . toHtml) errs
    FormMissing -> return $ toTypedContent ()