so far so good

hbs2-core/lib/HBS2/Net/PeerLocator.hs

@@ -1,8 +1,14 @@
 module HBS2.Net.PeerLocator where
 
+-- import HBS2.Prelude
 import HBS2.Net.Proto
 
-class (IsPeer peer, Monad m) => PeerLocator l peer m where
-  knownPeers :: l -> m [Peer peer]
+class PeerLocator l where
+  knownPeers :: (IsPeer peer, Monad m) => l -> m [Peer peer]
+
+data AnyPeerLocator = forall a . PeerLocator a => AnyPeerLocator a
+
+instance PeerLocator AnyPeerLocator where
+  knownPeers (AnyPeerLocator l) = knownPeers  l
 
 

hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs

@@ -17,8 +17,7 @@ newStaticPeerLocator seeds = do
   tv <- liftIO $ newTVarIO (Set.fromList seeds)
   pure $ StaticPeerLocator tv
 
-instance (MonadIO m, IsPeer p)
-  => PeerLocator  (StaticPeerLocator p) p m where
+instance PeerLocator  (StaticPeerLocator p)  where
 
   knownPeers _ = pure mempty
 

hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs

@@ -1,10 +1,11 @@
 module HBS2.Net.Proto.Actors.BlockInfo where
 
-import HBS2.Prelude
-import HBS2.Hash
-import HBS2.Net.Proto
-import HBS2.Clock
 import HBS2.Actors
+import HBS2.Clock
+import HBS2.Hash
+import HBS2.Net.PeerLocator
+import HBS2.Net.Proto
+import HBS2.Prelude
 
 import Data.Function
 import Data.Kind
@@ -19,19 +20,19 @@ import Prettyprinter
 data BlockInfoActor (m :: Type -> Type) =
   BlockInfoActor
   { tasks :: Pipeline m ()
+  , peers :: AnyPeerLocator
   }
 
-
 -- TODO: send block info request
 -- TODO: receive block info request
 -- TODO: cache block info per peer
 -- TODO: get block info per peer
 
 
-createBlockInfoActor :: MonadIO m => m (BlockInfoActor m )
-createBlockInfoActor = do
+createBlockInfoActor :: MonadIO m => AnyPeerLocator -> m (BlockInfoActor m )
+createBlockInfoActor l = do
   pip <- newPipeline 200 -- FIXME: to settings!
-  pure $ BlockInfoActor pip
+  pure $ BlockInfoActor pip l
 
 runBlockInfoActor :: MonadIO m => BlockInfoActor m -> m ()
 runBlockInfoActor b = runPipeline (tasks b)
@@ -41,6 +42,7 @@ stopBlockInfoActor b = stopPipeline (tasks b)
 
 requestBlockInfo :: forall peer h m . ( MonadIO m
                                       , Pretty (Hash h)
+                                      , IsPeer peer
                                       )
                  => BlockInfoActor m
                  -> Maybe (Peer peer)
@@ -50,7 +52,11 @@ requestBlockInfo :: forall peer h m . ( MonadIO m
 requestBlockInfo b mp h = do
   addJob (tasks b) do
     -- peers <- getPeers
+    --
     -- TODO: get given peer or some other peers
+    somePeers <- knownPeers @_ @peer (peers b)
+
+
     -- TODO: get cookie from cookie generator
     -- TODO: set waiting for request
     -- TODO: send block info request to messaging

hbs2-core/test/TestBlockInfoActor.hs

@@ -2,26 +2,40 @@ module TestBlockInfoActor where
 
 import HBS2.Hash
 import HBS2.Clock
+import HBS2.Net.Proto
 import HBS2.Net.Proto.Actors.BlockInfo
+import HBS2.Net.PeerLocator
+import HBS2.Net.PeerLocator.Static
 
 import Test.Tasty.HUnit
 
 import Test.QuickCheck
 import Data.Word
+import Data.Hashable (Hashable)
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as B
 import Control.Concurrent.Async
 
+data Fake
+
+instance IsPeer Fake where
+  newtype instance Peer Fake = FakePeer Int
+                               deriving stock (Eq,Ord,Show)
+                               deriving newtype (Hashable,Num,Enum,Real,Integral)
+
 testBlockInfoActor :: IO ()
 testBlockInfoActor = do
 
-  a <- createBlockInfoActor
+
+  np <- newStaticPeerLocator @Fake [1..10]
+
+  a <- createBlockInfoActor (AnyPeerLocator np)
   actor <- async $ runBlockInfoActor a
 
   let obj = shrink [0x00 .. 0xFF] :: [[Word8]]
 
   forConcurrently_ obj $ \x -> do
-    requestBlockInfo a Nothing (hashObject (B.pack x) :: Hash HbSync)
+    requestBlockInfo @Fake a Nothing (hashObject (B.pack x) :: Hash HbSync)
 
   pause ( 1 :: Timeout 'Seconds)