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

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

@ -38,7 +38,8 @@ data RPC e =
| RPCLRefNewAnswer (Hash HbSync)
| RPCLRefGet (Hash HbSync)
| 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)))
deriving stock (Generic)
@ -79,7 +80,8 @@ data RpcAdapter e m =
, rpcOnLRefNewAnswer :: Hash HbSync -> m ()
, rpcOnLRefGet :: Hash HbSync -> 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 ()
}
@ -135,5 +137,6 @@ rpcHandler adapter = \case
(RPCLRefNewAnswer h) -> rpcOnLRefNewAnswer adapter h
(RPCLRefGet h) -> rpcOnLRefGet adapter h
(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