fix(mail): fix #2979 by completing simple mail resent function

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

@@ -28,5 +28,8 @@ PrintLmsUser: E‑Learning Id
 PrintJobs: Druckaufräge
 PrintLetterType: Brieftypkürzel
 
-MCActDummy: Platzhalter
+MCActResendEmail: E‑Mail Kopie versenden
+MCActResendEmailTooltip: Eine unveränderte Kopie der E‑Mail erneut versenden. Nur die vorherigen Empfänger werden offiziell aufgeführt, sie erhalten jedoch keine neue Kopie.
+MCActResendEmailInfo n@Int recv@Text: #{pluralDEnN n "E‑Mail Kopie"} wurden an #{recv} versandt.
+
 CCActDummy: Platzhalter

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

@@ -28,5 +28,8 @@ PrintLmsUser: E‑learning id
 PrintJobs: Print jobs
 PrintLetterType: Letter type shorthand
 
-MCActDummy: Placeholder
+MCActResendEmail: Resend email copy
+MCActResendEmailTooltip: Resend an unchanged copy of the email. Only previous recipients will officially be listed, but they will not receive another copy.
+MCActResendEmailInfo n recv: #{n} #{noneOneMoreEN n "email copy" "email copy" "email copies"} were sent to #{recv} only.
+
 CCActDummy: Placeholder

src/Handler/MailCenter.hs

@@ -41,7 +41,7 @@ import qualified Data.ByteString.Lazy as LB
 import Handler.Utils
 
 
-data MCTableAction = MCActDummy -- just a dummy, since we don't now yet which actions we will be needing
+data MCTableAction = MCActResendEmail
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 instance Universe MCTableAction
@@ -49,25 +49,26 @@ instance Finite MCTableAction
 nullaryPathPiece ''MCTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''MCTableAction id
 
-data MCTableActionData  = MCActDummyData
+newtype MCTableActionData  = MCActResendEmailData UserEmail
   deriving (Eq, Ord, Read, Show, Generic)
 
 
 resendMailTo :: (MonoFoldable mono, Element mono ~ SentMailId) => UserEmail -> mono -> Handler ()
 resendMailTo recv smids = do
-  mails <- runDBRead $ E.select $ do
+  (recvName, mails) <- runDBRead $ (,)
-    (sm :& smc) <- E.from $ E.table @SentMail `E.innerJoin` E.table @SentMailContent `E.on` (\(sm :& smc) -> sm E.^. SentMailContentRef E.==. smc E.^. SentMailContentId)
+    <$> (userDisplayName . entityVal <<$>> getByFilter ([UserEmail ==. recv] ||. [UserDisplayEmail ==. recv]))
-    E.where_ $ sm E.^. SentMailId `E.in_` E.vals smids
+    <*> E.select (do
-    return (sm, smc)
+          (sm :& smc) <- E.from $ E.table @SentMail `E.innerJoin` E.table @SentMailContent `E.on` (\(sm :& smc) -> sm E.^. SentMailContentRef E.==. smc E.^. SentMailContentId)
-  -- recvName <- fmap userDisplayName $ getByFilter $ [UserEmail ==. recv] ||. [UserDisplayEmail ==. rev]
+          E.where_ $ sm E.^. SentMailId `E.in_` E.vals smids
+          return (sm, smc)
+        )
   forM_ mails $ \(Entity {entityVal=SentMail{..}}, Entity{entityVal=SentMailContent{sentMailContentContent=content}}) -> do
     let mailParts = getMailContent content
-        mailTo    = [Address{addressName = Nothing, addressEmail = ciOriginal recv}]
+        mailTo    = []
         mailCc    = []
-        mailBcc   = []
+        mailBcc   = [Address{addressName = recvName, addressEmail = ciOriginal recv}]
-        mailFrom  = error "not used"  -- :: Address
+        mailFrom  = error "Handler.MailCenter.resenMailTo: mailFrom not replaced by sendSimpleMail"  -- :: Address -- will be filled in later by sendSimpleMail
-        -- continue here: delete some weird outdated headers
+        mailHeaders = toHeaders sentMailHeaders -- :: Headers -- keep as it was? Includes To/Cc/Bcc
-        mailHeaders = toHeaders sentMailHeaders -- :: Headers
     sendSimpleMail Mail{..}
 
 
@@ -145,17 +146,16 @@ mkMCTable = do
       { dbParamsFormMethod = POST
       , dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
       , dbParamsFormAttrs  = []
-      , dbParamsFormSubmit = FormNoSubmit
+      , dbParamsFormSubmit = FormSubmit
-      , dbParamsFormAdditional = \_csrf -> return (FormMissing, mempty)
+      , dbParamsFormAdditional
-      -- , dbParamsFormSubmit = FormSubmit
+          = let acts :: Map MCTableAction (AForm Handler MCTableActionData)
-      -- , dbParamsFormAdditional
+                acts = mconcat
-      --     = let acts :: Map MCTableAction (AForm Handler MCTableActionData)
+                  [ singletonMap MCActResendEmail $ MCActResendEmailData
-      --           acts = mconcat
+                      <$> areq (emailField & cfStrip & cfCI) (fslI MsgMCActResendEmail & setTooltip MsgMCActResendEmailTooltip) Nothing
-      --             [ singletonMap MCActDummy $ pure MCActDummyData
+                  ]
-      --             ]
+             in renderAForm FormStandard
-      --        in renderAForm FormStandard
+               $  (, mempty) . First . Just
-      --          $  (, mempty) . First . Just
+              <$> multiActionA acts (fslI MsgTableAction) Nothing
-      --         <$> multiActionA acts (fslI MsgTableAction) Nothing
       , dbParamsFormEvaluate = liftHandler . runFormPost
       , dbParamsFormResult   = id
       , dbParamsFormIdent    = def
@@ -174,8 +174,9 @@ getMailCenterR = postMailCenterR
 postMailCenterR = do
   (mcRes, mcTable) <- runDB mkMCTable
   formResult mcRes $ \case
-    (MCActDummyData, Set.toList -> _smIds) -> do
+    (MCActResendEmailData recv, smIds) -> do
-      addMessageI Success MsgBoolIrrelevant
+      resendMailTo recv smIds
+      addMessageI (bool Success Error $ null smIds) $ MsgMCActResendEmailInfo (Set.size smIds) (ciOriginal recv)
       reloadKeepGetParams MailCenterR
   siteLayoutMsg MsgMenuMailCenter $ do
     setTitleI MsgMenuMailCenter

src/Mail.hs

@@ -375,6 +375,7 @@ defMailT ls (MailT mailC) = do
         mail3
         conn
 
+-- | sends an email as it is, no changes except mailFrom
 sendSimpleMail :: ( MonadHandler m
                   , YesodMail (HandlerSite m)
                   , MonadUnliftIO m