voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
Sergey Ivanov 2023-03-15 07:12:54 +04:00
parent fa9edc0146
commit 7074fec300
2 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hbs2-peer/app/PeerMain.hs
View File

@ -761,9 +761,9 @@ runPeer opts = Exception.handle myException $ do
who <- thatPeer (Proxy @(RPC e)) who <- thatPeer (Proxy @(RPC e))
void $ liftIO $ async $ withPeerM penv $ do void $ liftIO $ async $ withPeerM penv $ do
st <- getStorage st <- getStorage
mhval <- getLRefValAction st h hval <- getLRefValAction st h
forM_ mhval \hval ->
request who (RPCLRefGetAnswer @e h hval) request who (RPCLRefGetAnswer @e h hval)
debug $ "lrefGetAction sent" <+> pretty h
let arpc = RpcAdapter pokeAction let arpc = RpcAdapter pokeAction
@ -777,7 +777,7 @@ runPeer opts = Exception.handle myException $ do
logLevelAction logLevelAction
lrefAnnAction lrefAnnAction
lrefGetAction lrefGetAction
(\h hval -> pure ()) dontHandle
rpc <- async $ runRPC udp1 do rpc <- async $ runRPC udp1 do
runProto @e runProto @e
@ -910,7 +910,7 @@ withRPC o cmd = do
(const $ liftIO exitSuccess) (const $ liftIO exitSuccess)
(const $ liftIO exitSuccess) (const $ liftIO exitSuccess)
(\h hval -> Log.info $ pretty h <+> viaShow hval) (\(h, hval) -> Log.info $ pretty h <+> viaShow hval)
runRpcCommand :: RPCOpt -> RPCCommand -> IO () runRpcCommand :: RPCOpt -> RPCCommand -> IO ()
runRpcCommand opt = \case runRpcCommand opt = \case

6
hbs2-peer/app/RPC.hs
View File

@ -35,7 +35,7 @@ data RPC e =
| RPCLogLevel SetLogging | RPCLogLevel SetLogging
| RPCLRefAnn (Hash HbSync) | RPCLRefAnn (Hash HbSync)
| RPCLRefGet (Hash HbSync) | RPCLRefGet (Hash HbSync)
| RPCLRefGetAnswer (Hash HbSync) (Signed SignaturePresent (MutableRef e 'LinearRef)) | RPCLRefGetAnswer (Hash HbSync) (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
deriving stock (Generic) deriving stock (Generic)
@ -72,7 +72,7 @@ data RpcAdapter e m =
, rpcOnLogLevel :: SetLogging -> m () , rpcOnLogLevel :: SetLogging -> m ()
, rpcOnLRefAnn :: Hash HbSync -> m () , rpcOnLRefAnn :: Hash HbSync -> m ()
, rpcOnLRefGet :: Hash HbSync -> m () , rpcOnLRefGet :: Hash HbSync -> m ()
, rpcOnLRefGetAnswer :: Hash HbSync -> Signed SignaturePresent (MutableRef e 'LinearRef) -> m () , rpcOnLRefGetAnswer :: (Hash HbSync, Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef))) -> m ()
} }
newtype RpcM m a = RpcM { fromRpcM :: ReaderT RPCEnv m a } newtype RpcM m a = RpcM { fromRpcM :: ReaderT RPCEnv m a }
@ -124,5 +124,5 @@ rpcHandler adapter = \case
(RPCLogLevel l) -> rpcOnLogLevel adapter l (RPCLogLevel l) -> rpcOnLogLevel adapter l
(RPCLRefAnn h) -> rpcOnLRefAnn adapter h (RPCLRefAnn h) -> rpcOnLRefAnn adapter h
(RPCLRefGet h) -> rpcOnLRefGet adapter h (RPCLRefGet h) -> rpcOnLRefGet adapter h
(RPCLRefGetAnswer h hval) -> rpcOnLRefGetAnswer adapter h hval (RPCLRefGetAnswer h hval) -> rpcOnLRefGetAnswer adapter (h, hval)