chore(email): userMailT respects supervisors

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

@@ -19,7 +19,7 @@ UnauthorizedTokenInvalidAuthorityGroup: Ihr Authorisierungs-Token basiert auf de
 UnauthorizedTokenInvalidAuthorityValue: Ihr Authorisierungs-Token basiert auf Rechten, deren Spezifikation nicht interpretiert werden konnte.
 UnauthorizedTokenInvalidImpersonation: Ihr Authorisierungs-Token enthält die Anweisung sich als ein Nutzer:in auszugeben, dies ist jedoch nicht allen Benutzer:innen, auf deren Rechten ihr Authorisierungs-Token basiert, erlaubt.
 UnauthorizedToken404: Authorisierungs-Tokens können nicht auf Fehlerseiten ausgewertet werden.
-UnauthorizedSupervisor: Sie sind kein Ansprechpartner:in für diesen Benuzter:in.
+UnauthorizedSupervisor: Sie sind kein Ansprechpartner:in für diesen Benutzer:in.
 UnauthorizedSiteAdmin: Sie sind nicht System-weiter Administrator:in.
 UnauthorizedSchoolAdmin: Sie sind nicht als Administrator:in für dieses Institut eingetragen.
 UnauthorizedAdminEscalation: Sie sind nicht Administrator:in für alle Institute, für die dieser Nutzer/diese Nutzerin Administrator:in oder Veranstalter:in ist.

src/Handler/LMS.hs

@@ -383,10 +383,11 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
       user <-    view $ _dbtProjRow . resultUser
       lusr <- preview $ _dbtProjRow . resultLmsUser
       pjob <- preview $ _dbtProjRow . resultPrintJob
+      pjac <- preview $ _dbtProjRow . resultPrintAck
       forMM_ (view $ _dbtProjFilter . _ltProjFilterMayAccess) $ \b -> do 
         euid <- encrypt $ user ^. _entityKey
         guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ ForProfileDataR euid -- TODO create a page with proper rights; this is only for admins!        
-      return (qusr,user,lusr,pjob)
+      return (qusr,user,lusr,pjob,pjac)
 
     dbtColonnade = cols
     dbtSorting = mconcat
@@ -464,7 +465,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
           <*>  preview (resultLmsUser  . _entityVal . _lmsUserStarted)
           <*>  preview (resultLmsUser  . _entityVal . _lmsUserDatePin)
           <*> (join . preview (resultLmsUser  . _entityVal . _lmsUserReceived))
-          <*> (join . preview (resultLmsUser  . _entityVal . _lmsUserNotified))
+          <*> (join . preview (resultLmsUser  . _entityVal . _lmsUserNotified)) -- TODO: only exports last email date / print job sending date, not print acknowledge
           <*> (join . preview (resultLmsUser  . _entityVal . _lmsUserEnded))
     dbtCsvDecode = Nothing
     dbtExtraReps = []

src/Handler/Utils/Mail.hs

@@ -5,7 +5,7 @@
 module Handler.Utils.Mail
   ( addRecipientsDB
   , userAddress, userAddressFrom
-  , userMailT, superMailT
+  , userMailT
   , addFileDB
   , addHtmlMarkdownAlternatives
   , addHtmlMarkdownAlternatives'
@@ -47,12 +47,46 @@ userAddress :: User -> Address
 -- Uses `userEmail`
 userAddress User{userEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userEmail
 
+
 userMailT :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              , MonadThrow m
              , MonadUnliftIO m
-             ) => UserId -> MailT m a -> m a
+             ) => UserId -> MailT m () -> m ()
 userMailT uid mAct = do
+  superVs <- liftHandler . runDB $ selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] []
+  let receivers = if null superVs
+                    then [uid]
+                    else userSupervisorSupervisor . entityVal <$> superVs
+  -- underling <- liftHandler . runDB $ getJust uid
+  forM_ receivers $ \svr -> do 
+    supervisor@User
+      { userLanguages
+      , userDateTimeFormat
+      , userDateFormat
+      , userTimeFormat
+      , userCsvOptions
+      } <- liftHandler . runDB $ getJust svr
+    let ctx = MailContext
+                { mcLanguages = fromMaybe def userLanguages
+                , mcDateTimeFormat = \case
+                    SelFormatDateTime -> userDateTimeFormat
+                    SelFormatDate -> userDateFormat
+                    SelFormatTime -> userTimeFormat
+                , mcCsvOptions = userCsvOptions
+                }
+    mailT ctx $ do
+      _mailTo .= pure (userAddress supervisor)
+      -- unless (uid == svr) $ addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/supervisorPrefix.hamlet") -- TODO
+      mAct
+
+
+_userMailTdirect :: ( MonadHandler m
+             , HandlerSite m ~ UniWorX
+             , MonadThrow m
+             , MonadUnliftIO m
+             ) => UserId -> MailT m a -> m a
+_userMailTdirect uid mAct = do
   user@User
     { userLanguages
     , userDateTimeFormat
@@ -74,14 +108,6 @@ userMailT uid mAct = do
     mAct
 
 
-superMailT :: ( MonadHandler m
-             , HandlerSite m ~ UniWorX
-             , MonadThrow m
-             , MonadUnliftIO m
-             ) => Maybe UserId -> UserId -> MailT m a -> m a
-superMailT svr uid = userMailT $ fromMaybe uid svr
-
-
 addFileDB :: ( MonadMail m
              , HandlerSite m ~ UniWorX
              ) => FileReference -> m (Maybe MailObjectId)