From 088c2f5c751e868dbe50b7fdc04fc9f3f0206966 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 13 May 2022 20:22:25 +0200 Subject: [PATCH 01/21] feat(workflows): add archived timestamp --- models/workflows.model | 1 + src/Handler/Workflow/Instance/Initiate.hs | 5 +++-- src/Utils/Workflow.hs | 2 ++ 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/models/workflows.model b/models/workflows.model index d20d4e040..7156044fe 100644 --- a/models/workflows.model +++ b/models/workflows.model @@ -50,4 +50,5 @@ WorkflowWorkflow scope (WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey) -- TermId, SchoolId, CourseId graph SharedWorkflowGraphId state (WorkflowState FileReference SqlBackendKey) -- UserId + archived UTCTime Maybe deriving Generic diff --git a/src/Handler/Workflow/Instance/Initiate.hs b/src/Handler/Workflow/Instance/Initiate.hs index d0046ae91..f2ba34873 100644 --- a/src/Handler/Workflow/Instance/Initiate.hs +++ b/src/Handler/Workflow/Instance/Initiate.hs @@ -48,9 +48,10 @@ workflowInstanceInitiateR rScope win = workflowsDisabledWarning MsgWorkflowInsta wwId <- insert WorkflowWorkflow { workflowWorkflowInstance = Just wiId - , workflowWorkflowScope = workflowInstanceScope - , workflowWorkflowGraph = workflowInstanceGraph + , workflowWorkflowScope = workflowInstanceScope + , workflowWorkflowGraph = workflowInstanceGraph , workflowWorkflowState + , workflowWorkflowArchived = Nothing -- FIXME: set to now + 2 months if current state is final state } return . Just $ do diff --git a/src/Utils/Workflow.hs b/src/Utils/Workflow.hs index 9fe28aab5..89cc8a21f 100644 --- a/src/Utils/Workflow.hs +++ b/src/Utils/Workflow.hs @@ -200,12 +200,14 @@ getWorkflowWorkflowState' wwId Nothing = withReaderT (projectBackend @SqlBackend , workflowWorkflow E.^. WorkflowWorkflowScope , workflowWorkflow E.^. WorkflowWorkflowGraph , E.veryUnsafeCoerceSqlExprValue $ workflowWorkflow E.^. WorkflowWorkflowState + , workflowWorkflow E.^. WorkflowWorkflowArchived ) let ( E.Value workflowWorkflowInstance , E.Value workflowWorkflowScope , E.Value workflowWorkflowGraph , E.Value (wwState :: PersistValue) -- Don't parse + , E.Value workflowWorkflowArchived ) = res wwState' <- memcachedBy Nothing (WorkflowWorkflowStateParse wwState) . return $ fromPersistValue wwState case wwState' of From 465a92b9829db9a9969cf370c635bbf9407f07f5 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 13 May 2022 20:47:42 +0200 Subject: [PATCH 02/21] feat(app-settings): add duration after which finalized WorkflowWorkflows will be archived --- config/settings.yml | 2 ++ src/Settings.hs | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/config/settings.yml b/config/settings.yml index 89ee33642..d8d6e6534 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -295,3 +295,5 @@ bot-mitigations: volatile-cluster-settings-cache-time: 10 communication-attachments-max-size: 20971520 # 20MiB + +workflow-workflow-archive-after: 5270400 # 61 days diff --git a/src/Settings.hs b/src/Settings.hs index 094386068..1195e1578 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -228,6 +228,8 @@ data AppSettings = AppSettings , appJobMaxFlush :: Maybe Natural , appCommunicationAttachmentsMaxSize :: Maybe Natural + + , appWorkflowWorkflowArchiveAfter :: Maybe NominalDiffTime } deriving Show data JobMode = JobsLocal { jobsAcceptOffload :: Bool } @@ -700,6 +702,8 @@ instance FromJSON AppSettings where appCommunicationAttachmentsMaxSize <- o .:? "communication-attachments-max-size" + appWorkflowWorkflowArchiveAfter <- o .:? "workflow-workflow-archive-after" + return AppSettings{..} where isValidARCConf ARCConf{..} = arccMaximumWeight > 0 From 97723ad895c080819c29105717aeb9cfdd19c7a1 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 13 May 2022 22:31:59 +0200 Subject: [PATCH 03/21] feat(workflows): restrict all (except admin) workflow lists on non-archived --- src/Handler/Workflow/Workflow/List.hs | 43 +++++++++++++++++++-------- 1 file changed, 31 insertions(+), 12 deletions(-) diff --git a/src/Handler/Workflow/Workflow/List.hs b/src/Handler/Workflow/Workflow/List.hs index a884afb36..79b21461e 100644 --- a/src/Handler/Workflow/Workflow/List.hs +++ b/src/Handler/Workflow/Workflow/List.hs @@ -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) From 441609436a4e4a78f4ff826603a2a2be2dcabb41 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 13 May 2022 23:20:33 +0200 Subject: [PATCH 04/21] feat(workflows): implement archive routes --- routes | 33 ++++++++++++---------- src/Handler/Workflow/Workflow/List.hs | 40 ++++++++++++++++----------- 2 files changed, 43 insertions(+), 30 deletions(-) diff --git a/routes b/routes index f5083251c..313ee42e3 100644 --- a/routes +++ b/routes @@ -76,20 +76,23 @@ /global-workflows/instances GlobalWorkflowInstanceListR GET !free /global-workflows/instances/new GlobalWorkflowInstanceNewR GET POST /global-workflows/instances/#WorkflowInstanceName GlobalWorkflowInstanceR: - /edit GWIEditR GET POST - /delete GWIDeleteR GET POST - /workflows GWIWorkflowsR GET !free - /initiate GWIInitiateR GET POST !workflow - /update GWIUpdateR POST -/global-workflows GlobalWorkflowWorkflowListR GET !free + /edit GWIEditR GET POST + /delete GWIDeleteR GET POST + /workflows GWIWorkflowsR GET !free + /workflows-archive GWIWorkflowsArchiveR GET !free + /initiate GWIInitiateR GET POST !workflow + /update GWIUpdateR POST +/global-workflows GlobalWorkflowWorkflowListR GET !free +/global-workflows-archive GlobalWorkflowWorkflowArchiveR GET !free !/global-workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR: / GWWWorkflowR GET POST !workflow /files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex GWWFilesR GET !workflow /edit GWWEditR GET POST /delete GWWDeleteR GET POST -/workflow-instances TopWorkflowInstanceListR GET !free -/workflows TopWorkflowWorkflowListR GET !free +/workflow-instances TopWorkflowInstanceListR GET !free +/workflows TopWorkflowWorkflowListR GET !free +/workflows-archive TopWorkflowWorkflowArchiveR GET !free /health HealthR GET !free /instance InstanceR GET !free @@ -143,12 +146,14 @@ /workflows/instances SchoolWorkflowInstanceListR GET !free /workflows/instances/new SchoolWorkflowInstanceNewR GET POST /workflows/instances/#WorkflowInstanceName SchoolWorkflowInstanceR: - /edit SWIEditR GET POST - /delete SWIDeleteR GET POST - /workflows SWIWorkflowsR GET !free - /initiate SWIInitiateR GET POST !workflow - /update SWIUpdateR POST - /workflows SchoolWorkflowWorkflowListR GET !free + /edit SWIEditR GET POST + /delete SWIDeleteR GET POST + /workflows SWIWorkflowsR GET !free + /workflows-archive SWIWorkflowsArchiveR GET !free + /initiate SWIInitiateR GET POST !workflow + /update SWIUpdateR POST + /workflows SchoolWorkflowWorkflowListR GET !free + /workflows-archive SchoolWorkflowWorkflowArchiveR GET !free !/workflows/#CryptoFileNameWorkflowWorkflow SchoolWorkflowWorkflowR: / SWWWorkflowR GET POST !workflow /files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex SWWFilesR GET !workflow diff --git a/src/Handler/Workflow/Workflow/List.hs b/src/Handler/Workflow/Workflow/List.hs index 79b21461e..a8bc9dd5a 100644 --- a/src/Handler/Workflow/Workflow/List.hs +++ b/src/Handler/Workflow/Workflow/List.hs @@ -1,14 +1,14 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} module Handler.Workflow.Workflow.List - ( getGlobalWorkflowWorkflowListR - , getSchoolWorkflowWorkflowListR + ( getGlobalWorkflowWorkflowListR, getGlobalWorkflowWorkflowArchiveR + , getSchoolWorkflowWorkflowListR, getSchoolWorkflowWorkflowArchiveR , workflowWorkflowListR - , getGWIWorkflowsR - , getSWIWorkflowsR + , getGWIWorkflowsR, getGWIWorkflowsArchiveR + , getSWIWorkflowsR, getSWIWorkflowsArchiveR , workflowInstanceWorkflowsR , getAdminWorkflowWorkflowListR - , getTopWorkflowWorkflowListR + , getTopWorkflowWorkflowListR, getTopWorkflowWorkflowArchiveR ) where import Import hiding (Last(..), WriterT) @@ -65,11 +65,13 @@ restrictOnArchived workflowWorkflow now = maybe E.true $ \archived -> E.maybe (workflowWorkflow E.^. WorkflowWorkflowArchived) -getGlobalWorkflowWorkflowListR :: Handler Html -getGlobalWorkflowWorkflowListR = workflowWorkflowListR (Just False) WSGlobal +getGlobalWorkflowWorkflowListR, getGlobalWorkflowWorkflowArchiveR :: Handler Html +getGlobalWorkflowWorkflowListR = workflowWorkflowListR (Just False) WSGlobal +getGlobalWorkflowWorkflowArchiveR = workflowWorkflowListR (Just True ) WSGlobal -getSchoolWorkflowWorkflowListR :: SchoolId -> Handler Html -getSchoolWorkflowWorkflowListR = workflowWorkflowListR (Just False) . WSSchool +getSchoolWorkflowWorkflowListR, getSchoolWorkflowWorkflowArchiveR :: SchoolId -> Handler Html +getSchoolWorkflowWorkflowListR = workflowWorkflowListR (Just False) . WSSchool +getSchoolWorkflowWorkflowArchiveR = workflowWorkflowListR (Just True ) . WSSchool workflowWorkflowListR :: Maybe Bool -- ^ archived/non-archived workflows only? -> RouteWorkflowScope @@ -89,11 +91,13 @@ workflowWorkflowListR mArchived rScope = workflowsDisabledWarning (headings ^. _ headings = (MsgWorkflowWorkflowListScopeTitle rScope, MsgWorkflowWorkflowListScopeHeading rScope) -getGWIWorkflowsR :: WorkflowInstanceName -> Handler Html -getGWIWorkflowsR = workflowInstanceWorkflowsR (Just False) WSGlobal +getGWIWorkflowsR, getGWIWorkflowsArchiveR :: WorkflowInstanceName -> Handler Html +getGWIWorkflowsR = workflowInstanceWorkflowsR (Just False) WSGlobal +getGWIWorkflowsArchiveR = workflowInstanceWorkflowsR (Just True ) WSGlobal -getSWIWorkflowsR :: SchoolId -> WorkflowInstanceName -> Handler Html -getSWIWorkflowsR ssh = workflowInstanceWorkflowsR (Just False) $ WSSchool ssh +getSWIWorkflowsR, getSWIWorkflowsArchiveR :: SchoolId -> WorkflowInstanceName -> Handler Html +getSWIWorkflowsR = workflowInstanceWorkflowsR (Just False) . WSSchool +getSWIWorkflowsArchiveR = workflowInstanceWorkflowsR (Just True ) . WSSchool workflowInstanceWorkflowsR :: Maybe Bool -- ^ archived/non-archived workflows only? -> RouteWorkflowScope @@ -130,10 +134,14 @@ getAdminWorkflowWorkflowListR :: Handler Html getAdminWorkflowWorkflowListR = workflowWorkflowList headings def $ const E.true -- archived workflows included where headings = (MsgAdminWorkflowWorkflowListTitle, MsgAdminWorkflowWorkflowListHeading) -getTopWorkflowWorkflowListR :: Handler Html -getTopWorkflowWorkflowListR = do +getTopWorkflowWorkflowListR, getTopWorkflowWorkflowArchiveR :: Handler Html +getTopWorkflowWorkflowListR = topWorkflowWorkflowListR (Just False) +getTopWorkflowWorkflowArchiveR = topWorkflowWorkflowListR (Just True) + +topWorkflowWorkflowListR :: Maybe Bool -> Handler Html +topWorkflowWorkflowListR mArchived = 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) + workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ \workflowWorkflow -> isTopWorkflowScopeSql (workflowWorkflow E.^. WorkflowWorkflowScope) E.&&. restrictOnArchived workflowWorkflow now mArchived where headings = (MsgWorkflowWorkflowListTopTitle, MsgWorkflowWorkflowListTopHeading) From 4adaf1e806cf3bd1181c78c3d75d57692ed62356 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 13 May 2022 23:44:34 +0200 Subject: [PATCH 05/21] feat(workflows): implement breadcrumbs for archive routes --- src/Foundation/Navigation.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 697960e32..8c6c51b14 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -138,6 +138,7 @@ breadcrumb (SchoolR ssh sRoute) = case sRoute of Just (Entity _ WorkflowInstanceDescription{..}) -> i18nCrumb workflowInstanceDescriptionTitle $ Just bRoute SWIDeleteR -> i18nCrumb MsgBreadcrumbWorkflowInstanceDelete . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR SWIWorkflowsR -> i18nCrumb MsgBreadcrumbWorkflowInstanceWorkflowList . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR + SWIWorkflowsArchiveR -> i18nCrumb MsgBreadcrumbWorkflowInstanceWorkflowArchive . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR SWIInitiateR -> useRunDB $ do mayEdit <- hasReadAccessTo . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just . SchoolR ssh $ if @@ -145,6 +146,7 @@ breadcrumb (SchoolR ssh sRoute) = case sRoute of | otherwise -> SchoolWorkflowInstanceListR SWIUpdateR -> i18nCrumb MsgBreadcrumbWorkflowInstanceUpdate . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR SchoolWorkflowWorkflowListR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowList . Just $ SchoolR ssh SchoolWorkflowInstanceListR + SchoolWorkflowWorkflowArchiveR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowArchive . Just $ SchoolR ssh SchoolWorkflowInstanceListR SchoolWorkflowWorkflowR cID sRoute' -> case sRoute' of SWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) . Just $ SchoolR ssh SchoolWorkflowWorkflowListR SWWFilesR _ _ -> i18nCrumb MsgBreadcrumbWorkflowWorkflowFiles . Just . SchoolR ssh $ SchoolWorkflowWorkflowR cID SWWWorkflowR @@ -425,6 +427,7 @@ breadcrumb (GlobalWorkflowInstanceR win sRoute) = case sRoute of Just (Entity _ WorkflowInstanceDescription{..}) -> i18nCrumb workflowInstanceDescriptionTitle $ Just GlobalWorkflowInstanceListR GWIDeleteR -> i18nCrumb MsgBreadcrumbWorkflowInstanceDelete . Just $ GlobalWorkflowInstanceR win GWIEditR GWIWorkflowsR -> i18nCrumb MsgBreadcrumbWorkflowInstanceWorkflowList . Just $ GlobalWorkflowInstanceR win GWIEditR + GWIWorkflowsArchiveR -> i18nCrumb MsgBreadcrumbWorkflowInstanceWorkflowArchive . Just $ GlobalWorkflowInstanceR win GWIEditR GWIInitiateR -> do mayEdit <- useRunDB . hasReadAccessTo $ GlobalWorkflowInstanceR win GWIEditR i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just $ if @@ -432,14 +435,16 @@ breadcrumb (GlobalWorkflowInstanceR win sRoute) = case sRoute of | otherwise -> GlobalWorkflowInstanceListR GWIUpdateR -> i18nCrumb MsgBreadcrumbWorkflowInstanceUpdate . Just $ GlobalWorkflowInstanceR win GWIEditR breadcrumb GlobalWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbWorkflowWorkflowList $ Just GlobalWorkflowInstanceListR +breadcrumb GlobalWorkflowWorkflowArchiveR = i18nCrumb MsgBreadcrumbWorkflowWorkflowArchive $ Just GlobalWorkflowInstanceListR breadcrumb (GlobalWorkflowWorkflowR cID sRoute) = case sRoute of GWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just GlobalWorkflowWorkflowListR GWWFilesR _ _ -> i18nCrumb MsgBreadcrumbWorkflowWorkflowFiles . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR GWWEditR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowEdit . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR GWWDeleteR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowDelete . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR -breadcrumb TopWorkflowInstanceListR = i18nCrumb MsgBreadcrumbTopWorkflowInstanceList Nothing -breadcrumb TopWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbTopWorkflowWorkflowList $ Just TopWorkflowInstanceListR +breadcrumb TopWorkflowInstanceListR = i18nCrumb MsgBreadcrumbTopWorkflowInstanceList Nothing +breadcrumb TopWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbTopWorkflowWorkflowList $ Just TopWorkflowInstanceListR +breadcrumb TopWorkflowWorkflowArchiveR = i18nCrumb MsgBreadcrumbTopWorkflowWorkflowArchive $ Just TopWorkflowInstanceListR data NavQuickView From 64bd96dd704866e1eb93d17f5c4f978516dff7e3 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 14 May 2022 00:09:48 +0200 Subject: [PATCH 06/21] chore(workflow): complete canonical routes --- src/Handler/Utils/Workflow/CanonicalRoute.hs | 51 ++++++++++++-------- 1 file changed, 30 insertions(+), 21 deletions(-) diff --git a/src/Handler/Utils/Workflow/CanonicalRoute.hs b/src/Handler/Utils/Workflow/CanonicalRoute.hs index 507da9cee..969d403dd 100644 --- a/src/Handler/Utils/Workflow/CanonicalRoute.hs +++ b/src/Handler/Utils/Workflow/CanonicalRoute.hs @@ -12,11 +12,12 @@ data WorkflowScopeRoute | WorkflowInstanceNewR | WorkflowInstanceR WorkflowInstanceName WorkflowInstanceR | WorkflowWorkflowListR + | WorkflowWorkflowArchiveR | WorkflowWorkflowR CryptoFileNameWorkflowWorkflow WorkflowWorkflowR deriving (Eq, Ord, Read, Show, Generic, Typeable) data WorkflowInstanceR - = WIEditR | WIDeleteR | WIWorkflowsR | WIInitiateR | WIUpdateR + = WIEditR | WIDeleteR | WIWorkflowsR | WIWorkflowsArchiveR | WIInitiateR | WIUpdateR deriving (Eq, Ord, Read, Show, Generic, Typeable) data WorkflowWorkflowR @@ -32,12 +33,14 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute WorkflowInstanceListR -> GlobalWorkflowInstanceListR WorkflowInstanceNewR -> GlobalWorkflowInstanceNewR WorkflowInstanceR win subRoute -> GlobalWorkflowInstanceR win $ case subRoute of - WIEditR -> GWIEditR - WIDeleteR -> GWIDeleteR - WIWorkflowsR -> GWIWorkflowsR - WIInitiateR -> GWIInitiateR - WIUpdateR -> GWIUpdateR + WIEditR -> GWIEditR + WIDeleteR -> GWIDeleteR + WIWorkflowsR -> GWIWorkflowsR + WIWorkflowsArchiveR -> GWIWorkflowsArchiveR + WIInitiateR -> GWIInitiateR + WIUpdateR -> GWIUpdateR WorkflowWorkflowListR -> GlobalWorkflowWorkflowListR + WorkflowWorkflowArchiveR -> GlobalWorkflowWorkflowArchiveR WorkflowWorkflowR wwCID subRoute -> GlobalWorkflowWorkflowR wwCID $ case subRoute of WWWorkflowR -> GWWWorkflowR WWFilesR wpl stCID -> GWWFilesR wpl stCID @@ -47,12 +50,14 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute WorkflowInstanceListR -> SchoolWorkflowInstanceListR WorkflowInstanceNewR -> SchoolWorkflowInstanceNewR WorkflowInstanceR win subRoute -> SchoolWorkflowInstanceR win $ case subRoute of - WIEditR -> SWIEditR - WIDeleteR -> SWIDeleteR - WIWorkflowsR -> SWIWorkflowsR - WIInitiateR -> SWIInitiateR - WIUpdateR -> SWIUpdateR + WIEditR -> SWIEditR + WIDeleteR -> SWIDeleteR + WIWorkflowsR -> SWIWorkflowsR + WIWorkflowsArchiveR -> SWIWorkflowsArchiveR + WIInitiateR -> SWIInitiateR + WIUpdateR -> SWIUpdateR WorkflowWorkflowListR -> SchoolWorkflowWorkflowListR + WorkflowWorkflowArchiveR -> SchoolWorkflowWorkflowArchiveR WorkflowWorkflowR wwCID subRoute -> SchoolWorkflowWorkflowR wwCID $ case subRoute of WWWorkflowR -> SWWWorkflowR WWFilesR wpl stCID -> SWWFilesR wpl stCID @@ -63,12 +68,14 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute GlobalWorkflowInstanceListR -> Just ( WSGlobal, WorkflowInstanceListR ) GlobalWorkflowInstanceNewR -> Just ( WSGlobal, WorkflowInstanceNewR ) GlobalWorkflowInstanceR win subRoute -> Just . (WSGlobal, ) . WorkflowInstanceR win $ case subRoute of - GWIEditR -> WIEditR - GWIDeleteR -> WIDeleteR - GWIWorkflowsR -> WIWorkflowsR - GWIInitiateR -> WIInitiateR - GWIUpdateR -> WIUpdateR + GWIEditR -> WIEditR + GWIDeleteR -> WIDeleteR + GWIWorkflowsR -> WIWorkflowsR + GWIWorkflowsArchiveR -> WIWorkflowsArchiveR + GWIInitiateR -> WIInitiateR + GWIUpdateR -> WIUpdateR GlobalWorkflowWorkflowListR -> Just ( WSGlobal, WorkflowWorkflowListR ) + GlobalWorkflowWorkflowArchiveR -> Just ( WSGlobal, WorkflowWorkflowArchiveR ) GlobalWorkflowWorkflowR wwCID subRoute -> Just . (WSGlobal, ) . WorkflowWorkflowR wwCID $ case subRoute of GWWWorkflowR -> WWWorkflowR GWWFilesR wpl stCID -> WWFilesR wpl stCID @@ -78,12 +85,14 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute SchoolWorkflowInstanceListR -> Just ( WSSchool ssh, WorkflowInstanceListR ) SchoolWorkflowInstanceNewR -> Just ( WSSchool ssh, WorkflowInstanceNewR ) SchoolWorkflowInstanceR win subRoute -> Just . (WSSchool ssh, ) . WorkflowInstanceR win $ case subRoute of - SWIEditR -> WIEditR - SWIDeleteR -> WIDeleteR - SWIWorkflowsR -> WIWorkflowsR - SWIInitiateR -> WIInitiateR - SWIUpdateR -> WIUpdateR + SWIEditR -> WIEditR + SWIDeleteR -> WIDeleteR + SWIWorkflowsR -> WIWorkflowsR + SWIWorkflowsArchiveR -> WIWorkflowsArchiveR + SWIInitiateR -> WIInitiateR + SWIUpdateR -> WIUpdateR SchoolWorkflowWorkflowListR -> Just ( WSSchool ssh, WorkflowWorkflowListR ) + SchoolWorkflowWorkflowArchiveR -> Just ( WSSchool ssh, WorkflowWorkflowArchiveR ) SchoolWorkflowWorkflowR wwCID subRoute -> Just . (WSSchool ssh, ) . WorkflowWorkflowR wwCID $ case subRoute of SWWWorkflowR -> WWWorkflowR SWWFilesR wpl stCID -> WWFilesR wpl stCID From 08b36136d05453676f081555f4f0c699ab96169a Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 14 May 2022 00:10:14 +0200 Subject: [PATCH 07/21] chore(workflows): add missing breadcrumb archive messages --- messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg | 3 +++ messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg | 3 +++ 2 files changed, 6 insertions(+) diff --git a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg index c79919c59..e038094ad 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg @@ -93,11 +93,13 @@ BreadcrumbAdminWorkflowWorkflowNew: Workflow initiieren BreadcrumbWorkflowInstanceEdit win@WorkflowInstanceName !ident-ok: #{win} BreadcrumbWorkflowInstanceDelete: Löschen BreadcrumbWorkflowInstanceWorkflowList: Laufende Workflows +BreadcrumbWorkflowInstanceWorkflowArchive: Archivierte Workflows BreadcrumbWorkflowInstanceInitiate: Workflow starten BreadcrumbWorkflowInstanceList !ident-ok: Workflows BreadcrumbWorkflowInstanceNew: Neuer Workflow BreadcrumbWorkflowInstanceUpdate !ident-ok: Update BreadcrumbWorkflowWorkflowList: Laufende Workflows +BreadcrumbWorkflowWorkflowArchive: Archivierte Workflows BreadcrumbWorkflowWorkflow workflow@CryptoFileNameWorkflowWorkflow !ident-ok: #{toPathPiece workflow} BreadcrumbWorkflowWorkflowFiles: Dateien BreadcrumbWorkflowWorkflowEdit: Editieren @@ -105,6 +107,7 @@ BreadcrumbWorkflowWorkflowDelete: Löschen BreadcrumbGlobalWorkflowInstanceList: Systemweite Workflows BreadcrumbTopWorkflowInstanceList !ident-ok: Workflows BreadcrumbTopWorkflowWorkflowList: Laufende Workflows +BreadcrumbTopWorkflowWorkflowArchive: Archivierte Workflows BreadcrumbError: Fehler BreadcrumbUpload !ident-ok: Upload BreadcrumbUserAdd: Benutzer:in anlegen diff --git a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg index dfb3eb21a..bff225a9f 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg @@ -93,11 +93,13 @@ BreadcrumbAdminWorkflowWorkflowNew: Initiate workflow BreadcrumbWorkflowInstanceEdit win: #{win} BreadcrumbWorkflowInstanceDelete: Delete BreadcrumbWorkflowInstanceWorkflowList: Running workflows +BreadcrumbWorkflowInstanceWorkflowArchive: Archived workflows BreadcrumbWorkflowInstanceInitiate: Start workflow BreadcrumbWorkflowInstanceList: Workflows BreadcrumbWorkflowInstanceNew: New workflow BreadcrumbWorkflowInstanceUpdate !ident-ok: Update BreadcrumbWorkflowWorkflowList: Running workflows +BreadcrumbWorkflowWorkflowArchive: Archived workflows BreadcrumbWorkflowWorkflow workflow: #{toPathPiece workflow} BreadcrumbWorkflowWorkflowFiles: Files BreadcrumbWorkflowWorkflowEdit: Edit @@ -105,6 +107,7 @@ BreadcrumbWorkflowWorkflowDelete: Delete BreadcrumbGlobalWorkflowInstanceList: System-wide workflows BreadcrumbTopWorkflowInstanceList: Workflows BreadcrumbTopWorkflowWorkflowList: Running workflows +BreadcrumbTopWorkflowWorkflowArchive: Archived workflows BreadcrumbError: Error BreadcrumbUpload: Upload BreadcrumbUserAdd: Add user From fac92f9b5053d9f11dc1d72c81d290acd888cd63 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 14 May 2022 00:34:22 +0200 Subject: [PATCH 08/21] feat(workflows): implement archive and list page actions --- .../utils/navigation/menu/de-de-formal.msg | 2 + .../uniworx/utils/navigation/menu/en-eu.msg | 2 + src/Foundation/Navigation.hs | 52 +++++++++++++++++++ 3 files changed, 56 insertions(+) diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 69bc2b39d..b082c1571 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -127,11 +127,13 @@ MenuWorkflowInstanceWorkflows: Laufende Workflows MenuWorkflowInstanceInitiate: Workflow starten MenuWorkflowInstanceEdit: Bearbeiten MenuWorkflowWorkflowList: Laufende Workflows +MenuWorkflowWorkflowArchive: Archivierte Workflows MenuWorkflowWorkflowEdit: Editieren MenuWorkflowWorkflowDelete: Löschen MenuGlobalWorkflowInstanceList: Systemweite Workflows MenuTopWorkflowInstanceList !ident-ok: Workflows MenuTopWorkflowWorkflowList: Laufende Workflows +MenuTopWorkflowWorkflowArchive: Archivierte Workflows MenuTopWorkflowWorkflowListHeader !ident-ok: Workflows MenuGlossary: Begriffsverzeichnis MenuVersion: Versionsgeschichte diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 3a4a45a16..00b3ba02c 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -128,11 +128,13 @@ MenuWorkflowInstanceWorkflows: Running workflows MenuWorkflowInstanceInitiate: Start workflow MenuWorkflowInstanceEdit: Edit MenuWorkflowWorkflowList: Running workflows +MenuWorkflowWorkflowArchive: Archived workflows MenuWorkflowWorkflowEdit: Edit MenuWorkflowWorkflowDelete: Delete MenuGlobalWorkflowInstanceList: System-wide workflows MenuTopWorkflowInstanceList: Workflows MenuTopWorkflowWorkflowList: Running workflows +MenuTopWorkflowWorkflowArchive: Archived workflows MenuTopWorkflowWorkflowListHeader: Workflows MenuGlossary: Glossary MenuVersion: Version history diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 8c6c51b14..d3078f080 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -2636,6 +2636,32 @@ pageActions route | Just (rScope, WorkflowInstanceR win WIEditR) <- route ^? _Wo , navChildren = [] } ] +pageActions route | Just (rScope, WorkflowWorkflowListR) <- route ^? _WorkflowScopeRoute = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuWorkflowWorkflowArchive + , navRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowArchiveR) + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions route | Just (rScope, WorkflowWorkflowArchiveR) <- route ^? _WorkflowScopeRoute = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuWorkflowWorkflowList + , navRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowListR) + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] pageActions route | Just (rScope, WorkflowWorkflowR cID WWWorkflowR) <- route ^? _WorkflowScopeRoute = return [ NavPageActionSecondary { navLink = NavLink @@ -2671,6 +2697,32 @@ pageActions TopWorkflowInstanceListR = return , navChildren = [] } ] +pageActions TopWorkflowWorkflowListR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTopWorkflowWorkflowArchive + , navRoute = TopWorkflowWorkflowArchiveR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions TopWorkflowWorkflowArchiveR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTopWorkflowWorkflowList + , navRoute = TopWorkflowWorkflowListR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] pageActions _ = return [] submissionList :: ( MonadIO m From 23b106554567db8d75478389ef043f17b7b43458 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 18 May 2022 21:45:35 +0200 Subject: [PATCH 09/21] feat(workflows): set archived timestamp on state change --- src/Handler/Workflow/Workflow/Workflow.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Handler/Workflow/Workflow/Workflow.hs b/src/Handler/Workflow/Workflow/Workflow.hs index 441fa1d54..61bac5894 100644 --- a/src/Handler/Workflow/Workflow/Workflow.hs +++ b/src/Handler/Workflow/Workflow/Workflow.hs @@ -81,7 +81,7 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do WorkflowWorkflow{..} <- get404 wwId maybeT notFound . void . assertM (== review _DBWorkflowScope workflowWorkflowScope) $ fromRouteWorkflowScope rScope mEdgeForm <- workflowEdgeForm (Right wwId) Nothing - wGraph <- getSharedIdWorkflowGraph workflowWorkflowGraph + wGraph@WorkflowGraph{..} <- getSharedIdWorkflowGraph workflowWorkflowGraph let canonRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR) mEdge <- for mEdgeForm $ \edgeForm -> do @@ -94,7 +94,15 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do wiScope <- maybeT notFound . toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope return (wiScope, Entity wiId wInstance) - update wwId [ WorkflowWorkflowState =. view _DBWorkflowState nState ] + wwArchived <- lift . maybeT (pure Nothing) $ do + archiveAfter <- MaybeT . getsYesod $ view _appWorkflowWorkflowArchiveAfter + let WorkflowAction{wpTo,wpTime} = last nState + WGN{wgnFinal} <- hoistMaybe $ Map.lookup wpTo wgNodes + return $ const (archiveAfter `addUTCTime` wpTime) <$> wgnFinal + + update wwId [ WorkflowWorkflowState =. view _DBWorkflowState nState + , WorkflowWorkflowArchived =. wwArchived + ] return . Just $ do whenIsJust wInstance $ \(wiScope, Entity _ WorkflowInstance{..}) -> do @@ -207,7 +215,6 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do tell ( Just $ Last WorkflowCurrentState{..} , pure WorkflowHistoryItem{..} ) - WorkflowGraph{..} = wGraph wState = review _DBWorkflowState workflowWorkflowState in fmap (over _2 (sortOn (Down . whiTime) . reverse) . view _2) . runConduit $ sourceWorkflowActionInfos wwId wState .| execRWSC () Map.empty (C.mapM_ go) return (mEdge, (workflowState, workflowHistory)) From 424692d61110042462d7d88310290a8f682bd23a Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 19 May 2022 00:22:10 +0200 Subject: [PATCH 10/21] feat(workflows): show info and warnings about scheduled/performed archivation --- .../uniworx/categories/workflows/de-de-formal.msg | 2 ++ messages/uniworx/categories/workflows/en-eu.msg | 2 ++ src/Handler/Workflow/Workflow/Workflow.hs | 5 +++++ .../de-de-formal.hamlet | 4 ++++ .../i18n/workflow-archivation-scheduled/en-eu.hamlet | 4 ++++ templates/workflows/workflow.hamlet | 11 +++++++++++ 6 files changed, 28 insertions(+) create mode 100644 templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet create mode 100644 templates/i18n/workflow-archivation-scheduled/en-eu.hamlet diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index 6cd756c84..b30081a91 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -106,6 +106,8 @@ WorkflowWorkflowWorkflowStateHeading: Zustand/Daten WorkflowWorkflowWorkflowPayloadHeading: Aktueller Datensatz WorkflowWorkflowWorkflowStateStateLabel: Aktueller Zustand WorkflowWorkflowWorkflowStateStateHidden: Versteckter Zustand +WorkflowWorkflowWorkflowStateArchivedLabel: Archiviert seit +WorkflowWorkflowWorkflowArchivationInfo: Workflows, welche seit 61 Tagen abgeschlossen sind, werden automatisch archiviert. Archivierte Workflows werden nicht als laufende Workflows gelistet. Das Auslösen einer Aktion setzt den Archivierungszeitpunkt eines Workflows zurück. WorkflowWorkflowWorkflowHistoryLabelOthers: Aktionen Anderer WorkflowWorkflowWorkflowHistoryLabelOwn: Eigene Aktionen diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index 2dcc37915..143a0db74 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -65,6 +65,8 @@ WorkflowWorkflowWorkflowStateHeading: State/Data WorkflowWorkflowWorkflowPayloadHeading: Current data WorkflowWorkflowWorkflowStateStateLabel: Current state WorkflowWorkflowWorkflowStateStateHidden: Hidden state +WorkflowWorkflowWorkflowStateArchivedLabel: Archived since +WorkflowWorkflowWorkflowArchivationInfo: Workflows that are finalized since 61 days will be automatically moved to the archive. Archived workflows are not listed as running. Actions reset the archivation date of a workflow. WorkflowWorkflowWorkflowHistoryLabelOthers: Other users' actions WorkflowWorkflowWorkflowHistoryLabelOwn: Your actions diff --git a/src/Handler/Workflow/Workflow/Workflow.hs b/src/Handler/Workflow/Workflow/Workflow.hs index 61bac5894..99fe42538 100644 --- a/src/Handler/Workflow/Workflow/Workflow.hs +++ b/src/Handler/Workflow/Workflow/Workflow.hs @@ -52,6 +52,7 @@ data WorkflowHistoryItem = WorkflowHistoryItem data WorkflowCurrentState = WorkflowCurrentState { wcsState :: Maybe (Text, Maybe Icon) + , wcsArchived :: Maybe UTCTime , wcsMessages :: Set Message , wcsPayload :: [(Text, ([WorkflowFieldPayloadW Void (Maybe (Entity User))], Maybe Text))] } @@ -76,6 +77,7 @@ getSWWFilesR ssh = getWorkflowFilesR $ WSSchool ssh workflowR :: RouteWorkflowScope -> CryptoFileNameWorkflowWorkflow -> Handler Html workflowR rScope cID = workflowsDisabledWarning title heading $ do + now <- liftIO getCurrentTime (mEdge, (workflowState, workflowHistory)) <- runDB $ do wwId <- decrypt cID WorkflowWorkflow{..} <- get404 wwId @@ -212,6 +214,8 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do messageContent <- selectLanguageI18n wnmContent return Message{..} + let wcsArchived = workflowWorkflowArchived + tell ( Just $ Last WorkflowCurrentState{..} , pure WorkflowHistoryItem{..} ) @@ -255,6 +259,7 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do Nothing -> i18n MsgWorkflowPayloadUserGone Just (Entity _ User{..}) -> nameWidget userDisplayName userSurname WorkflowFieldPayloadW (WFPFile v ) -> absurd v + archivationScheduled archived = $(i18nWidgetFile "workflow-archivation-scheduled") $(widgetFile "workflows/workflow") where (heading, title) = case rScope of diff --git a/templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet b/templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet new file mode 100644 index 000000000..68cc8e463 --- /dev/null +++ b/templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet @@ -0,0 +1,4 @@ +$newline never + +

