diff --git a/hbs2-peer/app/CLI/RefChan.hs b/hbs2-peer/app/CLI/RefChan.hs index 023052f9..9d86d4c4 100644 --- a/hbs2-peer/app/CLI/RefChan.hs +++ b/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) + + + diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 9ad47fcb..bbcb24a2 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/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 diff --git a/hbs2-peer/app/RPC.hs b/hbs2-peer/app/RPC.hs index 20cfa5d8..85ee9ce2 100644 --- a/hbs2-peer/app/RPC.hs +++ b/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