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

wip, timeout for download

This commit is contained in:
Dmitry Zuikov 2023-07-14 21:32:30 +03:00
parent 599310a183
commit 3858ec35f7
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -53,7 +53,7 @@ data RefChanWorkerEnv e =
RefChanWorkerEnv RefChanWorkerEnv
{ _refChanWorkerEnvDownload :: DownloadEnv e { _refChanWorkerEnvDownload :: DownloadEnv e
, _refChanWorkerEnvHeadQ :: TQueue (RefChanHeadBlockTran e) , _refChanWorkerEnvHeadQ :: TQueue (RefChanHeadBlockTran e)
, _refChaWorkerEnvDownload :: TVar (HashMap HashRef ()) -- таймстемп можно , _refChaWorkerEnvDownload :: TVar (HashMap HashRef TimeSpec) -- таймстемп можно
} }
makeLenses 'RefChanWorkerEnv makeLenses 'RefChanWorkerEnv
@ -78,10 +78,11 @@ refChanAddDownload :: forall e m . ( m ~ PeerM e IO
=> RefChanWorkerEnv e -> HashRef -> m () => RefChanWorkerEnv e -> HashRef -> m ()
refChanAddDownload env r = do refChanAddDownload env r = do
penv <- ask penv <- ask
t <- getTimeCoarse
withPeerM penv $ withDownload (_refChanWorkerEnvDownload env) withPeerM penv $ withDownload (_refChanWorkerEnvDownload env)
$ processBlock @e (fromHashRef r) $ processBlock @e (fromHashRef r)
atomically $ modifyTVar (view refChaWorkerEnvDownload env) (HashMap.insert r ()) atomically $ modifyTVar (view refChaWorkerEnvDownload env) (HashMap.insert r t)
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
@ -140,16 +141,20 @@ refChanWorker env = do
monitorDownloads = forever do monitorDownloads = forever do
pause @'Seconds 2 pause @'Seconds 2
all <- atomically $ readTVar (view refChaWorkerEnvDownload env) <&> HashMap.keys all <- atomically $ readTVar (view refChaWorkerEnvDownload env) <&> HashMap.toList
now <- getTimeCoarse
-- FIXME: consider-timeouts-or-leak-is-possible -- FIXME: consider-timeouts-or-leak-is-possible
rest <- forM all $ \r -> do rest <- forM all $ \(r,t) -> do
here <- checkDownloaded r here <- checkDownloaded r
if here then do if here then do
refChanOnHead env (RefChanHeadBlockTran r) refChanOnHead env (RefChanHeadBlockTran r)
pure mempty pure mempty
else do else do
pure [(r,())] -- FIXME: fix-timeout-hardcode
let expired = realToFrac (toNanoSecs $ now - t) / 1e9 > 600
if expired then pure mempty else pure [(r,t)]
atomically $ writeTVar (view refChaWorkerEnvDownload env) (HashMap.fromList (mconcat rest)) atomically $ writeTVar (view refChaWorkerEnvDownload env) (HashMap.fromList (mconcat rest))