diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs index fb7cf82d..d36790db 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs +++ b/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 diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs index 25354c33..4e472b32 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs +++ b/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 - 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 + extractGroupKeySecret gk gks <- orThrowUser "can't get groupkey's secret" mgks diff --git a/hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs b/hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs index 755f1ff9..4690249b 100644 --- a/hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs +++ b/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 +