This commit is contained in:
Dmitry Zuikov 2024-07-29 17:20:29 +03:00
parent dc5827e2b2
commit 8ab5b5862e
3 changed files with 32 additions and 10 deletions

View File

@ -43,6 +43,22 @@ pattern BlobLike s <- (blobLike -> Just s)
pattern Nil :: forall {c} . Syntax c
pattern Nil <- ListVal []
pattern HashLike:: forall {c} . HashRef -> Syntax c
pattern HashLike x <- (
\case
StringLike s -> fromStringMay @HashRef s
_ -> Nothing
-> Just x )
pattern SignPubKeyLike :: forall {c} . (PubKey 'Sign 'HBS2Basic) -> Syntax c
pattern SignPubKeyLike x <- (
\case
StringLike s -> fromStringMay s
_ -> Nothing
-> Just x )
class Display a where
display :: MonadIO m => a -> m ()

View File

@ -22,12 +22,6 @@ import HBS2.KeyMan.App.Types
import Control.Monad.Trans.Cont
pattern HashLike:: forall {c} . HashRef -> Syntax c
pattern HashLike x <- (
\case
StringLike s -> fromStringMay @HashRef s
_ -> Nothing
-> Just x )
lwwRefEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
lwwRefEntries = do

View File

@ -60,6 +60,19 @@ reflogEntries = do
_ -> throwIO (BadFormException @C nil)
entry $ bindMatch "hbs2:reflog:add" $ \case
[SignPubKeyLike reflog] -> do
-- reflog <- keymanNewCredentials (Just "reflog") 0
flip runContT pure do
so <- detectRPC `orDie` "rpc not found"
api <- ContT $ withRPC2 @PeerAPI @UNIX so
void $ callService @RpcPollAdd api (reflog, "reflog", 31)
pure $ mkStr (show $ pretty (AsBase58 reflog))
_ -> throwIO (BadFormException @C nil)
entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case
[StringLike puk, StringLike hash] -> do
@ -98,11 +111,10 @@ reflogEntries = do
_ -> throwIO (BadFormException @C nil)
entry $ bindMatch "hbs2:reflog:tx:create-raw" $ \case
[SymbolVal "stdin", StringLike rlo] -> do
reflog <- orThrowUser "bad reflog" (fromStringMay rlo)
entry $ bindMatch "hbs2:reflog:tx:raw:create" $ \case
[SymbolVal "stdin", SignPubKeyLike reflog] -> do
rlu <- mkRefLogUpdateFrom reflog ( liftIO BS.getContents )
rlu <- mkRefLogUpdateFrom (RefLogKey reflog) ( liftIO BS.getContents )
<&> serialise
pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]