mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
fa9edc0146
commit
7074fec300
|
@ -761,9 +761,9 @@ runPeer opts = Exception.handle myException $ do
|
|||
who <- thatPeer (Proxy @(RPC e))
|
||||
void $ liftIO $ async $ withPeerM penv $ do
|
||||
st <- getStorage
|
||||
mhval <- getLRefValAction st h
|
||||
forM_ mhval \hval ->
|
||||
hval <- getLRefValAction st h
|
||||
request who (RPCLRefGetAnswer @e h hval)
|
||||
debug $ "lrefGetAction sent" <+> pretty h
|
||||
|
||||
|
||||
let arpc = RpcAdapter pokeAction
|
||||
|
@ -777,7 +777,7 @@ runPeer opts = Exception.handle myException $ do
|
|||
logLevelAction
|
||||
lrefAnnAction
|
||||
lrefGetAction
|
||||
(\h hval -> pure ())
|
||||
dontHandle
|
||||
|
||||
rpc <- async $ runRPC udp1 do
|
||||
runProto @e
|
||||
|
@ -910,7 +910,7 @@ withRPC o cmd = do
|
|||
|
||||
(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 opt = \case
|
||||
|
|
|
@ -35,7 +35,7 @@ data RPC e =
|
|||
| RPCLogLevel SetLogging
|
||||
| RPCLRefAnn (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)
|
||||
|
||||
|
||||
|
@ -72,7 +72,7 @@ data RpcAdapter e m =
|
|||
, rpcOnLogLevel :: SetLogging -> m ()
|
||||
, rpcOnLRefAnn :: 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 }
|
||||
|
@ -124,5 +124,5 @@ rpcHandler adapter = \case
|
|||
(RPCLogLevel l) -> rpcOnLogLevel adapter l
|
||||
(RPCLRefAnn h) -> rpcOnLRefAnn adapter h
|
||||
(RPCLRefGet h) -> rpcOnLRefGet adapter h
|
||||
(RPCLRefGetAnswer h hval) -> rpcOnLRefGetAnswer adapter h hval
|
||||
(RPCLRefGetAnswer h hval) -> rpcOnLRefGetAnswer adapter (h, hval)
|
||||
|
||||
|
|
Loading…
Reference in New Issue