wip

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

@@ -9,18 +9,23 @@ import Data.Text qualified as Text
 
 {- HLINT ignore "Functor law" -}
 
-helpList :: MonadUnliftIO m => Maybe String -> RunM c m ()
+helpList :: MonadUnliftIO m => Bool -> Maybe String -> RunM c m ()
-helpList p = do
+helpList hasDoc p = do
 
   let match = maybe (const True) (Text.isPrefixOf . Text.pack) p
 
   d <- ask >>= readTVarIO
   let ks = [k | Id k <- List.sort (HM.keys d)
            , match k
+           , not hasDoc || docDefined (HM.lookup (Id k) d)
            ]
 
   display_ $ vcat (fmap pretty ks)
 
+  where
+    docDefined (Just (Bind (Just w) _)) = True
+    docDefined _ = False
+
 helpEntries :: (MonadUnliftIO m, IsContext c) => MakeDictM c m ()
 helpEntries = do
 
@@ -29,8 +34,12 @@ helpEntries = do
       display_ $ "hbs2-cli tool" <> line
 
       case syn of
+
+        [StringLike "--documented"] -> do
+          helpList True Nothing
+
         (StringLike p : _) -> do
-          helpList (Just p)
+          helpList False (Just p)
 
         [ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )] -> do
           man <- ask >>= readTVarIO
@@ -39,5 +48,5 @@ helpEntries = do
 
           liftIO $ hPutDoc stdout (pretty man)
 
-        _ -> helpList Nothing
+        _ -> helpList False Nothing
 

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

@@ -439,6 +439,9 @@ arg = ManApplyArg
 args :: [ManApplyArg] -> MakeDictM c m () -> MakeDictM c m ()
 args argList = censor (HM.map (addSynopsis (ManSynopsis (ManApply argList))))
 
+opt :: Doc a -> Doc a -> Doc a
+opt n d = n <+> "-" <+> d
+
 examples :: ManExamples -> MakeDictM c m () -> MakeDictM c m ()
 examples (ManExamples s) = censor (HM.map setExamples )
   where

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

@@ -152,67 +152,129 @@ metaDataEntries = do
 
     _ -> throwIO (BadFormException @c nil)
 
