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

ad-hoc lref-update client side implementation

This commit is contained in:
Sergey Ivanov 2023-03-16 04:44:14 +04:00
parent e3dc95c8bf
commit 33f56c9620
2 changed files with 21 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -826,14 +826,16 @@ runPeer opts = Exception.handle myException $ do
request who (RPCLRefGetAnswer @e hval) request who (RPCLRefGetAnswer @e hval)
debug $ "lrefGetAction sent" <+> pretty h debug $ "lrefGetAction sent" <+> pretty h
let lrefUpdateAction h = do let lrefUpdateAction q@(sk, pk, lrefId, valh) = do
debug $ "lrefUpdateAction" <+> pretty True debug $ "lrefUpdateAction" <+> viaShow q
-- 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
-- -- mlref <- undefined -- FIXME: lrefUpdateAction let cred = PeerCredentials @e sk pk mempty
-- -- -- request who (RPCLRefUpdateAnswer @e mlref) liftIO $ modifyLinearRef st cred lrefId \_ -> pure valh
-- debug $ "lrefUpdateAction sent" <+> pretty h mlref <- getLRefValAction st lrefId
request who (RPCLRefUpdateAnswer @e mlref)
debug $ "lrefUpdateAction sent" <+> pretty mlref
let arpc = RpcAdapter let arpc = RpcAdapter
{ rpcOnPoke = pokeAction { rpcOnPoke = pokeAction
@ -1032,10 +1034,11 @@ runRpcCommand opt = \case
-- увеличить счётчик, обновить значение, подписать -- увеличить счётчик, обновить значение, подписать
-- выполнить (RPCLRefUpdate lref) -- выполнить (RPCLRefUpdate lref)
-- дождаться ответа -- дождаться ответа
let -- let
lref :: Signed 'SignaturePresent (MutableRef UDP 'LinearRef) -- lref :: Signed 'SignaturePresent (MutableRef UDP 'LinearRef)
lref = undefined -- lref = undefined
withRPC opt (RPCLRefUpdate lref) -- withRPC opt (RPCLRefUpdate lref)
withRPC opt (RPCLRefUpdate sk pk lrefId h)
_ -> pure () _ -> pure ()

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

@ -38,7 +38,8 @@ data RPC e =
| RPCLRefNewAnswer (Hash HbSync) | RPCLRefNewAnswer (Hash HbSync)
| RPCLRefGet (Hash HbSync) | RPCLRefGet (Hash HbSync)
| RPCLRefGetAnswer (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef))) | RPCLRefGetAnswer (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
| RPCLRefUpdate (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -- | RPCLRefUpdate (Signed 'SignaturePresent (MutableRef e 'LinearRef))
| RPCLRefUpdate (PrivKey 'Sign UDP) (PubKey 'Sign UDP) (Hash HbSync) (Hash HbSync)
| RPCLRefUpdateAnswer (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef))) | RPCLRefUpdateAnswer (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
deriving stock (Generic) deriving stock (Generic)
@ -79,7 +80,8 @@ data RpcAdapter e m =
, rpcOnLRefNewAnswer :: Hash HbSync -> m () , rpcOnLRefNewAnswer :: Hash HbSync -> m ()
, rpcOnLRefGet :: Hash HbSync -> m () , rpcOnLRefGet :: Hash HbSync -> m ()
, rpcOnLRefGetAnswer :: Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m () , rpcOnLRefGetAnswer :: Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
, rpcOnLRefUpdate :: (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m () -- , rpcOnLRefUpdate :: (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
, rpcOnLRefUpdate :: (PrivKey 'Sign UDP, PubKey 'Sign UDP, Hash HbSync, Hash HbSync) -> m ()
, rpcOnLRefUpdateAnswer :: Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m () , rpcOnLRefUpdateAnswer :: Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
} }
@ -135,5 +137,6 @@ rpcHandler adapter = \case
(RPCLRefNewAnswer h) -> rpcOnLRefNewAnswer adapter h (RPCLRefNewAnswer h) -> rpcOnLRefNewAnswer adapter h
(RPCLRefGet h) -> rpcOnLRefGet adapter h (RPCLRefGet h) -> rpcOnLRefGet adapter h
(RPCLRefGetAnswer hval) -> rpcOnLRefGetAnswer adapter hval (RPCLRefGetAnswer hval) -> rpcOnLRefGetAnswer adapter hval
(RPCLRefUpdate upd) -> rpcOnLRefUpdate adapter upd -- (RPCLRefUpdate upd) -> rpcOnLRefUpdate adapter upd
(RPCLRefUpdate sk pk lrefId h) -> rpcOnLRefUpdate adapter (sk, pk, lrefId, h)
(RPCLRefUpdateAnswer mupd) -> rpcOnLRefUpdateAnswer adapter mupd (RPCLRefUpdateAnswer mupd) -> rpcOnLRefUpdateAnswer adapter mupd