-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.Admin.Crontab
  ( getAdminCrontabR
  , getAdminJobsR
  , postAdminJobsR
  ) where

import Import
import Jobs
import Handler.Utils

-- import Data.Aeson (fromJSON)
-- import qualified Data.Aeson as Aeson
-- import qualified Data.Aeson.Types as Aeson
import qualified Data.Aeson.Encode.Pretty as Pretty

-- import qualified Data.CaseInsensitive as CI
import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as Text.Builder

import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HashMap

import qualified Data.UUID as UUID

import Database.Persist.Sql (deleteWhereCount)
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
-- import Database.Esqueleto.Utils.TH

-- Number of minutes a job must have been locked already to allow forced deletion
jobDeleteLockMinutes :: Int
jobDeleteLockMinutes = 3

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  } ''CronNextMatch


getAdminCrontabR :: Handler TypedContent
getAdminCrontabR = do
  jState <- getsYesod appJobState
  mCrontab' <- atomically . runMaybeT $ do
    JobState{jobCurrentCrontab} <- MaybeT $ tryReadTMVar jState
    MaybeT $ readTVar jobCurrentCrontab

  let mCrontab = mCrontab' <&> _2 %~ filter (hasn't $ _3 . _MatchNone)

  instanceId <- getsYesod appInstanceID

  selectRep $ do
    provideRep $ do
      crontabBearer <- runMaybeT . hoist runDB $ do
        guardM $ hasGlobalGetParam GetGenerateToken
        uid <- MaybeT maybeAuthId
        guardM . lift . existsBy $ UniqueUserGroupMember UserGroupCrontab uid

        encodeBearer =<< bearerToken (HashSet.singleton . Left $ toJSON UserGroupCrontab) Nothing (HashMap.singleton BearerTokenRouteEval $ HashSet.singleton AdminCrontabR) Nothing (Just Nothing) Nothing


      siteLayoutMsg MsgHeadingAdminCrontab $ do
        setTitleI MsgHeadingAdminCrontab
        [whamlet|
          $newline never
          $maybe t <- crontabBearer
            <section>
              <pre .token>
                #{toPathPiece t}
          <section>
            <dl .deflist>
              <dt .deflist__dt>_{MsgAdminInstanceId}
              <dd .deflist__dd .uuid>#{UUID.toText instanceId}
          <section>
            $maybe (genTime, crontab) <- mCrontab
              <p>
                ^{formatTimeW SelFormatDateTime genTime}
              <table .table .table--striped .table--hover>
                $forall (job, lExec, match) <- crontab
                  <tr .table__row>
                    <td .table__td>
                      $case match
                        $of MatchAsap
                          _{MsgCronMatchAsap}
                        $of MatchNone
                          _{MsgCronMatchNone}
                        $of MatchAt t
                          ^{formatTimeW SelFormatDateTime t}
                    <td .table__td>
                      $maybe lT <- lExec
                        ^{formatTimeW SelFormatDateTime lT}
                    <td .table__td .json>
                      #{doEnc job}
            $nothing
              <p .explanation>
                _{MsgAdminCrontabNotGenerated}
        |]
    provideJson mCrontab'
    provideRep . return . Text.Builder.toLazyText $ doEnc mCrontab'
  where
    doEnc :: ToJSON a => a -> _
    doEnc = Pretty.encodePrettyToTextBuilder' Pretty.defConfig
      { Pretty.confIndent = Pretty.Spaces 2
      , Pretty.confCompare = comparing $ \t -> ( t `elem` ["instruction", "job", "notification"]
                                               , Text.splitOn "-" t
                                               )
      }


data JobTableAction = ActJobDelete
                    | ActJobSleep
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

instance Universe JobTableAction
instance Finite JobTableAction
nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''JobTableAction id

data JobTableActionData
  = ActJobDeleteData { jobDeleteLocked :: Bool }
  | ActJobSleepData  { jobSleepNr, jobSleepSecs :: Int
                     , jobSleepNow :: Bool }
  deriving (Eq, Ord, Read, Show, Generic)


