wip12

cabal.project

@@ -10,6 +10,6 @@ constraints:
   , http-client >=0.7.16 && <0.8
 
 -- executable-static: True
-profiling: True
+-- profiling: True
 --library-profiling: False
 

hbs2-peer/app/BlockDownloadNew.hs

@@ -608,12 +608,10 @@ downloadDispatcher :: forall e m . ( e ~ L4Proto
                  -> SomeBrains e
                  -> PeerEnv e
                  -> m ()
-downloadDispatcher probe brains env = forever $ flip runContT pure do
+downloadDispatcher probe brains env = do
-
     debug $ red "downloadDispatcher spawned!"
 
-    pts   <- newTVarIO ( mempty :: HashMap (Peer e) (Async (), PeerNonce) )
+    sto <- withPeerM env getStorage
-
     wip       <- newTVarIO ( mempty :: HashMap HashRef DCB )
     parseQ    <- newTQueueIO
 
@@ -634,13 +632,6 @@ downloadDispatcher probe brains env = forever $ flip runContT pure do
         atomically $ insertNewDownloadSTM now ha
         newDownload @e brains ha
 
-    void $ ContT $ bracket none $ const do
-      readTVarIO pts <&> fmap fst . HM.elems >>= mapM_ cancel
-
-    void $ ContT $ withAsync $ manageThreads onBlockSTM wip pts
-
-    sto <- withPeerM env getStorage
-
     liftIO $ withPeerM env do
       subscribe @e DownloadReqKey $ \(DownloadReqData h) -> do
         here <- hasBlock sto h <&> isJust
@@ -648,6 +639,15 @@ downloadDispatcher probe brains env = forever $ flip runContT pure do
           debug $ green "New download request" <+> pretty h
           insertNewDownload (HashRef h)
 
+    forever $ flip runContT pure do
+
+      pts   <- newTVarIO ( mempty :: HashMap (Peer e) (Async (), PeerNonce) )
+
+      void $ ContT $ bracket none $ const do
+        readTVarIO pts <&> fmap fst . HM.elems >>= mapM_ cancel
+
+      void $ ContT $ withAsync $ manageThreads onBlockSTM wip pts
+
       dupes <- newTVarIO ( mempty :: HashMap HashRef Int )
 
       ContT $ withAsync $ forever $ pause @'Seconds 10 >> do