diff --git a/.fixme/log b/.fixme/log index 7cbda58b..e81a6e1b 100644 --- a/.fixme/log +++ b/.fixme/log @@ -160,3 +160,5 @@ fixme-set "workflow" "wip" "DZyVAuBYzB" fixme-set "workflow" "test" "DTZ2RqeN7y" fixme-set "workflow" "test" "84iLJsvCtT" fixme-set "workflow" "wip" "GkCkjVMAXW" + +fixme-set "workflow" "test" "GkCkjVMAXW" \ No newline at end of file diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 00f23d77..f24b47fd 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -554,7 +554,19 @@ runPeer opts = Exception.handle myException $ do let peersAction _ = do debug "rpcPeers command" - pure () + + who <- thatPeer (Proxy @(RPC e)) + + void $ liftIO $ async $ withPeerM penv $ do + pl <- getPeerLocator @e + pips <- knownPeers @e pl + for_ pips $ \p -> do + pd' <- find (KnownPeerKey p) id + maybe1 pd' (pure ()) $ \pd -> do + let k = view peerSignKey pd + debug $ "known-peer" <+> pretty p <+> pretty (AsBase58 k) + pa <- toPeerAddr p + request who (RPCPeersAnswer @e pa k) let arpc = RpcAdapter pokeAction dontHandle @@ -563,6 +575,7 @@ runPeer opts = Exception.handle myException $ do dontHandle fetchAction peersAction + dontHandle rpc <- async $ runRPC udp1 do runProto @e @@ -639,6 +652,10 @@ withRPC saddr cmd = do Log.info $ "pong from" <+> pretty pa exitSuccess + RPCPeers{} -> liftIO do + pause @'Seconds 1 + exitSuccess + _ -> pure () void $ liftIO $ waitAnyCatchCancel [proto] @@ -654,12 +671,16 @@ withRPC saddr cmd = do dontHandle dontHandle + (\(pa, k) -> Log.info $ pretty (AsBase58 k) <+> pretty pa + ) + runRpcCommand :: String -> RPCCommand -> IO () runRpcCommand saddr = \case - POKE -> withRPC saddr (RPCPoke @UDP) + POKE -> withRPC saddr RPCPoke PING s _ -> withRPC saddr (RPCPing s) - ANNOUNCE h -> withRPC saddr (RPCAnnounce @UDP h) - FETCH h -> withRPC saddr (RPCFetch @UDP h) + ANNOUNCE h -> withRPC saddr (RPCAnnounce h) + FETCH h -> withRPC saddr (RPCFetch h) + PEERS -> withRPC saddr RPCPeers _ -> pure () diff --git a/hbs2-peer/app/RPC.hs b/hbs2-peer/app/RPC.hs index 660a6df1..eee176d1 100644 --- a/hbs2-peer/app/RPC.hs +++ b/hbs2-peer/app/RPC.hs @@ -7,6 +7,8 @@ import HBS2.Net.Proto import HBS2.Hash import HBS2.Net.Messaging.UDP import HBS2.Actors.Peer +import HBS2.Net.Auth.Credentials +import HBS2.Net.Proto.Definition() import Control.Monad.Reader import Data.ByteString.Lazy (ByteString) @@ -21,6 +23,7 @@ data RPC e = | RPCAnnounce (Hash HbSync) | RPCFetch (Hash HbSync) | RPCPeers + | RPCPeersAnswer (PeerAddr e) (PubKey 'Sign e) deriving stock (Generic) @@ -50,6 +53,7 @@ data RpcAdapter e m = , rpcOnPong :: PeerAddr e -> m () , rpcOnFetch :: Hash HbSync -> m () , rpcOnPeers :: RPC e -> m () + , rpcOnPeersAnswer :: (PeerAddr e, PubKey 'Sign e) -> m () } newtype RpcM m a = RpcM { fromRpcM :: ReaderT RPCEnv m a } @@ -90,11 +94,12 @@ rpcHandler :: forall e m . ( MonadIO m => RpcAdapter e m -> RPC e -> m () rpcHandler adapter = \case - p@RPCPoke{} -> rpcOnPoke adapter p >> response (RPCPokeAnswer @e) - p@RPCPokeAnswer{} -> rpcOnPokeAnswer adapter p - (RPCAnnounce h) -> rpcOnAnnounce adapter h - (RPCPing pa) -> rpcOnPing adapter pa - (RPCPong pa) -> rpcOnPong adapter pa - (RPCFetch h) -> rpcOnFetch adapter h - p@RPCPeers{} -> rpcOnPeers adapter p + p@RPCPoke{} -> rpcOnPoke adapter p >> response (RPCPokeAnswer @e) + p@RPCPokeAnswer{} -> rpcOnPokeAnswer adapter p + (RPCAnnounce h) -> rpcOnAnnounce adapter h + (RPCPing pa) -> rpcOnPing adapter pa + (RPCPong pa) -> rpcOnPong adapter pa + (RPCFetch h) -> rpcOnFetch adapter h + p@RPCPeers{} -> rpcOnPeers adapter p + (RPCPeersAnswer pa k) -> rpcOnPeersAnswer adapter (pa,k)