+ Dieser Workflow wird am ^{formatTimeW SelFormatDateTime archived} archiviert. diff --git a/templates/i18n/workflow-archivation-scheduled/en-eu.hamlet b/templates/i18n/workflow-archivation-scheduled/en-eu.hamlet new file mode 100644 index 000000000..efa0e8f52 --- /dev/null +++ b/templates/i18n/workflow-archivation-scheduled/en-eu.hamlet @@ -0,0 +1,4 @@ +$newline never + +

+ This workflow will be archived on ^{formatTimeW SelFormatDateTime archived}. diff --git a/templates/workflows/workflow.hamlet b/templates/workflows/workflow.hamlet index aaac0b497..1df3fe1cc 100644 --- a/templates/workflows/workflow.hamlet +++ b/templates/workflows/workflow.hamlet @@ -1,6 +1,10 @@ $newline never $maybe WorkflowCurrentState{..} <- workflowState

+ $maybe archived <- wcsArchived + $if now < archived + ^{notification NotificationBroad =<< messageWidget Warning (archivationScheduled archived)} +

_{MsgWorkflowWorkflowWorkflowStateHeading} @@ -16,6 +20,13 @@ $maybe WorkflowCurrentState{..} <- workflowState $nothing _{MsgWorkflowWorkflowWorkflowStateStateHidden} + $maybe archived <- wcsArchived + $if now >= archived +
+ _{MsgWorkflowWorkflowWorkflowStateArchivedLabel} # + ^{messageTooltip =<< messageI Info MsgWorkflowWorkflowWorkflowArchivationInfo} +
+ ^{formatTimeW SelFormatDateTime archived} $forall msg <- wcsMessages ^{notification NotificationBroad msg} From 955281d2adfba76b1b1d9bf26b31fab08e599314 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 19 May 2022 20:05:50 +0200 Subject: [PATCH 11/21] chore: changelog --- src/Handler/Info.hs | 5 ++--- .../workflows-archivation.de-de-formal.hamlet | 11 +++++++++++ .../changelog/workflows-archivation.en-eu.hamlet | 13 +++++++++++++ 3 files changed, 26 insertions(+), 3 deletions(-) create mode 100644 templates/i18n/changelog/workflows-archivation.de-de-formal.hamlet create mode 100644 templates/i18n/changelog/workflows-archivation.en-eu.hamlet diff --git a/src/Handler/Info.hs b/src/Handler/Info.hs index eac3e22dc..170a156f7 100644 --- a/src/Handler/Info.hs +++ b/src/Handler/Info.hs @@ -42,11 +42,13 @@ getLegalR = -- | Allgemeine Informationen getInfoR :: Handler Html getInfoR = do + AppSettings{..} <- getsYesod appSettings' changelogEntries' <- runDB $ selectList [ ChangelogItemFirstSeenItem <-. universeF ] [] let changelogEntries = Map.fromListWith Set.union [ (Down changelogItemFirstSeenFirstSeen, Set.singleton changelogItemFirstSeenItem) | Entity _ ChangelogItemFirstSeen{..} <- changelogEntries' ] + changelogItems = $(i18nWidgetFiles "changelog") siteLayoutMsg MsgInfoHeading $ do setTitleI MsgInfoHeading @@ -58,9 +60,6 @@ getInfoR = do gitInfo = $gitDescribe <> " (" <> $gitCommitDate <> ")" $(widgetFile "versionHistory") - where - changelogItems = $(i18nWidgetFiles "changelog") - getGlossaryR :: Handler Html getGlossaryR = diff --git a/templates/i18n/changelog/workflows-archivation.de-de-formal.hamlet b/templates/i18n/changelog/workflows-archivation.de-de-formal.hamlet new file mode 100644 index 000000000..c775ce108 --- /dev/null +++ b/templates/i18n/changelog/workflows-archivation.de-de-formal.hamlet @@ -0,0 +1,11 @@ +$newline never + +$maybe archived <- appWorkflowWorkflowArchiveAfter + Workflows werden nun automatisch archiviert, sobald sie # + $if archived /= 0 + seit #{tshow (nominalDiffTimeToSeconds archived / 86400)} Tagen # + abgeschlossen sind. +$nothing + Workflows können nun archiviert werden. +
+Archivierte Workflows werden nicht mehr in der Liste laufender Workflows angezeigt, sondern sind über ein separates Archiv verfügbar. diff --git a/templates/i18n/changelog/workflows-archivation.en-eu.hamlet b/templates/i18n/changelog/workflows-archivation.en-eu.hamlet new file mode 100644 index 000000000..1a1fd4e70 --- /dev/null +++ b/templates/i18n/changelog/workflows-archivation.en-eu.hamlet @@ -0,0 +1,13 @@ +$newline never + +$maybe archived <- appWorkflowWorkflowArchiveAfter + Workflows are now being archived automatically # + $if archived == 0 + immediately # + $else + #{tshow (nominalDiffTimeToSeconds archived / 86400)} days # + after finalization. +$nothing + Workflow may now be archived. +
+Archived workflows are not shown among the list of running workflows, but can instead be accessed via a separate archive list. From 2fa29d077b11f9032ef494fe4e5364135fae8806 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 20 May 2022 20:18:29 +0200 Subject: [PATCH 12/21] chore(workflows): migrate archived --- src/Model/Migration/Definitions.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs index 78ac1db9e..8a8515098 100644 --- a/src/Model/Migration/Definitions.hs +++ b/src/Model/Migration/Definitions.hs @@ -103,9 +103,7 @@ data ManualMigration | Migration20210208StudyFeaturesRelevanceCachedUUIDs | Migration20210318CrontabSubmissionRatedNotification | Migration20210608SeparateTermActive - -- TODO: migration regarding authorship statements - -- - apply desired non-default modes for IfI - -- - set authorship statement texts for IfI + | Migration20220519WorkflowArchivation deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) deriving anyclass (Universe, Finite) @@ -1069,6 +1067,21 @@ customMigrations = mapF $ \case ALTER TABLE "term" DROP COLUMN "active"; |] + Migration20220519WorkflowArchivation -> do + now <- liftIO getCurrentTime + mArchiveAfter <- lift $ view _appWorkflowWorkflowArchiveAfter + + whenM (and2M (return $ is _Just mArchiveAfter) (not <$> columnExists "workflow_workflow" "archived")) $ do + [executeQQ| ALTER TABLE "workflow_workflow" ADD "archived" timestamp with time zone; |] + let getWorkflows = [queryQQ| SELECT "workflow_workflow"."id", "workflow_workflow".("state"->>-1)::json->'time', "workflow_workflow".("state"->>-1)::json->'to', "shared_workflow_graph"."graph"->'nodes' FROM "workflow_workflow" INNER JOIN "shared_workflow_graph" ON "workflow_workflow"."graph" = "shared_workflow_graph"."hash"; |] + migrateArchived [ fromPersistValue -> Right (wwId :: WorkflowWorkflowId), fromPersistValue -> Right (wpTime :: UTCTime), fromPersistValue -> Right (wpTo :: WorkflowGraphNodeLabel), fromPersistValue -> Right (wGraph :: DBWorkflowGraph) ] = maybeT (return ()) $ do + archiveAfter <- hoistMaybe mArchiveAfter + WGN{wgnFinal} <- hoistMaybe . Map.lookup wpTo $ wgNodes wGraph + let wwArchived = const (max now $ archiveAfter `addUTCTime` wpTime) <$> wgnFinal + lift [executeQQ| UPDATE workflow_workflow SET archived = #{wwArchived} WHERE id = #{wwId} |] + migrateArchived _ = return () + in runConduit $ getWorkflows .| C.mapM_ migrateArchived + tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool tableExists table = do From 4486a00d45ff9783115064b640b58f006b2e78d7 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 20 May 2022 21:25:34 +0200 Subject: [PATCH 13/21] fix(migration): dont force app settings --- src/Model/Migration/Definitions.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs index 8a8515098..a3fe8cda7 100644 --- a/src/Model/Migration/Definitions.hs +++ b/src/Model/Migration/Definitions.hs @@ -1069,10 +1069,9 @@ customMigrations = mapF $ \case Migration20220519WorkflowArchivation -> do now <- liftIO getCurrentTime - mArchiveAfter <- lift $ view _appWorkflowWorkflowArchiveAfter - - whenM (and2M (return $ is _Just mArchiveAfter) (not <$> columnExists "workflow_workflow" "archived")) $ do + whenM (and2M (tableExists "workflow_workflow") $ not <$> columnExists "workflow_workflow" "archived") $ do [executeQQ| ALTER TABLE "workflow_workflow" ADD "archived" timestamp with time zone; |] + mArchiveAfter <- lift $ view _appWorkflowWorkflowArchiveAfter let getWorkflows = [queryQQ| SELECT "workflow_workflow"."id", "workflow_workflow".("state"->>-1)::json->'time', "workflow_workflow".("state"->>-1)::json->'to', "shared_workflow_graph"."graph"->'nodes' FROM "workflow_workflow" INNER JOIN "shared_workflow_graph" ON "workflow_workflow"."graph" = "shared_workflow_graph"."hash"; |] migrateArchived [ fromPersistValue -> Right (wwId :: WorkflowWorkflowId), fromPersistValue -> Right (wpTime :: UTCTime), fromPersistValue -> Right (wpTo :: WorkflowGraphNodeLabel), fromPersistValue -> Right (wGraph :: DBWorkflowGraph) ] = maybeT (return ()) $ do archiveAfter <- hoistMaybe mArchiveAfter From cc5cd62572d02a1486766c509228d4275431b349 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 21 May 2022 01:04:40 +0200 Subject: [PATCH 14/21] chore(workflows): breadcrumb either list or archive --- src/Foundation/Navigation.hs | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index d3078f080..2c5214862 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -118,7 +118,7 @@ breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR -breadcrumb (SchoolR ssh sRoute) = case sRoute of +breadcrumb currentRoute@(SchoolR ssh sRoute) = case sRoute of SchoolEditR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do School{..} <- MaybeT $ get ssh isAdmin <- lift $ hasReadAccessTo SchoolListR @@ -148,7 +148,15 @@ breadcrumb (SchoolR ssh sRoute) = case sRoute of SchoolWorkflowWorkflowListR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowList . Just $ SchoolR ssh SchoolWorkflowInstanceListR SchoolWorkflowWorkflowArchiveR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowArchive . Just $ SchoolR ssh SchoolWorkflowInstanceListR SchoolWorkflowWorkflowR cID sRoute' -> case sRoute' of - SWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) . Just $ SchoolR ssh SchoolWorkflowWorkflowListR + SWWWorkflowR -> do + now <- liftIO getCurrentTime + mWorkflowWorkflow <- useRunDB . runMaybeT $ do + guardM . lift $ hasReadAccessTo currentRoute + wwId <- lift $ decrypt cID + MaybeT $ get wwId + let workflowList | Just WorkflowWorkflow{workflowWorkflowArchived=Just archived} <- mWorkflowWorkflow, archived <= now = SchoolWorkflowWorkflowArchiveR + | otherwise = SchoolWorkflowWorkflowListR + i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) . Just $ SchoolR ssh workflowList SWWFilesR _ _ -> i18nCrumb MsgBreadcrumbWorkflowWorkflowFiles . Just . SchoolR ssh $ SchoolWorkflowWorkflowR cID SWWWorkflowR SWWEditR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowEdit . Just . SchoolR ssh $ SchoolWorkflowWorkflowR cID SWWWorkflowR SWWDeleteR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowDelete . Just . SchoolR ssh $ SchoolWorkflowWorkflowR cID SWWWorkflowR @@ -436,8 +444,16 @@ breadcrumb (GlobalWorkflowInstanceR win sRoute) = case sRoute of GWIUpdateR -> i18nCrumb MsgBreadcrumbWorkflowInstanceUpdate . Just $ GlobalWorkflowInstanceR win GWIEditR breadcrumb GlobalWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbWorkflowWorkflowList $ Just GlobalWorkflowInstanceListR breadcrumb GlobalWorkflowWorkflowArchiveR = i18nCrumb MsgBreadcrumbWorkflowWorkflowArchive $ Just GlobalWorkflowInstanceListR -breadcrumb (GlobalWorkflowWorkflowR cID sRoute) = case sRoute of - GWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just GlobalWorkflowWorkflowListR +breadcrumb currentRoute@(GlobalWorkflowWorkflowR cID sRoute) = case sRoute of + GWWWorkflowR -> do + now <- liftIO getCurrentTime + mWorkflowWorkflow <- useRunDB . runMaybeT $ do + guardM . lift $ hasReadAccessTo currentRoute + wwId <- lift $ decrypt cID + MaybeT $ get wwId + let workflowList | Just WorkflowWorkflow{workflowWorkflowArchived=Just archived} <- mWorkflowWorkflow, archived <= now = GlobalWorkflowWorkflowArchiveR + | otherwise = GlobalWorkflowWorkflowListR + i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just workflowList GWWFilesR _ _ -> i18nCrumb MsgBreadcrumbWorkflowWorkflowFiles . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR GWWEditR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowEdit . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR GWWDeleteR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowDelete . Just $ GlobalWorkflowWorkflowR cID GWWWorkflowR From 18129bfb17ba7c3c6c922f133109131c858c0e5c Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 21 May 2022 01:50:20 +0200 Subject: [PATCH 15/21] chore(workflows): tweak list headings wrt archived --- .../categories/workflows/de-de-formal.msg | 24 +++++++++---------- .../uniworx/categories/workflows/en-eu.msg | 24 +++++++++---------- src/Handler/Workflow/Workflow/List.hs | 12 +++++----- 3 files changed, 30 insertions(+), 30 deletions(-) diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index b30081a91..b9f977c65 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -125,18 +125,18 @@ GlobalWorkflowWorkflowWorkflowTitle workflowWorkflowId@CryptoFileNameWorkflowWor SchoolWorkflowWorkflowWorkflowHeading ssh@SchoolId workflowWorkflowId@CryptoFileNameWorkflowWorkflow !ident-ok: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} SchoolWorkflowWorkflowWorkflowTitle ssh@SchoolId workflowWorkflowId@CryptoFileNameWorkflowWorkflow !ident-ok: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} -WorkflowWorkflowListScopeTitle rScope@RouteWorkflowScope: Laufende Workflows - _{rScope} -WorkflowWorkflowListScopeHeading rScope@RouteWorkflowScope: Laufende Workflows (_{rScope}) -WorkflowWorkflowListInstanceTitle: Laufende Workflows für Instanz -WorkflowWorkflowListInstanceHeading: Laufende Workflows für Instanz -WorkflowWorkflowListNamedInstanceTitle rScope@RouteWorkflowScope wiTitle@Text: Laufende Workflows - _{rScope}, #{wiTitle} -WorkflowWorkflowListNamedInstanceHeading rScope@RouteWorkflowScope wiTitle@Text: Laufende Workflows (_{rScope}, #{wiTitle}) -WorkflowWorkflowListNamedInstanceTitleDisabled rScope@RouteWorkflowScope: Laufende Workflows - _{rScope} -WorkflowWorkflowListNamedInstanceHeadingDisabled rScope@RouteWorkflowScope: Laufende Workflows (_{rScope}) -WorkflowWorkflowListTopTitle: Laufende Workflows -WorkflowWorkflowListTopHeading: Laufende Workflows -AdminWorkflowWorkflowListTitle: Laufende Workflows -AdminWorkflowWorkflowListHeading: Laufende Workflows +WorkflowWorkflowListScopeTitle rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows - _{rScope} +WorkflowWorkflowListScopeHeading rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows (_{rScope}) +WorkflowWorkflowListInstanceTitle mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows für Instanz +WorkflowWorkflowListInstanceHeading mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows für Instanz +WorkflowWorkflowListNamedInstanceTitle rScope@RouteWorkflowScope wiTitle@Text mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows - _{rScope}, #{wiTitle} +WorkflowWorkflowListNamedInstanceHeading rScope@RouteWorkflowScope wiTitle@Text mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows (_{rScope}, #{wiTitle}) +WorkflowWorkflowListNamedInstanceTitleDisabled rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows - _{rScope} +WorkflowWorkflowListNamedInstanceHeadingDisabled rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows (_{rScope}) +WorkflowWorkflowListTopTitle mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows +WorkflowWorkflowListTopHeading mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows +AdminWorkflowWorkflowListTitle: Alle Workflows +AdminWorkflowWorkflowListHeading: Alle Workflows WorkflowWorkflowListNumber: Nummer WorkflowWorkflowListScope: Bereich diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index 143a0db74..be13fa397 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -84,18 +84,18 @@ GlobalWorkflowWorkflowWorkflowTitle workflowWorkflowId: Workflow #{toPathPiece w SchoolWorkflowWorkflowWorkflowHeading ssh workflowWorkflowId: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} SchoolWorkflowWorkflowWorkflowTitle ssh workflowWorkflowId: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} -WorkflowWorkflowListScopeTitle rScope: Running workflows - _{rScope} -WorkflowWorkflowListScopeHeading rScope: Running workflows (_{rScope}) -WorkflowWorkflowListInstanceTitle: Running workflows for an instance -WorkflowWorkflowListInstanceHeading: Running workflows for an instance -WorkflowWorkflowListNamedInstanceTitle rScope wiTitle: Running workflows - _{rScope}, #{wiTitle} -WorkflowWorkflowListNamedInstanceHeading rScope wiTitle: Running workflows (_{rScope}, #{wiTitle}) -WorkflowWorkflowListNamedInstanceTitleDisabled rScope: Running Workflows - _{rScope} -WorkflowWorkflowListNamedInstanceHeadingDisabled rScope: Running Workflows (_{rScope}) -WorkflowWorkflowListTopTitle: Running workflows -WorkflowWorkflowListTopHeading: Running workflows -AdminWorkflowWorkflowListTitle: Running workflows -AdminWorkflowWorkflowListHeading: Running workflows +WorkflowWorkflowListScopeTitle rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows - _{rScope} +WorkflowWorkflowListScopeHeading rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows (_{rScope}) +WorkflowWorkflowListInstanceTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows for an instance +WorkflowWorkflowListInstanceHeading mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows for an instance +WorkflowWorkflowListNamedInstanceTitle rScope wiTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows - _{rScope}, #{wiTitle} +WorkflowWorkflowListNamedInstanceHeading rScope wiTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows (_{rScope}, #{wiTitle}) +WorkflowWorkflowListNamedInstanceTitleDisabled rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows - _{rScope} +WorkflowWorkflowListNamedInstanceHeadingDisabled rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows (_{rScope}) +WorkflowWorkflowListTopTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows +WorkflowWorkflowListTopHeading mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows +AdminWorkflowWorkflowListTitle: All workflows +AdminWorkflowWorkflowListHeading: All workflows WorkflowWorkflowListNumber: Number WorkflowWorkflowListScope: Scope diff --git a/src/Handler/Workflow/Workflow/List.hs b/src/Handler/Workflow/Workflow/List.hs index a8bc9dd5a..9e883e2e2 100644 --- a/src/Handler/Workflow/Workflow/List.hs +++ b/src/Handler/Workflow/Workflow/List.hs @@ -88,7 +88,7 @@ workflowWorkflowListR mArchived rScope = workflowsDisabledWarning (headings ^. _ columns = def { wwListColumnScope = False } - headings = (MsgWorkflowWorkflowListScopeTitle rScope, MsgWorkflowWorkflowListScopeHeading rScope) + headings = (MsgWorkflowWorkflowListScopeTitle rScope mArchived, MsgWorkflowWorkflowListScopeHeading rScope mArchived) getGWIWorkflowsR, getGWIWorkflowsArchiveR :: WorkflowInstanceName -> Handler Html @@ -103,7 +103,7 @@ workflowInstanceWorkflowsR :: Maybe Bool -- ^ archived/non-archived workflows on -> RouteWorkflowScope -> WorkflowInstanceName -> Handler Html -workflowInstanceWorkflowsR mArchived rScope win = workflowsDisabledWarning (MsgWorkflowWorkflowListNamedInstanceTitleDisabled rScope) (MsgWorkflowWorkflowListNamedInstanceHeadingDisabled rScope) $ do +workflowInstanceWorkflowsR mArchived rScope win = workflowsDisabledWarning (MsgWorkflowWorkflowListNamedInstanceTitleDisabled rScope mArchived) (MsgWorkflowWorkflowListNamedInstanceHeadingDisabled rScope mArchived) $ do now <- liftIO getCurrentTime (scope, desc) <- runDB $ do scope <- maybeT notFound $ fromRouteWorkflowScope rScope @@ -111,10 +111,10 @@ workflowInstanceWorkflowsR mArchived rScope win = workflowsDisabledWarning (MsgW desc <- selectWorkflowInstanceDescription wiId return (scope, desc) let headings = case desc of - Nothing -> (MsgWorkflowWorkflowListInstanceTitle, MsgWorkflowWorkflowListInstanceHeading) + Nothing -> (MsgWorkflowWorkflowListInstanceTitle mArchived, MsgWorkflowWorkflowListInstanceHeading mArchived) Just (Entity _ WorkflowInstanceDescription{..}) - -> ( MsgWorkflowWorkflowListNamedInstanceTitle rScope workflowInstanceDescriptionTitle - , MsgWorkflowWorkflowListNamedInstanceHeading rScope workflowInstanceDescriptionTitle + -> ( MsgWorkflowWorkflowListNamedInstanceTitle rScope workflowInstanceDescriptionTitle mArchived + , MsgWorkflowWorkflowListNamedInstanceHeading rScope workflowInstanceDescriptionTitle mArchived ) workflowWorkflowList headings columns . runReader $ do workflowWorkflow <- view queryWorkflowWorkflow @@ -142,7 +142,7 @@ topWorkflowWorkflowListR :: Maybe Bool -> Handler Html topWorkflowWorkflowListR mArchived = do now <- liftIO getCurrentTime 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 mArchived, MsgWorkflowWorkflowListTopHeading mArchived) type WorkflowWorkflowTableExpr = E.SqlExpr (Entity WorkflowWorkflow) From 4bdf4c185fed389d3704fbfed093d723af53a1ae Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 21 May 2022 02:58:40 +0200 Subject: [PATCH 16/21] chore(workflows): partially fix archived migration --- src/Model/Migration/Definitions.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs index a3fe8cda7..7ceffa67a 100644 --- a/src/Model/Migration/Definitions.hs +++ b/src/Model/Migration/Definitions.hs @@ -103,7 +103,7 @@ data ManualMigration | Migration20210208StudyFeaturesRelevanceCachedUUIDs | Migration20210318CrontabSubmissionRatedNotification | Migration20210608SeparateTermActive - | Migration20220519WorkflowArchivation + | Migration20220521WorkflowArchivation deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) deriving anyclass (Universe, Finite) @@ -1067,17 +1067,17 @@ customMigrations = mapF $ \case ALTER TABLE "term" DROP COLUMN "active"; |] - Migration20220519WorkflowArchivation -> do + Migration20220521WorkflowArchivation -> do now <- liftIO getCurrentTime whenM (and2M (tableExists "workflow_workflow") $ not <$> columnExists "workflow_workflow" "archived") $ do [executeQQ| ALTER TABLE "workflow_workflow" ADD "archived" timestamp with time zone; |] mArchiveAfter <- lift $ view _appWorkflowWorkflowArchiveAfter - let getWorkflows = [queryQQ| SELECT "workflow_workflow"."id", "workflow_workflow".("state"->>-1)::json->'time', "workflow_workflow".("state"->>-1)::json->'to', "shared_workflow_graph"."graph"->'nodes' FROM "workflow_workflow" INNER JOIN "shared_workflow_graph" ON "workflow_workflow"."graph" = "shared_workflow_graph"."hash"; |] - migrateArchived [ fromPersistValue -> Right (wwId :: WorkflowWorkflowId), fromPersistValue -> Right (wpTime :: UTCTime), fromPersistValue -> Right (wpTo :: WorkflowGraphNodeLabel), fromPersistValue -> Right (wGraph :: DBWorkflowGraph) ] = maybeT (return ()) $ do + let getWorkflows = [queryQQ| SELECT "workflow_workflow"."id", "workflow_workflow"."state"->-1->'time', "workflow_workflow"."state"->-1->'to', "shared_workflow_graph"."graph" FROM "workflow_workflow" INNER JOIN "shared_workflow_graph" ON "workflow_workflow"."graph" = "shared_workflow_graph"."hash"; |] + migrateArchived [ fromPersistValue -> Right (wwId :: WorkflowWorkflowId), fromPersistValue -> Right wpTime, fromPersistValue -> Right wpTo, fromPersistValue -> Right (wGraph :: DBWorkflowGraph) ] = maybeT (return ()) $ do archiveAfter <- hoistMaybe mArchiveAfter WGN{wgnFinal} <- hoistMaybe . Map.lookup wpTo $ wgNodes wGraph let wwArchived = const (max now $ archiveAfter `addUTCTime` wpTime) <$> wgnFinal - lift [executeQQ| UPDATE workflow_workflow SET archived = #{wwArchived} WHERE id = #{wwId} |] + lift [executeQQ| UPDATE "workflow_workflow" SET "archived" = #{wwArchived} WHERE "id" = #{wwId}; |] migrateArchived _ = return () in runConduit $ getWorkflows .| C.mapM_ migrateArchived From 09dbe8d1feae0f721f945f1b07b32c9c46a3e930 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 26 May 2022 19:56:16 +0200 Subject: [PATCH 17/21] chore: fix migration --- src/Model/Migration/Definitions.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs index 7ceffa67a..80e97dd07 100644 --- a/src/Model/Migration/Definitions.hs +++ b/src/Model/Migration/Definitions.hs @@ -1067,19 +1067,19 @@ customMigrations = mapF $ \case ALTER TABLE "term" DROP COLUMN "active"; |] - Migration20220521WorkflowArchivation -> do + Migration20220521WorkflowArchivation -> whenM (and2M (tableExists "workflow_workflow") $ not <$> columnExists "workflow_workflow" "archived") $ do now <- liftIO getCurrentTime - whenM (and2M (tableExists "workflow_workflow") $ not <$> columnExists "workflow_workflow" "archived") $ do - [executeQQ| ALTER TABLE "workflow_workflow" ADD "archived" timestamp with time zone; |] - mArchiveAfter <- lift $ view _appWorkflowWorkflowArchiveAfter - let getWorkflows = [queryQQ| SELECT "workflow_workflow"."id", "workflow_workflow"."state"->-1->'time', "workflow_workflow"."state"->-1->'to', "shared_workflow_graph"."graph" FROM "workflow_workflow" INNER JOIN "shared_workflow_graph" ON "workflow_workflow"."graph" = "shared_workflow_graph"."hash"; |] - migrateArchived [ fromPersistValue -> Right (wwId :: WorkflowWorkflowId), fromPersistValue -> Right wpTime, fromPersistValue -> Right wpTo, fromPersistValue -> Right (wGraph :: DBWorkflowGraph) ] = maybeT (return ()) $ do - archiveAfter <- hoistMaybe mArchiveAfter - WGN{wgnFinal} <- hoistMaybe . Map.lookup wpTo $ wgNodes wGraph - let wwArchived = const (max now $ archiveAfter `addUTCTime` wpTime) <$> wgnFinal - lift [executeQQ| UPDATE "workflow_workflow" SET "archived" = #{wwArchived} WHERE "id" = #{wwId}; |] - migrateArchived _ = return () - in runConduit $ getWorkflows .| C.mapM_ migrateArchived + -- mArchiveAfter <- lift $ view _appWorkflowWorkflowArchiveAfter + let mArchiveAfter = Just (5270400 :: NominalDiffTime) + [executeQQ| ALTER TABLE "workflow_workflow" ADD "archived" timestamp with time zone; |] + let getWorkflows = [queryQQ| SELECT "workflow_workflow"."id", "workflow_workflow"."state"->-1->'time', "workflow_workflow"."state"->-1->'to', "shared_workflow_graph"."graph" FROM "workflow_workflow" INNER JOIN "shared_workflow_graph" ON "workflow_workflow"."graph" = "shared_workflow_graph"."hash"; |] + migrateArchived [ fromPersistValue -> Right (wwId :: WorkflowWorkflowId), fmap Aeson.fromJSON . fromPersistValue -> Right (Aeson.Success wpTime), fmap Aeson.fromJSON . fromPersistValue -> Right (Aeson.Success wpTo), fromPersistValue -> Right (wGraph :: DBWorkflowGraph) ] = maybeT (return ()) $ do + archiveAfter <- hoistMaybe mArchiveAfter + WGN{wgnFinal} <- hoistMaybe . Map.lookup wpTo $ wgNodes wGraph + let wwArchived = const (max now $ archiveAfter `addUTCTime` wpTime) <$> wgnFinal + lift [executeQQ| UPDATE "workflow_workflow" SET "archived" = #{wwArchived} WHERE "id" = #{wwId}; |] + migrateArchived _ = return () + in runConduit $ getWorkflows .| C.mapM_ migrateArchived tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool From 2a9bb075faccd24d7f1de2f4e93bcfc0714ad714 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 26 May 2022 20:23:36 +0200 Subject: [PATCH 18/21] chore: reformulate messages --- messages/uniworx/categories/workflows/de-de-formal.msg | 6 +++--- messages/uniworx/categories/workflows/en-eu.msg | 6 +++--- .../workflow-archivation-scheduled/de-de-formal.hamlet | 7 ++++++- templates/i18n/workflow-archivation-scheduled/en-eu.hamlet | 7 ++++++- 4 files changed, 18 insertions(+), 8 deletions(-) diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index b9f977c65..38c861b29 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -106,8 +106,8 @@ WorkflowWorkflowWorkflowStateHeading: Zustand/Daten WorkflowWorkflowWorkflowPayloadHeading: Aktueller Datensatz WorkflowWorkflowWorkflowStateStateLabel: Aktueller Zustand WorkflowWorkflowWorkflowStateStateHidden: Versteckter Zustand -WorkflowWorkflowWorkflowStateArchivedLabel: Archiviert seit -WorkflowWorkflowWorkflowArchivationInfo: Workflows, welche seit 61 Tagen abgeschlossen sind, werden automatisch archiviert. Archivierte Workflows werden nicht als laufende Workflows gelistet. Das Auslösen einer Aktion setzt den Archivierungszeitpunkt eines Workflows zurück. +WorkflowWorkflowWorkflowStateArchivedLabel: Archiviert +WorkflowWorkflowWorkflowArchivationInfo: Workflows, welche seit 61 Tagen abgeschlossen sind, werden automatisch archiviert. Aktionen setzen den Archivierungszeitpunkt eines Workflows zurück. WorkflowWorkflowWorkflowHistoryLabelOthers: Aktionen Anderer WorkflowWorkflowWorkflowHistoryLabelOwn: Eigene Aktionen @@ -162,4 +162,4 @@ WorkflowInstanceUpdateUpdatedCategory: Kategorie-Update erfolgreich angewandt WorkflowInstanceUpdateDeletedDescriptionLanguage lang@Lang: Beschreibung/Titel in Sprache „#{lang}“ gelöscht WorkflowInstanceUpdateUpdatedDescriptionLanguage lang@Lang: Beschreibung/Titel-Update für Sprache „#{lang}“ angewandt -WorkflowsDisabled: Workflows sind temporär deaktiviert. \ No newline at end of file +WorkflowsDisabled: Workflows sind zur Zeit deaktiviert. \ No newline at end of file diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index be13fa397..2251e99c3 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -65,8 +65,8 @@ WorkflowWorkflowWorkflowStateHeading: State/Data WorkflowWorkflowWorkflowPayloadHeading: Current data WorkflowWorkflowWorkflowStateStateLabel: Current state WorkflowWorkflowWorkflowStateStateHidden: Hidden state -WorkflowWorkflowWorkflowStateArchivedLabel: Archived since -WorkflowWorkflowWorkflowArchivationInfo: Workflows that are finalized since 61 days will be automatically moved to the archive. Archived workflows are not listed as running. Actions reset the archivation date of a workflow. +WorkflowWorkflowWorkflowStateArchivedLabel: Archived +WorkflowWorkflowWorkflowArchivationInfo: Workflows that are finalized for 61 days will be automatically moved to the archive. Actions reset the archivation date of a workflow. WorkflowWorkflowWorkflowHistoryLabelOthers: Other users' actions WorkflowWorkflowWorkflowHistoryLabelOwn: Your actions @@ -162,4 +162,4 @@ WorkflowInstanceUpdateUpdatedCategory: Successfully applied updated category WorkflowInstanceUpdateDeletedDescriptionLanguage lang: Successfully deleted description/title for language “#{lang}” WorkflowInstanceUpdateUpdatedDescriptionLanguage lang: Successfully applied updated description/title for language “#{lang}” -WorkflowsDisabled: Workflows are temporarily disabled. +WorkflowsDisabled: Workflows are currently disabled. diff --git a/templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet b/templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet index 68cc8e463..ff304280d 100644 --- a/templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet +++ b/templates/i18n/workflow-archivation-scheduled/de-de-formal.hamlet @@ -1,4 +1,9 @@ $newline never

- Dieser Workflow wird am ^{formatTimeW SelFormatDateTime archived} archiviert. + Dieser Workflow wird am ^{formatTimeW SelFormatDateTime archived} archiviert, sofern keine weitere Aktion durchgeführt wird. + +

+ Sobald ein Workflow archiviert ist, wird er nicht mehr in der Liste laufender Workflows angeführt. +
+ Sie können in einem bereits archivierten Workflow auch weiterhin alle Aktionen ausführen, welche Sie in einem laufenden Workflow im gleichen Zustand durchführen könnten. diff --git a/templates/i18n/workflow-archivation-scheduled/en-eu.hamlet b/templates/i18n/workflow-archivation-scheduled/en-eu.hamlet index efa0e8f52..022023fe3 100644 --- a/templates/i18n/workflow-archivation-scheduled/en-eu.hamlet +++ b/templates/i18n/workflow-archivation-scheduled/en-eu.hamlet @@ -1,4 +1,9 @@ $newline never

- This workflow will be archived on ^{formatTimeW SelFormatDateTime archived}. + This workflow will be archived on ^{formatTimeW SelFormatDateTime archived} if no further action is performed. + +

+ Once a workflow has been archived, it will not be listed among the list of running workflows anymore. +
+ In an archived workflow, you are still able to perform any action that you could perform in a running workflow in the same current state. From ebd464c7e5069ddf7b42b55e1fe073ef8d739cdd Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 26 May 2022 20:29:50 +0200 Subject: [PATCH 19/21] chore: reformulate messages --- messages/uniworx/categories/workflows/de-de-formal.msg | 2 +- messages/uniworx/categories/workflows/en-eu.msg | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index 38c861b29..d7119ed2b 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -106,7 +106,7 @@ WorkflowWorkflowWorkflowStateHeading: Zustand/Daten WorkflowWorkflowWorkflowPayloadHeading: Aktueller Datensatz WorkflowWorkflowWorkflowStateStateLabel: Aktueller Zustand WorkflowWorkflowWorkflowStateStateHidden: Versteckter Zustand -WorkflowWorkflowWorkflowStateArchivedLabel: Archiviert +WorkflowWorkflowWorkflowStateArchivedLabel: Archiviert seit WorkflowWorkflowWorkflowArchivationInfo: Workflows, welche seit 61 Tagen abgeschlossen sind, werden automatisch archiviert. Aktionen setzen den Archivierungszeitpunkt eines Workflows zurück. WorkflowWorkflowWorkflowHistoryLabelOthers: Aktionen Anderer WorkflowWorkflowWorkflowHistoryLabelOwn: Eigene Aktionen diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index 2251e99c3..36baebc09 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -65,7 +65,7 @@ WorkflowWorkflowWorkflowStateHeading: State/Data WorkflowWorkflowWorkflowPayloadHeading: Current data WorkflowWorkflowWorkflowStateStateLabel: Current state WorkflowWorkflowWorkflowStateStateHidden: Hidden state -WorkflowWorkflowWorkflowStateArchivedLabel: Archived +WorkflowWorkflowWorkflowStateArchivedLabel: Archived since WorkflowWorkflowWorkflowArchivationInfo: Workflows that are finalized for 61 days will be automatically moved to the archive. Actions reset the archivation date of a workflow. WorkflowWorkflowWorkflowHistoryLabelOthers: Other users' actions WorkflowWorkflowWorkflowHistoryLabelOwn: Your actions From 84d3327db37aa1177cc2e9b40fa9fc3e03ec7867 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 26 May 2022 21:02:06 +0200 Subject: [PATCH 20/21] fix(workflows): correct interpolation of archived state in headings --- .../categories/workflows/de-de-formal.msg | 20 +++++++++---------- .../uniworx/categories/workflows/en-eu.msg | 20 +++++++++---------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index d7119ed2b..bb522d69a 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -125,16 +125,16 @@ GlobalWorkflowWorkflowWorkflowTitle workflowWorkflowId@CryptoFileNameWorkflowWor SchoolWorkflowWorkflowWorkflowHeading ssh@SchoolId workflowWorkflowId@CryptoFileNameWorkflowWorkflow !ident-ok: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} SchoolWorkflowWorkflowWorkflowTitle ssh@SchoolId workflowWorkflowId@CryptoFileNameWorkflowWorkflow !ident-ok: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} -WorkflowWorkflowListScopeTitle rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows - _{rScope} -WorkflowWorkflowListScopeHeading rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows (_{rScope}) -WorkflowWorkflowListInstanceTitle mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows für Instanz -WorkflowWorkflowListInstanceHeading mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows für Instanz -WorkflowWorkflowListNamedInstanceTitle rScope@RouteWorkflowScope wiTitle@Text mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows - _{rScope}, #{wiTitle} -WorkflowWorkflowListNamedInstanceHeading rScope@RouteWorkflowScope wiTitle@Text mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows (_{rScope}, #{wiTitle}) -WorkflowWorkflowListNamedInstanceTitleDisabled rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows - _{rScope} -WorkflowWorkflowListNamedInstanceHeadingDisabled rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows (_{rScope}) -WorkflowWorkflowListTopTitle mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows -WorkflowWorkflowListTopHeading mArchived@(Maybe Bool): #{tshow (maybe "Alle" (bool "Laufende" "Archivierte") mArchived)} Workflows +WorkflowWorkflowListScopeTitle rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows - _{rScope} +WorkflowWorkflowListScopeHeading rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows (_{rScope}) +WorkflowWorkflowListInstanceTitle mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows für Instanz +WorkflowWorkflowListInstanceHeading mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows für Instanz +WorkflowWorkflowListNamedInstanceTitle rScope@RouteWorkflowScope wiTitle@Text mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows - _{rScope}, #{wiTitle} +WorkflowWorkflowListNamedInstanceHeading rScope@RouteWorkflowScope wiTitle@Text mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows (_{rScope}, #{wiTitle}) +WorkflowWorkflowListNamedInstanceTitleDisabled rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows - _{rScope} +WorkflowWorkflowListNamedInstanceHeadingDisabled rScope@RouteWorkflowScope mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows (_{rScope}) +WorkflowWorkflowListTopTitle mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows +WorkflowWorkflowListTopHeading mArchived@(Maybe Bool): #{maybe (Text.pack "Alle") (bool "Laufende" "Archivierte") mArchived} Workflows AdminWorkflowWorkflowListTitle: Alle Workflows AdminWorkflowWorkflowListHeading: Alle Workflows diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index 36baebc09..daaa6cdf7 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -84,16 +84,16 @@ GlobalWorkflowWorkflowWorkflowTitle workflowWorkflowId: Workflow #{toPathPiece w SchoolWorkflowWorkflowWorkflowHeading ssh workflowWorkflowId: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} SchoolWorkflowWorkflowWorkflowTitle ssh workflowWorkflowId: Workflow #{ssh}, #{toPathPiece workflowWorkflowId} -WorkflowWorkflowListScopeTitle rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows - _{rScope} -WorkflowWorkflowListScopeHeading rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows (_{rScope}) -WorkflowWorkflowListInstanceTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows for an instance -WorkflowWorkflowListInstanceHeading mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows for an instance -WorkflowWorkflowListNamedInstanceTitle rScope wiTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows - _{rScope}, #{wiTitle} -WorkflowWorkflowListNamedInstanceHeading rScope wiTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows (_{rScope}, #{wiTitle}) -WorkflowWorkflowListNamedInstanceTitleDisabled rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows - _{rScope} -WorkflowWorkflowListNamedInstanceHeadingDisabled rScope mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows (_{rScope}) -WorkflowWorkflowListTopTitle mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows -WorkflowWorkflowListTopHeading mArchived: #{tshow (maybe "All" (bool "Running" "Archived") mArchived)} workflows +WorkflowWorkflowListScopeTitle rScope mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows - _{rScope} +WorkflowWorkflowListScopeHeading rScope mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows (_{rScope}) +WorkflowWorkflowListInstanceTitle mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows for an instance +WorkflowWorkflowListInstanceHeading mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows for an instance +WorkflowWorkflowListNamedInstanceTitle rScope wiTitle mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows - _{rScope}, #{wiTitle} +WorkflowWorkflowListNamedInstanceHeading rScope wiTitle mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows (_{rScope}, #{wiTitle}) +WorkflowWorkflowListNamedInstanceTitleDisabled rScope mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows - _{rScope} +WorkflowWorkflowListNamedInstanceHeadingDisabled rScope mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows (_{rScope}) +WorkflowWorkflowListTopTitle mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows +WorkflowWorkflowListTopHeading mArchived: #{maybe (Text.pack "All") (bool "Running" "Archived") mArchived} workflows AdminWorkflowWorkflowListTitle: All workflows AdminWorkflowWorkflowListHeading: All workflows From c4b225c07a033e987031c48fe645537aaef5c7e1 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 27 May 2022 00:44:47 +0200 Subject: [PATCH 21/21] chore(navigation): add missing page actions for wf archives --- src/Foundation/Navigation.hs | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 2c5214862..7b5bbb4df 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -2739,6 +2739,32 @@ pageActions TopWorkflowWorkflowArchiveR = return , navChildren = [] } ] +pageActions (SchoolR ssh (SchoolWorkflowInstanceR swiName SWIWorkflowsR)) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuWorkflowWorkflowArchive + , navRoute = SchoolR ssh $ SchoolWorkflowInstanceR swiName SWIWorkflowsArchiveR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (SchoolR ssh (SchoolWorkflowInstanceR swiName SWIWorkflowsArchiveR)) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuWorkflowWorkflowList + , navRoute = SchoolR ssh $ SchoolWorkflowInstanceR swiName SWIWorkflowsR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] pageActions _ = return [] submissionList :: ( MonadIO m