diff --git a/src/Foundation/Instances.hs b/src/Foundation/Instances.hs index cf56e7b5e..362af9d60 100644 --- a/src/Foundation/Instances.hs +++ b/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