From 69cd2622f25f69cb4a45664ae430c1e0005f9879 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Fri, 13 Jan 2023 12:44:38 +0300
Subject: [PATCH] wip

---
 hbs2-core/hbs2-core.cabal                     |  2 ++
 .../lib/HBS2/Net/Proto/Actors/BlockInfo.hs    | 35 +++++++++++--------
 hbs2-core/test/Main.hs                        |  2 ++
 hbs2-core/test/TestBlockInfoActor.hs          | 34 ++++++++++++++++++
 4 files changed, 59 insertions(+), 14 deletions(-)
 create mode 100644 hbs2-core/test/TestBlockInfoActor.hs

diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal
index cdb3e271..3784c481 100644
--- a/hbs2-core/hbs2-core.cabal
+++ b/hbs2-core/hbs2-core.cabal
@@ -116,6 +116,7 @@ test-suite test
 
     other-modules:  TestFakeMessaging
                   , TestActors
+                  , TestBlockInfoActor
 
     -- other-extensions:
 
@@ -131,6 +132,7 @@ test-suite test
         , microlens-platform
         , mtl
         , prettyprinter
+        , QuickCheck
         , random
         , safe
         , serialise
diff --git a/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs b/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs
index af137939..2a5b7dfd 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs
@@ -4,8 +4,11 @@ import HBS2.Prelude
 import HBS2.Hash
 import HBS2.Net.Proto
 import HBS2.Clock
+import HBS2.Actors
 
 import Data.Function
+import Data.Kind
+import Prettyprinter
 
 -- needs: logger
 -- needs: reader and shit
@@ -13,9 +16,9 @@ import Data.Function
 -- needs: cookie manager
 -- needs: peer manager
 
-data BlockInfoActor =
+data BlockInfoActor (m :: Type -> Type) =
   BlockInfoActor
-  {
+  { tasks :: Pipeline m ()
   }
 
 
@@ -25,27 +28,31 @@ data BlockInfoActor =
 -- TODO: get block info per peer
 
 
-createBlockInfoActor :: MonadIO m => m BlockInfoActor
+createBlockInfoActor :: MonadIO m => m (BlockInfoActor m )
 createBlockInfoActor = do
-  pure $ BlockInfoActor
+  pip <- newPipeline 200 -- FIXME: to settings!
+  pure $ BlockInfoActor pip
 
-runBlockInfoActor :: MonadIO m => BlockInfoActor -> m ()
-runBlockInfoActor _ =
-  fix \next -> do
-    pause (1 :: Timeout 'Seconds)
-    next
+runBlockInfoActor :: MonadIO m => BlockInfoActor m -> m ()
+runBlockInfoActor b = runPipeline (tasks b)
 
-requestBlockInfo :: MonadIO m
-                 => BlockInfoActor
+stopBlockInfoActor :: MonadIO m => BlockInfoActor m -> m ()
+stopBlockInfoActor b = stopPipeline (tasks b)
+
+requestBlockInfo :: forall peer h m . ( MonadIO m
+                                      , Pretty (Hash h)
+                                      )
+                 => BlockInfoActor m
                  -> Maybe (Peer peer)
                  -> Hash h
                  -> m  ()
 
-requestBlockInfo b h = do
-  undefined
+requestBlockInfo b _ h = do
+  addJob (tasks b) do
+    liftIO $ print ( "request-info" <+> pretty h)
 
 getBlockInfo :: MonadIO m
-             => BlockInfoActor
+             => BlockInfoActor m
              -> Maybe (Peer peer)
              -> m (Maybe BlockInfo)
 
diff --git a/hbs2-core/test/Main.hs b/hbs2-core/test/Main.hs
index b8eb0774..626f601f 100644
--- a/hbs2-core/test/Main.hs
+++ b/hbs2-core/test/Main.hs
@@ -2,6 +2,7 @@ module Main where
 
 import TestFakeMessaging
 import TestActors
+import TestBlockInfoActor
 
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -13,6 +14,7 @@ main =
       [
         testCase "testFakeMessaging1" testFakeMessaging1
       , testCase "testActorsBasic" testActorsBasic
+      , testCase "testBlockInfoActor" testBlockInfoActor
       ]
 
 
diff --git a/hbs2-core/test/TestBlockInfoActor.hs b/hbs2-core/test/TestBlockInfoActor.hs
new file mode 100644
index 00000000..10caa55c
--- /dev/null
+++ b/hbs2-core/test/TestBlockInfoActor.hs
@@ -0,0 +1,34 @@
+module TestBlockInfoActor where
+
+import HBS2.Hash
+import HBS2.Clock
+import HBS2.Net.Proto.Actors.BlockInfo
+
+import Test.Tasty.HUnit
+
+import Test.QuickCheck
+import Data.Word
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as B
+import Control.Concurrent.Async
+
+testBlockInfoActor :: IO ()
+testBlockInfoActor = do
+
+  a <- createBlockInfoActor
+  actor <- async $ runBlockInfoActor a
+
+  let obj = shrink [0x00 .. 0xFF] :: [[Word8]]
+
+  forConcurrently_ obj $ \x -> do
+    requestBlockInfo a Nothing (hashObject (B.pack x) :: Hash HbSync)
+
+  pause ( 1 :: Timeout 'Seconds)
+
+  stopBlockInfoActor a
+
+  waitAnyCatchCancel [actor]
+
+  assertBool "testBlockInfoActor" True
+
+