wip, rpc for refchan get

hbs2-peer/app/CLI/RefChan.hs

@@ -22,6 +22,7 @@ import Data.Maybe
 pRefChan :: Parser (IO ())
 pRefChan = hsubparser (   command "head" (info pRefChanHead (progDesc "head commands" ))
                        <> command "propose" (info pRefChanPropose (progDesc "post propose transaction"))
+                       <> command "get"     (info pRefChanGet (progDesc "get refchan value"))
                       )
 
 
@@ -117,3 +118,14 @@ pRefChanPropose = do
     else do
       runRpcCommand opts (REFCHANPROPOSE (puk, serialise box))
 
+
+pRefChanGet :: Parser (IO ())
+pRefChanGet = do
+  opts <- pRpcCommon
+  sref <- strArgument (metavar "REFCHAH-REF")
+  pure do
+    puk <- pure (fromStringMay @(RefChanId L4Proto) sref) `orDie` "can't parse refchan/public key"
+    runRpcCommand opts (REFCHANGET puk)
+
+
+

hbs2-peer/app/PeerMain.hs

@@ -1025,6 +1025,15 @@ runPeer opts = U.handle (\e -> myException e
             --   консенсус слать тогда. может, и оставить
             lift $ runResponseM me $ refChanUpdateProto @e True pc refChanAdapter (Propose @e puk proposed)
 
+  let refChanGetAction puk = do
+        trace $ "refChanGetAction" <+> pretty (AsBase58 puk)
+        who <- thatPeer (Proxy @(RPC e))
+        void $ liftIO $ async $ withPeerM penv $ do
+          sto <- getStorage
+          h <- liftIO $ getRef sto (RefChanLogKey @(Encryption e) puk)
+          trace $ "refChanGetAction ANSWER IS" <+> pretty h
+          request who (RPCRefChanGetAnsw @e  h)
+
   let arpc = RpcAdapter pokeAction
                         dieAction
                         dontHandle
@@ -1044,6 +1053,11 @@ runPeer opts = U.handle (\e -> myException e
                         refChanHeadGetAction
                         dontHandle
                         refChanHeadFetchAction
+
+                        dontHandle -- rpcOnRefChanFetch
+                        refChanGetAction
+                        dontHandle -- rpcOnRefChanGetAnsw
+
                         refChanProposeAction
 
   rpc <- async $ runRPC udp1 do

hbs2-peer/app/RPC.hs

@@ -64,6 +64,8 @@ data RPCCommand =
   | REFCHANHEADSEND (Hash HbSync)
   | REFCHANHEADGET (PubKey 'Sign (Encryption L4Proto))
   | REFCHANHEADFETCH (PubKey 'Sign (Encryption L4Proto))
+  | REFCHANFETCH (PubKey 'Sign (Encryption L4Proto))
+  | REFCHANGET (PubKey 'Sign (Encryption L4Proto))
   | REFCHANPROPOSE (PubKey 'Sign (Encryption L4Proto), ByteString)
 
 data RPC e =
@@ -82,10 +84,16 @@ data RPC e =
   | RPCRefLogFetch (PubKey 'Sign (Encryption e))
   | RPCRefLogGet (PubKey 'Sign (Encryption e))
   | RPCRefLogGetAnswer (Maybe (Hash HbSync))
+
   | RPCRefChanHeadSend (Hash HbSync)
   | RPCRefChanHeadGet (PubKey 'Sign (Encryption e))
   | RPCRefChanHeadGetAnsw (Maybe (Hash HbSync))
   | RPCRefChanHeadFetch (PubKey 'Sign (Encryption e))
+
+  | RPCRefChanFetch (PubKey 'Sign (Encryption e))
+  | RPCRefChanGet (PubKey 'Sign (Encryption e))
+  | RPCRefChanGetAnsw (Maybe (Hash HbSync))
+
   | RPCRefChanPropose (PubKey 'Sign (Encryption e), ByteString)
 
   deriving stock (Generic)
@@ -124,10 +132,17 @@ data RpcAdapter e m =
   , rpcOnRefLogFetch   :: PubKey 'Sign (Encryption e) -> m ()
   , rpcOnRefLogGet     :: PubKey 'Sign (Encryption e) -> m ()
   , rpcOnRefLogGetAnsw :: Maybe (Hash HbSync) -> m ()
+
   , rpcOnRefChanHeadSend :: Hash HbSync -> m ()
   , rpcOnRefChanHeadGet :: PubKey 'Sign (Encryption e) -> m ()
   , rpcOnRefChanHeadGetAnsw :: Maybe (Hash HbSync) -> m ()
   , rpcOnRefChanHeadFetch :: PubKey 'Sign (Encryption e) -> m ()
+
+  -- refchan commands
+  , rpcOnRefChanFetch   :: PubKey 'Sign (Encryption e) -> m ()
+  , rpcOnRefChanGet     :: PubKey 'Sign (Encryption e) -> m ()
+  , rpcOnRefChanGetAnsw :: Maybe (Hash HbSync) -> m ()
+
   , rpcOnRefChanPropose :: (PubKey 'Sign (Encryption e), ByteString) -> m ()
   }
 
@@ -185,9 +200,15 @@ rpcHandler adapter = \case
     (RPCRefLogGet e)   -> rpcOnRefLogGet adapter e
     (RPCRefLogGetAnswer s)   -> rpcOnRefLogGetAnsw adapter s
     (RPCRefChanHeadSend s)   -> rpcOnRefChanHeadSend adapter s
+
     (RPCRefChanHeadGet s)   -> rpcOnRefChanHeadGet adapter s
     (RPCRefChanHeadGetAnsw s)   -> rpcOnRefChanHeadGetAnsw adapter s
     (RPCRefChanHeadFetch s)   -> rpcOnRefChanHeadFetch adapter s
+
+    (RPCRefChanGet s)   -> rpcOnRefChanGet adapter s
+    (RPCRefChanGetAnsw s)   -> rpcOnRefChanGetAnsw adapter s
+    (RPCRefChanFetch s)   -> rpcOnRefChanFetch adapter s
+
     (RPCRefChanPropose s)   -> rpcOnRefChanPropose adapter s
 
 data RPCOpt =
@@ -211,9 +232,14 @@ runRpcCommand opt = \case
   REFLOGUPDATE bs -> withRPC opt (RPCRefLogUpdate bs)
   REFLOGFETCH k -> withRPC opt (RPCRefLogFetch k)
   REFLOGGET k -> withRPC opt (RPCRefLogGet k)
+
   REFCHANHEADSEND h -> withRPC opt (RPCRefChanHeadSend h)
   REFCHANHEADGET s -> withRPC opt (RPCRefChanHeadGet s)
   REFCHANHEADFETCH s -> withRPC opt (RPCRefChanHeadFetch s)
+
+  REFCHANGET s -> withRPC opt (RPCRefChanGet s)
+  REFCHANFETCH s -> withRPC opt (RPCRefChanFetch s)
+
   REFCHANPROPOSE s -> withRPC opt (RPCRefChanPropose s)
 
   _ -> pure ()
@@ -249,6 +275,8 @@ withRPC o cmd = rpcClientMain o $ runResourceT do
 
   rchanheadMVar <- liftIO newEmptyMVar
 
+  rchangetMVar <- liftIO newEmptyMVar
+
   let  adapter =
         RpcAdapter dontHandle
                    dontHandle
@@ -278,6 +306,11 @@ withRPC o cmd = rpcClientMain o $ runResourceT do
 
                    dontHandle -- rpcOnRefChanHeadFetch
 
+                   dontHandle -- rpcOnRefChanFetch
+                   dontHandle -- rpcOnRefChanGet
+
+                   (liftIO . putMVar rchangetMVar) -- rpcOnRefChanHeadGetAnsw
+
                    dontHandle -- rpcOnRefChanPropose
 
 
@@ -360,6 +393,20 @@ withRPC o cmd = rpcClientMain o $ runResourceT do
                         pause @'Seconds 0.25
                         exitSuccess
 
+                      RPCRefChanFetch {} -> liftIO do
+                        pause @'Seconds 0.25
+                        exitSuccess
+
+                      RPCRefChanGet {} -> liftIO do
+                        r <- race (pause @'Seconds 2) do
+                                withMVar rchangetMVar $ \v -> do
+                                  pure v
+
+                        case r of
+                          Right (Just x) -> print (pretty x) >> exitSuccess
+
+                          _ -> exitFailure
+
                       RPCRefChanPropose{} -> liftIO do
                         pause @'Seconds 0.25
                         exitSuccess