wip

hbs2-tests/test/PeerMain.hs

@@ -17,6 +17,7 @@ import HBS2.Net.Messaging.Fake
 import HBS2.Actors.Peer
 import HBS2.Defaults
 
+import HBS2.Data.Types.Refs
 import HBS2.Storage
 import HBS2.Storage.Simple
 import HBS2.Storage.Simple.Extra
@@ -332,23 +333,6 @@ runFakePeer ev p0 bus work = do
   mapM_ cancel [w,cw,peer]
 
 
-test1 :: IO ()
-test1 = do
-
-  hSetBuffering stderr LineBuffering
-
-  fake <- newFakeP2P True
-
-  void $ race (pause (2 :: Timeout 'Seconds)) $ do
-
-      let p0 = 0 :: Peer Fake
-      let p1 = 1 :: Peer Fake
-
-      ev1 <- newPeerEventsIO
-      ev0 <- newPeerEventsIO
-
-      p1Thread <- async $ runFakePeer ev1 p1 fake $ forever $ liftIO yield
-
 -- TODO: замутить мап/кэш со статистикой по блоку:
 --       сколько блок там маринуется и т.п.
 --       Если блок в этом кэше и еще не скачан, то
@@ -372,6 +356,10 @@ test1 = do
 --
 --
 
+
+blockDownloadLoop ev0 p1 = do
+
+
   let ini = [ "5KP4vM6RuEX6RA1ywthBMqZV5UJDLANC17UrF6zuWdRt"
             , "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ"
             ]
@@ -381,7 +369,6 @@ test1 = do
     traverse_ (atomically . TBQ.writeTBQueue b) ini
     pure b
 
-      p0Thread <- async $ runFakePeer ev0 p0 fake $ do
 
   -- TODO: random shuffle and take X
   -- подтягиваем новых пиров откуда можем
@@ -393,6 +380,8 @@ test1 = do
 
   fix \next -> do
 
+    -- Вечно ждём. Это  и правильно  и неправильно
+
     blkHash <- liftIO $ atomically $ TBQ.readTBQueue blkQ
 
     -- TODO: check is this block is already here
@@ -413,8 +402,18 @@ test1 = do
     --       истёк и вызывает их
     --       ?
 
-          addBlockReadyEventNotify ev0 blkHash $ \h -> do
-            debug $ "DOWNLOADED BLOCK" <+> pretty h <+> "NOW WHAT?"
+    addBlockReadyEventNotify ev0 blkHash $ \hash -> do
+      debug $ "DOWNLOADED BLOCK" <+> pretty hash <+> "NOW WHAT?"
+
+      -- ВЫКОВЫРЯТЬ СТОРЕЙДЖ (как?)
+      -- ЗАСУНУТЫЙ В READER?
+
+      obj <- undefined -- getBlock ss hash
+
+      let mbLink = deserialiseOrFail @AnnotatedHashRef obj
+
+      pure ()
+
 
     --  -- TODO: смотрим, что за блок
     --  --       если Merkle - то качаем рекурсивно
@@ -437,7 +436,6 @@ test1 = do
 
         update @Fake new key id
         request p (BlockChunks coo (BlockGetAllChunks @Fake blkHash chusz)) -- FIXME: nice construction
-              liftIO $ print $ "DAVAI BLOCK!" <+> pretty h
 
       _ -> pure ()
 
@@ -451,20 +449,33 @@ test1 = do
 
     next
 
+
+
+test1 :: IO ()
+test1 = do
+
+  hSetBuffering stderr LineBuffering
+
+  fake <- newFakeP2P True
+
+  void $ race (pause (10 :: Timeout 'Seconds)) $ do
+
+      let p0 = 0 :: Peer Fake
+      let p1 = 1 :: Peer Fake
+
+      ev1 <- newPeerEventsIO
+      ev0 <- newPeerEventsIO
+
+      p1Thread <- async $ runFakePeer ev1 p1 fake $ forever $ liftIO yield
+
+      p0Thread <- async $ runFakePeer ev0 p0 fake $ do
+
+        blockDownloadLoop ev0 p1
+
       let peerz = p0Thread : [p1Thread]
 
 
-    --  -- TODO: смотрим, что за блок
-    --  --       если Merkle - то качаем рекурсивно
-    --  --       если ссылка - то смотрим, что за ссылка
-    --  --       проверяем пруфы
-    --  --       качаем рекурсивно
-
-    --  -- let mbLink = deserialiseOrFail @Merkle obj
-
-    --  pure ()
-
-      pause ( 1 :: Timeout 'Seconds)
+      pause ( 5 :: Timeout 'Seconds)
 
       mapM_ cancel peerz