diff --git a/CHANGELOG.md b/CHANGELOG.md
index 3ab98e1a6..35e55b013 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -156,6 +156,7 @@ All notable changes to this project will be documented in this file. See [standa
### Bug Fixes
+
* **system-message:** add volatile cluster setting model default ([6655582](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6655582ace098808bfcea90ca85fce2fe0024d2b))
## [25.29.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.29.1...v25.29.2) (2022-04-21)
diff --git a/routes b/routes
index 9c7b89ae8..98a440272 100644
--- a/routes
+++ b/routes
@@ -282,4 +282,4 @@
/swagger SwaggerR GET !free
/swagger.json SwaggerJsonR GET !free
-!/*WellKnownFileName WellKnownR GET !free
\ No newline at end of file
+!/*WellKnownFileName WellKnownR GET !free
diff --git a/src/Application.hs b/src/Application.hs
index 0eabab1f9..d3df9d441 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -156,7 +156,6 @@ import Handler.ApiDocs
import Handler.Swagger
import ServantApi () -- YesodSubDispatch instances
-
import Servant.API
import Servant.Client
import Network.HTTP.Client.TLS (mkManagerSettings)
diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs
index 47d2fd6fb..4e4de1cbc 100644
--- a/src/Foundation/I18n.hs
+++ b/src/Foundation/I18n.hs
@@ -142,6 +142,11 @@ ordinalEN (toMessage -> numStr) = case lastChar of
where
lastChar = last <$> fromNullable numStr
+notDE :: Bool -> Text
+notDE = bool "nicht" ""
+
+notEN :: Bool -> Text
+notEN = bool "not" ""
{- -- TODO: use this is message eventually
-- Commonly used plurals
diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs
index f63c1093f..39c341b34 100644
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@@ -111,7 +111,7 @@ breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCe
breadcrumb (PrintDownloadR _) = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR
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
@@ -2511,6 +2511,51 @@ pageActions PrintCenterR = return
, navChildren = []
}
]
+pageActions ApiDocsR = return
+ [ NavPageActionPrimary
+ { navLink = NavLink
+ { navLabel = MsgMenuSwagger
+ , navRoute = SwaggerR
+ , navAccess' = NavAccessTrue
+ , navType = NavTypeLink { navModal = False }
+ , navQuick' = mempty
+ , navForceActive = False
+ }
+ , navChildren = []
+ }
+ ]
+pageActions (TopWorkflowWorkflowListR lState) =
+ let lState' | lState == WorkflowWorkflowListActive = WorkflowWorkflowListArchive
+ | otherwise = WorkflowWorkflowListActive
+ in return
+ [ NavPageActionPrimary
+ { navLink = NavLink
+ { navLabel = MsgMenuTopWorkflowWorkflowList lState'
+ , navRoute = TopWorkflowWorkflowListR lState'
+ , navAccess' = NavAccessTrue
+ , navType = NavTypeLink { navModal = False }
+ , navQuick' = mempty
+ , navForceActive = False
+ }
+ , navChildren = []
+ }
+ ]
+pageActions (SchoolR ssh (SchoolWorkflowInstanceR swiName (SWIWorkflowsR lState))) =
+ let lState' | lState == WorkflowWorkflowListActive = WorkflowWorkflowListArchive
+ | otherwise = WorkflowWorkflowListActive
+ in return
+ [ NavPageActionPrimary
+ { navLink = NavLink
+ { navLabel = MsgMenuWorkflowWorkflowList lState'
+ , navRoute = SchoolR ssh . SchoolWorkflowInstanceR swiName $ SWIWorkflowsR lState'
+ , navAccess' = NavAccessTrue
+ , navType = NavTypeLink { navModal = False }
+ , navQuick' = mempty
+ , navForceActive = False
+ }
+ , navChildren = []
+ }
+ ]
pageActions _ = return []
submissionList :: ( MonadIO m
diff --git a/src/Handler/Info.hs b/src/Handler/Info.hs
index b4ce9389d..170a156f7 100644
--- a/src/Handler/Info.hs
+++ b/src/Handler/Info.hs
@@ -42,6 +42,7 @@ 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)
diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs
index 94e900e4f..e51dfc6aa 100644
--- a/src/Handler/SystemMessage.hs
+++ b/src/Handler/SystemMessage.hs
@@ -19,6 +19,7 @@ import qualified Data.Text as Text (intercalate)
import qualified Database.Esqueleto.Legacy as E
+
invalidateVisibleSystemMessages :: (MonadHandler m, HandlerSite m ~ UniWorX) => m ()
invalidateVisibleSystemMessages = memcachedByInvalidate AuthCacheVisibleSystemMessages $ Proxy @(Map SystemMessageId (Maybe UTCTime, Maybe UTCTime))
@@ -49,7 +50,6 @@ systemMessageVolatileClusterSettingsForm (fmap Set.toList -> mPrev) = wFormToAFo
miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/systemMessage/volatileClusterSettings/layout")
fmap Set.fromList <$> massInputAccumEditW miAdd miEdit miButtonAction miLayout ("system-message-volatile-cluster-settings" :: Text) (fslI MsgSystemMessageOnVolatileClusterSettings) False mPrev
-
getMessageR, postMessageR :: CryptoUUIDSystemMessage -> Handler Html
getMessageR = postMessageR
postMessageR cID = do
diff --git a/src/Jobs/Handler/Files.hs b/src/Jobs/Handler/Files.hs
index 79b25593f..ae522be5b 100644
--- a/src/Jobs/Handler/Files.hs
+++ b/src/Jobs/Handler/Files.hs
@@ -106,7 +106,6 @@ dispatchJobDetectMissingFiles = JobHandlerAtomicDeferrableWithFinalizer act fin
let useRefSource refKind refSource = transPipe (lift . withReaderT projectBackend) (refSource .| C.filterM (\ref -> not <$> exists [FileContentEntryHash ==. ref])) .| C.mapM_ (insertRef refKind)
useRefSource (nameToPathPiece ''Job) jobFileReferences
-
let allMissingDb :: Set Minio.Object
allMissingDb = setOf (folded . folded . re minioFileReference) missingDb
filterMissingDb :: forall m. Monad m
diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs
index bc779af34..e9ed2dfd6 100644
--- a/src/Model/Migration/Definitions.hs
+++ b/src/Model/Migration/Definitions.hs
@@ -101,9 +101,7 @@ data ManualMigration
| Migration20210208StudyFeaturesRelevanceCachedUUIDs
| Migration20210318CrontabSubmissionRatedNotification
| Migration20210608SeparateTermActive
- -- TODO: migration regarding authorship statements
- -- - apply desired non-default modes for IfI
- -- - set authorship statement texts for IfI
+ | Migration20220521WorkflowArchivation
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
deriving anyclass (Universe, Finite)
@@ -1018,6 +1016,20 @@ customMigrations = mapF $ \case
ALTER TABLE "term" DROP COLUMN "active";
|]
+ Migration20220521WorkflowArchivation -> whenM (and2M (tableExists "workflow_workflow") $ not <$> columnExists "workflow_workflow" "archived") $ do
+ now <- liftIO getCurrentTime
+ -- 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_ $ do
+ archiveAfter <- hoistMaybe mArchiveAfter
+ WGN{wgnFinal} <- hoistMaybe . Map.lookup wpTo $ wgNodes wGraph
+ let wwArchived = 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
diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs
index e8c1a13b1..faa946814 100644
--- a/src/Model/Types/Common.hs
+++ b/src/Model/Types/Common.hs
@@ -62,4 +62,4 @@ type TermCandidateIncidence = UUID
type SessionFileReference = Digest SHA3_256
type QualificationName = CI Text
-type QualificationShorthand = CI Text
\ No newline at end of file
+type QualificationShorthand = CI Text
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index ff923d430..a26776c30 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -76,6 +76,7 @@ import qualified Data.Binary as Binary
import qualified Data.ByteString.Base64.URL as Base64 (encodeUnpadded)
import qualified Data.ByteString as BS
+
------------
-- Fields --
------------
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.
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index 6797a3515..cce60d648 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -880,6 +880,21 @@ fillDb = do
, systemMessageLastChanged = now
, systemMessageLastUnhide = now
}
+ void $ insert SystemMessage
+ { systemMessageNewsOnly = False
+ , systemMessageFrom = Just now
+ , systemMessageTo = Nothing
+ , systemMessageOnVolatileClusterSettings = Set.singleton (ClusterVolatileWorkflowsEnabled, toJSON False)
+ , systemMessageAuthenticatedOnly = False
+ , systemMessageSeverity = Warning
+ , systemMessageManualPriority = Nothing
+ , systemMessageDefaultLanguage = "de"
+ , systemMessageContent = "Workflow-System zur Zeit deaktiviert (systemMessageOnVolatileClusterSettings-Test)"
+ , systemMessageSummary = Nothing
+ , systemMessageCreated = now
+ , systemMessageLastChanged = now
+ , systemMessageLastUnhide = now
+ }
void $ insert SystemMessage
{ systemMessageNewsOnly = True
, systemMessageFrom = Just now