refactor(email): eliminate userAddress function due to user company linked email

models/users.model

@@ -92,7 +92,7 @@ UserCompany
     supervisor            Bool       default=false -- should this user be made supervisor for all _new_ users associated with this company?        
     supervisorReroute     Bool       default=false -- if supervisor is true, should this supervisor receive email for _new_ company users?
     priority              Int        default=0     -- higher number, higher priority
-    useCompanyAddress     Bool       default=true  -- if true, CompanyPostalAddress is used if UserPostalAddress is Nothing, respects priority
+    useCompanyAddress     Bool       default=true  -- if true, CompanyPostalAddress and CompanyEmail are used if UserPostalAddress/UserDisplayEmail are Nothing, respects priority
     UniqueUserCompany user company   -- a user may belong to multiple companies, but to each one only once
     deriving Generic
 UserSupervisor

src/Handler/Admin.hs

@@ -170,7 +170,7 @@ retrieveUnreachableUsers = do
       return user
     filterM hasInvalidEmail emailOnlyUsers    
   where 
-    hasInvalidEmail = fmap isNothing . getEmailAddress
+    hasInvalidEmail = fmap isNothing . getUserEmail
   
 
 allDriversHaveAvsId :: UTCTime -> DB Bool

src/Handler/Utils/Avs.hs

@@ -494,12 +494,11 @@ updateAvsUserByIds apids = do
                         eml_new = (newAvsFirmInfo ^.         _avsFirmPrimaryEmail) <|> (newAvsPersonInfo ^.         _avsInfoPersonEMail)
                     in mkUpdate usr eml_new eml_old $
                       CheckAvsUpdate UserDisplayEmail           $ to (fromMaybe mempty) . from _CI                                        -- Maybe nicht im User, aber im AvsInfo PROBLEM: Hängt auch von der FirmenEmail ab und muss daher im Verbund betrachtet werden.
-          -- TODO: company address no longer stored with each individual user
-          frm_ups = maybeEmpty oldAvsFirmInfo $ \oldAvsFirmInfo' -> mapMaybe (mkUpdate usr newAvsFirmInfo oldAvsFirmInfo')                    
-                    [ CheckAvsUpdate UserPostAddress _avsFirmPostAddress 
-                    ]
-          
-          usr_ups = mcons eml_up $ frm_ups <> per_ups
+          -- Note: company address no longer stored with each individual user; referenced with UserCompany instead
+          -- frm_ups = maybeEmpty oldAvsFirmInfo $ \oldAvsFirmInfo' -> mapMaybe (mkUpdate usr newAvsFirmInfo oldAvsFirmInfo')                    
+          --           [ CheckAvsUpdate UserPostAddress _avsFirmPostAddress 
+          --           ]
+          usr_ups = mcons eml_up per_ups -- <> frm_ups
           avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
                     [ UserAvsLastSynch      =. now
                     , UserAvsLastSynchError =. Nothing
@@ -523,6 +522,7 @@ updateAvsUserByIds apids = do
           -- Add function to use a secondary company post address that won't be updated
           -- TODO #76 -- aktuelle Firmen löschen
           -- TODO #36
+          -- TODO add EmailSuperior to UserSupervisor if not alreadu, using failsafe LDAP lookup if possible
           (Just oafi) | ((==) `on` view _avsFirmPostAddressSimple) oafi newAvsFirmInfo        -- company address unchanged
               -> return ()
           (Just oafi) | ((==) `on` view _avsFirmPrimaryEmail)      oafi newAvsFirmInfo        -- company primary email unchanged
@@ -583,8 +583,8 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
                   , companyShorthand      = newAvsFirmInfo ^. _avsFirmAbbreviation  . from _CI
                   , companyAvsId          = newAvsFirmInfo ^. _avsFirmFirmNo
                   , companyPrefersPostal  = True
-                  , companyPostAddress    = Nothing
-                  , companyEmail          = Nothing
+                  , companyPostAddress    = newAvsFirmInfo ^. _avsFirmPostAddress
+                  , companyEmail          = newAvsFirmInfo ^. _avsFirmPrimaryEmail . _Just . from _CI . re _Just
                   }
         insert $ foldl' upd dmy firmInfo2company
 

