sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 17:34:52 +09:00
Code Issues Activity

Debug logs for periodic delivery

Browse source
This commit is contained in:
fr33domlover 2019-05-11 22:26:06 +00:00
parent 48cfccd3d2
commit d70d34bb6b
1 changed files with 44 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
src/Vervis/Federation.hs
View file

@ -1753,15 +1753,47 @@ retryOutboxDelivery = do
deleteWhere [ForwardingId <-. forwardingOld]
return (groupUnlinked lonelyNew, groupLinked linkedNew, groupForwarding forwardingNew)
let deliver = deliverHttp
logInfo "Periodic delivery prepared DB, starting async HTTP POSTs"
logDebug $
"Periodic delivery forking linked " <>
T.pack (show $ map (snd . fst) dls)
waitsDL <- traverse (fork . deliverLinked deliver now) dls
logDebug $
"Periodic delivery forking forwarding " <>
T.pack (show $ map (snd . fst) fws)
waitsFW <- traverse (fork . deliverForwarding now) fws
logDebug $
"Periodic delivery forking unlinked " <>
T.pack (show $ map (snd . fst) udls)
waitsUDL <- traverse (fork . deliverUnlinked deliver now) udls
logDebug $
T.concat
[ "Periodic delivery waiting for ", T.pack $ show $ length waitsDL
, " linked"
]
resultsDL <- sequence waitsDL
unless (and resultsDL) $ logError "Periodic delivery DL error"
logDebug $
T.concat
[ "Periodic delivery waiting for ", T.pack $ show $ length waitsFW
, " forwarding"
]
resultsFW <- sequence waitsFW
unless (and resultsFW) $ logError "Periodic delivery FW error"
logDebug $
T.concat
[ "Periodic delivery waiting for "
, T.pack $ show $ length waitsUDL, " unlinked"
]
resultsUDL <- sequence waitsUDL
unless (and resultsUDL) $ logError "Periodic delivery UDL error"
logInfo "Periodic delivery done"
where
adaptUnlinked
@ -1830,7 +1862,11 @@ retryOutboxDelivery = do
return False
Right success -> return success
deliverLinked deliver now ((_, h), recips) = do
logDebug $ "Periodic deliver starting linked for host " <> h
waitsR <- for recips $ \ ((raid, (ident, inbox)), delivs) -> fork $ do
logDebug $
"Periodic deliver starting linked for actor " <>
renderFedURI (l2f h ident)
waitsD <- for delivs $ \ (dlid, fwd, doc) -> fork $ do
let fwd' = if fwd then Just ident else Nothing
e <- deliver doc fwd' h inbox
@ -1858,7 +1894,11 @@ retryOutboxDelivery = do
logError $ "Periodic DL delivery error for host " <> h
return True
deliverUnlinked deliver now ((iid, h), recips) = do
logDebug $ "Periodic deliver starting unlinked for host " <> h
waitsR <- for recips $ \ ((uraid, luRecip), delivs) -> fork $ do
logDebug $
"Periodic deliver starting unlinked for actor " <>
renderFedURI (l2f h luRecip)
e <- fetchRemoteActor iid h luRecip
case e of
Right (Right (Entity raid ra)) -> do
@ -1888,7 +1928,11 @@ retryOutboxDelivery = do
logError $ "Periodic UDL delivery error for host " <> h
return True
deliverForwarding now ((_, h), recips) = do
logDebug $ "Periodic deliver starting forwarding for host " <> h
waitsR <- for recips $ \ ((raid, inbox), delivs) -> fork $ do
logDebug $
"Periodic deliver starting forwarding for inbox " <>
renderFedURI (l2f h inbox)
waitsD <- for delivs $ \ (fwid, body, sender, sig) -> fork $ do
e <- forwardActivity (l2f h inbox) sig sender body
case e of