fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: don't redirect monitoring routes & crontab tokens

Browse Source
This commit is contained in:
Gregor Kleen 2020-12-09 15:33:54 +01:00
parent c5ee5b26d5
commit 3a106d1ee5
3 changed files with 47 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Foundation/Yesod/Middleware.hs
View File

@ -138,6 +138,13 @@ yesodMiddleware = cacheControlMiddleware . storeBearerMiddleware . csrfMiddlewar
normalizeApprootMiddleware :: HandlerFor UniWorX a -> HandlerFor UniWorX a
normalizeApprootMiddleware handler = maybeT handler $ do
route <- MaybeT getCurrentRoute
case route of
MetricsR -> mzero
HealthR -> mzero
InstanceR -> mzero
_other -> return ()
reqHost <- MaybeT $ W.requestHeaderHost <$> waiRequest
let rApproot = authoritiveApproot route
app <- getYesod

59
src/Handler/Admin/Crontab.hs
View File

@ -14,6 +14,9 @@ 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
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 1
@ -30,33 +33,45 @@ getAdminCrontabR = do
let mCrontab = mCrontab' <&> _2 %~ filter (hasn't $ _3 . _MatchNone)
selectRep $ do
provideRep $
provideRep $ do
crontabBearer <- runMaybeT . hoist runDB $ do
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 (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>
<pre>
$maybe t <- crontabBearer
<section>
<pre .token>
#{toPathPiece t}
<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
_{MsgAdminCrontabNotGenerated}
$nothing
<p .explanation>
_{MsgAdminCrontabNotGenerated}
|]
provideJson mCrontab'
provideRep . return . Text.Builder.toLazyText $ doEnc mCrontab'

4
src/Model/Types/Security.hs
View File

@ -245,16 +245,18 @@ predDNFEntail = over _dnfTerms $ ofoldl' entail Set.empty
data UserGroupName
= UserGroupMetrics
= UserGroupMetrics | UserGroupCrontab
| UserGroupCustom { userGroupCustomName :: CI Text }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriving anyclass (Hashable)
instance PathPiece UserGroupName where
toPathPiece UserGroupMetrics = "metrics"
toPathPiece UserGroupCrontab = "crontab"
toPathPiece (UserGroupCustom t) = CI.original t
fromPathPiece t = Just $ if
| "metrics" `ciEq` t -> UserGroupMetrics
| "crontab" `ciEq` t -> UserGroupCrontab
| otherwise -> UserGroupCustom $ CI.mk t
where
ciEq :: Text -> Text -> Bool