src/Handler/Utils/Communication.hs

@@ -102,7 +102,7 @@ crJobsCourseCommunication jCourse Communication{..} = do
       adrReceiverMails = Set.map (Address Nothing . CI.original) rawReceiverMails
   netReceiverAddresses <- lift $ do
     netReceiverIds <- getReceiversFor $ jSender : Set.toList rawReceiverIds -- ensure supervisors get only one email
-    (userAddress . entityVal) <<$>> selectList [UserId <-. netReceiverIds] [] -- TODO
+    maybeMapM getEmailAddressFor netReceiverIds
   -- let jAllRecipientAddresses = Set.fromList netReceiverAddresses <> adrReceiverMails
   let jAllRecipientAddresses = Set.map getAddress (Set.fromList (AddressEqIgnoreName <$> netReceiverAddresses) <> Set.map AddressEqIgnoreName adrReceiverMails)
   forM_ jAllRecipientAddresses $ \raddr ->
@@ -124,7 +124,7 @@ crJobsFirmCommunication jCompanies Communication{..} = do
       adrReceiverMails = Set.map (Address Nothing . CI.original) rawReceiverMails
   netReceiverAddresses <- lift $ do
     netReceiverIds <- getReceiversFor $ jSender : Set.toList rawReceiverIds -- ensure supervisors get only one email
-    (userAddress . entityVal) <<$>> selectList [UserId <-. netReceiverIds] []
+    maybeMapM getEmailAddressFor netReceiverIds    
   -- let jAllRecipientAddresses = Set.fromList netReceiverAddresses <> adrReceiverMails
   let jAllRecipientAddresses = Set.map getAddress (Set.fromList (AddressEqIgnoreName <$> netReceiverAddresses) <> Set.map AddressEqIgnoreName adrReceiverMails)
   forM_ jAllRecipientAddresses $ \raddr ->

src/Handler/Utils/Mail.hs

