mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
Sergey Ivanov
parent
7074fec300
commit
70ef552bd3
|
|
@ -843,8 +843,8 @@ FIXME: Обработка ошибок в асинхронном приложе
|
|||
|
||||
FIXME: RPC, cli для линейных ссылок
|
||||
|
||||
* [x] lref-get через rpc пира get
|
||||
* [ ] lref-new через rpc пира new
|
||||
* [ ] lref-get через rpc пира get
|
||||
* [ ] lref-update через rpc пира update
|
||||
|
||||
* [ ] lref-list через rpc пира list
|
||||
|
|
|
|||
|
|
@ -96,6 +96,10 @@ data instance MutableRef e 'LinearRef
|
|||
}
|
||||
deriving stock (Generic, Show)
|
||||
|
||||
instance Pretty (MutableRef e 'LinearRef) where
|
||||
pretty LinearMutableRef {..} =
|
||||
parens ( "LinearMutableRef" <+> pretty lrefId <+> pretty lrefHeight <+> pretty lrefVal)
|
||||
|
||||
instance Serialise (MutableRef e 'LinearRef)
|
||||
|
||||
---
|
||||
|
|
@ -114,8 +118,10 @@ data instance Signed SignaturePresent (MutableRef e 'LinearRef)
|
|||
instance Serialise (Signature e) =>
|
||||
Serialise (Signed 'SignaturePresent (MutableRef e 'LinearRef))
|
||||
|
||||
instance Show (Signature e) =>
|
||||
Show (Signed 'SignaturePresent (MutableRef e 'LinearRef))
|
||||
instance (Show (Signature e), Pretty (MutableRef e 'LinearRef)
|
||||
) => Pretty (Signed 'SignaturePresent (MutableRef e 'LinearRef)) where
|
||||
pretty LinearMutableRefSigned {..} =
|
||||
parens ( "LinearMutableRefSigned" <+> viaShow lmrefSignature <+> pretty lmrefSignedRef)
|
||||
|
||||
data instance Signed 'SignatureVerified (MutableRef e 'LinearRef)
|
||||
= LinearMutableRefSignatureVerified
|
||||
|
|
|
|||
|
|
@ -762,7 +762,7 @@ runPeer opts = Exception.handle myException $ do
|
|||
void $ liftIO $ async $ withPeerM penv $ do
|
||||
st <- getStorage
|
||||
hval <- getLRefValAction st h
|
||||
request who (RPCLRefGetAnswer @e h hval)
|
||||
request who (RPCLRefGetAnswer @e hval)
|
||||
debug $ "lrefGetAction sent" <+> pretty h
|
||||
|
||||
|
||||
|
|
@ -846,11 +846,31 @@ withRPC o cmd = do
|
|||
|
||||
pokeQ <- newTQueueIO
|
||||
|
||||
lrefGetQ <- newTQueueIO
|
||||
|
||||
let rpcAdapter = RpcAdapter
|
||||
dontHandle
|
||||
(liftIO . atomically . writeTQueue pokeQ)
|
||||
(const $ liftIO exitSuccess)
|
||||
(const $ notice "ping?")
|
||||
(liftIO . atomically . writeTQueue pingQ)
|
||||
dontHandle
|
||||
dontHandle
|
||||
|
||||
(\(pa, k) -> Log.info $ pretty (AsBase58 k) <+> pretty pa
|
||||
)
|
||||
|
||||
dontHandle
|
||||
|
||||
(const $ liftIO exitSuccess)
|
||||
(const $ liftIO exitSuccess)
|
||||
(liftIO . atomically . writeTQueue lrefGetQ)
|
||||
|
||||
prpc <- async $ runRPC udp1 do
|
||||
env <- ask
|
||||
proto <- liftIO $ async $ continueWithRPC env $ do
|
||||
runProto @UDP
|
||||
[ makeResponse (rpcHandler (adapter pingQ pokeQ))
|
||||
[ makeResponse (rpcHandler rpcAdapter)
|
||||
]
|
||||
|
||||
request rpc cmd
|
||||
|
|
@ -885,7 +905,11 @@ withRPC o cmd = do
|
|||
|
||||
RPCLRefAnn{} -> pause @'Seconds 0.1 >> liftIO exitSuccess
|
||||
|
||||
RPCLRefGet{} -> pause @'Seconds 1 >> liftIO exitSuccess
|
||||
RPCLRefGet{} ->
|
||||
void $ liftIO $ void $ race (pause @'Seconds 5 >> exitFailure) do
|
||||
pa <- liftIO $ atomically $ readTQueue lrefGetQ
|
||||
Log.info $ "got RPCLRefGetAnswer" <+> pretty pa
|
||||
exitSuccess
|
||||
|
||||
_ -> pure ()
|
||||
|
||||
|
|
@ -893,25 +917,6 @@ withRPC o cmd = do
|
|||
|
||||
void $ waitAnyCatchCancel [mrpc, prpc]
|
||||
|
||||
where
|
||||
adapter q pq = RpcAdapter
|
||||
dontHandle
|
||||
(liftIO . atomically . writeTQueue pq)
|
||||
(const $ liftIO exitSuccess)
|
||||
(const $ notice "ping?")
|
||||
(liftIO . atomically . writeTQueue q)
|
||||
dontHandle
|
||||
dontHandle
|
||||
|
||||
(\(pa, k) -> Log.info $ pretty (AsBase58 k) <+> pretty pa
|
||||
)
|
||||
|
||||
dontHandle
|
||||
|
||||
(const $ liftIO exitSuccess)
|
||||
(const $ liftIO exitSuccess)
|
||||
(\(h, hval) -> Log.info $ pretty h <+> viaShow hval)
|
||||
|
||||
runRpcCommand :: RPCOpt -> RPCCommand -> IO ()
|
||||
runRpcCommand opt = \case
|
||||
POKE -> withRPC opt RPCPoke
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ data RPC e =
|
|||
| RPCLogLevel SetLogging
|
||||
| RPCLRefAnn (Hash HbSync)
|
||||
| RPCLRefGet (Hash HbSync)
|
||||
| RPCLRefGetAnswer (Hash HbSync) (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
|
||||
| RPCLRefGetAnswer (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, Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef))) -> m ()
|
||||
, rpcOnLRefGetAnswer :: 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 hval) -> rpcOnLRefGetAnswer adapter hval
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue