From ba50676a1fe66c5f24f251984f2cb49c0e98aead Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Thu, 28 Jul 2022 21:29:37 +0200 Subject: Service: wait with output after head commit --- src/Network.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'src/Network.hs') diff --git a/src/Network.hs b/src/Network.hs index 7195129..3cf714d 100644 --- a/src/Network.hs +++ b/src/Network.hs @@ -835,10 +835,12 @@ sendToPeerList :: (Service s, MonadIO m) => Peer -> [ServiceReply s] -> m () sendToPeerList peer parts = do let st = peerStorage peer pst = peerInStorage peer - srefs <- liftIO $ forM parts $ \case ServiceReply (Left x) _ -> store st x - ServiceReply (Right sx) _ -> return $ storedRef sx - prefs <- mapM (copyRef pst) srefs - let content = map snd $ filter (\(ServiceReply _ use, _) -> use) (zip parts srefs) + srefs <- liftIO $ fmap catMaybes $ forM parts $ \case + ServiceReply (Left x) use -> Just . (,use) <$> store st x + ServiceReply (Right sx) use -> return $ Just (storedRef sx, use) + ServiceFinally act -> act >> return Nothing + prefs <- mapM (copyRef pst . fst) srefs + let content = map fst $ filter snd srefs header = TransportHeader (ServiceType (serviceID $ head parts) : map ServiceRef prefs) packet = TransportPacket header content ackedBy = concat [[ Acknowledged r, Rejected r, DataRequest r ] | r <- prefs ] -- cgit v1.2.3