rpc-own-peer-key

.fixme/log

@@ -161,4 +161,6 @@ fixme-set "workflow" "test" "DTZ2RqeN7y"
 fixme-set "workflow" "test" "84iLJsvCtT"
 fixme-set "workflow" "wip" "GkCkjVMAXW"
 
-fixme-set "workflow" "test" "GkCkjVMAXW"
+fixme-set "workflow" "test" "GkCkjVMAXW"
+
+fixme-set "workflow" "test" "t8M3AEnm93"

docs/devlog.md

@@ -1,6 +1,10 @@
 
 ## 2023-02-15
 
+TODO: rpc-own-peer-key
+
+  poke to print peer's own auth key
+
 TODO: rpc-known-peers
 
 TODO: announce-group

hbs2-peer/app/PeerMain.hs

@@ -538,7 +538,11 @@ runPeer opts = Exception.handle myException $ do
               void $ liftIO $ waitAnyCatchCancel workers
 
   let pokeAction _ = do
+        who <- thatPeer (Proxy @(RPC e))
+        let k = view peerSignPk pc
+        -- FIXME: to-delete-POKE
         liftIO $ atomically $ writeTQueue rpcQ POKE
+        request who (RPCPokeAnswer @e k)
 
   let annAction h = do
         liftIO $ atomically $ writeTQueue rpcQ (ANNOUNCE h)
@@ -654,6 +658,17 @@ withRPC saddr cmd = do
                                  Log.info $ "pong from" <+> pretty pa
                                  exitSuccess
 
+
+                      RPCPoke{} -> do
+                        let onTimeout = do pause @'Seconds 0.5
+                                           Log.info "no-one-is-here"
+                                           exitFailure
+
+                        void $ liftIO $ race onTimeout do
+                                 k <- liftIO $ atomically $ readTQueue pokeQ
+                                 Log.info $ "alive-and-kicking" <+> pretty (AsBase58 k)
+                                 exitSuccess
+
                       RPCPeers{} -> liftIO do
                         pause @'Seconds 1
                         exitSuccess
@@ -665,8 +680,8 @@ withRPC saddr cmd = do
   void $ waitAnyCatchCancel [mrpc, prpc]
 
   where
-    adapter q = RpcAdapter dontHandle
-                          (const $ notice "alive-and-kicking" >> liftIO exitSuccess)
+    adapter q pq = RpcAdapter dontHandle
+                          (liftIO . atomically . writeTQueue pq)
                           (const $ liftIO exitSuccess)
                           (const $ notice "ping?")
                           (liftIO . atomically . writeTQueue q)

hbs2-peer/app/RPC.hs

@@ -19,7 +19,7 @@ data RPC e =
     RPCPoke
   | RPCPing (PeerAddr e)
   | RPCPong (PeerAddr e)
-  | RPCPokeAnswer
+  | RPCPokeAnswer (PubKey 'Sign e)
   | RPCAnnounce (Hash HbSync)
   | RPCFetch (Hash HbSync)
   | RPCPeers
@@ -47,7 +47,7 @@ makeLenses 'RPCEnv
 data RpcAdapter e m =
   RpcAdapter
   { rpcOnPoke        :: RPC e -> m ()
-  , rpcOnPokeAnswer  :: RPC e -> m ()
+  , rpcOnPokeAnswer  :: PubKey 'Sign e -> m ()
   , rpcOnAnnounce    :: Hash HbSync -> m ()
   , rpcOnPing        :: PeerAddr e -> m ()
   , rpcOnPong        :: PeerAddr e -> m ()
@@ -94,8 +94,8 @@ 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
+    p@RPCPoke{}        -> rpcOnPoke adapter p
+    (RPCPokeAnswer k)  -> rpcOnPokeAnswer adapter k
     (RPCAnnounce h)    -> rpcOnAnnounce adapter h
     (RPCPing pa)       -> rpcOnPing adapter pa
     (RPCPong pa)       -> rpcOnPong adapter pa