fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

feat(workflows): restrict all (except admin) workflow lists on non-archived

Browse Source
This commit is contained in:
Sarah Vaupel 2022-05-13 22:31:59 +02:00 committed by Sarah Vaupel
parent 465a92b982
commit 97723ad895
1 changed files with 31 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/Handler/Workflow/Workflow/List.hs
View File

@ -55,21 +55,33 @@ instance Default WorkflowWorkflowListFilterProj where
, wwProjFilterFinal = Nothing
}
makeLenses_ ''WorkflowWorkflowListFilterProj
makeLenses_ ''WorkflowWorkflowListFilterProj
restrictOnArchived :: E.SqlExpr (Entity WorkflowWorkflow) -> UTCTime -> Maybe Bool -> E.SqlExpr (E.Value Bool)
restrictOnArchived workflowWorkflow now = maybe E.true $ \archived -> E.maybe
(E.val $ not archived)
(\archivedOn -> if archived then archivedOn E.<=. E.val now else E.val now E.<. archivedOn)
(workflowWorkflow E.^. WorkflowWorkflowArchived)
getGlobalWorkflowWorkflowListR :: Handler Html
getGlobalWorkflowWorkflowListR = workflowWorkflowListR WSGlobal
getGlobalWorkflowWorkflowListR = workflowWorkflowListR (Just False) WSGlobal
getSchoolWorkflowWorkflowListR :: SchoolId -> Handler Html
getSchoolWorkflowWorkflowListR = workflowWorkflowListR . WSSchool
getSchoolWorkflowWorkflowListR = workflowWorkflowListR (Just False) . WSSchool
workflowWorkflowListR :: RouteWorkflowScope -> Handler Html
workflowWorkflowListR rScope = workflowsDisabledWarning (headings ^. _1) (headings ^. _2) $ do
workflowWorkflowListR :: Maybe Bool -- ^ archived/non-archived workflows only?
-> RouteWorkflowScope
-> Handler Html
workflowWorkflowListR mArchived rScope = workflowsDisabledWarning (headings ^. _1) (headings ^. _2) $ do
now <- liftIO getCurrentTime
scope <- runDB . maybeT notFound $ fromRouteWorkflowScope rScope
workflowWorkflowList headings columns . runReader $ do
workflowWorkflow <- view queryWorkflowWorkflow
return $ workflowWorkflow E.^. WorkflowWorkflowScope E.==. E.val (scope ^. _DBWorkflowScope)
return $
workflowWorkflow E.^. WorkflowWorkflowScope E.==. E.val (scope ^. _DBWorkflowScope)
E.&&. restrictOnArchived workflowWorkflow now mArchived
where
columns = def
{ wwListColumnScope = False
@ -78,13 +90,17 @@ workflowWorkflowListR rScope = workflowsDisabledWarning (headings ^. _1) (headin
getGWIWorkflowsR :: WorkflowInstanceName -> Handler Html
getGWIWorkflowsR = workflowInstanceWorkflowsR WSGlobal
getGWIWorkflowsR = workflowInstanceWorkflowsR (Just False) WSGlobal
getSWIWorkflowsR :: SchoolId -> WorkflowInstanceName -> Handler Html
getSWIWorkflowsR ssh = workflowInstanceWorkflowsR $ WSSchool ssh
getSWIWorkflowsR ssh = workflowInstanceWorkflowsR (Just False) $ WSSchool ssh
workflowInstanceWorkflowsR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler Html
workflowInstanceWorkflowsR rScope win = workflowsDisabledWarning (MsgWorkflowWorkflowListNamedInstanceTitleDisabled rScope) (MsgWorkflowWorkflowListNamedInstanceHeadingDisabled rScope) $ do
workflowInstanceWorkflowsR :: Maybe Bool -- ^ archived/non-archived workflows only?
-> RouteWorkflowScope
-> WorkflowInstanceName
-> Handler Html
workflowInstanceWorkflowsR mArchived rScope win = workflowsDisabledWarning (MsgWorkflowWorkflowListNamedInstanceTitleDisabled rScope) (MsgWorkflowWorkflowListNamedInstanceHeadingDisabled rScope) $ do
now <- liftIO getCurrentTime
(scope, desc) <- runDB $ do
scope <- maybeT notFound $ fromRouteWorkflowScope rScope
wiId <- getKeyBy404 . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope
@ -102,6 +118,7 @@ workflowInstanceWorkflowsR rScope win = workflowsDisabledWarning (MsgWorkflowWor
E.where_ $ workflowInstance E.^. WorkflowInstanceName E.==. E.val win
E.&&. workflowInstance E.^. WorkflowInstanceScope E.==. E.val (scope ^. _DBWorkflowScope)
E.&&. workflowWorkflow E.^. WorkflowWorkflowInstance E.==. E.just (workflowInstance E.^. WorkflowInstanceId)
E.&&. restrictOnArchived workflowWorkflow now mArchived
where
columns = def
{ wwListColumnInstance = False
@ -110,11 +127,13 @@ workflowInstanceWorkflowsR rScope win = workflowsDisabledWarning (MsgWorkflowWor
getAdminWorkflowWorkflowListR :: Handler Html
getAdminWorkflowWorkflowListR = workflowWorkflowList headings def $ const E.true
getAdminWorkflowWorkflowListR = workflowWorkflowList headings def $ const E.true -- archived workflows included
where headings = (MsgAdminWorkflowWorkflowListTitle, MsgAdminWorkflowWorkflowListHeading)
getTopWorkflowWorkflowListR :: Handler Html
getTopWorkflowWorkflowListR = workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ isTopWorkflowScopeSql . (E.^. WorkflowWorkflowScope)
getTopWorkflowWorkflowListR = do
now <- liftIO getCurrentTime
workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ \workflowWorkflow -> isTopWorkflowScopeSql (workflowWorkflow E.^. WorkflowWorkflowScope) E.&&. restrictOnArchived workflowWorkflow now (Just False)
where headings = (MsgWorkflowWorkflowListTopTitle, MsgWorkflowWorkflowListTopHeading)