From b349045d467459ae0d2b9c8f5ffe932e5f11dfec Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Thu, 25 Jul 2024 06:49:19 +0300
Subject: [PATCH] wip

---
 hbs2-cli/app/Main.hs                  | 30 ++-----------------
 hbs2-cli/hbs2-cli.cabal               |  1 +
 hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs  | 42 +++++++++++++++++++++++++++
 hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs |  4 +--
 4 files changed, 47 insertions(+), 30 deletions(-)
 create mode 100644 hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs

diff --git a/hbs2-cli/app/Main.hs b/hbs2-cli/app/Main.hs
index 0dd5634f..ec2a5bc2 100644
--- a/hbs2-cli/app/Main.hs
+++ b/hbs2-cli/app/Main.hs
@@ -5,6 +5,7 @@ module Main where
 import HBS2.CLI.Prelude
 import HBS2.CLI.Run
 import HBS2.CLI.Run.KeyMan
+import HBS2.CLI.Run.Keyring
 import HBS2.CLI.Run.MetaData
 
 import HBS2.OrDie
@@ -145,7 +146,7 @@ main = do
               _ -> helpList Nothing
 
 
-        entry $ bindMatch "debug:show-cli" $ nil_ \case
+        entry $ bindMatch "debug:cli:show" $ nil_ \case
           _ -> display cli
 
         entry $ bindMatch "hbs2:peer:detect" $ nil_ \case
@@ -168,33 +169,6 @@ main = do
 
             readTVarIO r
 
-        entry $ bindMatch "hbs2:keyring:list-encryption" $ \syn -> do
-          lbs <- case syn of
-
-                [ ListVal [ SymbolVal "file", StringLike fn ] ] -> do
-                  liftIO $ BS.readFile fn
-
-                [ LitStrVal s ] -> do
-                  pure (BS8.pack (Text.unpack s))
-
-                _ -> throwIO (BadFormException @C nil)
-
-          cred <- pure (parseCredentials @'HBS2Basic (AsCredFile lbs))
-                    `orDie` "bad keyring file"
-
-          let e = [ mkStr @C (show (pretty (AsBase58 p))) | KeyringEntry p _ _ <- view peerKeyring cred ]
-
-          pure $ mkList @C e
-
-        entry $ bindMatch "hbs2:keyring:new" $ \syn -> do
-            n <- case syn of
-                  [LitIntVal k] -> pure k
-                  []            -> pure 1
-                  _ -> throwIO (BadFormException @C nil)
-
-            cred0 <- newCredentials @'HBS2Basic
-            cred <- foldM (\cred _ -> addKeyPair Nothing cred) cred0 [1..n]
-            pure $ mkStr @C $ show $ pretty $ AsCredFile $ AsBase58 cred
 
         entry $ bindMatch "hbs2:reflog:tx:create-raw" $ \case
           [SymbolVal "stdin", StringLike reflog] -> do
diff --git a/hbs2-cli/hbs2-cli.cabal b/hbs2-cli/hbs2-cli.cabal
index fc412109..a91d85a6 100644
--- a/hbs2-cli/hbs2-cli.cabal
+++ b/hbs2-cli/hbs2-cli.cabal
@@ -104,6 +104,7 @@ library
       HBS2.CLI.Run
       HBS2.CLI.Run.Internal
       HBS2.CLI.Run.KeyMan
+      HBS2.CLI.Run.Keyring
       HBS2.CLI.Run.MetaData
       HBS2.CLI.Run.Help
 
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs b/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs
new file mode 100644
index 00000000..c5c187da
--- /dev/null
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs
@@ -0,0 +1,42 @@
+module HBS2.CLI.Run.Keyring where
+
+import HBS2.CLI.Prelude
+import HBS2.CLI.Run.Internal
+
+import HBS2.Net.Auth.Credentials
+import HBS2.KeyMan.App.Types
+
+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 = do
+  entry $ bindMatch "hbs2:keyring:list-encryption" $ \syn -> do
+    lbs <- case syn of
+
+          [ ListVal [ SymbolVal "file", StringLike fn ] ] -> do
+            liftIO $ BS.readFile fn
+
+          [ LitStrVal s ] -> do
+            pure (BS8.pack (Text.unpack s))
+
+          _ -> throwIO (BadFormException @C nil)
+
+    cred <- pure (parseCredentials @'HBS2Basic (AsCredFile lbs))
+              `orDie` "bad keyring file"
+
+    let e = [ mkStr @c (show (pretty (AsBase58 p))) | KeyringEntry p _ _ <- view peerKeyring cred ]
+
+    pure $ mkList @c e
+
+  entry $ bindMatch "hbs2:keyring:new" $ \syn -> do
+      n <- case syn of
+            [LitIntVal k] -> pure k
+            []            -> pure 1
+            _ -> throwIO (BadFormException @C nil)
+
+      cred0 <- newCredentials @'HBS2Basic
+      cred <- foldM (\cred _ -> addKeyPair Nothing cred) cred0 [1..n]
+      pure $ mkStr @c $ show $ pretty $ AsCredFile $ AsBase58 cred
+
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
index 0d3e5f2d..184e6ed9 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
@@ -25,6 +25,8 @@ import Data.Maybe
 import Data.Text.Encoding qualified as TE
 import Data.Text qualified as Text
 
+{- HLINT ignore "Functor law" -}
+
 metaFromSyntax :: [Syntax c] -> HashMap Text Text
 metaFromSyntax syn =
   HM.fromList [ (t k, t v) | (ListVal [ k, v ]) <- syn ]
@@ -60,8 +62,6 @@ createTreeWithMetadata meta lbs = do
         <&> HashRef
 
 
-
-
 metaDataEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
 metaDataEntries = do