diff --git a/messages/uniworx/categories/authorization/de-de-formal.msg b/messages/uniworx/categories/authorization/de-de-formal.msg index 4728f2384..15d5204e6 100644 --- a/messages/uniworx/categories/authorization/de-de-formal.msg +++ b/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. diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 3086f65c7..f8b08ac15 100644 --- a/src/Handler/LMS.hs +++ b/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 = [] diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index f4b1ac754..576fbc495 100644 --- a/src/Handler/Utils/Mail.hs +++ b/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)