@@ -3,9 +3,7 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 module Handler.Utils.Mail
-  ( addRecipientsDB
-  , userAddress, userAddress'
-  , userAddressFrom
+  ( addRecipientsDB    
   , userMailT, userMailTdirect
   , addFileDB
   , addHtmlMarkdownAlternatives
@@ -16,7 +14,7 @@ import Import
 import Handler.Utils.Pandoc
 import Handler.Utils.Files
 import Handler.Utils.Widgets (nameHtml') -- TODO: how to use name widget here?
-import Handler.Utils.Users (getReceivers, getEmailAddress)
+import Handler.Utils.Users (getReceivers, getUserEmail)
 import Handler.Utils.Profile 
 
 import qualified Data.CaseInsensitive as CI
@@ -40,30 +38,30 @@ addRecipientsDB uFilter = runConduit $ transPipe (liftHandler . runDB) (selectSo
       let addr = Address (Just userDisplayName) $ CI.original $ pickValidUserEmail userDisplayEmail userEmail
       _mailTo %= flip snoc addr
 
-userAddressFrom :: User -> Address
+-- -- These pure functions may no longer be used, since they ignore company emails address indirections via UserCompany es 
+-- 
+-- userAddressFrom :: User -> Address
 -- ^ Format an e-mail address suitable for usage in a @From@-header
 --
 -- Uses `userDisplayEmail` only
-userAddressFrom User{userDisplayEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userDisplayEmail
+-- userAddressFrom User{userDisplayEmail, userDisplayName} = Address (Just userDisplayName) $ CI.original userDisplayEmail
 
+-- userAddress :: User -> Address
+-- -- ^ Format an e-mail address suitable for usage as a recipient
+-- --
+-- -- Like userAddressFrom, but prefers `userDisplayEmail` (if valid) and otherwise uses `userEmail`. Unlike Uni2work, userEmail from LDAP is untrustworthy.
+-- userAddress User{userEmail, userDisplayEmail, userDisplayName}
+--   = Address (Just userDisplayName) $ CI.original $ pickValidUserEmail userDisplayEmail userEmail
 
--- TODO: Check that these functions can be used or are replaced, since they ignore company emails addresses
-userAddress :: User -> Address
--- ^ Format an e-mail address suitable for usage as a recipient
---
--- Like userAddressFrom, but prefers `userDisplayEmail` (if valid) and otherwise uses `userEmail`. Unlike Uni2work, userEmail from LDAP is untrustworthy.
-userAddress User{userEmail, userDisplayEmail, userDisplayName}
-  = Address (Just userDisplayName) $ CI.original $ pickValidUserEmail userDisplayEmail userEmail
-
-userAddress' :: UserEmail -> UserEmail -> UserDisplayName -> Address
--- Like userAddress', but does not require a complete entity
-userAddress' userEmail  userDisplayEmail userDisplayName
-  = Address (Just userDisplayName) $ CI.original $ pickValidUserEmail userDisplayEmail userEmail
+-- userAddress' :: UserEmail -> UserEmail -> UserDisplayName -> Address
+-- -- Like userAddress', but does not require a complete entity
+-- userAddress' userEmail  userDisplayEmail userDisplayName
+--   = Address (Just userDisplayName) $ CI.original $ pickValidUserEmail userDisplayEmail userEmail
 
 
 userAddressError :: (MonadHandler m, HandlerSite m ~ UniWorX, m ~ HandlerFor UniWorX) => Entity User -> m (Bool, Address)
 userAddressError usr@Entity{entityVal=User{userEmail, userDisplayEmail, userDisplayName}} = 
-  runDB (getEmailAddress usr) >>= \case
+  runDB (getUserEmail usr) >>= \case
     Just okEmail -> pure (True, Address (Just userDisplayName) $ CI.original okEmail)
     Nothing -> do
       $logErrorS "Mail" $ "Attempt to email invalid address: " <> tshow userDisplayEmail <> " / " <> tshow userEmail <> ". Sent to support instead." -- <> " with subject " <> tshow failedSubject

src/Handler/Utils/Users.hs

@@ -15,7 +15,9 @@ module Handler.Utils.Users
   , guessUser
   , UserAssimilateException(..), UserAssimilateExceptionReason(..)
   , assimilateUser
-  , getEmailAddress
+  , getUserEmail
+  , getEmailAddress, getJustEmailAddress
+  , getEmailAddressFor, getJustEmailAddressFor
   , getPostalAddress, getPostalAddress'
   , getPostalPreferenceAndAddress, getPostalPreferenceAndAddress'
   , abbrvName
@@ -55,6 +57,12 @@ import Handler.Utils.Profile
 
 import Jobs.Types(Job, JobChildren)
 
+data ExceptionUserHandling
+  = ExceptionUserHasNoEmail
+  deriving (Eq, Ord, Read, Show, Generic) -- Enum, Bounded,
+instance Exception ExceptionUserHandling
+
+
 abbrvName :: User -> Text
 abbrvName User{userDisplayName, userFirstName, userSurname} =
     if  | (lastDisplayName : tsrif) <- reverse nameParts
@@ -81,7 +89,7 @@ getUserCompanyAddress uid prj = runMaybeT $ do
 getPostalPreferenceAndAddress :: Entity User -> DB (Bool, Maybe [Text], Maybe UserEmail)
 getPostalPreferenceAndAddress usr = do
   pa <- getPostalAddress usr
-  em <- getEmailAddress  usr
+  em <- getUserEmail  usr
   let usrPrefPost = usr ^. _entityVal . _userPrefersPostal
       finalPref   = (usrPrefPost && isJust pa) || isNothing em
       -- finalPref   = isJust pa && (usrPrefPost || isNothing em)
@@ -92,15 +100,27 @@ getPostalPreferenceAndAddress usr = do
 getPostalPreferenceAndAddress' :: Entity User -> DB (Bool, Maybe StoredMarkup, Maybe UserEmail)
 getPostalPreferenceAndAddress' usr = do
   pa <- getPostalAddress' usr
-  em <- getEmailAddress   usr
+  em <- getUserEmail   usr
   let usrPrefPost = usr ^. _entityVal . _userPrefersPostal
       finalPref   = (usrPrefPost && isJust pa) || isNothing em
       -- finalPref   = isJust pa && (usrPrefPost || isNothing em)
   return (finalPref, pa, em)
  
+getEmailAddressFor :: UserId -> DB (Maybe Address)
+getEmailAddressFor = maybeM (return Nothing) getEmailAddress . getEntity
+
+getJustEmailAddressFor :: UserId -> DB Address
+getJustEmailAddressFor = maybeThrowM ExceptionUserHasNoEmail . getEmailAddressFor
     
-getEmailAddress :: Entity User -> DB (Maybe UserEmail)
-getEmailAddress Entity{entityKey=uid, entityVal=User{userDisplayEmail, userEmail}}
+getJustEmailAddress :: Entity User -> DB Address
+getJustEmailAddress = maybeThrowM ExceptionUserHasNoEmail . getEmailAddress
+
+getEmailAddress :: Entity User -> DB (Maybe Address)
+getEmailAddress usr@Entity{entityVal=User{userDisplayName}} = toAddress <<$>> getUserEmail usr  
+  where toAddress = Address (Just userDisplayName) . CI.original
+
+getUserEmail :: Entity User -> DB (Maybe UserEmail)
+getUserEmail Entity{entityKey=uid, entityVal=User{userDisplayEmail, userEmail}}
   | validEmail' userDisplayEmail
     = return $ Just userDisplayEmail
   | otherwise

src/Jobs/Handler/ChangeUserDisplayEmail.hs

@@ -9,6 +9,7 @@ module Jobs.Handler.ChangeUserDisplayEmail
 import Import
 
 import Handler.Utils.Mail
+import Handler.Utils.Users
 import qualified Data.HashSet as HashSet
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.CaseInsensitive as CI
@@ -24,10 +25,13 @@ dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = JobHandlerException $ do
     setDisplayEmailUrl = SomeRoute (SetDisplayEmailR, [(toPathPiece GetBearer, toPathPiece jwt)])
   setDisplayEmailUrl' <- toTextUrl setDisplayEmailUrl
 
-  user@User{..} <- runDB $ getJust jUser
+  (Entity{entityVal=User{..}}, userAddress) <- runDB $ do
+    usrEnt <- getJustEntity jUser -- error aborts job
+    usrAdr <- getJustEmailAddress usrEnt
+    return (usrEnt, usrAdr)
 
   userMailT jUser $ do
-    _mailTo .= pure (userAddress user & _addressEmail .~ CI.original jDisplayEmail)
+    _mailTo .= pure (userAddress & _addressEmail .~ CI.original jDisplayEmail)
     replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
     setSubjectI MsgMailSubjectChangeUserDisplayEmail
     addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))

src/Jobs/Handler/Invitation.hs

@@ -8,6 +8,7 @@ module Jobs.Handler.Invitation
 
 import Import
 import Handler.Utils.Mail
+import Handler.Utils.Users
 
 import qualified Data.CaseInsensitive as CI
 import Text.Hamlet
@@ -20,12 +21,15 @@ dispatchJobInvitation :: Maybe UserId
                       -> Html
                       -> JobHandler UniWorX
 dispatchJobInvitation jInviter jInvitee jInvitationUrl jInvitationSubject jInvitationExplanation = JobHandlerException $ do
-  mInviter <- join <$> traverse (runDB . get) jInviter
+  (mInviter, mInviterAddress) <- ifMaybeM jInviter (Nothing,Nothing) $ \uid -> runDB $ do 
+    usrEnt <- getEntity uid
+    usrAdr <- join <$> traverse getEmailAddress usrEnt
+    return (usrEnt ^? _Just . _entityVal, usrAdr)
 
   mailT def $ do
     _mailTo .= [Address Nothing $ CI.original jInvitee]
-    whenIsJust mInviter $ \jInviter' ->
-      replaceMailHeader "Reply-To" . Just . renderAddress $ userAddressFrom jInviter'
+    whenIsJust mInviterAddress $ \jInviterAddress ->
+      replaceMailHeader "Reply-To" . Just $ renderAddress jInviterAddress
     replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
     replaceMailHeader "Subject" $ Just jInvitationSubject
     addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))

src/Jobs/Handler/QueueNotification.hs

@@ -16,7 +16,8 @@ import Jobs.Queue
 
 import qualified Data.Set as Set
 
-import Handler.Utils.Profile (pickValidUserEmail')
+-- import Handler.Utils.Profile (pickValidUserEmail')
+import Handler.Utils.Users (getUserEmail)
 import Handler.Utils.ExamOffice.Exam
 import Handler.Utils.ExamOffice.ExternalExam
 
@@ -27,8 +28,8 @@ dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
 dispatchJobQueueNotification jNotification = JobHandlerAtomic $
   runConduit $ yield jNotification
             .| transPipe (hoist lift) determineNotificationCandidates
-            .| C.filterM (\(notification', override, Entity _ User{userNotificationSettings,userDisplayEmail,userEmail}) -> 
-                and2M (return $ isJust $ pickValidUserEmail' userDisplayEmail userEmail) $ -- TODO: use getEmailAddress instead - although it is a DB action!
+            .| C.filterM (\(notification', override, usr@(Entity _ User{userNotificationSettings})) -> 
+                and2M (isJust <$> hoist lift (getUserEmail usr)) $
                   or2M (return override) $ notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification'))
             .| C.map (\(notification', _, Entity uid _) -> JobSendNotification uid notification')
             .| sinkDBJobs

src/Jobs/Handler/SendCourseCommunication.hs

@@ -12,6 +12,7 @@ import Import
 import Text.Hamlet
 
 import Handler.Utils
+import Handler.Utils.Users
 
 import qualified Data.CaseInsensitive as CI
 import Handler.Utils.Csv (partIsAttachmentCsv)
@@ -28,14 +29,17 @@ dispatchJobSendCourseCommunication :: Either UserEmail UserId
                                    -> CommunicationContent
                                    -> JobHandler UniWorX
 dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCourse jSender jMailObjectUUID CommunicationContent{..} = JobHandlerException $ do
-  (sender, Course{..}) <- runDB $ (,)
-    <$> getJust jSender
-    <*> getJust jCourse
+  (Course{..}, senderAddress) <- runDB $ do
+    crs <- getJust jCourse
+    usr <- getJustEntity jSender
+    adr <- getJustEmailAddress usr
+    return (crs, adr)
+    
   either (\email -> mailT def . (assign _mailTo (pure . Address Nothing $ CI.original email) *>)) userMailT jRecipientEmail $ do -- userMailT obeys reroutes, userMailT direct does not
     MsgRenderer mr <- getMailMsgRenderer
 
     void $ setMailObjectUUID jMailObjectUUID
-    _mailFrom .= userAddressFrom sender
+    _mailFrom .= senderAddress
     addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
     addMailHeader "Auto-Submitted" "no"
     setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgUtilCommCourseSubject) SomeMessage ccSubject
@@ -55,15 +59,13 @@ dispatchJobSendFirmCommunication :: Either UserEmail UserId
                                    -> CommunicationContent
                                    -> JobHandler UniWorX
 dispatchJobSendFirmCommunication jRecipientEmail jAllRecipientAddresses _jCompanies jSender jMailObjectUUID CommunicationContent{..} = JobHandlerException $ do
-  -- (sender,mbComp) <- runDB $ (,)
-  --   <$> getJust jSender
-  --   <*> ifMaybeM jCompany Nothing get
-  sender <- runDB $ getJust jSender    
+  senderAddress <- runDB $ getJustEmailAddressFor jSender
+    
   either (\email -> mailT def . (assign _mailTo (pure . Address Nothing $ CI.original email) *>)) userMailT jRecipientEmail $ do -- userMailT obeys reroutes, userMailT direct does not
     MsgRenderer mr <- getMailMsgRenderer
 
     void $ setMailObjectUUID jMailObjectUUID
-    _mailFrom .= userAddressFrom sender
+    _mailFrom .= senderAddress
     addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
     addMailHeader "Auto-Submitted" "no"
     setSubjectI $ maybe (SomeMessage MsgUtilCommFirmSubject) SomeMessage ccSubject

src/Jobs/Handler/SendNotification/SubmissionEdited.hs

@@ -13,6 +13,7 @@ module Jobs.Handler.SendNotification.SubmissionEdited
 import Import
 
 import Handler.Utils
+import Handler.Utils.Users
 import Jobs.Handler.SendNotification.Utils
 
 import Text.Hamlet
@@ -36,10 +37,11 @@ dispatchNotificationSubmissionEdited nInitiator nSubmission jRecipient = userMai
       E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
            E.&&. user E.^. UserId E.!=. E.val jRecipient
       return user
+    coSubmittorsAddrs <- maybeMapM getEmailAddress coSubmittors
 
-    return (course, sheet, submission, initiator, coSubmittors)
+    return (course, sheet, submission, initiator, coSubmittorsAddrs)
 
-  let allCoSubmittors = Text.intercalate ", " $ map (renderAddress . userAddressFrom . entityVal) coSubmittors
+  let allCoSubmittors = Text.intercalate ", " $ map renderAddress coSubmittors
   addMailHeader "Reply-To" allCoSubmittors
 
   replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
@@ -69,14 +71,15 @@ dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMai
       E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
            E.&&. user E.^. UserId E.!=. E.val jRecipient
       return user
+    coSubmittorsAddrs <- maybeMapM getEmailAddress coSubmittors
 
     user <- getJust nUser
 
-    return (user, course, sheet, submission, coSubmittors)
+    return (user, course, sheet, submission, coSubmittorsAddrs)
 
   let isSelf = nUser == jRecipient
 
-  let allCoSubmittors = Text.intercalate ", " $ map (renderAddress . userAddressFrom . entityVal) coSubmittors
+  let allCoSubmittors = Text.intercalate ", " $ map renderAddress coSubmittors
   addMailHeader "Reply-To" allCoSubmittors
 
   replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
@@ -99,7 +102,7 @@ dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMai
 
 dispatchNotificationSubmissionUserDeleted :: UserId -> SheetId -> SubmissionId -> UserId -> Handler ()
 dispatchNotificationSubmissionUserDeleted nUser nSheet nSubmission jRecipient = userMailT jRecipient $ do
-  (User{..}, Course{..}, Sheet{..}, mSubmission, coSubmittors) <- liftHandler . runDB $ do
+  (User{..}, Course{..}, Sheet{..}, mSubmission, coSubmittors, coSubmittorsAddrs) <- liftHandler . runDB $ do
     submission <- get nSubmission
 
     sheet <- maybe (getJust nSheet) (belongsToJust submissionSheet) submission
@@ -110,15 +113,15 @@ dispatchNotificationSubmissionUserDeleted nUser nSheet nSubmission jRecipient =
       E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
            E.&&. user E.^. UserId E.!=. E.val jRecipient
       return user
-
+    coSubmittorsAddrs <- maybeMapM getEmailAddress coSubmittors
     user <- getJust nUser
 
-    return (user, course, sheet, submission, coSubmittors)
+    return (user, course, sheet, submission, coSubmittors, coSubmittorsAddrs)
 
   let isSelf = nUser == jRecipient
 
   unless (null coSubmittors) $ do
-    let allCoSubmittors = Text.intercalate ", " $ map (renderAddress . userAddressFrom . entityVal) coSubmittors
+    let allCoSubmittors = Text.intercalate ", " $ map renderAddress coSubmittorsAddrs
     addMailHeader "Reply-To" allCoSubmittors
 
   replaceMailHeader "Auto-Submitted" $ Just "auto-generated"

src/Jobs/Handler/SendNotification/SubmissionRated.hs

@@ -11,6 +11,7 @@ module Jobs.Handler.SendNotification.SubmissionRated
 import Import
 
 import Handler.Utils
+import Handler.Utils.Users
 import Jobs.Handler.SendNotification.Utils
 
 import Text.Hamlet
@@ -19,22 +20,25 @@ import qualified Data.CaseInsensitive as CI
 
 dispatchNotificationSubmissionRated :: SubmissionId -> UserId -> Handler ()
 dispatchNotificationSubmissionRated nSubmission jRecipient = maybeT_ $ do
-  (Course{..}, Sheet{..}, Submission{..}, corrector, sheetTypeDesc, hasAccess, csid) <- lift . runDB $ do
+  (Course{..}, Sheet{..}, Submission{..}, corrector, correctorAddr, sheetTypeDesc, hasAccess, csid) <- lift . runDB $ do
     submission@Submission{submissionRatingBy} <- getJust nSubmission
     sheet@Sheet{sheetName} <- belongsToJust submissionSheet submission
     course@Course{..} <- belongsToJust sheetCourse sheet
-    corrector <- traverse getJust submissionRatingBy
+    correctorEnt  <- traverse getJustEntity submissionRatingBy
+    correctorAddr <- join <$> traverse getEmailAddress correctorEnt
+    let corrector = correctorEnt ^? _Just . _entityVal
+
     sheetTypeDesc <- sheetTypeDescription (sheetCourse sheet) (sheetType sheet)
     csid <- encrypt nSubmission
 
     hasAccess <- is _Authorized <$> evalAccessForDB (Just jRecipient) (CSubmissionR courseTerm courseSchool courseShorthand sheetName csid CorrectionR) False
-    return (course, sheet, submission, corrector, sheetTypeDesc, hasAccess, csid)
+    return (course, sheet, submission, corrector, correctorAddr, sheetTypeDesc, hasAccess, csid)
 
   guard hasAccess
 
   lift . userMailT jRecipient $ do
-    whenIsJust corrector $ \corrector' ->
-      addMailHeader "Reply-To" . renderAddress $ userAddressFrom corrector'
+    whenIsJust correctorAddr $ \correctorAddr' ->
+      addMailHeader "Reply-To" $ renderAddress correctorAddr'
     replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
     setSubjectI $ MsgMailSubjectSubmissionRated courseShorthand
 

src/Utils.hs

@@ -1006,6 +1006,10 @@ maybeThrow exc = maybe (throwM exc) return
 maybeThrowM :: (Exception e, MonadThrow m) => e -> m (Maybe a) -> m a
 maybeThrowM = fromMaybeM . throwM
 
+maybeMapM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b]
+maybeMapM f = foldr go (pure [])
+  where 
+    go = liftA2 (maybe id (:)) . f
 
 mapMaybeM :: ( Monad m
              , MonoFoldable (f a)

src/Utils/Mail.hs

@@ -13,7 +13,7 @@ import qualified Data.CaseInsensitive as CI
 
 import qualified Text.Email.Validate as Email
 
--- also see `Handler.Utils.Users.getEmailAddress` for Tests accepting User Type
+-- also see `Handler.Utils.Users.getUserEmail` for Tests accepting User Type
 validEmail :: Text -> Bool      -- Email = Text
 validEmail email = validRFC5322 && not invalidFraport
   where