From 5d8531be644c9b802defa0af2243a99c27aeadd1 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sat, 3 Aug 2024 12:40:11 +0300
Subject: [PATCH] wip

---
 .../Data/Config/Suckless/Script/Internal.hs   | 15 ++++++-
 hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs          | 22 +++++++++-
 hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs          | 44 ++++++++++++++++++-
 3 files changed, 75 insertions(+), 6 deletions(-)

diff --git a/hbs2-cli/lib/Data/Config/Suckless/Script/Internal.hs b/hbs2-cli/lib/Data/Config/Suckless/Script/Internal.hs
index edb7fb22..60e6913b 100644
--- a/hbs2-cli/lib/Data/Config/Suckless/Script/Internal.hs
+++ b/hbs2-cli/lib/Data/Config/Suckless/Script/Internal.hs
@@ -665,8 +665,19 @@ fmt = \case
 internalEntries :: forall c m . (IsContext c, Exception (BadFormException c), MonadUnliftIO m) => MakeDictM c m ()
 internalEntries = do
 
-    entry $ bindValue "false" (Literal noContext (LitBool False))
-    entry $ bindValue "true"  (Literal noContext (LitBool True))
+    entry $ bindValue "false"      (Literal noContext (LitBool False))
+    entry $ bindValue "true"       (Literal noContext (LitBool True))
+    entry $ bindValue "chr:semi"   (mkStr ";")
+    entry $ bindValue "chr:tilda"  (mkStr "~")
+    entry $ bindValue "chr:colon"  (mkStr ":")
+    entry $ bindValue "chr:comma"  (mkStr ",")
+    entry $ bindValue "chr:q"      (mkStr "'")
+    entry $ bindValue "chr:minus"  (mkStr "-")
+    entry $ bindValue "chr:dq"     (mkStr "\"")
+    entry $ bindValue "chr:lf"     (mkStr "\n")
+    entry $ bindValue "chr:cr"     (mkStr "\r")
+    entry $ bindValue "chr:tab"    (mkStr "\t")
+    entry $ bindValue "chr:space"  (mkStr " ")
 
     brief "concatenates list of string-like elements into a string"
       $ args [arg "list" "(list ...)"]
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs b/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs
index c5c187da..6928b877 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs
@@ -10,7 +10,10 @@ import Data.ByteString qualified as BS
 import Data.ByteString.Char8 qualified as BS8
 import Data.Text qualified as Text
 
-keyringEntries :: forall c m . (MonadUnliftIO m, IsContext c) => MakeDictM c m ()
+keyringEntries :: forall c m . ( MonadUnliftIO m
+                               , IsContext c
+                               , Exception (BadFormException c)
+                               ) => MakeDictM c m ()
 keyringEntries = do
   entry $ bindMatch "hbs2:keyring:list-encryption" $ \syn -> do
     lbs <- case syn of
@@ -30,7 +33,10 @@ keyringEntries = do
 
     pure $ mkList @c e
 
-  entry $ bindMatch "hbs2:keyring:new" $ \syn -> do
+  brief "creates a new keyring (credentials)"
+    $ args [arg "int?" "encrypt-keys-num"]
+    $ returns "keyring" "string"
+    $ entry $ bindMatch "hbs2:keyring:new" $ \syn -> do
       n <- case syn of
             [LitIntVal k] -> pure k
             []            -> pure 1
@@ -40,3 +46,15 @@ keyringEntries = do
       cred <- foldM (\cred _ -> addKeyPair Nothing cred) cred0 [1..n]
       pure $ mkStr @c $ show $ pretty $ AsCredFile $ AsBase58 cred
 
+
+  entry $ bindMatch "hbs2:keyring:show" $ \case
+    [StringLike fn] -> do
+      bs <- liftIO $ BS.readFile fn
+      cred <- parseCredentials @'HBS2Basic (AsCredFile bs)
+                  & orThrowUser "bad credentials file"
+
+      pure $ mkStr $ show $ pretty (ListKeyringKeys cred)
+
+    _ -> throwIO $ BadFormException @c nil
+
+
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs b/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs
index 23991369..73ea27e5 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs
@@ -117,8 +117,10 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
             case what of
               "parsed"  -> do
 
-                  lbs <- runExceptT (readFromMerkle sto (SimpleKey (coerce hx)))
-                            >>= orThrowUser "can't decode refchan head "
+                  lbz <- runExceptT (readFromMerkle sto (SimpleKey (coerce hx)))
+                           <&> either (const Nothing) Just
+
+                  lbs <- ContT $ maybe1 lbz (pure nil)
 
                   (_, hdblk) <- unboxSignedBox @(RefChanHeadBlock L4Proto) @'HBS2Basic lbs
                                    & orThrowUser "can't unbox signed box"
@@ -132,6 +134,44 @@ HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
 
       _ -> throwIO (BadFormException @c nil)
 
+  entry $ bindMatch "hbs2:refchan:head:update" $ \case
+      [SignPubKeyLike rchan, StringLike headFile] -> do
+
+        sto <- getStorage
+
+        rchanApi <- getClientAPI @RefChanAPI @UNIX
+
+        rch <- liftIO (readFile headFile)
+                 <&> fromStringMay @(RefChanHeadBlock L4Proto)
+                 >>= orThrowUser "can't parse RefChanHeadBlock"
+
+        creds <- runKeymanClient $ loadCredentials rchan
+                       >>= orThrowUser "can't load credentials"
+
+        let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch
+
+        href <- writeAsMerkle sto  (serialise box)
+
+        callService @RpcRefChanHeadPost rchanApi (HashRef href)
+            >>= orThrowUser "can't post refchan head"
+
+        pure nil
+
+      _ -> throwIO (BadFormException @c nil)
+
+
+  entry $ bindMatch "hbs2:refchan:get" $ \case
+    [SignPubKeyLike rchan] -> do
+
+      api <- getClientAPI @RefChanAPI @UNIX
+
+      h <- callService @RpcRefChanGet api rchan
+             >>= orThrowUser "can't request refchan head"
+
+      pure $ maybe nil (mkStr . show . pretty . AsBase58) h
+
+    _ -> throwIO (BadFormException @c nil)
+
   entry $ bindMatch "hbs2:refchan:create" $ \syn -> do
 
     peerApi  <- getClientAPI @PeerAPI @UNIX