95 lines
3.1 KiB
Haskell
95 lines
3.1 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Handler.Admin.Crontab
|
|
( getAdminCrontabR
|
|
) where
|
|
|
|
import Import
|
|
import Jobs
|
|
import Handler.Utils.DateTime
|
|
|
|
import qualified Data.Aeson.Encode.Pretty as Pretty
|
|
import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder')
|
|
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
|
|
|
import qualified Data.HashSet as HashSet
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
|
|
import qualified Data.UUID as UUID
|
|
|
|
|
|
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 MsgMenuAdminCrontab $ do
|
|
setTitleI MsgMenuAdminCrontab
|
|
[whamlet|
|
|
$newline never
|
|
$maybe t <- crontabBearer
|
|
<section>
|
|
<pre .token>
|
|
#{toPathPiece t}
|
|
<section>
|
|
<dl .deflist>
|
|
<dt .deflist__dt>_{MsgInstanceId}
|
|
<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 :: _ => a -> _
|
|
doEnc = encodePrettyToTextBuilder' Pretty.defConfig
|
|
{ Pretty.confIndent = Pretty.Spaces 2
|
|
, Pretty.confCompare = comparing $ \t -> ( t `elem` ["instruction", "job", "notification"]
|
|
, Text.splitOn "-" t
|
|
)
|
|
}
|