From b68ac8854486411a2b1e1213495317dff8f1d3f6 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Sun, 2 Feb 2025 11:45:50 +0300 Subject: [PATCH] wip --- hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs | 34 +++++++++---------- hbs2-cli/lib/HBS2/CLI/Run/Tree.hs | 17 ++++++++++ hbs2-core/lib/HBS2/Data/Types/Refs.hs | 11 ++++++ .../Data/Config/Suckless/Script/Internal.hs | 3 +- 4 files changed, 45 insertions(+), 20 deletions(-) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs index 5b21c82c..60c81932 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs @@ -142,8 +142,8 @@ metaDataEntries = do ) $ examples [qc| -(hbs2:tree:metadata:get :parsed 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd) -(dict (mime-type: "text/plain; charset=us-ascii") (file-name: "qqq.txt")) +(hbs2:tree:metadata:get 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd) +((mime-type: "text/plain; charset=us-ascii") (file-name: "qqq.txt")) (hbs2:tree:metadata:get :raw 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd mime-type: "text/plain; charset=us-ascii" @@ -151,7 +151,7 @@ file-name: "qqq.txt" |] $ entry $ bindMatch "hbs2:tree:metadata:get" $ \case - [ SymbolVal how, StringLike hash ] -> do + [ StringLike hash ] -> do r <- flip runContT pure do @@ -187,18 +187,17 @@ file-name: "qqq.txt" _ -> mzero - case (how, r) of - ("parsed", Just (LitStrVal r0)) -> do - + maybe1 r (pure nil) $ \case + TextLike r0 -> do let xs = parseTop r0 & either mempty (fmap fixContext) - pure $ mkForm "dict" xs + pure $ mkList xs _ -> pure $ fromMaybe nil r - _ -> throwIO (BadFormException @c nil) + _ -> throwIO (BadFormException @c nil) brief "creates a merkle tree with metadata" $ returns "string" "hash" @@ -220,23 +219,22 @@ $ echo TEST | hbs2-cli hbs2:tree:metadata:create :stdin ;; empty metadata -hbs2-cli hbs2:tree:metadata:get :raw 7dGqTtoehsgn7bADcVTyp93tq2FfuQgtBuVvYL46jdyz +hbs2-cli hbs2:tree:metadata:get 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 +$ hbs2-cli hbs2:tree:metadata:get 2ASBLBPRUMrHoSkNYsRWwJQiiXuSGDZTaCXAdDTdeJY6 hello: "world" +$ hbs2-cli hbs2:tree:metadata:get 7YyWZ44sWpHvrqnFxL8G8HJo4o4p659diusZoHyhXCTx +((mime-type: "text/plain; charset=us-ascii") (file-name: "MetaData.hs")) + $ 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]] \ @@ -253,7 +251,7 @@ GixS4wssCD4x7LzvHve2JhFCghW1Hwia2tiGTfTTef1u Check metadata -$ hbs2-cli hbs2:tree:metadata:get :raw BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y +$ hbs2-cli hbs2:tree:metadata:get BFLcbpNEqngsJ8gzx3ps4ETXfpUMGgjEETNEVgR18KG4y mime-type: "image/svg+xml; charset=us-ascii" file-name: "lambda.svg" @@ -272,12 +270,12 @@ $ hbs2-cli hbs2:groupkey:list-public-keys [hbs2:groupkey:load GixS4wssCD4x7LzvHv SymbolVal "auto" -> pure [Auto] - ListVal (SymbolVal "dict" : [ListVal [SymbolVal "encrypted", StringLike key]]) + ListVal [ListVal [SymbolVal "encrypted", StringLike key]] -> do pure [Encrypted key] - ListVal (SymbolVal "dict" : w) -> do - pure [MetaDataEntry x y | ListVal [SymbolVal x, StringLike y] <- w ] + ListVal ws -> do + pure [MetaDataEntry x y | ListVal [SymbolVal x, StringLike y] <- ws ] StringLike rest -> do pure [MetaDataFile rest] diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs b/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs index 7625bc30..eb7e5c45 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs @@ -7,6 +7,8 @@ import HBS2.CLI.Run.Internal import HBS2.CLI.Run.Internal.GroupKey as G import HBS2.CLI.Run.Internal.Merkle +import HBS2.Defaults + import HBS2.Data.Types.Refs import HBS2.Merkle import HBS2.System.Dir @@ -45,3 +47,18 @@ treeEntries = do _ -> throwIO (BadFormException @c nil) + brief "reads merkle tree data from storage" + $ args [arg "list of hashes" "trees"] + $ desc [qc|hbs2:grove creates a 'grove' - merkle tree of list of hashes of merkle trees +It's just an easy way to create a such thing, you may browse it by hbs2 cat -H +|] + $ returns "hash" "string" + $ entry $ bindMatch "hbs2:grove" $ \case + HashLikeList hashes@(x:_) -> lift do + sto <- getStorage + let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) hashes + mkSym . show . pretty <$> liftIO (makeMerkle 0 pt $ \(_,_,bss) -> do + void $ putBlock sto bss) + + _ -> throwIO (BadFormException @c nil) + diff --git a/hbs2-core/lib/HBS2/Data/Types/Refs.hs b/hbs2-core/lib/HBS2/Data/Types/Refs.hs index 1ca455d4..4c725fa1 100644 --- a/hbs2-core/lib/HBS2/Data/Types/Refs.hs +++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs @@ -18,6 +18,7 @@ import Codec.Serialise(serialise) import Data.Map (Map) import Data.Map qualified as Map import Data.Data +import Data.Maybe import Data.Text qualified as Text class RefMetaData a where @@ -144,5 +145,15 @@ pattern HashLike x <- ( _ -> Nothing -> Just x ) +pattern HashLikeList :: forall {c} . [HashRef] -> [Syntax c] +pattern HashLikeList e <- (hashLikeList -> e) + +hashLikeList :: [Syntax c] -> [HashRef] +hashLikeList syn = [ hashLike s | s <- syn ] & takeWhile isJust & catMaybes + +hashLike :: Syntax c -> Maybe HashRef +hashLike = \case + HashLike x -> Just x + _ -> Nothing diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs index b0f56e5a..cab504ef 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -1439,8 +1439,7 @@ internalEntries = do _ -> pure $ mkBool False entry $ bindMatch "not" $ \case - [w] -> do - pure $ if isFalse w then mkBool True else mkBool False + [w] -> pure (mkBool (isTrue w)) _ -> throwIO (BadFormException @c nil) brief "get system environment"