wip, block download rework

hbs2-peer/app/RPC2.hs

@@ -190,7 +190,7 @@ downloadFromPeer t cache env h peer = liftIO $ withPeerM env do
               . set sBlockSize (fromIntegral size)
                 $ down
 
-    (what, rs) <- liftIO $ withPeerM env do
+    eblk <- liftIO $ withPeerM env do
       update @e new key id
 
       debug $ "FUCKIN WAIT FOR CHUNKS!" <+> pretty h
@@ -199,22 +199,40 @@ downloadFromPeer t cache env h peer = liftIO $ withPeerM env do
 
       let total = L.length $ calcChunks size (fromIntegral chunkSize)
 
-      blk <- atomically do
+      flip runContT pure do
+
+        worker <- ContT $ withAsync do
+          atomically do
             wtf <- readTVar _sBlockChunks2
             unless (IntMap.size wtf == total) retry
             pure wtf
 
+        waiter <- ContT $ withAsync $ fix \next -> do
+           r <- race (pause t) (atomically $ readTQueue chuQ)
+           case r of
+            Left{}  -> cancel worker
+            Right{} -> next
+
+        result <- waitCatch worker
+
+        void $ ContT $ bracket none $ const do
+          cancel waiter
           atomically $ flushTQueue chuQ
+          expire @e key
+
+        pure result
+
+    callCC \exit2 -> do
+
+      blk <- case eblk of
+              Right x -> pure x
+              Left{}  -> exit2 (Left (PeerRequestTimeout peer))
 
       let rs = LBS.concat $ IntMap.elems blk
 
       ha <- enqueueBlock sto rs
 
-      expire @e key
-
-      pure (ha, rs)
-
-    case what of
+      case ha of
         Nothing -> pure $ Left StorageError
 
         Just h1 | h1 == h -> do