diff --git a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs b/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs index af97a470..422d42a4 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs +++ b/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 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 10be3b3a..54339926 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 @@ -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 diff --git a/hbs2-sync/src/HBS2/Sync/State.hs b/hbs2-sync/src/HBS2/Sync/State.hs index 0de42b76..16e8713f 100644 --- a/hbs2-sync/src/HBS2/Sync/State.hs +++ b/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 diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 98873d3f..19735536 100644 --- a/hbs2/Main.hs +++ b/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)