wip

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

@@ -3,6 +3,7 @@ module HBS2.CLI.Run.Internal.GroupKey where
 import HBS2.CLI.Prelude hiding (mapMaybe)
 
 import HBS2.Data.Types.Refs
+import HBS2.Data.Types.SmallEncryptedBlock
 import HBS2.Storage.Operations.Class
 import HBS2.Storage.Operations.ByteString
 import Data.Maybe
@@ -12,6 +13,7 @@ import HBS2.Net.Auth.GroupKeySymm as Symm
 import Control.Monad.Trans.Cont
 import Control.Monad.Except
 import Codec.Serialise
+import Data.ByteString (ByteString)
 
 groupKeyFromKeyList :: MonadUnliftIO m => [String] -> m (GroupKey 'Symm HBS2Basic)
 groupKeyFromKeyList ks = do
@@ -19,6 +21,13 @@ groupKeyFromKeyList ks = do
   Symm.generateGroupKey @'HBS2Basic Nothing members
 
 
+encryptBlock :: MonadUnliftIO m
+             => GroupKey 'Symm 'HBS2Basic
+             -> ByteString
+             -> m (SmallEncryptedBlock ByteString)
+
+encryptBlock gk bs = undefined
+
 loadGroupKey :: (IsContext c, MonadUnliftIO m) => HashRef -> RunM c m (Maybe (GroupKey 'Symm HBS2Basic))
 loadGroupKey h = do
 

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

@@ -57,11 +57,7 @@ createTreeWithMetadata sto mgk meta lbs = do -- flip runContT pure do
     createEncryptedTree gk mt = do
       -- 1. find key
       mgks <- runKeymanClient do
-        runMaybeT do
+                extractGroupKeySecret gk
-          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
 

hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs

@@ -7,6 +7,7 @@ import HBS2.KeyMan.Config
 
 import HBS2.Prelude.Plated
 import HBS2.Net.Auth.Credentials
+import HBS2.Net.Auth.GroupKeySymm as Symm
 import HBS2.Net.Proto.Types
 
 
@@ -17,6 +18,7 @@ import UnliftIO
 import DBPipe.SQLite
 import Text.InterpolatedString.Perl6 (qc)
 import Data.Maybe
+import Data.HashMap.Strict qualified as HM
 import Control.Monad.Trans.Maybe
 import Data.List qualified as List
 import Data.ByteString qualified as BS
@@ -106,3 +108,14 @@ loadKeyRingEntries pks = KeyManClient do
                                 ]
     pure $ catMaybes r & List.sortOn (Down . fst)
 
+
+extractGroupKeySecret :: MonadIO m
+                      => GroupKey 'Symm 'HBS2Basic
+                      -> KeyManClient m (Maybe GroupSecret)
+extractGroupKeySecret gk = 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
+