From e970e0a30eeeca577f4759b3d5657289457f2e1f Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Wed, 15 Feb 2023 10:12:53 +0300
Subject: [PATCH] default config path bug fixed

---
 hbs2-peer/app/PeerConfig.hs |  2 +-
 hbs2-peer/app/PeerMain.hs   | 12 ++++++++++++
 hbs2-peer/app/RPC.hs        |  5 ++++-
 3 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/hbs2-peer/app/PeerConfig.hs b/hbs2-peer/app/PeerConfig.hs
index 786ac53a..90592cd4 100644
--- a/hbs2-peer/app/PeerConfig.hs
+++ b/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
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index 0baecce9..00f23d77 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/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
diff --git a/hbs2-peer/app/RPC.hs b/hbs2-peer/app/RPC.hs
index 106c5d1f..660a6df1 100644
--- a/hbs2-peer/app/RPC.hs
+++ b/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 }
@@ -91,7 +93,8 @@ 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
+    (RPCPing pa)      -> rpcOnPing adapter pa
     (RPCPong pa)      -> rpcOnPong adapter pa
     (RPCFetch h)      -> rpcOnFetch adapter h
+    p@RPCPeers{}      -> rpcOnPeers adapter p