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 07:55:58 +03:00
parent 8e567c87d0
commit 3e65c4b7b7
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -95,18 +95,18 @@ refChanAddDownload env chan r = do
atomically $ modifyTVar (view refChanWorkerEnvDownload env) (HashMap.insert r (chan,t)) atomically $ modifyTVar (view refChanWorkerEnvDownload env) (HashMap.insert r (chan,t))
-- FIXME: slow-deep-scan-exception-seems-not-working
checkDownloaded :: forall m . (MonadIO m, HasStorage m, Block ByteString ~ ByteString) => HashRef -> m Bool checkDownloaded :: forall m . (MonadIO m, HasStorage m, Block ByteString ~ ByteString) => HashRef -> m Bool
checkDownloaded hr = do checkDownloaded hr = do
sto <- getStorage sto <- getStorage
let readBlock h = liftIO $ getBlock sto h let readBlock h = liftIO $ getBlock sto h
result <- runExceptT $ result <- S.toList_ $
deepScan ScanDeep (const $ throwError DataNotReady) (fromHashRef hr) readBlock $ \ha -> do deepScan ScanDeep (const $ S.yield Nothing) (fromHashRef hr) readBlock $ \ha -> do
here <- liftIO $ hasBlock sto ha <&> isJust here <- liftIO $ hasBlock sto ha
unless here $ throwError DataNotReady S.yield here
pure $ either (const False) (const True) result
pure $ isJust $ sequence result
-- FIXME: move-to-library -- FIXME: move-to-library
readBlob :: forall m . ( MonadIO m readBlob :: forall m . ( MonadIO m