wip, changed GroupKeySymm interface

hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs

@@ -412,6 +412,17 @@ instance ( MonadIO m
 
 data EncMethod = Method1 | Method2
 
+-- findSecretDefault :: MonadIO m =>
+
+
+findSecretDefault :: forall s m . (s ~ 'HBS2Basic, Monad  m)
+                  => [KeyringEntry s]
+                  -> GroupKey 'Symm s
+                  -> m (Maybe GroupSecret)
+
+findSecretDefault keys gk = do
+  pure $ [ lookupGroupKey sk pk gk | KeyringEntry pk sk  _ <- keys ] & catMaybes & headMay
+
 instance ( MonadIO m
          , MonadError OperationError m
          , h ~ HbSync
@@ -421,17 +432,20 @@ instance ( MonadIO m
          ) => MerkleReader (ToDecrypt 'Symm sch ByteString) s h m where
 
   data instance TreeKey (ToDecrypt 'Symm sch ByteString) =
-      ToDecryptBS   [KeyringEntry sch] (Hash HbSync)
-    | ToDecryptBS2  (GroupKey 'Symm sch) B8.ByteString [KeyringEntry sch] (MTreeAnn [HashRef])
+      -- ToDecryptBS   [KeyringEntry sch] (Hash HbSync)
+    ToDecryptBS { treeHash   :: Hash HbSync
+                , findSecret :: forall m1 . MonadIO m1 => GroupKey 'Symm sch -> m1 (Maybe GroupSecret)
+                }
 
   type instance ToBlockR  (ToDecrypt 'Symm sch ByteString) = ByteString
   type instance ReadResult (ToDecrypt 'Symm sch ByteString) = ByteString
 
-  readFromMerkle sto decrypt  = do
+  readFromMerkle sto decrypt@ToDecryptBS{..}  = do
 
-    (keys, gk, nonceS, tree) <- decryptDataFrom decrypt
+    (gk, nonceS, tree) <- decryptDataFrom decrypt
 
-    let gksec' = [ lookupGroupKey sk pk gk | (pk,sk) <- keys ] & catMaybes & headMay
+    gksec' <- findSecret gk
+     -- [ lookupGroupKey sk pk gk | (pk,sk) <- keys ] & catMaybes & headMay
 
     gksec <- maybe1 gksec' (throwError (GroupKeyNotFound 2)) pure
 
@@ -470,12 +484,8 @@ instance ( MonadIO m
     where
 
       decryptDataFrom = \case
-        ToDecryptBS2 gk nonce ke tree  -> do
-          let keys = [ (view krPk x, view krSk x) | x <- ke ]
-          pure (keys, gk, nonce, tree)
 
-        ToDecryptBS ke h  -> do
-          let keys = [ (view krPk x, view krSk x) | x <- ke ]
+        ToDecryptBS h _  -> do
 
           bs <- getBlock sto h >>= maybe (throwError MissedBlockError) pure
           let what = tryDetect h bs
@@ -490,8 +500,7 @@ instance ( MonadIO m
 
           gk <- either (const $ throwError (GroupKeyNotFound 1)) pure (deserialiseOrFail @(GroupKey 'Symm sch) gkbs)
 
-          pure (keys, gk, nonceS, tree)
-
+          pure (gk, nonceS, tree)
 
 
 encryptBlock :: ( MonadIO m

hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs

@@ -253,7 +253,7 @@ readBundle sto rh ref = do
     MerkleAnn (MTreeAnn {_mtaCrypt = EncryptGroupNaClSymm gkh _}) -> do
       ke <- loadKeyrings (HashRef gkh)
       let meta = BundleMeta ref True
-      BundleWithMeta meta <$> readFromMerkle sto (ToDecryptBS ke key)
+      BundleWithMeta meta <$> readFromMerkle sto (ToDecryptBS key (findSecretDefault ke))
 
     _ -> throwError UnsupportedFormat
 

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

@@ -620,7 +620,7 @@ getTreeContents sto href = do
       kre <- runKeymanClient do
                 loadKeyRingEntries rcpts <&> fmap snd
 
-      readFromMerkle sto (ToDecryptBS kre (coerce href))
+      readFromMerkle sto (ToDecryptBS (coerce href) (findSecretDefault kre))
 
     _ -> throwError UnsupportedFormat
 

hbs2/Main.hs

@@ -268,7 +268,7 @@ runCat opts ss = do
                          lift $ runKeymanClient do
                            loadKeyRingEntries rcpts <&> fmap snd
 
-          elbs <- runExceptT $ readFromMerkle ss (ToDecryptBS keyring mhash)
+          elbs <- runExceptT $ readFromMerkle ss (ToDecryptBS mhash (findSecretDefault keyring))
           case elbs of
             Right lbs -> LBS.putStr lbs
             Left e    -> die (show e)