diff --git a/models/system-messages b/models/system-messages index 0547718ae..0ceec9223 100644 --- a/models/system-messages +++ b/models/system-messages @@ -2,7 +2,7 @@ SystemMessage from UTCTime Maybe to UTCTime Maybe authenticatedOnly Bool - severity MessageClass + severity MessageStatus defaultLanguage Lang content Html summary Html Maybe diff --git a/src/Foundation.hs b/src/Foundation.hs index 047e3f670..70ad9da14 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -220,7 +220,7 @@ instance RenderMessage UniWorX MsgLanguage where instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route) -embedRenderMessage ''UniWorX ''MessageClass ("Message" <>) +embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>) embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel embedRenderMessage ''UniWorX ''StudyFieldType id embedRenderMessage ''UniWorX ''SheetFileType id diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 501cc97b9..946310640 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -20,6 +20,8 @@ import Database.Persist.Sql (fromSqlKey) -- import qualified Data.UUID.Cryptographic as UUID +import Control.Monad.Trans.Writer (mapWriterT) + -- BEGIN - Buttons needed only here data ButtonCreate = CreateMath | CreateInf -- Dummy for Example deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) @@ -84,15 +86,12 @@ postAdminTestR = do _other -> addMessage Warning "KEIN Knopf erkannt" ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm "email" $ renderAForm FormStandard emailTestForm - case emailResult of - (FormSuccess (email, ls)) -> do - jId <- runDB $ do - jId <- queueJob $ JobSendTestEmail email ls - addMessage Success [shamlet|Email-test gestartet (Job ##{tshow (fromSqlKey jId)})|] - return jId - writeJobCtl $ JobCtlPerform jId - FormMissing -> return () - (FormFailure errs) -> forM_ errs $ addMessage Error . toHtml + formResultModal emailResult AdminTestR $ \(email, ls) -> do + jId <- mapWriterT runDB $ do + jId <- queueJob $ JobSendTestEmail email ls + tell . pure $ Message Success [shamlet|Email-test gestartet (Job ##{tshow (fromSqlKey jId)})|] + return jId + writeJobCtl $ JobCtlPerform jId let emailWidget' = [whamlet|