voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
Dmitry Zuikov 2024-08-02 07:16:02 +03:00
parent 0bd163bc25
commit 11d2786f62
1 changed files with 67 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
View File

@ -9,15 +9,9 @@ import HBS2.CLI.Run.Internal.Merkle
import HBS2.Data.Types.Refs import HBS2.Data.Types.Refs
import HBS2.Merkle import HBS2.Merkle
import HBS2.System.Logger.Simple.ANSI as All
import HBS2.System.Dir import HBS2.System.Dir
import HBS2.Storage import HBS2.Storage
import HBS2.Storage.Operations.ByteString import HBS2.Storage.Operations.ByteString
import HBS2.Peer.CLI.Detect
import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.API.Storage
import HBS2.Peer.RPC.Client.StorageClient
import HBS2.KeyMan.Keys.Direct
import HBS2.Net.Auth.Schema() import HBS2.Net.Auth.Schema()
@ -107,66 +101,91 @@ metaDataEntries = do
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
entry $ bindMatch "hbs2:tree:metadata:get-gk" $ \case brief "get group key from encrypted tree"
[ StringLike hash ] -> flip runContT pure do $ args [arg "string" "tree-hash"]
$ returns "group-key-hash" "string"
$ examples [qc|
(gk,_) <- lift $ getGroupKeyHash (fromString hash) (hbs2:tree:metadata:get-gk 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd)
5fshZRucawt47YJLuD1rVXRez2dcvCbz17m69YyduTEm
case gk of |]
Just h -> pure $ mkStr (show $ pretty h) $ entry $ bindMatch "hbs2:tree:metadata:get-gk" $ \case
_ -> pure nil [ StringLike hash ] -> flip runContT pure do
_ -> throwIO (BadFormException @c nil) (gk,_) <- lift $ getGroupKeyHash (fromString hash)
entry $ bindMatch "hbs2:tree:metadata:get" $ \case case gk of
[ SymbolVal how, StringLike hash ] -> do Just h -> pure $ mkStr (show $ pretty h)
_ -> pure nil
r <- flip runContT pure do _ -> throwIO (BadFormException @c nil)
sto <- ContT withPeerStorage brief "get metadata from tree"
$ args [arg "symbol?" "method", arg "string" "tree-hash"]
$ returns "group-key-hash" "string"
$ desc ( opt "symbol?" ":parsed" <+> "return metadata as dict" <> line
<> "if other value or absense then return metadata as string"
)
$ examples [qc|
runMaybeT do (hbs2:tree:metadata:get :parsed 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd)
(dict (mime-type: "text/plain; charset=us-ascii") (file-name: "qqq.txt"))
headBlock <- getBlock sto (fromString hash) (hbs2:tree:metadata:get :raw 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd
>>= toMPlus mime-type: "text/plain; charset=us-ascii"
<&> deserialiseOrFail @(MTreeAnn [HashRef]) file-name: "qqq.txt"
>>= toMPlus |]
$ entry $ bindMatch "hbs2:tree:metadata:get"
$ \case
[ SymbolVal how, StringLike hash ] -> do
case headBlock of r <- flip runContT pure do
MTreeAnn { _mtaMeta = ShortMetadata s } -> do
pure $ mkStr s
MTreeAnn { _mtaMeta = AnnHashRef h, _mtaCrypt = NullEncryption } -> do sto <- ContT withPeerStorage
getBlock sto h
>>= toMPlus
<&> LBS.toStrict
<&> TE.decodeUtf8
<&> mkStr
MTreeAnn { _mtaMeta = AnnHashRef h } -> do runMaybeT do
getBlock sto h
>>= toMPlus
<&> deserialiseOrFail @(SmallEncryptedBlock AnnMetaData)
>>= toMPlus
>>= lift . lift . G.decryptBlock sto
<&> \case
ShortMetadata s -> mkStr s
_ -> nil
_ -> mzero headBlock <- getBlock sto (fromString hash)
>>= toMPlus
<&> deserialiseOrFail @(MTreeAnn [HashRef])
>>= toMPlus
case (how, r) of case headBlock of
("parsed", Just (LitStrVal r0)) -> do MTreeAnn { _mtaMeta = ShortMetadata s } -> do
pure $ mkStr s
MTreeAnn { _mtaMeta = AnnHashRef h, _mtaCrypt = NullEncryption } -> do
getBlock sto h
>>= toMPlus
<&> LBS.toStrict
<&> TE.decodeUtf8
<&> mkStr
MTreeAnn { _mtaMeta = AnnHashRef h } -> do
getBlock sto h
>>= toMPlus
<&> deserialiseOrFail @(SmallEncryptedBlock AnnMetaData)
>>= toMPlus
>>= lift . lift . G.decryptBlock sto
<&> \case
ShortMetadata s -> mkStr s
_ -> nil
_ -> mzero
case (how, r) of
("parsed", Just (LitStrVal r0)) -> do
let xs = parseTop r0 let xs = parseTop r0
& fromRight mempty & fromRight mempty
pure $ mkForm "dict" xs pure $ mkForm "dict" xs
_ -> pure $ fromMaybe nil r _ -> pure $ fromMaybe nil r
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
brief "creates a merkle tree with metadata" brief "creates a merkle tree with metadata"
$ returns "string" "hash" $ returns "string" "hash"