mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
dc5827e2b2
commit
8ab5b5862e
|
@ -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 ()
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)]
|
||||
|
|
Loading…
Reference in New Issue