Slightly better system messages

src/Foundation.hs

@@ -1379,6 +1379,10 @@ applySystemMessages = liftHandlerT . runDB . runConduit $ selectSource [] [] .|
       cID <- encrypt smId
       void . assertM (== Authorized) . lift $ evalAccessDB (MessageR cID) False
 
+      now <- liftIO getCurrentTime
+      guard $ NTop systemMessageFrom <= NTop (Just now)
+      guard $ NTop (Just now) < NTop systemMessageTo
+
       let sessionKey = "sm-" <> tshow (ciphertext cID)
       _ <- assertM isNothing $ lookupSessionJson sessionKey :: MaybeT (YesodDB UniWorX) (Maybe ())
       setSessionJson sessionKey ()

src/Handler/SystemMessage.hs

@@ -121,7 +121,7 @@ postMessageR cID = do
   maySubmit <- (== Authorized) <$> evalAccess (MessageR cID) True
   forms <- traverse (const mkForm) $ () <$ guard maySubmit
 
-  defaultLayout
+  siteLayout' (toWidget <$> summary)
     $(widgetFile "system-message")
   where
     modifySystemMessage smId SystemMessage{..} = do

templates/system-message.hamlet

@@ -1,7 +1,7 @@
 <section>
-  $maybe summary' <- summary
-    <h2>
-      #{summary'}
+  $# $maybe summary' <- summary
+  $#   <h2>
+  $#     #{summary'}
   <p>
     #{content}
 

test/Database.hs

@@ -571,3 +571,8 @@ fillDb = do
   void . insert' $ DegreeCourse dbs sdBsc sdMath
   void . insert' $ Lecturer gkleen dbs CourseLecturer
   void . insert' $ Lecturer jost   dbs CourseAssistant
+
+  void . insert $ SystemMessage (Just now) Nothing False Success "de" "System-Nachrichten werden angezeigt" Nothing
+  void . insert $ SystemMessage (Just now) Nothing False Info "de" "System-Nachrichten können längeren Inhalt enthalten" (Just "System-Nachricht Zusammenfassung")
+  void . insert $ SystemMessage (Just now) (Just now) False Info "de" "System-Nachrichten haben Ablaufdaten" Nothing
+  void . insert $ SystemMessage Nothing Nothing False Error "de" "System-Nachrichten können Inaktiv sein" Nothing