diff --git a/hbs2-cli/lib/HBS2/CLI/Prelude.hs b/hbs2-cli/lib/HBS2/CLI/Prelude.hs index 6c879130..0f1fd694 100644 --- a/hbs2-cli/lib/HBS2/CLI/Prelude.hs +++ b/hbs2-cli/lib/HBS2/CLI/Prelude.hs @@ -6,12 +6,14 @@ module HBS2.CLI.Prelude , module Data.HashMap.Strict , module Control.Monad.Reader , module HBS2.System.Logger.Simple.ANSI + , module HBS2.Misc.PrettyStuff , Generic ) where import HBS2.Prelude.Plated import HBS2.OrDie import HBS2.System.Logger.Simple.ANSI +import HBS2.Misc.PrettyStuff import Data.HashMap.Strict import Data.Config.Suckless diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs index aff33bb6..25354c33 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs @@ -1,9 +1,12 @@ module HBS2.CLI.Run.Internal.Merkle where import HBS2.CLI.Prelude +import HBS2.Defaults import HBS2.CLI.Run.Internal import HBS2.CLI.Run.Internal.GroupKey +import HBS2.Hash +import HBS2.Net.Auth.GroupKeySymm as Symm import HBS2.Data.Types.Refs import HBS2.Merkle import HBS2.Storage @@ -17,6 +20,8 @@ import Codec.Serialise import Data.ByteString.Lazy qualified as LBS import Data.HashMap.Strict qualified as HM import Data.Text qualified as Text +import Control.Monad.Trans.Maybe +import Control.Monad.Except -- TODO: client-api-candidate createTreeWithMetadata :: (MonadUnliftIO m) @@ -24,14 +29,14 @@ createTreeWithMetadata :: (MonadUnliftIO m) -> Maybe (GroupKey 'Symm 'HBS2Basic) -> HashMap Text Text -> LBS.ByteString - -> m HashRef + -> m (Either OperationError HashRef) createTreeWithMetadata sto mgk meta lbs = do -- flip runContT pure do let mt = vcat [ pretty k <> ":" <+> dquotes (pretty v) | (k,v) <- HM.toList meta ] & show & Text.pack case mgk of - Nothing -> createSimpleTree mt + Nothing -> Right <$> createSimpleTree mt Just gk -> createEncryptedTree gk mt where @@ -42,15 +47,45 @@ createTreeWithMetadata sto mgk meta lbs = do -- flip runContT pure do <&> deserialiseOrFail @(MTree [HashRef]) >>= orThrowUser "merkle tree corrupted/invalid" - -- FIXME: support-encryption let mann = MTreeAnn (ShortMetadata mt) NullEncryption t0 putBlock sto (serialise mann) >>= orThrowUser "can't write tree" <&> HashRef + -- FIXME: support-encryption createEncryptedTree gk mt = do - -- 1. - error "oopsie" + -- 1. find key + mgks <- runKeymanClient do + runMaybeT do + s <- forM (HM.toList $ recipients gk) $ \(pk,box) -> do + KeyringEntry pk sk _ <- MaybeT $ loadKeyRingEntry pk + MaybeT $ pure (Symm.lookupGroupKey sk pk gk) + MaybeT $ pure $ headMay s + + gks <- orThrowUser "can't get groupkey's secret" mgks + + -- FIXME: consider-other-nonce-calculation + -- надо считать начальный нонс (от чего / как?) + -- нонс: да так-то пофиг от чего, но: + -- если брать рандомные места в байтстроке -- + -- она зафорсится + -- что вообще зависит от начального нонса: + -- если в файл будет допись в конец, то + -- "старые" блоки останутся такими же, как были + -- что хорошо для дедуплицирования, но + -- потенциально это менее безопасно. + -- можно еще с метаданными похэшировать, тогда + -- нонс будет более уникальный; но поменялись метаданные -- поменялось всё + let s0 = LBS.take ( 1024 * 1024 ) lbs + + let (HbSyncHash nonce) = hashObject @HbSync s0 + -- куда-то девать зашифрованные метаданные + -- + let segments = readChunkedBS lbs defBlockSize + + let source = ToEncryptSymmBS gks (Right gk) nonce segments (ShortMetadata mt) Nothing + + runExceptT $ writeAsMerkle sto source <&> HashRef diff --git a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs index f5e90af0..eaa4ebd6 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs @@ -5,6 +5,7 @@ module HBS2.CLI.Run.MetaData (metaDataEntries) where import HBS2.CLI.Prelude import HBS2.CLI.Run.Internal import HBS2.CLI.Run.Internal.GroupKey +import HBS2.CLI.Run.Internal.Merkle import HBS2.Data.Types.Refs import HBS2.Merkle @@ -157,7 +158,8 @@ metaDataEntries = do sto <- ContT withPeerStorage - href <- lift $ createTreeWithMetadata sto gk (meta0 <> meta1) lbs + href <- lift (createTreeWithMetadata sto gk (meta0 <> meta1) lbs) + `orDie` "encryption error" pure $ mkStr (show $ pretty href) diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 2d7925ed..5abd81fd 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -273,7 +273,7 @@ runCat opts ss = do Right lbs -> LBS.putStr lbs Left e -> die (show e) - MerkleAnn ann -> die "asymmetric gropup encryption is deprecated" + MerkleAnn ann -> die "asymmetric group encryption is deprecated" -- FIXME: what-if-multiple-seq-ref-? SeqRef (SequentialRef _ (AnnotatedHashRef _ h)) -> do