chore(mail): stub towards #171

new routes /mail and /mail/show/UUID to eventually display all sent emails by the system

messages/uniworx/categories/print/de-de-formal.msg

@@ -26,4 +26,6 @@ PrintPDF !ident-ok: PDF
 PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
 PrintLmsUser: E‑Learning Id
 PrintJobs: Druckaufräge
-PrintLetterType: Brieftypkürzel
+PrintLetterType: Brieftypkürzel
+
+MCActDummy: Platzhalter

messages/uniworx/categories/print/en-eu.msg

@@ -26,4 +26,6 @@ PrintPDF: PDF
 PrintManualRenewal: Manual sending of an apron driver's licence renewal letter
 PrintLmsUser: E‑learning id
 PrintJobs: Print jobs
-PrintLetterType: Letter type shorthand
+PrintLetterType: Letter type shorthand
+
+MCActDummy: Placeholder

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -149,6 +149,9 @@ MenuPrintDownload: Brief herunterladen
 MenuPrintLog: LPR Schnittstelle
 MenuPrintAck: Druckbestätigung
 
+MenuMailCenter: E‑Mails
+MenuMailShow: Anzeige
+
 MenuApiDocs: API-Dokumentation (Englisch)
 MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger)
 

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -149,6 +149,9 @@ MenuPrintDownload: Download Letter
 MenuPrintLog: LPR Interface
 MenuPrintAck: Acknowledge Printing
 
+MenuMailCenter: Email
+MenuMailShow: Display
+
 MenuApiDocs: API documentation
 MenuSwagger: OpenAPI 2.0 (Swagger)
 

routes

@@ -84,6 +84,9 @@
 /print/download/#CryptoUUIDPrintJob   PrintDownloadR  GET       !system-printer
 /print/log                            PrintLogR       GET       !system-printer
 
+/mail                                 MailCenterR     GET POST
+/mail/show/#CryptoUUIDSentMail        MailShowR       GET
+
 /health                       HealthR           GET             !free
 /health/interface/+Texts      HealthInterfaceR  GET             !free
 /instance                     InstanceR         GET             !free

src/Application.hs

@@ -158,6 +158,7 @@ import Handler.Qualification
 import Handler.LMS
 import Handler.SAP
 import Handler.PrintCenter
+import Handler.MailCenter
 import Handler.ApiDocs
 import Handler.Swagger
 import Handler.Firm
@@ -352,15 +353,15 @@ makeFoundation appSettings''@AppSettings{..} = do
           handleIf isBucketExists (const $ return ()) $ Minio.makeBucket appUploadTmpBucket Nothing
         return conn
 
-      appAvsQuery <- case appAvsConf of 
+      appAvsQuery <- case appAvsConf of
         Nothing -> do
           $logErrorS "avsPrepare" "appAvsConfig is empty, i.e. invalid AVS configuration settings."
           return Nothing
-          -- error "AvsConfig is empty, i.e. invalid AVS configuration settings."          
+          -- error "AvsConfig is empty, i.e. invalid AVS configuration settings."
-          
+
-        Just avsConf -> do          
+        Just avsConf -> do
           manager <- newManagerSettings $ mkManagerSettings (def { settingDisableCertificateValidation = True }) Nothing
