From 8634d20e2ad2d3746cf7b6111b91db9e57e4863b Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 26 Jul 2021 10:39:30 +0200 Subject: [PATCH] feat(workflows): replace pages with warning if turned off --- .../categories/workflows/de-de-formal.msg | 21 +++++++++----- .../uniworx/categories/workflows/en-eu.msg | 15 ++++++---- src/Handler/Utils/Workflow.hs | 29 +++++++++++++++++++ src/Handler/Workflow/Instance/Initiate.hs | 6 ++-- src/Handler/Workflow/Instance/List.hs | 15 +++++----- src/Handler/Workflow/Workflow/List.hs | 17 +++++------ src/Handler/Workflow/Workflow/Workflow.hs | 15 +++++----- .../workflows-disabled/de-de-formal.hamlet | 9 ++++++ .../i18n/workflows-disabled/en-eu.hamlet | 9 ++++++ 9 files changed, 94 insertions(+), 42 deletions(-) create mode 100644 src/Handler/Utils/Workflow.hs create mode 100644 templates/i18n/workflows-disabled/de-de-formal.hamlet create mode 100644 templates/i18n/workflows-disabled/en-eu.hamlet diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index b875b5d8b..6cd756c84 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -55,14 +55,17 @@ WorkflowDescription: Beschreibung GlobalWorkflowInstancesHeading: Workflows (Systemweit) GlobalWorkflowInstancesTitle: Workflows (Systemweit) -GlobalWorkflowInstanceInitiateHeading workflowInstanceTitle@Text: Worklow initiieren: #{workflowInstanceTitle} -GlobalWorkflowInstanceInitiateTitle: Worklow initiieren +GlobalWorkflowInstanceInitiateHeading workflowInstanceTitle@Text: Workflow initiieren: #{workflowInstanceTitle} +GlobalWorkflowInstanceInitiateTitle: Workflow initiieren SchoolWorkflowInstancesHeading ssh@SchoolId !ident-ok: Workflows (#{ssh}) SchoolWorkflowInstancesTitle ssh@SchoolId !ident-ok: Workflows (#{ssh}) -SchoolWorkflowInstanceInitiateHeading ssh@SchoolId workflowInstanceTitle@Text: Worklow initiieren: #{ssh}, #{workflowInstanceTitle} -SchoolWorkflowInstanceInitiateTitle ssh@SchoolId: Worklow initiieren: #{ssh} +SchoolWorkflowInstanceInitiateHeading ssh@SchoolId workflowInstanceTitle@Text: Workflow initiieren: #{ssh}, #{workflowInstanceTitle} +SchoolWorkflowInstanceInitiateTitle ssh@SchoolId: Workflow initiieren: #{ssh} + +WorkflowInstanceInitiateHeadingDisabled: Workflow initiieren +WorkflowInstanceInitiateTitleDisabled: Workflow initiieren WorkflowEdgeNumberedVariant edgeLabel@Text i@Natural: #{edgeLabel} (Variante #{i}) WorkflowEdgeFormEdge: Aktion @@ -120,12 +123,14 @@ 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@Text: Laufende Workflows - #{rScope} -WorkflowWorkflowListScopeHeading rScope@Text: Laufende Workflows (#{rScope}) +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@Text wiTitle@Text: Laufende Workflows - #{rScope}, #{wiTitle} -WorkflowWorkflowListNamedInstanceHeading rScope@Text wiTitle@Text: Laufende Workflows (#{rScope}, #{wiTitle}) +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 diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index 5fc8d4911..2dcc37915 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -23,6 +23,9 @@ SchoolWorkflowInstancesTitle ssh: Workflows (#{ssh}) SchoolWorkflowInstanceInitiateHeading ssh workflowInstanceTitle: Initiate workflow: #{ssh}, #{workflowInstanceTitle} SchoolWorkflowInstanceInitiateTitle ssh: Initiate workflow: #{ssh} +WorkflowInstanceInitiateHeadingDisabled: Initiate Workflow +WorkflowInstanceInitiateTitleDisabled: Initiate Workflow + WorkflowEdgeNumberedVariant edgeLabel i: #{edgeLabel} (variant #{i}) WorkflowEdgeFormEdge: Action WorkflowEdgeFormHiddenPayload i: Hidden dataset #{i} @@ -79,12 +82,14 @@ 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}) +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}) +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 @@ -155,4 +160,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. \ No newline at end of file +WorkflowsDisabled: Workflows are temporarily disabled. diff --git a/src/Handler/Utils/Workflow.hs b/src/Handler/Utils/Workflow.hs new file mode 100644 index 000000000..947e0c6d3 --- /dev/null +++ b/src/Handler/Utils/Workflow.hs @@ -0,0 +1,29 @@ +module Handler.Utils.Workflow + ( workflowsDisabledWarning + , module Reexport + ) where + +import Import + +import Handler.Utils.I18n + +import Handler.Utils.Workflow.Form as Reexport +import Handler.Utils.Workflow.EdgeForm as Reexport +import Handler.Utils.Workflow.Restriction as Reexport +import Handler.Utils.Workflow.CanonicalRoute as Reexport +import Handler.Utils.Workflow.Workflow as Reexport + + +workflowsDisabledWarning :: ( MonadHandler m + , HandlerSite m ~ UniWorX + , RenderMessage UniWorX titleMsg, RenderMessage UniWorX headingMsg + ) + => titleMsg -> headingMsg + -> m Html + -> m Html +workflowsDisabledWarning tMsg hMsg = volatileBool clusterVolatileWorkflowsEnabled warningHtml + where + warningHtml = liftHandler . siteLayoutMsg hMsg $ do + setTitleI tMsg + + notificationWidget NotificationBroad Warning $(i18nWidgetFile "workflows-disabled") diff --git a/src/Handler/Workflow/Instance/Initiate.hs b/src/Handler/Workflow/Instance/Initiate.hs index 361d675c5..d0046ae91 100644 --- a/src/Handler/Workflow/Instance/Initiate.hs +++ b/src/Handler/Workflow/Instance/Initiate.hs @@ -10,9 +10,7 @@ import Utils.Form import Utils.Workflow import Handler.Utils -import Handler.Utils.Workflow.EdgeForm -import Handler.Utils.Workflow.CanonicalRoute -import Handler.Utils.Workflow.Workflow (followEdge) +import Handler.Utils.Workflow import qualified Data.CaseInsensitive as CI import qualified Data.List.NonEmpty as NonEmpty @@ -27,7 +25,7 @@ getSWIInitiateR = postSWIInitiateR postSWIInitiateR ssh = workflowInstanceInitiateR $ WSSchool ssh workflowInstanceInitiateR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler Html -workflowInstanceInitiateR rScope win = do +workflowInstanceInitiateR rScope win = workflowsDisabledWarning MsgWorkflowInstanceInitiateTitleDisabled MsgWorkflowInstanceInitiateHeadingDisabled $ do (WorkflowInstance{..}, ((edgeAct, edgeView'), edgeEnc), mDesc) <- runDB $ do scope <- maybeT notFound $ fromRouteWorkflowScope rScope Entity wiId wi@WorkflowInstance{..} <- getBy404 . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope diff --git a/src/Handler/Workflow/Instance/List.hs b/src/Handler/Workflow/Instance/List.hs index e2af7d31c..66c73f030 100644 --- a/src/Handler/Workflow/Instance/List.hs +++ b/src/Handler/Workflow/Instance/List.hs @@ -12,7 +12,7 @@ import Import import Handler.Utils import Utils.Workflow -import Handler.Utils.Workflow.CanonicalRoute +import Handler.Utils.Workflow import Handler.Workflow.Instance.Update import qualified Database.Esqueleto.Legacy as E @@ -135,7 +135,7 @@ getSchoolWorkflowInstanceListR = workflowInstanceListR . WSSchool workflowInstanceListR :: RouteWorkflowScope -> Handler Html -workflowInstanceListR rScope = do +workflowInstanceListR rScope = workflowsDisabledWarning title heading $ do instances <- runDB $ do dbScope <- maybeT notFound $ view _DBWorkflowScope <$> fromRouteWorkflowScope rScope @@ -163,11 +163,6 @@ workflowInstanceListR rScope = do , workflowInstanceName ) - (heading, title) <- case rScope of - WSGlobal -> return (MsgGlobalWorkflowInstancesHeading, MsgGlobalWorkflowInstancesTitle) - WSSchool ssh -> return (MsgSchoolWorkflowInstancesHeading ssh, MsgSchoolWorkflowInstancesTitle ssh) - _other -> error "not implemented" - siteLayoutMsg heading $ do setTitleI title let mPitch = Just $(i18nWidgetFile "workflow-instance-list-explanation") @@ -185,6 +180,12 @@ workflowInstanceListR rScope = do toListRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR) toUpdateRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIUpdateR) + (heading, title) = case rScope of + WSGlobal -> (MsgGlobalWorkflowInstancesHeading, MsgGlobalWorkflowInstancesTitle) + WSSchool ssh -> (MsgSchoolWorkflowInstancesHeading ssh, MsgSchoolWorkflowInstancesTitle ssh) + _other -> error "not implemented" + + getTopWorkflowInstanceListR :: Handler Html getTopWorkflowInstanceListR = do gInstances <- runDB $ do diff --git a/src/Handler/Workflow/Workflow/List.hs b/src/Handler/Workflow/Workflow/List.hs index f48943e3a..10c394f8e 100644 --- a/src/Handler/Workflow/Workflow/List.hs +++ b/src/Handler/Workflow/Workflow/List.hs @@ -14,8 +14,7 @@ module Handler.Workflow.Workflow.List import Import hiding (Last(..), WriterT) import Utils.Workflow -import Handler.Utils.Workflow.Workflow -import Handler.Utils.Workflow.CanonicalRoute +import Handler.Utils.Workflow import Handler.Workflow.Workflow.Workflow (WorkflowHistoryItemActor'(..), WorkflowHistoryItemActor) @@ -66,17 +65,16 @@ getSchoolWorkflowWorkflowListR :: SchoolId -> Handler Html getSchoolWorkflowWorkflowListR = workflowWorkflowListR . WSSchool workflowWorkflowListR :: RouteWorkflowScope -> Handler Html -workflowWorkflowListR rScope = do +workflowWorkflowListR rScope = workflowsDisabledWarning (headings ^. _1) (headings ^. _2) $ do scope <- runDB . maybeT notFound $ fromRouteWorkflowScope rScope - MsgRenderer mr <- getMsgRenderer - workflowWorkflowList (headings mr) columns . runReader $ do + workflowWorkflowList headings columns . runReader $ do workflowWorkflow <- view queryWorkflowWorkflow return $ workflowWorkflow E.^. WorkflowWorkflowScope E.==. E.val (scope ^. _DBWorkflowScope) where columns = def { wwListColumnScope = False } - headings mr = (MsgWorkflowWorkflowListScopeTitle $ mr rScope, MsgWorkflowWorkflowListScopeHeading $ mr rScope) + headings = (MsgWorkflowWorkflowListScopeTitle rScope, MsgWorkflowWorkflowListScopeHeading rScope) getGWIWorkflowsR :: WorkflowInstanceName -> Handler Html @@ -86,18 +84,17 @@ getSWIWorkflowsR :: SchoolId -> WorkflowInstanceName -> Handler Html getSWIWorkflowsR ssh = workflowInstanceWorkflowsR $ WSSchool ssh workflowInstanceWorkflowsR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler Html -workflowInstanceWorkflowsR rScope win = do +workflowInstanceWorkflowsR rScope win = workflowsDisabledWarning (MsgWorkflowWorkflowListNamedInstanceTitleDisabled rScope) (MsgWorkflowWorkflowListNamedInstanceHeadingDisabled rScope) $ do (scope, desc) <- runDB $ do scope <- maybeT notFound $ fromRouteWorkflowScope rScope wiId <- getKeyBy404 . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope desc <- selectWorkflowInstanceDescription wiId return (scope, desc) - MsgRenderer mr <- getMsgRenderer let headings = case desc of Nothing -> (MsgWorkflowWorkflowListInstanceTitle, MsgWorkflowWorkflowListInstanceHeading) Just (Entity _ WorkflowInstanceDescription{..}) - -> ( MsgWorkflowWorkflowListNamedInstanceTitle (mr rScope) workflowInstanceDescriptionTitle - , MsgWorkflowWorkflowListNamedInstanceHeading (mr rScope) workflowInstanceDescriptionTitle + -> ( MsgWorkflowWorkflowListNamedInstanceTitle rScope workflowInstanceDescriptionTitle + , MsgWorkflowWorkflowListNamedInstanceHeading rScope workflowInstanceDescriptionTitle ) workflowWorkflowList headings columns . runReader $ do workflowWorkflow <- view queryWorkflowWorkflow diff --git a/src/Handler/Workflow/Workflow/Workflow.hs b/src/Handler/Workflow/Workflow/Workflow.hs index 3a4248245..441fa1d54 100644 --- a/src/Handler/Workflow/Workflow/Workflow.hs +++ b/src/Handler/Workflow/Workflow/Workflow.hs @@ -13,9 +13,7 @@ import Utils.Workflow import Data.Semigroup (Last(..)) import Handler.Utils -import Handler.Utils.Workflow.EdgeForm -import Handler.Utils.Workflow.CanonicalRoute -import Handler.Utils.Workflow.Workflow +import Handler.Utils.Workflow import qualified Data.Map as Map import qualified Data.Set as Set @@ -77,7 +75,7 @@ getSWWFilesR ssh = getWorkflowFilesR $ WSSchool ssh workflowR :: RouteWorkflowScope -> CryptoFileNameWorkflowWorkflow -> Handler Html -workflowR rScope cID = do +workflowR rScope cID = workflowsDisabledWarning title heading $ do (mEdge, (workflowState, workflowHistory)) <- runDB $ do wwId <- decrypt cID WorkflowWorkflow{..} <- get404 wwId @@ -216,10 +214,6 @@ workflowR rScope cID = do sequenceOf_ (_Just . _1 . _1 . _Just) mEdge - (heading, title) <- case rScope of - WSGlobal -> return (MsgGlobalWorkflowWorkflowWorkflowHeading cID, MsgGlobalWorkflowWorkflowWorkflowTitle cID) - WSSchool ssh -> return (MsgSchoolWorkflowWorkflowWorkflowHeading ssh cID, MsgSchoolWorkflowWorkflowWorkflowTitle ssh cID) - _other -> error "not implemented" let headingWgt | Just WorkflowCurrentState{..} <- workflowState , Just (_, Just icn) <- wcsState @@ -255,6 +249,11 @@ workflowR rScope cID = do Just (Entity _ User{..}) -> nameWidget userDisplayName userSurname WorkflowFieldPayloadW (WFPFile v ) -> absurd v $(widgetFile "workflows/workflow") + where + (heading, title) = case rScope of + WSGlobal -> (MsgGlobalWorkflowWorkflowWorkflowHeading cID, MsgGlobalWorkflowWorkflowWorkflowTitle cID) + WSSchool ssh -> (MsgSchoolWorkflowWorkflowWorkflowHeading ssh cID, MsgSchoolWorkflowWorkflowWorkflowTitle ssh cID) + _other -> error "not implemented" getWorkflowFilesR :: RouteWorkflowScope -> CryptoFileNameWorkflowWorkflow diff --git a/templates/i18n/workflows-disabled/de-de-formal.hamlet b/templates/i18n/workflows-disabled/de-de-formal.hamlet new file mode 100644 index 000000000..86f8f1712 --- /dev/null +++ b/templates/i18n/workflows-disabled/de-de-formal.hamlet @@ -0,0 +1,9 @@ +$newline never +

+ Workflows sind temporär deaktiviert +

+ Uni2work-Administrator:innen deaktivieren das Workflowsystem gelegentlich manuell um die Last auf das System zu reduzieren. + +
+ + So kann die Performance und Stabilität des Systems in Zeiten erwarteter hoher Last verbessert werden um z.B. Online-Prüfungen reibungsloser ablaufen zu lassen. diff --git a/templates/i18n/workflows-disabled/en-eu.hamlet b/templates/i18n/workflows-disabled/en-eu.hamlet new file mode 100644 index 000000000..2d14cfc87 --- /dev/null +++ b/templates/i18n/workflows-disabled/en-eu.hamlet @@ -0,0 +1,9 @@ +$newline never +

+ Workflows are temporarily disabled +

+ Uni2work-administrators deactivate the workflow system manually on occasion to reduce load on the system. + +
+ + This is done to improve performance and stability of the system when high load is expected to improve the experience during e.g. online exams.