wip

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

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
 
 

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)
 

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