diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal index 3784c481..834683af 100644 --- a/hbs2-core/hbs2-core.cabal +++ b/hbs2-core/hbs2-core.cabal @@ -73,6 +73,8 @@ library , HBS2.Merkle , HBS2.Net.Messaging , HBS2.Net.Messaging.Fake + , HBS2.Net.PeerLocator + , HBS2.Net.PeerLocator.Static , HBS2.Net.Proto , HBS2.Net.Proto.Actors.BlockInfo , HBS2.Prelude diff --git a/hbs2-core/lib/HBS2/Net/PeerLocator.hs b/hbs2-core/lib/HBS2/Net/PeerLocator.hs new file mode 100644 index 00000000..973cb3eb --- /dev/null +++ b/hbs2-core/lib/HBS2/Net/PeerLocator.hs @@ -0,0 +1,8 @@ +module HBS2.Net.PeerLocator where + +import HBS2.Net.Proto + +class (IsPeer peer, Monad m) => PeerLocator l peer m where + knownPeers :: l -> m [Peer peer] + + diff --git a/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs b/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs new file mode 100644 index 00000000..38ed26b9 --- /dev/null +++ b/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs @@ -0,0 +1,24 @@ +module HBS2.Net.PeerLocator.Static where + +import HBS2.Prelude +import HBS2.Net.Proto +import HBS2.Net.PeerLocator + +import Control.Concurrent.STM.TVar +import Data.Set (Set) +import Data.Set qualified as Set + +newtype StaticPeerLocator p = + StaticPeerLocator (TVar (Set (Peer p))) + + +newStaticPeerLocator :: (IsPeer p, MonadIO m) => [Peer p] -> m (StaticPeerLocator p) +newStaticPeerLocator seeds = do + tv <- liftIO $ newTVarIO (Set.fromList seeds) + pure $ StaticPeerLocator tv + +instance (MonadIO m, IsPeer p) + => PeerLocator (StaticPeerLocator p) p m where + + knownPeers _ = pure mempty + diff --git a/hbs2-core/lib/HBS2/Net/Proto.hs b/hbs2-core/lib/HBS2/Net/Proto.hs index 05479ec2..373b346c 100644 --- a/hbs2-core/lib/HBS2/Net/Proto.hs +++ b/hbs2-core/lib/HBS2/Net/Proto.hs @@ -5,7 +5,7 @@ import HBS2.Prelude.Plated import Data.Kind import Data.Hashable -class (Hashable (Peer a), Eq (Peer a)) => IsPeer a where +class (Hashable (Peer a), Eq (Peer a), Ord (Peer a)) => IsPeer a where data family Peer a :: Type diff --git a/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs b/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs index 2a5b7dfd..b463eb63 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Actors/BlockInfo.hs @@ -47,8 +47,14 @@ requestBlockInfo :: forall peer h m . ( MonadIO m -> Hash h -> m () -requestBlockInfo b _ h = do +requestBlockInfo b mp h = do addJob (tasks b) do + -- peers <- getPeers + -- TODO: get given peer or some other peers + -- TODO: get cookie from cookie generator + -- TODO: set waiting for request + -- TODO: send block info request to messaging + liftIO $ print ( "request-info" <+> pretty h) getBlockInfo :: MonadIO m