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): implement archive routes

Browse Source
This commit is contained in:
Sarah Vaupel 2022-05-13 23:20:33 +02:00 committed by Sarah Vaupel
parent 97723ad895
commit 441609436a
2 changed files with 43 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
routes
View File

@ -76,20 +76,23 @@
/global-workflows/instances GlobalWorkflowInstanceListR GET !free /global-workflows/instances GlobalWorkflowInstanceListR GET !free
/global-workflows/instances/new GlobalWorkflowInstanceNewR GET POST /global-workflows/instances/new GlobalWorkflowInstanceNewR GET POST
/global-workflows/instances/#WorkflowInstanceName GlobalWorkflowInstanceR: /global-workflows/instances/#WorkflowInstanceName GlobalWorkflowInstanceR:
/edit GWIEditR GET POST /edit GWIEditR GET POST
/delete GWIDeleteR GET POST /delete GWIDeleteR GET POST
/workflows GWIWorkflowsR GET !free /workflows GWIWorkflowsR GET !free
/initiate GWIInitiateR GET POST !workflow /workflows-archive GWIWorkflowsArchiveR GET !free
/update GWIUpdateR POST /initiate GWIInitiateR GET POST !workflow
/global-workflows GlobalWorkflowWorkflowListR GET !free /update GWIUpdateR POST
/global-workflows GlobalWorkflowWorkflowListR GET !free
/global-workflows-archive GlobalWorkflowWorkflowArchiveR GET !free
!/global-workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR: !/global-workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR:
/ GWWWorkflowR GET POST !workflow / GWWWorkflowR GET POST !workflow
/files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex GWWFilesR GET !workflow /files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex GWWFilesR GET !workflow
/edit GWWEditR GET POST /edit GWWEditR GET POST
/delete GWWDeleteR GET POST /delete GWWDeleteR GET POST
/workflow-instances TopWorkflowInstanceListR GET !free /workflow-instances TopWorkflowInstanceListR GET !free
/workflows TopWorkflowWorkflowListR GET !free /workflows TopWorkflowWorkflowListR GET !free
/workflows-archive TopWorkflowWorkflowArchiveR GET !free
/health HealthR GET !free /health HealthR GET !free
/instance InstanceR GET !free /instance InstanceR GET !free
@ -143,12 +146,14 @@
/workflows/instances SchoolWorkflowInstanceListR GET !free /workflows/instances SchoolWorkflowInstanceListR GET !free
/workflows/instances/new SchoolWorkflowInstanceNewR GET POST /workflows/instances/new SchoolWorkflowInstanceNewR GET POST
/workflows/instances/#WorkflowInstanceName SchoolWorkflowInstanceR: /workflows/instances/#WorkflowInstanceName SchoolWorkflowInstanceR:
/edit SWIEditR GET POST /edit SWIEditR GET POST
/delete SWIDeleteR GET POST /delete SWIDeleteR GET POST
/workflows SWIWorkflowsR GET !free /workflows SWIWorkflowsR GET !free
/initiate SWIInitiateR GET POST !workflow /workflows-archive SWIWorkflowsArchiveR GET !free
/update SWIUpdateR POST /initiate SWIInitiateR GET POST !workflow
/workflows SchoolWorkflowWorkflowListR GET !free /update SWIUpdateR POST
/workflows SchoolWorkflowWorkflowListR GET !free
/workflows-archive SchoolWorkflowWorkflowArchiveR GET !free
!/workflows/#CryptoFileNameWorkflowWorkflow SchoolWorkflowWorkflowR: !/workflows/#CryptoFileNameWorkflowWorkflow SchoolWorkflowWorkflowR:
/ SWWWorkflowR GET POST !workflow / SWWWorkflowR GET POST !workflow
/files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex SWWFilesR GET !workflow /files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex SWWFilesR GET !workflow

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

