fixed GkCkjVMAXW

.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"

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)
+  ANNOUNCE h -> withRPC saddr (RPCAnnounce h)
-  FETCH h  -> withRPC saddr (RPCFetch @UDP h)
+  FETCH h  -> withRPC saddr (RPCFetch h)
+  PEERS -> withRPC saddr RPCPeers
 
   _ -> pure ()
 

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 }
@@ -97,4 +101,5 @@ rpcHandler adapter = \case
     (RPCPong pa)       -> rpcOnPong adapter pa
     (RPCFetch h)       -> rpcOnFetch adapter h
     p@RPCPeers{}       -> rpcOnPeers adapter p
+    (RPCPeersAnswer pa k) -> rpcOnPeersAnswer adapter (pa,k)