fix(mails): prevent emails being resent to due archiving errors

src/Foundation/Instances.hs

@@ -255,7 +255,7 @@ instance YesodMail UniWorX where
         return mRes
 
     (smtpRecipients, sentMailContentContent, sentMail) <- atomically $ takeTMVar mailRecord
-    liftHandler . runDB . setSerializable $ do
+    void . tryAny . liftHandler . runDB . setSerializable $ do -- Ignore exceptions that occur during logging
       sentMailRecipient <- if
         | [Address _ (CI.mk -> recipAddr)] <- smtpRecipients -> do
             recipUsers <- E.select . E.from $ \user -> do
@@ -275,11 +275,14 @@ instance YesodMail UniWorX where
               | otherwise -> Nothing
         | otherwise -> return Nothing
 
-      void $ insertUnique SentMailContent{ sentMailContentHash = unSentMailContentKey $ sentMailContentRef sentMail
-                                         , sentMailContentContent
-                                         }
+      -- @insertUnique@ _does not_ work here
+      unlessM (exists [ SentMailContentHash ==. unSentMailContentKey (sentMailContentRef sentMail) ]) $
+        insert_ SentMailContent { sentMailContentHash = unSentMailContentKey $ sentMailContentRef sentMail
+                                , sentMailContentContent
+                                }
       insert_ sentMail{ sentMailRecipient }
-      wait mailProcess
+      wait mailProcess -- Abort transaction if sending failed
+    wait mailProcess -- Rethrow exceptions for mailprocess; technically unnecessary due to linkage, doesn't hurt, though
 
 instance (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadCrypto m where
   type MonadCryptoKey m = CryptoIDKey