@ -1,14 +1,14 @@
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Handler.Workflow.Workflow.List module Handler.Workflow.Workflow.List
( getGlobalWorkflowWorkflowListR ( getGlobalWorkflowWorkflowListR, getGlobalWorkflowWorkflowArchiveR
, getSchoolWorkflowWorkflowListR , getSchoolWorkflowWorkflowListR, getSchoolWorkflowWorkflowArchiveR
, workflowWorkflowListR , workflowWorkflowListR
, getGWIWorkflowsR , getGWIWorkflowsR, getGWIWorkflowsArchiveR
, getSWIWorkflowsR , getSWIWorkflowsR, getSWIWorkflowsArchiveR
, workflowInstanceWorkflowsR , workflowInstanceWorkflowsR
, getAdminWorkflowWorkflowListR , getAdminWorkflowWorkflowListR
, getTopWorkflowWorkflowListR , getTopWorkflowWorkflowListR, getTopWorkflowWorkflowArchiveR
) where ) where
import Import hiding (Last(..), WriterT) import Import hiding (Last(..), WriterT)
@ -65,11 +65,13 @@ restrictOnArchived workflowWorkflow now = maybe E.true $ \archived -> E.maybe
(workflowWorkflow E.^. WorkflowWorkflowArchived) (workflowWorkflow E.^. WorkflowWorkflowArchived)
getGlobalWorkflowWorkflowListR :: Handler Html getGlobalWorkflowWorkflowListR, getGlobalWorkflowWorkflowArchiveR :: Handler Html
getGlobalWorkflowWorkflowListR = workflowWorkflowListR (Just False) WSGlobal getGlobalWorkflowWorkflowListR = workflowWorkflowListR (Just False) WSGlobal
getGlobalWorkflowWorkflowArchiveR = workflowWorkflowListR (Just True ) WSGlobal
getSchoolWorkflowWorkflowListR :: SchoolId -> Handler Html getSchoolWorkflowWorkflowListR, getSchoolWorkflowWorkflowArchiveR :: SchoolId -> Handler Html
getSchoolWorkflowWorkflowListR = workflowWorkflowListR (Just False) . WSSchool getSchoolWorkflowWorkflowListR = workflowWorkflowListR (Just False) . WSSchool
getSchoolWorkflowWorkflowArchiveR = workflowWorkflowListR (Just True ) . WSSchool
workflowWorkflowListR :: Maybe Bool -- ^ archived/non-archived workflows only? workflowWorkflowListR :: Maybe Bool -- ^ archived/non-archived workflows only?
-> RouteWorkflowScope -> RouteWorkflowScope
@ -89,11 +91,13 @@ workflowWorkflowListR mArchived rScope = workflowsDisabledWarning (headings ^. _
headings = (MsgWorkflowWorkflowListScopeTitle rScope, MsgWorkflowWorkflowListScopeHeading rScope) headings = (MsgWorkflowWorkflowListScopeTitle rScope, MsgWorkflowWorkflowListScopeHeading rScope)
getGWIWorkflowsR :: WorkflowInstanceName -> Handler Html getGWIWorkflowsR, getGWIWorkflowsArchiveR :: WorkflowInstanceName -> Handler Html
getGWIWorkflowsR = workflowInstanceWorkflowsR (Just False) WSGlobal getGWIWorkflowsR = workflowInstanceWorkflowsR (Just False) WSGlobal
getGWIWorkflowsArchiveR = workflowInstanceWorkflowsR (Just True ) WSGlobal
getSWIWorkflowsR :: SchoolId -> WorkflowInstanceName -> Handler Html getSWIWorkflowsR, getSWIWorkflowsArchiveR :: SchoolId -> WorkflowInstanceName -> Handler Html
getSWIWorkflowsR ssh = workflowInstanceWorkflowsR (Just False) $ WSSchool ssh getSWIWorkflowsR = workflowInstanceWorkflowsR (Just False) . WSSchool
getSWIWorkflowsArchiveR = workflowInstanceWorkflowsR (Just True ) . WSSchool
workflowInstanceWorkflowsR :: Maybe Bool -- ^ archived/non-archived workflows only? workflowInstanceWorkflowsR :: Maybe Bool -- ^ archived/non-archived workflows only?
-> RouteWorkflowScope -> RouteWorkflowScope
@ -130,10 +134,14 @@ getAdminWorkflowWorkflowListR :: Handler Html
getAdminWorkflowWorkflowListR = workflowWorkflowList headings def $ const E.true -- archived workflows included getAdminWorkflowWorkflowListR = workflowWorkflowList headings def $ const E.true -- archived workflows included
where headings = (MsgAdminWorkflowWorkflowListTitle, MsgAdminWorkflowWorkflowListHeading) where headings = (MsgAdminWorkflowWorkflowListTitle, MsgAdminWorkflowWorkflowListHeading)
getTopWorkflowWorkflowListR :: Handler Html getTopWorkflowWorkflowListR, getTopWorkflowWorkflowArchiveR :: Handler Html
getTopWorkflowWorkflowListR = do getTopWorkflowWorkflowListR = topWorkflowWorkflowListR (Just False)
getTopWorkflowWorkflowArchiveR = topWorkflowWorkflowListR (Just True)
topWorkflowWorkflowListR :: Maybe Bool -> Handler Html
topWorkflowWorkflowListR mArchived = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ \workflowWorkflow -> isTopWorkflowScopeSql (workflowWorkflow E.^. WorkflowWorkflowScope) E.&&. restrictOnArchived workflowWorkflow now (Just False) workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ \workflowWorkflow -> isTopWorkflowScopeSql (workflowWorkflow E.^. WorkflowWorkflowScope) E.&&. restrictOnArchived workflowWorkflow now mArchived
where headings = (MsgWorkflowWorkflowListTopTitle, MsgWorkflowWorkflowListTopHeading) where headings = (MsgWorkflowWorkflowListTopTitle, MsgWorkflowWorkflowListTopHeading)