wip, decryption with groupkey finding

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
 

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

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
+getTreeContents :: forall m . ( MonadUnliftIO m
-                   , MonadError OperationError 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
+      let findStuff g = do
-                loadKeyRingEntries rcpts <&> fmap snd
+            runKeymanClientRO @IO $ findMatchedGroupKeySecret sto g
 
-      readFromMerkle sto (ToDecryptBS (coerce href) (findSecretDefault kre))
+      readFromMerkle sto (ToDecryptBS (coerce href) (liftIO . findStuff))
 
     _ -> throwError UnsupportedFormat
 

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)