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,8 +152,70 @@ 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
 
+$ echo TEST | hbs2-cli hbs2:tree:metadata:create :stdin
+7dGqTtoehsgn7bADcVTyp93tq2FfuQgtBuVvYL46jdyz
+
+;; empty metadata
+
+hbs2-cli hbs2:tree:metadata:get :raw 7dGqTtoehsgn7bADcVTyp93tq2FfuQgtBuVvYL46jdyz
+
+Create merkle tree with custom metadata
+
+$ echo TEST | hbs2-cli hbs2:tree:metadata:create :stdin [kw hello world]
+2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6
+
+$ hbs2-cli hbs2:tree:metadata:get :raw 2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6
+hello: "world"
+
+$ hbs2-cli hbs2:tree:metadata:create :auto ./lambda.svg
+3fv5ym8NhY8zat37NaTvY9PDcwJqMLUD73ewHxtHysWg
+
+$ hbs2-cli hbs2:tree:metadata:get :raw 3fv5ym8NhY8zat37NaTvY9PDcwJqMLUD73ewHxtHysWg
+mime-type: "image/svg+xml; charset=us-ascii"
+file-name: "lambda.svg"
+
+Create encrypted tree metadata with a new groupkey
+
+$ hbs2-cli [define pks [list EiwWxY3xwTfnLKJdzzxNMZgA2ZvYAZd9e8B8pFeCtnrn]] \
+  and [define gk [hbs2:groupkey:store [hbs2:groupkey:create pks]]] \
+  and [hbs2:tree:metadata:create :auto [kw :encrypted gk] ./lambda.svg]
+
+BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4
+
+Check group key
+
+$ hbs2-cli hbs2:tree:metadata:get-gk BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y
+
+GixS4wssCD4x7LzvHve2JhFCghW1Hwia2tiGTfTTef1u
+
+Check metadata
+
+$ hbs2-cli hbs2:tree:metadata:get :raw BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y
+
+mime-type: "image/svg+xml; charset=us-ascii"
+file-name: "lambda.svg"
+
+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