wip

hbs2-cli/app/Main.hs

@@ -7,6 +7,7 @@ import HBS2.CLI.Run
 import HBS2.CLI.Run.KeyMan
 import HBS2.CLI.Run.Keyring
 import HBS2.CLI.Run.GroupKey
+import HBS2.CLI.Run.Sigil
 import HBS2.CLI.Run.MetaData
 
 import HBS2.OrDie
@@ -131,6 +132,7 @@ main = do
         keymanEntries
         keyringEntries
         groupKeyEntries
+        sigilEntries
         metaDataEntries
 
         entry $ bindMatch "help" $ nil_ $ \syn -> do

hbs2-cli/hbs2-cli.cabal

@@ -107,6 +107,7 @@ library
       HBS2.CLI.Run.KeyMan
       HBS2.CLI.Run.Keyring
       HBS2.CLI.Run.MetaData
+      HBS2.CLI.Run.Sigil
       HBS2.CLI.Run.Help
 
     build-depends:    base

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

@@ -2,6 +2,8 @@ module HBS2.CLI.Run.GroupKey where
 
 
 import HBS2.CLI.Prelude hiding (mapMaybe)
+import HBS2.System.Logger.Simple.ANSI as All
+import HBS2.Base58
 import Data.List qualified as L
 import Data.Maybe
 import HBS2.CLI.Run.Internal
@@ -9,6 +11,11 @@ import HBS2.Net.Auth.GroupKeySymm as Symm
 
 import HBS2.Net.Auth.Credentials
 
+import Data.Text qualified as Text
+import Data.ByteString.Lazy.Char8 as LBS8
+import Data.HashMap.Strict qualified as HM
+import Lens.Micro.Platform
+
 {- HLINT ignore "Functor law" -}
 
 groupKeyFromKeyList :: MonadUnliftIO m => [String] -> m (GroupKey 'Symm HBS2Basic)
@@ -36,3 +43,20 @@ groupKeyEntries = do
 
       _ -> throwIO $ BadFormException @C nil
 
+
+  entry $ bindMatch "hbs2:groupkey:list-public-keys" $ \syn -> do
+    case syn of
+      [LitStrVal s] -> do
+
+        let lbs = LBS8.pack (Text.unpack s)
+        gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
+                `orDie` "invalid group key"
+
+        let rcpt = recipients gk & HM.keys & fmap (mkStr . show . pretty . AsBase58)
+
+        pure $ mkList @c rcpt
+
+      _ -> throwIO $ BadFormException @C nil
+
+
+

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

@@ -0,0 +1,68 @@
+module HBS2.CLI.Run.Sigil where
+
+import HBS2.CLI.Prelude
+import HBS2.CLI.Run.Internal
+
+import HBS2.Base58
+import HBS2.Data.Types.SignedBox
+import HBS2.Net.Auth.Credentials
+import HBS2.Net.Auth.Credentials.Sigil
+
+import Data.List qualified as L
+import Data.ByteString.Char8 qualified as BS8
+import Data.Text qualified as Text
+import Lens.Micro.Platform
+
+sigilEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
+sigilEntries = do
+
+  entry $ bindMatch "hbs2:sigil:parse" $ \case
+    [StringLike s] -> do
+
+      let bs = BS8.pack s
+      sigil <- pure (parseSerialisableFromBase58 @(Sigil 'HBS2Basic) bs)
+                  `orDie` "parse sigil failed"
+
+      (_,sd) <- pure (unboxSignedBox0 @(SigilData 'HBS2Basic) (sigilData sigil))
+                  `orDie` "signature check failed"
+
+      pure (parseTop $ show $ parens ("sigil" <> line <> indent 2 (vcat $ [pretty sigil, pretty sd])))
+              `orDie` "bad sigil"
+              <&> head
+
+    _ -> throwIO $ BadFormException @C nil
+
+  entry $ bindMatch "hbs2:sigil:create-from-keyring" $ \syn -> do
+
+    args <- case syn of
+      [ StringLike s ] -> pure (fmap snd . headMay, s)
+      [ StringLike p, StringLike s ] -> pure ( findKey p, s)
+      [ LitIntVal n, StringLike s ] -> pure ( L.lookup n, s)
+
+      _ -> throwIO $ BadFormException @C nil
+
+    let lbs = BS8.pack (snd args)
+
+    cred <- pure (parseCredentials @'HBS2Basic (AsCredFile lbs))
+               `orDie` "bad keyring data"
+
+    let es = zip [0..]
+                 [ p | KeyringEntry p _ _
+                     <- view peerKeyring cred
+                 ]
+
+    enc <- pure (fst args es)
+           `orDie` "key not found"
+
+    sigil <- pure (makeSigilFromCredentials @'HBS2Basic cred enc Nothing Nothing)
+              `orDie` "can't create a sigil"
+
+    pure $ mkStr (show $ pretty $ AsBase58 sigil)
+
+  where
+    findKey s xs = headMay [ k
+                           | e@(_,k) <- xs
+                           , L.isPrefixOf s (show $ pretty (AsBase58 k))
+                           ]
+
+