wip, encrypt/decrypt fixme log trees

fixme-new/lib/Fixme/Run/Internal.hs

@@ -12,6 +12,7 @@ import Fixme.Scan as Scan
 import Fixme.GK
 
 import HBS2.Git.Local.CLI
+import HBS2.CLI.Run.MetaData (createTreeWithMetadata,getTreeContents)
 
 import HBS2.Polling
 import HBS2.OrDie
@@ -479,21 +480,19 @@ refchanExport opts = do
       for_ chu $ \x -> callCC \next -> do
 
         -- FIXME: encrypt-tree
-        --   1. откуда ключ взять
 
-        --   2. куда его положить
-
-
-        --
-        --   3. один на всех?
-        --   4. по одному на каждого?
-        --   5. как будет устроена ротация
         --   6. как делать доступ к историческим данным
         --   6.1 новые ключи в этот же рефчан
         --   6.2 или новые ключи в какой-то еще рефчан
-        h  <- writeAsMerkle sto (serialise x)
 
-        let tx = AnnotatedHashRef Nothing (HashRef h)
+        let s = maybe "[ ]" (const $ yellow "[@]") gk0
+
+        let gk = snd <$> gk0
+
+        href <- liftIO $ createTreeWithMetadata sto gk mempty (serialise x)
+                  >>= orThrowPassIO
+
+        let tx = AnnotatedHashRef Nothing href
 
         lift do
 
@@ -501,7 +500,7 @@ refchanExport opts = do
 
           let box = makeSignedBox @'HBS2Basic @BS.ByteString pk sk (LBS.toStrict lbs)
 
-          warn $ "POST" <+> red "unencrypted!" <+> pretty (length x) <+> pretty (hashObject @HbSync (serialise box))
+          warn $ "POST" <+> pretty (length x) <+> s <> "tree" <+> pretty href <+> pretty (hashObject @HbSync (serialise box))
 
           unless dry do
             r <- callRpcWaitMay @RpcRefChanPropose (TimeoutSec 1) rchanAPI (chan, box)
@@ -511,6 +510,7 @@ refchanExport opts = do
 
       pure $ length what
 
+
 refchanUpdate :: FixmePerks m => FixmeM m ()
 refchanUpdate = do
 
@@ -610,7 +610,7 @@ refchanImport = do
         else do
 
           -- FIXME: decrypt-tree
-          what <- runExceptT (readFromMerkle sto (SimpleKey (coerce href)))
+          what <- liftIO (runExceptT $ getTreeContents sto href)
                     <&> either (const Nothing) Just
                     >>= toMPlus
 

hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs

@@ -8,6 +8,7 @@ import HBS2.CLI.Run.Internal.GroupKey as G
 import HBS2.Hash
 import HBS2.Net.Auth.GroupKeySymm as Symm
 import HBS2.Data.Types.Refs
+import HBS2.Data.Detect
 import HBS2.Merkle
 import HBS2.Storage
 import HBS2.Storage.Operations.ByteString
@@ -19,6 +20,7 @@ import HBS2.KeyMan.Keys.Direct
 import HBS2.Net.Auth.Schema()
 
 import Codec.Serialise
+import Data.Coerce
 import Data.ByteString.Lazy qualified as LBS
 import Data.HashMap.Strict qualified as HM
 import Data.Text qualified as Text
@@ -115,3 +117,39 @@ createTreeWithMetadata sto mgk meta lbs = do -- flip runContT pure do
       runExceptT $ writeAsMerkle sto source <&> HashRef
 
 
+getTreeContents :: forall m . ( MonadUnliftIO m
+                              , MonadIO m
+                              , MonadError OperationError m
+                   )
+                => AnyStorage
+                -> HashRef
+                -> m LBS.ByteString
+
+getTreeContents sto href = do
+
+  blk <- getBlock sto (coerce href)
+           >>= orThrowError MissedBlockError
+
+  let q = tryDetect (coerce href) blk
+
+  case q of
+
+    Merkle _ -> do
+      readFromMerkle sto (SimpleKey (coerce href))
+
+    MerkleAnn (MTreeAnn {_mtaCrypt = NullEncryption }) -> do
+      readFromMerkle sto (SimpleKey (coerce href))
+
+    MerkleAnn ann@(MTreeAnn {_mtaCrypt = EncryptGroupNaClSymm gkh _}) -> do
+
+      rcpts  <- Symm.loadGroupKeyMaybe @'HBS2Basic sto (HashRef gkh)
+                  >>= orThrowError (GroupKeyNotFound 11)
+                  <&> HM.keys . Symm.recipients
+
+      let findStuff g = do
+            runKeymanClientRO @IO $ findMatchedGroupKeySecret sto g
+
+      readFromMerkle sto (ToDecryptBS (coerce href) (liftIO . findStuff))
+
+    _ -> throwError UnsupportedFormat
+

hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs

@@ -3,6 +3,7 @@
 module HBS2.CLI.Run.MetaData
   ( metaDataEntries
   , createTreeWithMetadata
+  , getTreeContents
   ) where
 
 import HBS2.CLI.Prelude

hbs2-sync/src/HBS2/Sync/Internal.hs

@@ -11,6 +11,8 @@ import HBS2.Peer.RPC.API.Storage
 import HBS2.Peer.RPC.Client.Unix (UNIX)
 import HBS2.Peer.RPC.Client
 
+import HBS2.CLI.Run.MetaData (getTreeContents)
+
 import HBS2.CLI.Run.Internal hiding (PeerNotConnectedException)
 
 import Control.Monad.Trans.Maybe

hbs2-sync/src/HBS2/Sync/State.hs

@@ -24,7 +24,7 @@ import HBS2.Peer.RPC.Client.RefChan as Client
 
 import HBS2.KeyMan.Keys.Direct
 
-import HBS2.CLI.Run.MetaData (createTreeWithMetadata)
+import HBS2.CLI.Run.MetaData (createTreeWithMetadata, getTreeContents)
 
 import DBPipe.SQLite
 import Data.Config.Suckless.Script.File
@@ -599,39 +599,6 @@ mergeState seed orig = do
         else
           new
 
-getTreeContents :: forall m . ( MonadUnliftIO m
-                              , MonadIO m
-                              , MonadError OperationError m
-                   )
-                => AnyStorage
-                -> HashRef
-                -> m LBS.ByteString
-
-getTreeContents sto href = do
-
-  blk <- getBlock sto (coerce href)
-           >>= orThrowError MissedBlockError
-
-  let q = tryDetect (coerce href) blk
-
-  case q of
-
-    MerkleAnn (MTreeAnn {_mtaCrypt = NullEncryption }) -> do
-      readFromMerkle sto (SimpleKey (coerce href))
-
-    MerkleAnn ann@(MTreeAnn {_mtaCrypt = EncryptGroupNaClSymm gkh _}) -> do
-
-      rcpts  <- Symm.loadGroupKeyMaybe @'HBS2Basic sto (HashRef gkh)
-                  >>= orThrowError (GroupKeyNotFound 11)
-                  <&> HM.keys . Symm.recipients
-
-      let findStuff g = do
-            runKeymanClientRO @IO $ findMatchedGroupKeySecret sto g
-
-      readFromMerkle sto (ToDecryptBS (coerce href) (liftIO . findStuff))
-
-    _ -> throwError UnsupportedFormat
-
 
 runDirectory :: ( IsContext c
                 , SyncAppPerks m