wip

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

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
 

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
+

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