-- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Winnie Ros -- -- 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.Map as Map import qualified Data.HashSet as HashSet import qualified Data.HashMap.Strict as HashMap import qualified Data.UUID as UUID import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E -- import Database.Esqueleto.Utils.TH 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
                #{toPathPiece t}
          
_{MsgAdminInstanceId}
#{UUID.toText instanceId}
$maybe (genTime, crontab) <- mCrontab

^{formatTimeW SelFormatDateTime genTime} $forall (job, lExec, match) <- crontab
$case match $of MatchAsap _{MsgCronMatchAsap} $of MatchNone _{MsgCronMatchNone} $of MatchAt t ^{formatTimeW SelFormatDateTime t} $maybe lT <- lExec ^{formatTimeW SelFormatDateTime lT} #{doEnc job} $nothing

_{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 ) } getAdminJobsR, postAdminJobsR :: Handler Html getAdminJobsR = postAdminJobsR postAdminJobsR = do let jobsDBTable = DBTable{..} where resultJob :: Lens' (DBRow (Entity QueuedJob)) (Entity QueuedJob) resultJob = _dbrOutput dbtSQLQuery = return dbtRowKey = (E.^. QueuedJobId) dbtProj = dbtProjId dbtColonnade = dbColonnade $ mconcat -- remove call to dbColonnade if table actions are added [ 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 } dbtParams = def dbtIdent :: Text dbtIdent = "queued-jobs" dbtCsvEncode = noCsvEncode dbtCsvDecode = Nothing dbtExtraReps = [] jobsDBTableValidator = def & defaultSorting [SortDescBy "creation-time"] ((), jobsTable) <- runDB $ dbTable jobsDBTableValidator jobsDBTable siteLayoutMsg MsgMenuAdminJobs $ do setTitleI MsgMenuAdminJobs [whamlet| ^{jobsTable} |] 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