default config path bug fixed

hbs2-peer/app/PeerConfig.hs

@@ -94,7 +94,7 @@ peerConfigRead mbfp = do
 
   xdg <- peerConfigDefault
 
-  let cfgPath = fromMaybe xdg mbfp
+  let cfgPath = maybe xdg (</> cfgName) mbfp
   let dir = takeDirectory cfgPath
 
   debug $ "searching config" <+> pretty cfgPath

hbs2-peer/app/PeerMain.hs

@@ -123,6 +123,7 @@ data RPCCommand =
   | PING (PeerAddr UDP) (Maybe (Peer UDP))
   | CHECK PeerNonce (PeerAddr UDP) (Hash HbSync)
   | FETCH (Hash HbSync)
+  | PEERS
 
 data PeerOpts =
   PeerOpts
@@ -165,6 +166,7 @@ runCLI = join . customExecParser (prefs showHelpOnError) $
                         <> command "announce"  (info pAnnounce (progDesc "announce block"))
                         <> command "ping"      (info pPing (progDesc "ping another peer"))
                         <> command "fetch"     (info pFetch (progDesc "fetch block"))
+                        <> command "peers"     (info pPeers (progDesc "show known peers"))
                         )
 
     common = do
@@ -212,6 +214,10 @@ runCLI = join . customExecParser (prefs showHelpOnError) $
       h   <- strArgument ( metavar "ADDR" )
       pure $ runRpcCommand rpc (PING h Nothing)
 
+    pPeers = do
+      rpc <- pRpcCommon
+      pure $ runRpcCommand rpc PEERS
+
     pInit = do
       pref <- optional $ strArgument ( metavar "DIR" )
       pure $ peerConfigInit pref
@@ -546,12 +552,17 @@ runPeer opts = Exception.handle myException $ do
         liftIO $ withPeerM penv
                $ withDownload denv (processBlock h)
 
+  let peersAction _ = do
+        debug "rpcPeers command"
+        pure ()
+
   let arpc = RpcAdapter pokeAction
                         dontHandle
                         annAction
                         pingAction
                         dontHandle
                         fetchAction
+                        peersAction
 
   rpc <- async $ runRPC udp1 do
                    runProto @e
@@ -641,6 +652,7 @@ withRPC saddr cmd = do
                           (const $ notice "ping?")
                           (liftIO . atomically . writeTQueue q)
                           dontHandle
+                          dontHandle
 
 runRpcCommand :: String -> RPCCommand -> IO ()
 runRpcCommand saddr = \case

hbs2-peer/app/RPC.hs

@@ -20,6 +20,7 @@ data RPC e =
   | RPCPokeAnswer
   | RPCAnnounce (Hash HbSync)
   | RPCFetch (Hash HbSync)
+  | RPCPeers
   deriving stock (Generic)
 
 
@@ -48,6 +49,7 @@ data RpcAdapter e m =
   , rpcOnPing        :: PeerAddr e -> m ()
   , rpcOnPong        :: PeerAddr e -> m ()
   , rpcOnFetch       :: Hash HbSync -> m ()
+  , rpcOnPeers       :: RPC e -> m ()
   }
 
 newtype RpcM m a = RpcM { fromRpcM :: ReaderT RPCEnv m a }
@@ -94,4 +96,5 @@ rpcHandler adapter = \case
     (RPCPing pa)      -> rpcOnPing adapter pa
     (RPCPong pa)      -> rpcOnPong adapter pa
     (RPCFetch h)      -> rpcOnFetch adapter h
+    p@RPCPeers{}      -> rpcOnPeers adapter p