From 8ab5b5862ea3bc55a97b37ddea98e80dfce80164 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Mon, 29 Jul 2024 17:20:29 +0300
Subject: [PATCH] wip

---
 hbs2-cli/lib/HBS2/CLI/Run/Internal.hs | 16 ++++++++++++++++
 hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs   |  6 ------
 hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs   | 20 ++++++++++++++++----
 3 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
index 6788a16d..6c8c012e 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
+++ b/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 ()
 
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs b/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs
index 779d97bb..4240ba29 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs
+++ b/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
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
index 573b580b..8ce1ba7b 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
+++ b/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
-    [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)]