voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, tryin to fetch refchan head

This commit is contained in:
Dmitry Zuikov 2023-07-15 08:01:41 +03:00
parent 3e65c4b7b7
commit 17c5d3797f
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
hbs2-peer/app/RefChan.hs
View File

@ -32,17 +32,18 @@ import PeerTypes
import PeerConfig import PeerConfig
import BlockDownload import BlockDownload
import Control.Exception ()
import Control.Monad.Except (throwError, runExceptT)
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Lazy qualified as LBS
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict qualified as HashMap
import UnliftIO import Data.List qualified as List
import Lens.Micro.Platform
import Control.Monad.Except (throwError, runExceptT)
import Data.Maybe import Data.Maybe
import Control.Exception () import Lens.Micro.Platform
import Control.Monad.Trans.Maybe import UnliftIO
import Streaming.Prelude qualified as S import Streaming.Prelude qualified as S
import Streaming qualified as S import Streaming qualified as S
@ -103,10 +104,11 @@ checkDownloaded hr = do
result <- S.toList_ $ result <- S.toList_ $
deepScan ScanDeep (const $ S.yield Nothing) (fromHashRef hr) readBlock $ \ha -> do deepScan ScanDeep (const $ S.yield Nothing) (fromHashRef hr) readBlock $ \ha -> do
here <- liftIO $ hasBlock sto ha unless (fromHashRef hr == ha) do
S.yield here here <- liftIO $ hasBlock sto ha
S.yield here
pure $ isJust $ sequence result pure $ maybe False (not . List.null) $ sequence result
-- FIXME: move-to-library -- FIXME: move-to-library
readBlob :: forall m . ( MonadIO m readBlob :: forall m . ( MonadIO m