diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 7cb07f419..496e65092 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1147,6 +1147,8 @@ SystemMessageFrom: Sichtbar ab SystemMessageTo: Sichtbar bis SystemMessageAuthenticatedOnly: Nur angemeldet SystemMessageSeverity: Schwere +SystemMessagePriority: Priorität +SystemMessagePriorityNegative: Priorität darf nicht negativ sein SystemMessageId: Id SystemMessageSummaryContent: Zusammenfassung / Inhalt SystemMessageSummary: Zusammenfassung diff --git a/models/system-messages.model b/models/system-messages.model index 1ba853a41..0d5cd5611 100644 --- a/models/system-messages.model +++ b/models/system-messages.model @@ -6,12 +6,14 @@ SystemMessage newsOnly Bool default=false authenticatedOnly Bool -- Show message to all users upon visiting the site or only upon login? severity MessageStatus -- Success, Warning, Error, Info, ... + manualPriority Natural Maybe created UTCTime default=now() lastChanged UTCTime default=now() lastUnhide UTCTime default=now() defaultLanguage Lang -- Language of @content@ and @summary@ content Html -- Detailed message shown when clicking on the @summary@-popup or when no @summary@ is specified summary Html Maybe + SystemMessageTranslation -- Translation of a @SystemMessage@ into another language; which language to choose is determined by user-sent HTTP-headers message SystemMessageId language Lang diff --git a/src/Foundation.hs b/src/Foundation.hs index a02f1d10c..924e9a0a4 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -2238,7 +2238,7 @@ applySystemMessages = liftHandler . maybeT_ . catchMPlus (Proxy @CryptoIDError) cRoute <- lift getCurrentRoute guard $ cRoute /= Just NewsR - lift . runDB . runConduit $ selectSource [] [] .| C.mapM_ applyMessage + lift . runDB . runConduit $ selectSource [] [Asc SystemMessageManualPriority] .| C.mapM_ applyMessage where syncSystemMessageHidden uid = runDB $ do smSt <- lookupRegisteredCookiesJson id CookieSystemMessageState :: DB (MergeHashMap CryptoUUIDSystemMessage UserSystemMessageState) diff --git a/src/Handler/News.hs b/src/Handler/News.hs index f3ee2f78d..ee46deb25 100644 --- a/src/Handler/News.hs +++ b/src/Handler/News.hs @@ -75,7 +75,7 @@ newsSystemMessages = do .| C.iterM (\(smId, _, _, _) -> tellShown smId) .| C.mapM (\(smId, sm@SystemMessage{..}, trans, hidden) -> (sm, trans, hidden,,) <$> formatTime SelFormatDateTime (maybe id max systemMessageFrom systemMessageLastChanged) <*> mkHideForm smId sm) .| C.consume - let messages = sortOn (\(SystemMessage{..}, _, _, _, _) -> (Down $ maybe id max systemMessageFrom systemMessageLastChanged, systemMessageSeverity)) messages' + let messages = sortOn (\(SystemMessage{..}, _, _, _, _) -> (Down systemMessageManualPriority, Down $ maybe id max systemMessageFrom systemMessageLastChanged, systemMessageSeverity)) messages' hiddenUrl <- toTextUrl (NewsR, [(toPathPiece GetHidden, "")]) diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs index f4b40496a..1eb650483 100644 --- a/src/Handler/SystemMessage.hs +++ b/src/Handler/SystemMessage.hs @@ -41,6 +41,7 @@ postMessageR cID = do <*> apopt checkBoxField (fslI MsgSystemMessageNewsOnly) (Just systemMessageNewsOnly) <*> apopt checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) (Just systemMessageAuthenticatedOnly) <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) (Just systemMessageSeverity) + <*> aopt (natFieldI MsgSystemMessagePriorityNegative) (fslI MsgSystemMessagePriority) (Just systemMessageManualPriority) <*> pure systemMessageCreated <*> (bool systemMessageLastChanged now <$> apopt checkBoxField (fslI MsgSystemMessageRecordChanged & setTooltip MsgSystemMessageRecordChangedTip) (Just True)) <*> (bool systemMessageLastUnhide now <$> apopt checkBoxField (fslI MsgSystemMessageUnhide & setTooltip MsgSystemMessageUnhideTip) (Just False)) @@ -175,6 +176,7 @@ postMessageListR = do , sortable (Just "news-only") (i18nCell MsgSystemMessageNewsOnly) $ \DBRow { dbrOutput = (Entity _ SystemMessage{..}, _) } -> tickmarkCell systemMessageNewsOnly , sortable (Just "authenticated") (i18nCell MsgSystemMessageAuthenticatedOnly) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> tickmarkCell systemMessageAuthenticatedOnly , sortable (Just "severity") (i18nCell MsgSystemMessageSeverity) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> i18nCell systemMessageSeverity + , sortable (Just "priority") (i18nCell MsgSystemMessagePriority) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> maybe mempty numCell systemMessageManualPriority , sortable (Just "created") (i18nCell MsgSystemMessageCreated) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ formatTimeW SelFormatDateTime systemMessageCreated , sortable (Just "last-changed") (i18nCell MsgSystemMessageLastChanged) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ formatTimeW SelFormatDateTime systemMessageLastChanged , sortable (Just "last-unhide") (i18nCell MsgSystemMessageLastUnhide) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ formatTimeW SelFormatDateTime systemMessageLastUnhide @@ -212,6 +214,9 @@ postMessageListR = do , ( "severity" , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageSeverity ) + , ( "priority" + , SortColumn (E.^. SystemMessageManualPriority) + ) , ( "created" , SortColumn $ \systemMessage -> systemMessage E.^. SystemMessageCreated ) @@ -283,6 +288,7 @@ postMessageListR = do <*> apopt checkBoxField (fslI MsgSystemMessageNewsOnly) (Just False) <*> apopt checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) (Just False) <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) (Just Info) + <*> aopt (natFieldI MsgSystemMessagePriorityNegative) (fslI MsgSystemMessagePriority) (Just Nothing) <*> pure now <*> pure now <*> pure now <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just $ NonEmpty.head appLanguages) <*> areq htmlField (fslI MsgSystemMessageContent) Nothing diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 8205128d6..e752ed049 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -922,6 +922,7 @@ fillDb = do , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Success + , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten werden angezeigt" , systemMessageSummary = Nothing @@ -936,6 +937,7 @@ fillDb = do , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Info + , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können längeren Inhalt enthalten" , systemMessageSummary = Just "System-Nachricht Zusammenfassung" @@ -949,6 +951,7 @@ fillDb = do , systemMessageTo = Just now , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Info + , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten haben Ablaufdaten" , systemMessageSummary = Nothing @@ -962,6 +965,7 @@ fillDb = do , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Error + , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können Inaktiv sein" , systemMessageSummary = Nothing @@ -975,6 +979,7 @@ fillDb = do , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Error + , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können nur auf \"Aktuelles\" angezeigt werden" , systemMessageSummary = Nothing