getAdminJobsR, postAdminJobsR :: Handler Html
getAdminJobsR = postAdminJobsR
postAdminJobsR = do
  let
    jobsDBTable = DBTable{..}
      where
        resultJob :: Lens' (DBRow (Entity QueuedJob)) (Entity QueuedJob)
        resultJob = _dbrOutput

        dbtIdent :: Text
        dbtIdent = "queued-jobs"

        dbtSQLQuery = return
        dbtRowKey = (E.^. QueuedJobId)
        dbtProj = dbtProjId
        dbtColonnade = mconcat
          [ dbSelect (applying _2) id (return . view (resultJob . _entityKey))
          , sortable (Just "job")               (i18nCell MsgTableJob)                  $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe textCell $ getJobName queuedJobContent
          , sortable (Just "creation-time")     (i18nCell MsgTableCreationTime)         $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> dateTimeCell queuedJobCreationTime
          , sortable (Just "content")           (i18nCell MsgTableJobContent)           $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cell [whamlet|#{doEnc queuedJobContent}|] & addCellClass ("json"::Text)
          , sortable (Just "lock-time")         (i18nCell MsgTableJobLockTime)          $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe dateTimeCell queuedJobLockTime
          , sortable (Just "lock-instance")     (i18nCell MsgTableJobLockInstance)      $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe (stringCell . show) queuedJobLockInstance
          , sortable (Just "creation-instance") (i18nCell MsgTableJobCreationInstance)  $ \(view $ resultJob . _entityVal -> QueuedJob{..}) ->            stringCell $ show  queuedJobCreationInstance
          ]
        dbtSorting = Map.fromList
          [ ("creation-time"    , SortColumnNullsInv (E.^. QueuedJobCreationTime))
          , ("job"              , SortColumn         (\v -> v E.^. QueuedJobContent E.->>. "job"))
          , ("content"          , SortColumn         (E.^. QueuedJobContent))
          , ("lock-time"        , SortColumnNullsInv (E.^. QueuedJobLockTime))
          , ("lock-instance"    , SortColumn         (E.^. QueuedJobLockInstance))
          , ("creation-instance", SortColumn         (E.^. QueuedJobCreationInstance))
          ]
        dbtFilter = Map.fromList
          [
            ("job", FilterColumn $ E.mkContainsFilter (\v -> v E.^. QueuedJobContent E.->>. "job"))
          ]
        dbtFilterUI = \mPrev -> mconcat
          [
            prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob)
          ]
        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }

        areq_posIntF msg = areq (posIntFieldI $ SomeMessages " " [SomeMessage msg, SomeMessage MsgMustBePositive]) (fslI msg)
        acts :: Map JobTableAction (AForm Handler JobTableActionData)
        acts = Map.fromList
          [ (ActJobDelete, ActJobDeleteData
              <$> areq checkBoxField (fslI $ MsgActJobDeleteForce jobDeleteLockMinutes) Nothing
          ),(ActJobSleep,  ActJobSleepData
              <$> areq_posIntF             MsgJobSleepNr    (Just    1)
              <*> areq_posIntF             MsgJobSleepSecs  (Just   60)
              <*> areq checkBoxField (fslI MsgJobSleepNow)  (Just True)
          )]

        dbtParams = DBParamsForm
          { dbParamsFormAdditional =
            renderAForm FormStandard
               $  (, mempty) . First . Just
              <$> multiActionA acts (fslI MsgTableAction) Nothing
          , dbParamsFormMethod    = POST
          , dbParamsFormAction    = Nothing -- Just $ SomeRoute currentRoute
          , dbParamsFormAttrs     = []
          , dbParamsFormSubmit    = FormSubmit
          , dbParamsFormEvaluate  = liftHandler . runFormPost
          , dbParamsFormResult    = id
          , dbParamsFormIdent     = def
          }
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []
    -- jobsDBTableValidator :: PSValidator (MForm Handler) (FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))))
    jobsDBTableValidator = def
      & defaultSorting [SortDescBy "creation-time"]
    postprocess :: FormResult (First JobTableActionData, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob)))
                -> FormResult (JobTableActionData, Set QueuedJobId)
    postprocess inp = do
      (First (Just act), jobMap) <- inp
      let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
      return (act, jobSet)
  (jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable)

  formResult jobActRes $ \case
    (ActJobDeleteData{jobDeleteLocked}, jobIds) -> do
      now <- liftIO getCurrentTime
      let cutoff :: UTCTime
          cutoff = addUTCTime (nominalMinute * fromIntegral (negate jobDeleteLockMinutes)) now
          jobReq    = length jobIds
          lockCriteria
            | jobDeleteLocked =
                [ QueuedJobLockTime ==. Nothing ] ||.
                [ QueuedJobLockTime <=. Just cutoff ]
            | otherwise =
                [ QueuedJobLockTime     ==. Nothing
                , QueuedJobLockInstance ==. Nothing
                ]
      rmvd <- runDB $ fromIntegral <$> deleteWhereCount
        ((QueuedJobId <-. Set.toList jobIds) : lockCriteria)

      addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
      reloadKeepGetParams AdminJobsR

    (ActJobSleepData{..}, _) -> do
      let jSleep   = JobSleep jobSleepSecs
          enqSleep = bool (void . queueJob) queueJob' jobSleepNow jSleep
      replicateM_ jobSleepNr enqSleep
      addMessageI Success (MsgTableJobActSleepFeedback jobSleepNr jobSleepSecs jobSleepNow)
      reloadKeepGetParams AdminJobsR

  -- gather some data on job worles
  (nrWorkers, jobStateVar) <- getsYesod (view _appJobWorkers &&& appJobState)
  jState <- atomically $ tryReadTMVar jobStateVar
  let running = Map.size . jobWorkers <$> jState

  siteLayoutMsg MsgMenuAdminJobs $ do
    setTitleI MsgMenuAdminJobs
    [whamlet|
      <section>
        ^{jobsTable}
      <section>
        <ul>
          <li> #{running} job workers currently running
          <li> #{nrWorkers} job workers configured to run
    |]
  where
    doEnc :: ToJSON a => a -> _
    doEnc = Pretty.encodePrettyToTextBuilder' Pretty.defConfig
      { Pretty.confIndent = Pretty.Spaces 2
      , Pretty.confCompare = comparing $ \t -> ( t `elem` ["job", "notification"]
                                               , Text.splitOn "-" t
                                               )
      }

    getJobName :: Value -> Maybe Text
    getJobName (Object o)
      | Just (String s) <- HashMap.lookup "job" o = Just s --  (kebabToCamel s)
    getJobName _ = Nothing