diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs index 54339926..ff5728ec 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs @@ -244,6 +244,8 @@ readBundle sto rh ref = do let q = tryDetect (fromHashRef ref) obj + let findSec = runKeymanClientRO . findMatchedGroupKeySecret sto + case q of Merkle t -> do let meta = BundleMeta ref False @@ -251,9 +253,8 @@ readBundle sto rh ref = do readFromMerkle sto (SimpleKey key) MerkleAnn (MTreeAnn {_mtaCrypt = EncryptGroupNaClSymm gkh _}) -> do - ke <- loadKeyrings (HashRef gkh) let meta = BundleMeta ref True - BundleWithMeta meta <$> readFromMerkle sto (ToDecryptBS key (findSecretDefault ke)) + BundleWithMeta meta <$> readFromMerkle sto (ToDecryptBS key (liftIO . findSec)) _ -> throwError UnsupportedFormat diff --git a/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs b/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs index 753b6e9f..afed53ed 100644 --- a/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs +++ b/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs @@ -39,6 +39,13 @@ newtype KeyManClient m a = KeyManClient { fromKeyManClient :: DBPipeM m a } , MonadUnliftIO ) +runKeymanClientRO :: MonadUnliftIO m => KeyManClient m a -> m a +runKeymanClientRO action = do + dbPath <- getStatePath + env <- liftIO newAppEnv + let db = appDb env + withDB db (fromKeyManClient action) + runKeymanClient :: MonadUnliftIO m => KeyManClient m a -> m a runKeymanClient action = do dbPath <- getStatePath diff --git a/hbs2-sync/src/HBS2/Sync/State.hs b/hbs2-sync/src/HBS2/Sync/State.hs index 16e8713f..a07f3516 100644 --- a/hbs2-sync/src/HBS2/Sync/State.hs +++ b/hbs2-sync/src/HBS2/Sync/State.hs @@ -22,6 +22,8 @@ import HBS2.Peer.RPC.Client.Unix (UNIX) import HBS2.Peer.RPC.Client import HBS2.Peer.RPC.Client.RefChan as Client +import HBS2.KeyMan.Keys.Direct + import HBS2.CLI.Run.MetaData (createTreeWithMetadata) import DBPipe.SQLite @@ -592,8 +594,9 @@ mergeState seed orig = do else new -getTreeContents :: ( MonadUnliftIO m - , MonadError OperationError m +getTreeContents :: forall m . ( MonadUnliftIO m + , MonadIO m + , MonadError OperationError m ) => AnyStorage -> HashRef @@ -617,10 +620,10 @@ getTreeContents sto href = do >>= orThrowError (GroupKeyNotFound 11) <&> HM.keys . Symm.recipients - kre <- runKeymanClient do - loadKeyRingEntries rcpts <&> fmap snd + let findStuff g = do + runKeymanClientRO @IO $ findMatchedGroupKeySecret sto g - readFromMerkle sto (ToDecryptBS (coerce href) (findSecretDefault kre)) + readFromMerkle sto (ToDecryptBS (coerce href) (liftIO . findStuff)) _ -> throwError UnsupportedFormat diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 19735536..0cab6176 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -268,7 +268,8 @@ runCat opts ss = do lift $ runKeymanClient do loadKeyRingEntries rcpts <&> fmap snd - elbs <- runExceptT $ readFromMerkle ss (ToDecryptBS mhash (findSecretDefault keyring)) + let sto = AnyStorage ss + elbs <- runExceptT $ readFromMerkle ss (ToDecryptBS mhash (liftIO . runKeymanClientRO . findMatchedGroupKeySecret sto)) case elbs of Right lbs -> LBS.putStr lbs Left e -> die (show e)