mirror of https://github.com/voidlizard/hbs2
54 lines
1.5 KiB
Haskell
54 lines
1.5 KiB
Haskell
{-# Language AllowAmbiguousTypes #-}
|
|
module DownloadQ where
|
|
|
|
import HBS2.Prelude
|
|
import HBS2.Clock
|
|
import HBS2.Events
|
|
import HBS2.Data.Types.Refs
|
|
import HBS2.Net.PeerLocator
|
|
import HBS2.Peer.Brains
|
|
import HBS2.Storage
|
|
import HBS2.Storage.Operations.Missed
|
|
|
|
import PeerTypes
|
|
import PeerConfig
|
|
|
|
import Data.Foldable
|
|
import Control.Monad
|
|
import Lens.Micro.Platform
|
|
|
|
downloadQueue :: forall e m . ( MyPeer e
|
|
, DownloadFromPeerStuff e m
|
|
, HasPeerLocator e (BlockDownloadM e m)
|
|
, HasPeerLocator e m
|
|
, EventListener e (DownloadReq e) m
|
|
, HasStorage m
|
|
) => PeerConfig
|
|
-> SomeBrains e
|
|
-> DownloadEnv e -> m ()
|
|
|
|
downloadQueue _ brains denv = do
|
|
debug "DownloadQ started"
|
|
|
|
down <- listDownloads @e brains
|
|
sto <- getStorage
|
|
|
|
withDownload denv do
|
|
forM_ down $ \(HashRef h,_) -> do
|
|
missed <- findMissedBlocks sto (HashRef h)
|
|
for_ missed $ \h -> do
|
|
debug $ "DownloadQ:" <+> pretty h
|
|
addDownload mzero (fromHashRef h)
|
|
|
|
-- FIXME: timeout-hardcodes
|
|
let refs = listDownloads @e brains <&> fmap (set _2 30)
|
|
|
|
polling (Polling 5 20) refs $ \ref -> do
|
|
missed <- findMissedBlocks sto ref
|
|
trace $ "DownloadQ. check" <+> pretty ref <+> pretty (length missed)
|
|
|
|
when (null missed) do
|
|
delDownload @e brains ref
|
|
|
|
|