wip

hbs2-cli/lib/HBS2/CLI/Run/Internal.hs

@@ -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 ()
 

hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs

@@ -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

hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs

@@ -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
+  entry $ bindMatch "hbs2:reflog:tx:raw:create" $ \case
-    [SymbolVal "stdin", StringLike rlo] -> do
+    [SymbolVal "stdin", SignPubKeyLike reflog] -> do
-      reflog <- orThrowUser "bad reflog" (fromStringMay rlo)
 
-      rlu <- mkRefLogUpdateFrom reflog ( liftIO BS.getContents )
+      rlu <- mkRefLogUpdateFrom (RefLogKey reflog) ( liftIO BS.getContents )
                 <&> serialise
 
       pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]