feat(workflows): replace pages with warning if turned off

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}
+GlobalWorkflowInstanceInitiateHeading workflowInstanceTitle@Text: Workflow initiieren: #{workflowInstanceTitle}
-GlobalWorkflowInstanceInitiateTitle: Worklow initiieren
+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}
+SchoolWorkflowInstanceInitiateHeading ssh@SchoolId workflowInstanceTitle@Text: Workflow initiieren: #{ssh}, #{workflowInstanceTitle}
-SchoolWorkflowInstanceInitiateTitle ssh@SchoolId: Worklow initiieren: #{ssh}
+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}
+WorkflowWorkflowListScopeTitle rScope@RouteWorkflowScope: Laufende Workflows - _{rScope}
-WorkflowWorkflowListScopeHeading rScope@Text: 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}
+WorkflowWorkflowListNamedInstanceTitle rScope@RouteWorkflowScope wiTitle@Text: Laufende Workflows - _{rScope}, #{wiTitle}
-WorkflowWorkflowListNamedInstanceHeading rScope@Text 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

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}
+WorkflowWorkflowListScopeTitle rScope: Running workflows - _{rScope}
-WorkflowWorkflowListScopeHeading 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}
+WorkflowWorkflowListNamedInstanceTitle rScope wiTitle: Running workflows - _{rScope}, #{wiTitle}
-WorkflowWorkflowListNamedInstanceHeading 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.
+WorkflowsDisabled: Workflows are temporarily disabled.

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")

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
-import Handler.Utils.Workflow.CanonicalRoute
-import Handler.Utils.Workflow.Workflow (followEdge)
 
 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 

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

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
-import Handler.Utils.Workflow.CanonicalRoute
 
 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 columns . runReader $ do
-  workflowWorkflowList (headings mr) 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
+          -> ( MsgWorkflowWorkflowListNamedInstanceTitle rScope workflowInstanceDescriptionTitle
-             , MsgWorkflowWorkflowListNamedInstanceHeading (mr rScope) workflowInstanceDescriptionTitle
+             , MsgWorkflowWorkflowListNamedInstanceHeading rScope workflowInstanceDescriptionTitle
              )
   workflowWorkflowList headings columns . runReader $ do
     workflowWorkflow <- view queryWorkflowWorkflow

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
-import Handler.Utils.Workflow.CanonicalRoute
-import Handler.Utils.Workflow.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

templates/i18n/workflows-disabled/de-de-formal.hamlet

@@ -0,0 +1,9 @@
+$newline never
+<p>
+  Workflows sind temporär deaktiviert
+<p>
+  Uni2work-Administrator:innen deaktivieren das Workflowsystem gelegentlich manuell um die Last auf das System zu reduzieren.
+
+  <br>
+
+  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.

templates/i18n/workflows-disabled/en-eu.hamlet

@@ -0,0 +1,9 @@
+$newline never
+<p>
+  Workflows are temporarily disabled
+<p>
+  Uni2work-administrators deactivate the workflow system manually on occasion to reduce load on the system.
+
+  <br>
+
+  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.