mirror of https://github.com/voidlizard/hbs2
lref-list
This commit is contained in:
Sergey Ivanov
parent
33f56c9620
commit
3207a48968
|
|
@ -845,9 +845,8 @@ FIXME: RPC, cli для линейных ссылок
|
|||
|
||||
* [x] lref-get через rpc пира get
|
||||
* [x] lref-new через rpc пира new
|
||||
* [ ] lref-update через rpc пира update
|
||||
|
||||
* [ ] lref-list через rpc пира list
|
||||
* [x] lref-update через rpc пира update
|
||||
* [x] lref-list через rpc пира list
|
||||
|
||||
* [ ] cli на запрос значений ссылки у всех нод
|
||||
* [ ] cli на запрос всех ссылок ноды
|
||||
|
|
|
|||
|
|
@ -24,4 +24,3 @@ fromBase58 = decodeBase58 bitcoinAlphabet
|
|||
|
||||
instance Pretty (AsBase58 ByteString) where
|
||||
pretty (AsBase58 bs) = pretty $ BS8.unpack $ toBase58 bs
|
||||
|
||||
|
|
|
|||
|
|
@ -67,6 +67,10 @@ data RefGenesis e = RefGenesis
|
|||
}
|
||||
deriving stock (Generic)
|
||||
|
||||
instance (Pretty (AsBase58 (PubKey 'Sign e))) => Pretty (RefGenesis e) where
|
||||
pretty RefGenesis {..} =
|
||||
parens ( "RefGenesis" <+> pretty (AsBase58 refOwner) <+> pretty (show refName) <+> pretty refMeta)
|
||||
|
||||
instance (Serialise (PubKey 'Sign e)) => Serialise (RefGenesis e)
|
||||
|
||||
data RefForm
|
||||
|
|
|
|||
|
|
@ -80,6 +80,12 @@ instance Serialise MNodeData
|
|||
data AnnMetaData = NoMetaData | ShortMetadata Text | AnnHashRef (Hash HbSync)
|
||||
deriving stock (Generic,Data,Show)
|
||||
|
||||
instance Pretty AnnMetaData where
|
||||
pretty = \case
|
||||
NoMetaData -> "NoMetaData"
|
||||
ShortMetadata t -> "ShortMetadata" <+> pretty (show t)
|
||||
AnnHashRef h -> "AnnHashRef" <+> pretty h
|
||||
|
||||
instance Serialise AnnMetaData
|
||||
|
||||
data MTreeAnn a = MTreeAnn
|
||||
|
|
|
|||
|
|
@ -179,6 +179,7 @@ data RPCCommand =
|
|||
| SETLOG SetLogging
|
||||
| LREFANN (Hash HbSync)
|
||||
| LREFNEW (PubKey 'Sign UDP) Text
|
||||
| LREFLIST
|
||||
| LREFGET (Hash HbSync)
|
||||
| LREFUPDATE (PrivKey 'Sign UDP) (PubKey 'Sign UDP) (Hash HbSync) (Hash HbSync)
|
||||
|
||||
|
|
@ -245,7 +246,7 @@ runCLI = join . customExecParser (prefs showHelpOnError) $
|
|||
<> command "log" (info pLog (progDesc "set logging level"))
|
||||
<> command "lref-ann" (info pLRefAnn (progDesc "announce linear ref"))
|
||||
<> command "lref-new" (info pLRefNew (progDesc "generates a new linear ref"))
|
||||
-- <> command "lref-list" (info pLRefList (progDesc "list node linear refs"))
|
||||
<> command "lref-list" (info pLRefList (progDesc "list node linear refs"))
|
||||
<> command "lref-get" (info pLRefGet (progDesc "get a linear ref"))
|
||||
<> command "lref-update" (info pLRefUpdate (progDesc "updates a linear ref"))
|
||||
)
|
||||
|
|
@ -333,10 +334,10 @@ runCLI = join . customExecParser (prefs showHelpOnError) $
|
|||
`orDie` "can't parse credential file"
|
||||
runRpcCommand rpc (LREFNEW (_peerSignPk cred) t)
|
||||
|
||||
-- pLRefList = do
|
||||
-- rpc <- pRpcCommon
|
||||
-- pure $ do
|
||||
-- runRpcCommand rpc (LREFLIST)
|
||||
pLRefList = do
|
||||
rpc <- pRpcCommon
|
||||
pure $ do
|
||||
runRpcCommand rpc (LREFLIST)
|
||||
|
||||
pLRefGet = do
|
||||
rpc <- pRpcCommon
|
||||
|
|
@ -817,6 +818,21 @@ runPeer opts = Exception.handle myException $ do
|
|||
request who (RPCLRefNewAnswer @e h)
|
||||
debug $ "lrefNewAction sent" <+> pretty h
|
||||
|
||||
let lrefListAction h = do
|
||||
debug $ "lrefListAction" <+> pretty h
|
||||
who <- thatPeer (Proxy @(RPC e))
|
||||
void $ liftIO $ async $ withPeerM penv $ do
|
||||
st <- getStorage
|
||||
hs :: [Hash HbSync] <- liftIO $ readNodeLinearRefList @e st (_peerSignPk pc)
|
||||
lrefs <- catMaybes <$> forM hs \chh -> runMaybeT do
|
||||
g :: RefGenesis [Hash HbSync] <- MaybeT $
|
||||
((either (const Nothing) Just . deserialiseOrFail) =<<)
|
||||
<$> (liftIO $ getBlock st chh)
|
||||
mlrefVal <- ((either (const Nothing) Just . deserialiseOrFail) =<<)
|
||||
<$> (liftIO $ readLinkRaw st chh)
|
||||
lift $ request who (RPCLRefListAnswer @e (g, mlrefVal))
|
||||
debug $ "lrefListAction sent" <+> pretty (length lrefs)
|
||||
|
||||
let lrefGetAction h = do
|
||||
debug $ "lrefGetAction" <+> pretty h
|
||||
who <- thatPeer (Proxy @(RPC e))
|
||||
|
|
@ -832,9 +848,11 @@ runPeer opts = Exception.handle myException $ do
|
|||
void $ liftIO $ async $ withPeerM penv $ do
|
||||
st <- getStorage
|
||||
let cred = PeerCredentials @e sk pk mempty
|
||||
-- FIXME: do not increment counter if value is the same
|
||||
liftIO $ modifyLinearRef st cred lrefId \_ -> pure valh
|
||||
mlref <- getLRefValAction st lrefId
|
||||
request who (RPCLRefUpdateAnswer @e mlref)
|
||||
-- FIXME: maybe fire rpc command to announce new lref value
|
||||
debug $ "lrefUpdateAction sent" <+> pretty mlref
|
||||
|
||||
let arpc = RpcAdapter
|
||||
|
|
@ -850,6 +868,8 @@ runPeer opts = Exception.handle myException $ do
|
|||
, rpcOnLRefAnn = lrefAnnAction
|
||||
, rpcOnLRefNew = lrefNewAction
|
||||
, rpcOnLRefNewAnswer = dontHandle
|
||||
, rpcOnLRefList = lrefListAction
|
||||
, rpcOnLRefListAnswer = dontHandle
|
||||
, rpcOnLRefGet = lrefGetAction
|
||||
, rpcOnLRefGetAnswer = dontHandle
|
||||
, rpcOnLRefUpdate = lrefUpdateAction
|
||||
|
|
@ -925,6 +945,8 @@ withRPC o cmd = do
|
|||
|
||||
lrefNewQ <- newTQueueIO
|
||||
|
||||
lrefListQ <- newTQueueIO
|
||||
|
||||
lrefGetQ <- newTQueueIO
|
||||
|
||||
lrefUpdateQ <- newTQueueIO
|
||||
|
|
@ -947,6 +969,9 @@ withRPC o cmd = do
|
|||
, rpcOnLRefNew = const $ liftIO exitSuccess
|
||||
, rpcOnLRefNewAnswer = liftIO . atomically . writeTQueue lrefNewQ
|
||||
--
|
||||
, rpcOnLRefList = const $ liftIO exitSuccess
|
||||
, rpcOnLRefListAnswer = liftIO . atomically . writeTQueue lrefListQ
|
||||
--
|
||||
, rpcOnLRefGet = const $ liftIO exitSuccess
|
||||
, rpcOnLRefGetAnswer = liftIO . atomically . writeTQueue lrefGetQ
|
||||
--
|
||||
|
|
@ -993,11 +1018,22 @@ withRPC o cmd = do
|
|||
|
||||
RPCLRefAnn{} -> pause @'Seconds 0.1 >> liftIO exitSuccess
|
||||
|
||||
RPCLRefNew{} ->
|
||||
void $ liftIO $ void $ race (pause @'Seconds 5 >> exitFailure) do
|
||||
pa <- liftIO $ atomically $ readTQueue lrefNewQ
|
||||
Log.info $ "got RPCLRefNewAnswer" <+> pretty pa
|
||||
exitSuccess
|
||||
RPCLRefNew{} -> do
|
||||
fix \go -> do
|
||||
r <- liftIO $ race (pause @'Seconds 5)
|
||||
(atomically $ readTQueue lrefNewQ)
|
||||
case r of
|
||||
Left _ -> pure ()
|
||||
Right pa -> do
|
||||
Log.info $ "got RPCLRefNewAnswer" <+> pretty pa
|
||||
go
|
||||
liftIO exitSuccess
|
||||
|
||||
RPCLRefList{} ->
|
||||
void $ liftIO $ void $ race (pause @'Seconds 5 >> exitSuccess) do
|
||||
forever do
|
||||
(g, lrefVal) <- liftIO $ atomically $ readTQueue lrefListQ
|
||||
Log.info $ "got RPCLRefListAnswer" <+> pretty g <+> pretty lrefVal
|
||||
|
||||
RPCLRefGet{} ->
|
||||
void $ liftIO $ void $ race (pause @'Seconds 5 >> exitFailure) do
|
||||
|
|
@ -1027,6 +1063,7 @@ runRpcCommand opt = \case
|
|||
SETLOG s -> withRPC opt (RPCLogLevel s)
|
||||
LREFANN h -> withRPC opt (RPCLRefAnn h)
|
||||
LREFNEW pk title -> withRPC opt (RPCLRefNew pk title)
|
||||
LREFLIST -> withRPC opt RPCLRefList
|
||||
LREFGET h -> withRPC opt (RPCLRefGet h)
|
||||
LREFUPDATE sk pk lrefId h -> do
|
||||
-- FIXME LREFUPDATE implementation
|
||||
|
|
|
|||
|
|
@ -36,6 +36,8 @@ data RPC e =
|
|||
| RPCLRefAnn (Hash HbSync)
|
||||
| RPCLRefNew (PubKey 'Sign e) Text
|
||||
| RPCLRefNewAnswer (Hash HbSync)
|
||||
| RPCLRefList
|
||||
| RPCLRefListAnswer (RefGenesis [Hash HbSync], Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
|
||||
| RPCLRefGet (Hash HbSync)
|
||||
| RPCLRefGetAnswer (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
|
||||
-- | RPCLRefUpdate (Signed 'SignaturePresent (MutableRef e 'LinearRef))
|
||||
|
|
@ -78,6 +80,8 @@ data RpcAdapter e m =
|
|||
, rpcOnLRefAnn :: Hash HbSync -> m ()
|
||||
, rpcOnLRefNew :: (PubKey 'Sign e, Text) -> m ()
|
||||
, rpcOnLRefNewAnswer :: Hash HbSync -> m ()
|
||||
, rpcOnLRefList :: () -> m ()
|
||||
, rpcOnLRefListAnswer :: (RefGenesis [Hash HbSync], Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef))) -> m ()
|
||||
, rpcOnLRefGet :: Hash HbSync -> m ()
|
||||
, rpcOnLRefGetAnswer :: Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
|
||||
-- , rpcOnLRefUpdate :: (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
|
||||
|
|
@ -135,6 +139,8 @@ rpcHandler adapter = \case
|
|||
(RPCLRefAnn h) -> rpcOnLRefAnn adapter h
|
||||
(RPCLRefNew pk t) -> rpcOnLRefNew adapter (pk, t)
|
||||
(RPCLRefNewAnswer h) -> rpcOnLRefNewAnswer adapter h
|
||||
RPCLRefList -> rpcOnLRefList adapter ()
|
||||
(RPCLRefListAnswer lrefVal) -> rpcOnLRefListAnswer adapter lrefVal
|
||||
(RPCLRefGet h) -> rpcOnLRefGet adapter h
|
||||
(RPCLRefGetAnswer hval) -> rpcOnLRefGetAnswer adapter hval
|
||||
-- (RPCLRefUpdate upd) -> rpcOnLRefUpdate adapter upd
|
||||
|
|
|
|||
Loading…
Reference in New Issue