-          let avsServer = BaseUrl 
+          let avsServer = BaseUrl
                             { baseUrlScheme = Https
                             , baseUrlHost = avsHost avsConf
                             , baseUrlPort = avsPort avsConf
@@ -657,7 +658,7 @@ appMain = runResourceT $ do
                    notifyWatchdog = forever' Nothing $ \pResults -> do
                      let delay = floor $ wInterval % 4
                      d <- liftIO $ newDelay delay
- 
+
                      $logDebugS "Notify" $ "Waiting up to " <> tshow delay <> "µs..."
                      mResults <- atomically $ asum
                        [ pResults <$ waitDelay d

src/CryptoID.hs

@@ -59,6 +59,7 @@ decCryptoIDs [ ''SubmissionId
              , ''MaterialFileId
              , ''PrintJobId
              , ''QualificationId
+             , ''SentMailId
              ]
 
 decCryptoIDKeySize

src/Foundation/Navigation.hs

@@ -136,6 +136,9 @@ breadcrumb PrintAckR{}      = i18nCrumb MsgMenuPrintSend      $ Just PrintCenter
 breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintAck       $ Just PrintCenterR
 breadcrumb PrintLogR        = i18nCrumb MsgMenuPrintLog       $ Just PrintCenterR
 
+breadcrumb MailCenterR      = i18nCrumb MsgMenuMailCenter       Nothing
+breadcrumb MailShowR{}      = i18nCrumb MsgMenuMailShow       $ Just MailCenterR
+
 breadcrumb SchoolListR      = i18nCrumb MsgMenuSchoolList       $ Just AdminR
 breadcrumb (SchoolR ssh sRoute) = case sRoute of
   SchoolEditR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
@@ -1225,7 +1228,7 @@ pageActions (AdminUserR cID) = return
   , NavPageActionPrimary
     { navLink = defNavLink MsgMenuUserEdit $ ForProfileR cID
     , navChildren = []
-    }  
+    }
   , NavPageActionPrimary
     { navLink = defNavLinkModal MsgUserHijack $ AdminHijackUserR cID
     , navChildren = []
@@ -1461,7 +1464,7 @@ pageActions (ForProfileDataR cID) = return
   [ NavPageActionPrimary
     { navLink = defNavLink MsgAdminUserHeading $ AdminUserR cID
     , navChildren = []
-    }  
+    }
   ]
 pageActions TermShowR = do
   participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR

src/Handler/Course/Edit.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>,Winnie Ros <winnie.ros@campus.lmu.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 

src/Handler/LMS.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022-23 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 

src/Handler/MailCenter.hs

@@ -0,0 +1,144 @@
+-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Handler.MailCenter
+  ( getMailCenterR, postMailCenterR
+  , getMailShowR
+  ) where
+
+import Import
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+-- import qualified Data.Aeson  as Aeson
+-- import qualified Data.Text as Text
+
+-- import Database.Persist.Sql (updateWhereCount)
+-- import           Database.Esqueleto.Experimental ((:&)(..))
+import qualified Database.Esqueleto.Legacy as EL (on) -- only `on` and `from` are different, needed for dbTable using Esqueleto.Legacy
+import qualified Database.Esqueleto.Experimental as E
+import qualified Database.Esqueleto.Utils as E
+import Database.Esqueleto.Utils.TH
+
+-- import Utils.Print
+
+import Handler.Utils
+-- import Handler.Utils.Csv
+-- import qualified Data.Csv as Csv
+-- import qualified Data.CaseInsensitive as CI
+
+-- import Jobs.Queue
+
+
+-- avoids repetition of local definitions
+single :: (k,a) -> Map k a
+single = uncurry Map.singleton
+
+
+data MCTableAction = MCActDummy -- just a dummy, since we don't now yet which actions we will be needing
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
+
+instance Universe MCTableAction
+instance Finite MCTableAction
+nullaryPathPiece ''MCTableAction $ camelToPathPiece' 2
+embedRenderMessage ''UniWorX ''MCTableAction id
+
+data MCTableActionData  = MCActDummyData
+  deriving (Eq, Ord, Read, Show, Generic)
+
+
+type MCTableExpr =
+  (                   E.SqlExpr (Entity SentMail)
+    `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
+  )
+
+queryMail :: MCTableExpr -> E.SqlExpr (Entity SentMail)
+queryMail = $(sqlLOJproj 2 1)
+
+{-
+queryRecipient :: MCTableExpr -> E.SqlExpr (Maybe (Entity User))
+queryRecipient = $(sqlLOJproj 2 2)
+-}
+
+type MCTableData = DBRow (Entity SentMail, Maybe (Entity User))
+
+resultMail :: Lens' MCTableData (Entity SentMail)
+resultMail = _dbrOutput . _1
+
+{-
+resultRecipient :: Traversal' MCTableData (Entity User)
+resultRecipient = _dbrOutput . _2 . _Just
+-}
+
+mkMCTable :: DB (FormResult (MCTableActionData, Set SentMailId), Widget)
+mkMCTable = do
+  let
+    dbtSQLQuery :: MCTableExpr -> E.SqlQuery (E.SqlExpr (Entity SentMail), E.SqlExpr (Maybe (Entity User)))
+    dbtSQLQuery  (mail `E.LeftOuterJoin` recipient) = do
+      EL.on $ mail E.^. SentMailRecipient E.==. recipient E.?. UserId
+      return (mail, recipient)
+    dbtRowKey = queryMail >>> (E.^. SentMailId)
+    dbtProj = dbtProjId
+    dbtColonnade = mconcat
+      [ dbSelect (applying _2) id (return . view (resultMail . _entityKey))
+      , sortable (Just "sent")      (i18nCell MsgPrintJobCreated)       $ \(   view $ resultMail . _entityVal . _sentMailSentAt -> t) ->      dateTimeCell t -- TODO: msg
+      ]
+    dbtSorting = mconcat
+      [ single ("sent"      , SortColumn $ queryMail >>> (E.^. SentMailSentAt))
+      ]
+    dbtFilter = mconcat
+      [ single ("sent"      , FilterColumn . E.mkDayFilter  $ views (to queryMail)      (E.^. SentMailSentAt))
+      ]
+    dbtFilterUI mPrev = mconcat
+      [ prismAForm (singletonFilter "sent"      . maybePrism _PathPiece) mPrev $ aopt (hoistField lift  dayField)  (fslI MsgPrintJobCreated) -- TODO: msg
+      ]
+    dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
+    dbtIdent :: Text
+    dbtIdent = "sent-mail"
+    dbtCsvEncode = noCsvEncode
+    dbtCsvDecode = Nothing
+    dbtExtraReps = []
+    dbtParams = DBParamsForm
+      { dbParamsFormMethod = POST
+      , dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
+      , dbParamsFormAttrs  = []
+      , dbParamsFormSubmit = FormSubmit
+      , dbParamsFormAdditional
+          = let acts :: Map MCTableAction (AForm Handler MCTableActionData)
+                acts = mconcat
+                  [ singletonMap MCActDummy $ pure MCActDummyData
+                  ]
+             in renderAForm FormStandard
+               $  (, mempty) . First . Just
+              <$> multiActionA acts (fslI MsgTableAction) Nothing
+      , dbParamsFormEvaluate = liftHandler . runFormPost
+      , dbParamsFormResult   = id
+      , dbParamsFormIdent    = def
+      }
+    postprocess :: FormResult (First MCTableActionData, DBFormResult SentMailId Bool MCTableData)
+                -> FormResult (      MCTableActionData, Set SentMailId)
+    postprocess inp = do
+        (First (Just act), jobMap) <- inp
+        let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
+        return (act, jobSet)
+    psValidator = def & defaultSorting [SortDescBy "sent"]
+  over _1 postprocess <$> dbTable psValidator DBTable{..}
+
+getMailCenterR,  postMailCenterR :: Handler Html
+getMailCenterR = postMailCenterR
+postMailCenterR = do
+  (mcRes, mcTable) <- runDB mkMCTable
+  formResult mcRes $ \case
+    (MCActDummyData, Set.toList -> _smIds) -> do
+      addMessageI Success MsgBoolIrrelevant
+      reloadKeepGetParams MailCenterR
+  siteLayoutMsg MsgMenuMailCenter $ do
+    setTitleI MsgMenuMailCenter
+    $(widgetFile "mail-center")
+
+
+getMailShowR :: CryptoUUIDSentMail -> Handler Html
+getMailShowR _ = error "TODO: STUB"

src/Handler/PrintCenter.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -20,9 +20,9 @@ import qualified Data.Set as Set
 import qualified Data.Map as Map
 
 import Database.Persist.Sql (updateWhereCount)
-import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
+import qualified Database.Esqueleto.Experimental  as Ex     -- needs TypeApplications Lang-Pragma
-import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Legacy        as E      -- needed for dbTable using Esqueleto.Legacy
-import qualified Database.Esqueleto.Utils as E
+import qualified Database.Esqueleto.Utils         as E
 import Database.Esqueleto.Utils.TH
 
 import Utils.Print
@@ -133,10 +133,10 @@ instance Finite PJTableAction
 nullaryPathPiece ''PJTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''PJTableAction id
 
--- Not yet needed, since there is no additional data for now:
 data PJTableActionData  = PJActAcknowledgeData | PJActReprintData { ignoreReroute :: Maybe Bool }
   deriving (Eq, Ord, Read, Show, Generic)
 
+
 type PJTableExpr = (                  E.SqlExpr (Entity PrintJob)
                     `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
                     `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))

templates/mail-center.hamlet

@@ -0,0 +1,9 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section>
+  <p> 
+    ^{mcTable}