From 3b569777bc63b8800670a4834fec59020270b9b1 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sat, 25 Feb 2023 06:16:37 +0300
Subject: [PATCH] optional-rpc-parameter

---
 .fixme/log                                 |  2 +
 hbs2-core/lib/HBS2/System/Logger/Simple.hs |  8 +++-
 hbs2-peer/app/PeerConfig.hs                |  4 +-
 hbs2-peer/app/PeerMain.hs                  | 53 +++++++++++++++-------
 4 files changed, 47 insertions(+), 20 deletions(-)

diff --git a/.fixme/log b/.fixme/log
index e4987cd7..f54ff337 100644
--- a/.fixme/log
+++ b/.fixme/log
@@ -216,3 +216,5 @@ fixme-set "workflow" "wip" "BhME2nDpbd"
 fixme-set "assigned" "voidlizard" "BhME2nDpbd"
 
 
+
+fixme-set "workflow" "test" "BhME2nDpbd"
\ No newline at end of file
diff --git a/hbs2-core/lib/HBS2/System/Logger/Simple.hs b/hbs2-core/lib/HBS2/System/Logger/Simple.hs
index ee4b47e0..5e550c6d 100644
--- a/hbs2-core/lib/HBS2/System/Logger/Simple.hs
+++ b/hbs2-core/lib/HBS2/System/Logger/Simple.hs
@@ -11,7 +11,7 @@ module HBS2.System.Logger.Simple
   , warn
   , notice
   , info
-  , setLogging
+  , setLogging, setLoggingOff
   , defLog
   , loggerTr
   , module HBS2.System.Logger.Simple.Class
@@ -63,6 +63,12 @@ setLogging f = do
   let key = logKey @a
   void $ liftIO $ atomicModifyIORef' loggers (\x -> (IntMap.insert key def x, ()))
 
+
+setLoggingOff :: forall a m . (MonadIO m, HasLogLevel a) => m ()
+setLoggingOff = do
+  let key = logKey @a
+  void $ liftIO $ atomicModifyIORef' loggers (\x -> (IntMap.delete key x, IntMap.lookup key x))
+
 withLogger :: forall a m . (HasLogLevel a, MonadIO m) => (LoggerEntry -> m ()) -> m ()
 withLogger f = do
   lo <- liftIO $ readIORef loggers <&> IntMap.lookup (logKey @a)
diff --git a/hbs2-peer/app/PeerConfig.hs b/hbs2-peer/app/PeerConfig.hs
index b6a3647d..7ba54e86 100644
--- a/hbs2-peer/app/PeerConfig.hs
+++ b/hbs2-peer/app/PeerConfig.hs
@@ -47,7 +47,7 @@ cfgName = "config"
 
 newtype PeerConfig =
   PeerConfig [Syntax C]
-  deriving newtype (Monoid, Semigroup)
+  deriving newtype (Monoid, Semigroup, Pretty)
 
 
 peerConfigDefault :: MonadIO m => m FilePath
@@ -126,7 +126,7 @@ peerConfigRead mbfp = do
 
     let confData = confData' <> either mempty id (parseTop  peerConfDef)
 
-    debug $ pretty confData
+    -- debug $ pretty confData
 
     config <- flip transformBiM confData $ \case
                 List co (Key "key" [LitStrVal p]) -> do
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index f7009b05..550cbadd 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -119,6 +119,14 @@ instance HasCfgValue PeerAcceptAnnounceKey AcceptAnnounce where
       kk = key @PeerAcceptAnnounceKey @AcceptAnnounce
 
 
+data RPCOpt =
+  RPCOpt
+  { _rpcOptConf :: Maybe FilePath
+  , _rpcOptAddr :: Maybe String
+  }
+
+makeLenses 'RPCOpt
+
 data RPCCommand =
     POKE
   | ANNOUNCE (Hash HbSync)
