From e29053145fb1d36c9af67d828d9f7e96fe8d84f9 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Thu, 9 May 2019 23:09:34 +0000
Subject: [PATCH] Log errors for linked delivery from outbox, both in handler
 and periodic

---
 src/Vervis/Federation.hs | 29 ++++++++++++++++++++++++-----
 1 file changed, 24 insertions(+), 5 deletions(-)

diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs
index 914ad98..e28204c 100644
--- a/src/Vervis/Federation.hs
+++ b/src/Vervis/Federation.hs
@@ -1561,12 +1561,18 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
         deliverFetched deliver now ((_, h), recips@(r :| rs)) = do
             let (raid, luActor, luInbox, dlid) = r
             (_, e) <- deliver luActor h luInbox
-            let e' = case e of
-                        Left err ->
+            e' <- case e of
+                    Left err -> do
+                        logError $ T.concat
+                            [ "Outbox DL delivery #", T.pack $ show dlid
+                            , " error for <", renderFedURI $ l2f h luActor
+                            , ">: ",  T.pack $ displayException err
+                            ]
+                        return $
                             if isInstanceErrorP err
                                 then Nothing
                                 else Just False
-                        Right _resp -> Just True
+                    Right _resp -> return $ Just True
             case e' of
                 Nothing -> runDB $ do
                     let recips' = NE.toList recips
@@ -1584,7 +1590,12 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
                             (_, e) <- deliver luActor h luInbox
                             runDB $
                                 case e of
-                                    Left _err -> do
+                                    Left err -> do
+                                        logError $ T.concat
+                                            [ "Outbox DL delivery #", T.pack $ show dlid
+                                            , " error for <", renderFedURI $ l2f h luActor
+                                            , ">: ",  T.pack $ displayException err
+                                            ]
                                         updateWhere [RemoteActorId ==. raid, RemoteActorErrorSince ==. Nothing] [RemoteActorErrorSince =. Just now]
                                         update dlid [DeliveryRunning =. False]
                                     Right _resp -> delete dlid
@@ -1636,6 +1647,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
 
 retryOutboxDelivery :: Worker ()
 retryOutboxDelivery = do
+    logInfo "Periodic delivery starting"
     now <- liftIO $ getCurrentTime
     (udls, dls, fws) <- runSiteDB $ do
         -- Get all unlinked deliveries which aren't running already in outbox
@@ -1729,6 +1741,7 @@ retryOutboxDelivery = do
     unless (and resultsFW) $ logError "Periodic delivery FW error"
     resultsUDL <- sequence waitsUDL
     unless (and resultsUDL) $ logError "Periodic delivery UDL error"
+    logInfo "Periodic delivery done"
     where
     adaptUnlinked
         (E.Value iid, E.Value h, E.Value uraid, E.Value luRecip, E.Value since, E.Value udlid, E.Value obid, E.Value fwd, E.Value act, E.Value mraid) =
@@ -1801,7 +1814,13 @@ retryOutboxDelivery = do
                 let fwd' = if fwd then Just ident else Nothing
                 e <- deliver doc fwd' h inbox
                 case e of
-                    Left _err -> return False
+                    Left err -> do
+                        logError $ T.concat
+                            [ "Periodic DL delivery #", T.pack $ show dlid
+                            , " error for <", renderFedURI $ l2f h ident, ">: "
+                            ,  T.pack $ displayException err
+                            ]
+                        return False
                     Right _resp -> do
                         runSiteDB $ delete dlid
                         return True