diff options
Diffstat (limited to 'src/Network.hs')
| -rw-r--r-- | src/Network.hs | 10 |
1 files changed, 6 insertions, 4 deletions
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 ] |