{-# 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
                #{toPathPiece t}
          
_{MsgInstanceId}
#{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 :: _ => a -> _ doEnc = encodePrettyToTextBuilder' Pretty.defConfig { Pretty.confIndent = Pretty.Spaces 2 , Pretty.confCompare = comparing $ \t -> ( t `elem` ["instruction", "job", "notification"] , Text.splitOn "-" t ) }