-  entry $ bindMatch "hbs2:tree:metadata:create" $ \syn -> do
+  brief "creates a merkle tree with metadata"
+    $ returns "string" "hash"
+    $ args [ arg "list-of-options" "..." ]
+    $ desc ( "options:" <> line
+             <> indent 4 (
+                  vcat [ opt ":stdin" "read data from stdin"
+                       , opt ":auto"  "create metadata from file using libmagic"
+                       , opt  "[kw [encrypted group-key-hash]]" "encrypt metadata with given group key"
+                       , opt  "dict" "custom metadata dictionary"
+                       , opt  "filename : string-like" "file name, ignored if stdin option set"
+                       ])
+             )
+    $ examples [qc|
+Create not encrypted merkle tree for string from stdin without metadata
 
-    case syn of
+$ echo TEST | hbs2-cli hbs2:tree:metadata:create :stdin
+7dGqTtoehsgn7bADcVTyp93tq2FfuQgtBuVvYL46jdyz
 
-      args -> do
+;; empty metadata
-        opts' <- for args $ \case
-          SymbolVal "stdin"     -> pure [Stdin]
 
-          SymbolVal "auto"      -> pure [Auto]
+hbs2-cli hbs2:tree:metadata:get :raw 7dGqTtoehsgn7bADcVTyp93tq2FfuQgtBuVvYL46jdyz
 
-          ListVal (SymbolVal "dict" : [ListVal [SymbolVal "encrypted", StringLike key]])
+Create merkle tree with custom metadata
-            -> do
-              pure [Encrypted key]
 
-          ListVal (SymbolVal "dict" : w)  -> do
+$ echo TEST | hbs2-cli hbs2:tree:metadata:create :stdin [kw hello world]
-            pure [MetaDataEntry x y | ListVal [SymbolVal x, StringLike y] <- w ]
+2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6
 
-          StringLike rest  -> do
+$ hbs2-cli hbs2:tree:metadata:get :raw 2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6
-            pure [MetaDataFile rest]
+hello: "world"
 
-          _ -> pure mempty
+$ hbs2-cli hbs2:tree:metadata:create :auto ./lambda.svg
+3fv5ym8NhY8zat37NaTvY9PDcwJqMLUD73ewHxtHysWg
 
-        let opts = mconcat opts' & Set.fromList
+$ hbs2-cli hbs2:tree:metadata:get :raw 3fv5ym8NhY8zat37NaTvY9PDcwJqMLUD73ewHxtHysWg
-        let inFile = headMay [ x | MetaDataFile x <- universeBi opts ]
+mime-type: "image/svg+xml; charset=us-ascii"
+file-name: "lambda.svg"
 
-        lbs <- case (Set.member Stdin opts, inFile) of
+Create encrypted tree metadata with a new groupkey
-                 (True, _) -> liftIO LBS.getContents
-                 (False, Just fn) -> liftIO (LBS.readFile fn)
-                 (_, Nothing) -> liftIO LBS.getContents
 
-        meta0 <- if not (Set.member Auto opts) || isNothing inFile then
+$ hbs2-cli [define pks [list EiwWxY3xwTfnLKJdzzxNMZgA2ZvYAZd9e8B8pFeCtnrn]] \
-                   pure (mempty :: HashMap Text Text)
+  and [define gk [hbs2:groupkey:store [hbs2:groupkey:create pks]]] \
-                 else liftIO do
+  and [hbs2:tree:metadata:create :auto [kw :encrypted gk] ./lambda.svg]
-                    let fn = fromJust inFile
-                    magic <- magicOpen [MagicMimeType,MagicMime,MagicMimeEncoding]
-                    magicLoadDefault magic
-                    mime <- magicFile magic fn
-                    pure $ HM.fromList [ ("file-name", Text.pack (takeFileName fn))
-                                       , ("mime-type", Text.pack mime)
-                                       ]
 
-        let meta1  = HM.fromList [  (txt n, txt e) | MetaDataEntry n e <- universeBi opts ]
+BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4
 
-        let enc = headMay [ e | x@(Encrypted e) <- universeBi opts ]
+Check group key
 
-        gk <- runMaybeT do
+$ hbs2-cli hbs2:tree:metadata:get-gk BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y
-                s <- toMPlus enc
-                g <- lift $ loadGroupKey (fromString s)
-                toMPlus g
 
-        when (isJust enc && isNothing gk) do
+GixS4wssCD4x7LzvHve2JhFCghW1Hwia2tiGTfTTef1u
-          error $ show $  "Can't load group key" <+> pretty enc
 
-        flip runContT pure do
+Check metadata
 
-          sto <- ContT withPeerStorage
+$ hbs2-cli hbs2:tree:metadata:get :raw BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y
 
-          href <- lift (createTreeWithMetadata sto  gk (meta0 <> meta1) lbs)
+mime-type: "image/svg+xml; charset=us-ascii"
-                    `orDie` "encryption error"
+file-name: "lambda.svg"
 
-          pure $ mkStr (show $ pretty href)
+List group key
+
+$ hbs2-cli hbs2:groupkey:list-public-keys [hbs2:groupkey:load GixS4wssCD4x7LzvHve2JhFCghW1Hwia2tiGTfTTef1u]
+("EiwWxY3xwTfnLKJdzzxNMZgA2ZvYAZd9e8B8pFeCtnrn")
+    |]
+    $ entry $ bindMatch "hbs2:tree:metadata:create" $ \syn -> do
+        case syn of
+
+          args -> do
+            opts' <- for args $ \case
+              SymbolVal "stdin"     -> pure [Stdin]
+
+              SymbolVal "auto"      -> pure [Auto]
+
+              ListVal (SymbolVal "dict" : [ListVal [SymbolVal "encrypted", StringLike key]])
+                -> do
+                  pure [Encrypted key]
+
+              ListVal (SymbolVal "dict" : w)  -> do
+                pure [MetaDataEntry x y | ListVal [SymbolVal x, StringLike y] <- w ]
+
+              StringLike rest  -> do
+                pure [MetaDataFile rest]
+
+              _ -> pure mempty
+
+            let opts = mconcat opts' & Set.fromList
+            let inFile = headMay [ x | MetaDataFile x <- universeBi opts ]
+
+            lbs <- case (Set.member Stdin opts, inFile) of
+                     (True, _) -> liftIO LBS.getContents
+                     (False, Just fn) -> liftIO (LBS.readFile fn)
+                     (_, Nothing) -> liftIO LBS.getContents
+
+            meta0 <- if not (Set.member Auto opts) || isNothing inFile then
+                       pure (mempty :: HashMap Text Text)
+                     else liftIO do
+                        let fn = fromJust inFile
+                        magic <- magicOpen [MagicMimeType,MagicMime,MagicMimeEncoding]
+                        magicLoadDefault magic
+                        mime <- magicFile magic fn
+                        pure $ HM.fromList [ ("file-name", Text.pack (takeFileName fn))
+                                           , ("mime-type", Text.pack mime)
+                                           ]
+
+            let meta1  = HM.fromList [  (txt n, txt e) | MetaDataEntry n e <- universeBi opts ]
+
+            let enc = headMay [ e | x@(Encrypted e) <- universeBi opts ]
+
+            gk <- runMaybeT do
+                    s <- toMPlus enc
+                    g <- lift $ loadGroupKey (fromString s)
+                    toMPlus g
+
+            when (isJust enc && isNothing gk) do
+              error $ show $  "Can't load group key" <+> pretty enc
+
+            flip runContT pure do
+
+              sto <- ContT withPeerStorage
+
+              href <- lift (createTreeWithMetadata sto  gk (meta0 <> meta1) lbs)
+                        `orDie` "encryption error"
+
+              pure $ mkStr (show $ pretty href)
 
   entry $ bindMatch "cbor:base58" $ \case
     [ LitStrVal x ] -> do