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