@@ -171,6 +179,12 @@ runCLI = join . customExecParser (prefs showHelpOnError) $
                         <> command "peers"     (info pPeers (progDesc "show known peers"))
                         )
 
+    confOpt = strOption ( long "config"  <> short 'c' <> help "config" )
+
+    rpcOpt = strOption ( short 'r' <> long "rpc"
+                                   <> help "addr:port" )
+
+
     common = do
       pref <- optional $ strOption ( short 'p' <> long "prefix"
                                                <> help "storage prefix" )
@@ -178,13 +192,12 @@ runCLI = join . customExecParser (prefs showHelpOnError) $
       l    <- optional $ strOption ( short 'l' <> long "listen"
                                     <> help "addr:port" )
 
-      r    <- optional $ strOption ( short 'r' <> long "rpc"
-                                    <> help "addr:port" )
+      r    <- optional rpcOpt
 
       k    <- optional $ strOption ( short 'k' <> long "key"
                                     <> help "peer keys file" )
 
-      c <- optional $ strOption ( long "config"  <> short 'c' <> help "config" )
+      c <- optional confOpt
 
       pure $ PeerOpts pref l r k c
 
@@ -192,10 +205,8 @@ runCLI = join . customExecParser (prefs showHelpOnError) $
       runPeer <$> common
 
     pRpcCommon = do
-      strOption (     short 'r' <> long "rpc"
-                   <> help "addr:port"
-                   <> value defRpcUDP
-                )
+      RPCOpt <$> optional confOpt
+             <*> optional rpcOpt
 
     pPoke = do
       rpc <- pRpcCommon
@@ -303,7 +314,7 @@ runPeer opts = Exception.handle myException $ do
   conf <- peerConfigRead (view peerConfig opts)
 
   -- let (PeerConfig syn) = conf
-  -- print $ pretty syn
+  print $ pretty conf
 
   let listenConf = cfgValue @PeerListenKey conf
   let rpcConf = cfgValue @PeerRpcKey conf
@@ -650,8 +661,16 @@ emitToPeer :: ( MonadIO m
 
 emitToPeer env k e = liftIO $ withPeerM env (emit k e)
 
-withRPC :: String -> RPC UDP -> IO ()
-withRPC saddr cmd = do
+withRPC :: RPCOpt -> RPC UDP -> IO ()
+withRPC o cmd = do
+
+  setLoggingOff @DEBUG
+
+  conf <- peerConfigRead (view rpcOptConf o)
+
+  let rpcConf = cfgValue @PeerRpcKey conf :: Maybe String
+
+  saddr <- pure  (view rpcOptAddr o <|> rpcConf) `orDie` "RPC endpoint not set"
 
   as <- parseAddr (fromString saddr) <&> fmap (PeerUDP . addrAddress)
   let rpc' = headMay $ L.sortBy (compare `on` addrPriority) as
@@ -719,13 +738,13 @@ withRPC saddr cmd = do
                           (\(pa, k) -> Log.info $ pretty (AsBase58 k) <+> pretty pa
                           )
 
-runRpcCommand :: String -> RPCCommand -> IO ()
-runRpcCommand saddr = \case
-  POKE -> withRPC saddr RPCPoke
-  PING s _ -> withRPC saddr (RPCPing s)
-  ANNOUNCE h -> withRPC saddr (RPCAnnounce h)
-  FETCH h  -> withRPC saddr (RPCFetch h)
-  PEERS -> withRPC saddr RPCPeers
+runRpcCommand :: RPCOpt -> RPCCommand -> IO ()
+runRpcCommand opt = \case
+  POKE -> withRPC opt RPCPoke
+  PING s _ -> withRPC opt (RPCPing s)
+  ANNOUNCE h -> withRPC opt (RPCAnnounce h)
+  FETCH h  -> withRPC opt (RPCFetch h)
+  PEERS -> withRPC opt RPCPeers
 
   _ -> pure ()