relocate metadata encryption - part 4

lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -127,7 +127,6 @@ module Cardano.Wallet.Api.Http.Shelley.Server
     , rndStateChange
     , withWorkerCtx
     , getCurrentEpoch
-    , fromMetadataEncrypted
 
     -- * Workers
     , manageRewardBalance
@@ -182,7 +181,6 @@ import Cardano.Wallet
     , ErrConstructSharedWallet (..)
     , ErrConstructTx (..)
     , ErrCreateMigrationPlan (..)
-    , ErrDecodeTx (..)
     , ErrGetPolicyId (..)
     , ErrNoSuchWallet (..)
     , ErrReadRewardAccount (..)
@@ -364,7 +362,6 @@ import Cardano.Wallet.Api.Types
     , ApiConstructTransactionData (..)
     , ApiDecodeTransactionPostData (..)
     , ApiDecodedTransaction (..)
-    , ApiEncryptMetadata (..)
     , ApiExternalInput (..)
     , ApiFee (..)
     , ApiForeignStakeKey (..)
@@ -485,11 +482,7 @@ import Cardano.Wallet.Api.Types.MintBurn
 import Cardano.Wallet.Api.Types.SchemaMetadata
     ( TxMetadataSchema (..)
     , TxMetadataWithSchema (TxMetadataWithSchema)
-    , metadataPBKDF2Config
-    , cip20MetadataKey
-    , cip83EncryptMethodKey
-    , cip83EncryptPayloadKey
-    , cip83EncryptPayloadValue
+    , fromMetadataEncrypted
     , toMetadataEncrypted
     )
 import Cardano.Wallet.Api.Types.Transaction
@@ -732,19 +725,11 @@ import Control.Tracer
     ( Tracer
     , contramap
     )
-import Cryptography.Cipher.AES256CBC
-    ( CipherMode (..)
-    )
 import Cryptography.Core
     ( genSalt
     )
 import Data.Bifunctor
-    ( bimap
-    , first
-    )
-import Data.ByteArray.Encoding
-    ( Base (..)
-    , convertFromBase
+    ( first
     )
 import Data.ByteString
     ( ByteString
@@ -961,19 +946,14 @@ import qualified Cardano.Wallet.Read as Read
 import qualified Cardano.Wallet.Read.Hash as Hash
 import qualified Cardano.Wallet.Registry as Registry
 import qualified Control.Concurrent.Concierge as Concierge
-import qualified Cryptography.Cipher.AES256CBC as AES256CBC
-import qualified Cryptography.KDF.PBKDF2 as PBKDF2
-import qualified Data.Aeson as Aeson
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
 import qualified Data.Foldable as F
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
 import qualified Internal.Cardano.Write.Tx as Write
     ( Datum (DatumHash, NoDatum)
     , IsRecentEra
@@ -3162,105 +3142,6 @@ constructTransaction api knownPools poolStatus apiWalletId body = do
             . Map.toList
             . foldr (uncurry (Map.insertWith (<>))) Map.empty
 
-
--- When decryption is enabled we do the following:
--- (a) retrieve list of TxMetaBytes under proper key, ie.674,
---     cip20MetadataKey
--- (b) recreate each encrypted payload from chunks
---     (0, TxMetaBytes chunk1)
---     (1, TxMetaBytes chunk2)
---     ....
---     (N, TxMetaBytes chunkN)
---     ie., payload=chunk1+chunk2+...+chunkN
--- (c) decrypt each payload
--- (d) update structure
--- (e) decode metadata
-fromMetadataEncrypted
-    :: ApiEncryptMetadata
-    -> Cardano.TxMetadata
-    -> Either ErrDecodeTx Cardano.TxMetadata
-fromMetadataEncrypted apiEncrypt metadata =
-   composePayload metadata >>=
-   mapM decrypt >>=
-   adjust metadata
-  where
-    checkPresenceOfMethod value =
-        let presentPair (Cardano.TxMetaText k, Cardano.TxMetaText v) =
-                k == cip83EncryptMethodKey && v == cip83EncryptPayloadValue
-            presentPair _ = False
-        in case value of
-            Cardano.TxMetaMap list -> not (any presentPair list)
-            _ -> True
-    getEncryptedPayload value =
-        let presentPair (Cardano.TxMetaText k, Cardano.TxMetaList _) =
-                k == cip83EncryptPayloadKey
-            presentPair _ = False
-        in case value of
-            Cardano.TxMetaMap list -> snd <$> filter presentPair list
-            _ -> []
-    extractTxt (Cardano.TxMetaText txt) = txt
-    extractTxt _ =
-        error "TxMetaText is expected"
-    extractPayload (Cardano.TxMetaList chunks)=
-        foldl T.append T.empty $ extractTxt <$> chunks
-    extractPayload _ = T.empty
-    composePayload (Cardano.TxMetadata themap) = do
-        validValue <- case Map.lookup cip20MetadataKey themap of
-            Nothing -> Left ErrDecodeTxMissingMetadataKey
-            Just v -> pure v
-        when (checkPresenceOfMethod validValue) $
-            Left ErrDecodeTxMissingEncryptionMethod
-        let payloads = getEncryptedPayload validValue
-        if null payloads then
-            Left ErrDecodeTxMissingValidEncryptionPayload
-        else do
-            let extracted = extractPayload <$> payloads
-            when (T.empty `elem` extracted) $
-                Left ErrDecodeTxMissingValidEncryptionPayload
-            Right extracted
-
-    pwd = BA.convert $ unPassphrase $ getApiT $ apiEncrypt ^. #passphrase
-    decodeFromJSON = ---use metadataValueFromJsonNoSchema when available from cardano-api
-        first (ErrDecodeTxDecryptedPayload . T.pack) .
-        Aeson.eitherDecode . BL.fromStrict
-    decrypt payload = case convertFromBase Base64 (T.encodeUtf8 payload) of
-        Right payloadBS ->
-            case AES256CBC.getSaltFromEncrypted payloadBS of
-                     Nothing -> Left ErrDecodeTxMissingSalt
-                     Just salt -> do
-                         let (secretKey, iv) =
-                                 PBKDF2.generateKey metadataPBKDF2Config pwd (Just salt)
-                         decrypted <- bimap ErrDecodeTxDecryptPayload fst
-                             (AES256CBC.decrypt WithPadding secretKey iv payloadBS)
-                         decodeFromJSON decrypted
-        Left _ ->
-            Left ErrDecodeTxEncryptedPayloadWrongBase
-
-    adjust (Cardano.TxMetadata metadata') decodedElems =
-        pure $ Cardano.TxMetadata $
-        Map.adjust updateMetaMap cip20MetadataKey metadata'
-      where
-        updateElem acc@(decryptedList, list) elem' = case elem' of
-            (Cardano.TxMetaText k, Cardano.TxMetaText v) ->
-                if k == cip83EncryptMethodKey && v == cip83EncryptPayloadValue then
-                    -- omiting this element
-                    acc
-                else
-                    (decryptedList, list ++ [elem'])
-            (Cardano.TxMetaText k, v) -> case decryptedList of
-                toAdd : rest ->
-                    if k == cip83EncryptPayloadKey then
-                        (rest, list ++ [(Cardano.TxMetaText k, toAdd)] )
-                    else
-                        (decryptedList, list ++ [(Cardano.TxMetaText k, v)] )
-                _ -> error "we have checked already in composePayload that there is enough elements in decrypedList"
-            _ -> error "we have checked already in composePayload that there is pair (TxMetaText, something)"
-
-        updateMetaMap v = case v of
-            Cardano.TxMetaMap list ->
-                Cardano.TxMetaMap $ snd $ L.foldl updateElem (decodedElems,[]) list
-            _ -> error "we have checked already in composePayload that there is TxMetaMap"
-
 toUsignedTxWdrl
     :: c -> ApiWithdrawalGeneral n -> Maybe (RewardAccount, Coin, c)
 toUsignedTxWdrl p = \case
@@ -3722,8 +3603,10 @@ decodeTransaction
                } = walletTx
             db = wrk ^. dbLayer
         metadata' <- case (decryptMetadata, metadata) of
-            (Just apiDecrypt, Just meta) ->
-                case fromMetadataEncrypted apiDecrypt meta of
+            (Just apiDecrypt, Just meta) -> do
+                let pwd = BA.convert $ unPassphrase $
+                          getApiT $ apiDecrypt ^. #passphrase
+                case fromMetadataEncrypted pwd meta of
                     Left err ->
                         liftHandler $ throwE err
                     Right txmetadata ->

lib/api/src/Cardano/Wallet/Api/Types/SchemaMetadata.hs

@@ -32,6 +32,7 @@ import Cardano.Api.Error
     )
 import Cardano.Wallet
     ( ErrConstructTx (..)
+    , ErrDecodeTx (..)
     )
 import Cardano.Wallet.Primitive.Types.Tx
     ( TxMetadata (..)
@@ -66,6 +67,7 @@ import Data.Bifunctor
     )
 import Data.ByteArray.Encoding
     ( Base (..)
+    , convertFromBase
     , convertToBase
     )
 import Data.ByteString
@@ -392,3 +394,100 @@ toMetadataEncrypted pwd payload saltM =
     updateTxMetadata v = TxMetadata (Map.insert cip20MetadataKey v themap)
       where
         TxMetadata themap = payload ^. #txMetadataWithSchema_metadata
+
+-- When decryption is enabled we do the following:
+-- (a) retrieve list of TxMetaBytes under proper key, ie.674,
+--     cip20MetadataKey
+-- (b) recreate each encrypted payload from chunks
+--     (0, TxMetaBytes chunk1)
+--     (1, TxMetaBytes chunk2)
+--     ....
+--     (N, TxMetaBytes chunkN)
+--     ie., payload=chunk1+chunk2+...+chunkN
+-- (c) decrypt each payload
+-- (d) update structure
+-- (e) decode metadata
+fromMetadataEncrypted
+    :: ByteString
+    -> TxMetadata
+    -> Either ErrDecodeTx TxMetadata
+fromMetadataEncrypted pwd metadata =
+   composePayload metadata >>=
+   mapM decrypt >>=
+   adjust metadata
+  where
+    checkPresenceOfMethod value =
+        let presentPair (TxMetaText k, TxMetaText v) =
+                k == cip83EncryptMethodKey && v == cip83EncryptPayloadValue
+            presentPair _ = False
+        in case value of
+            TxMetaMap list -> not (any presentPair list)
+            _ -> True
+    getEncryptedPayload value =
+        let presentPair (TxMetaText k, TxMetaList _) =
+                k == cip83EncryptPayloadKey
+            presentPair _ = False
+        in case value of
+            TxMetaMap list -> snd <$> filter presentPair list
+            _ -> []
+    extractTxt (TxMetaText txt) = txt
+    extractTxt _ =
+        error "TxMetaText is expected"
+    extractPayload (TxMetaList chunks)=
+        foldl T.append T.empty $ extractTxt <$> chunks
+    extractPayload _ = T.empty
+    composePayload (TxMetadata themap) = do
+        validValue <- case Map.lookup cip20MetadataKey themap of
+            Nothing -> Left ErrDecodeTxMissingMetadataKey
+            Just v -> pure v
+        when (checkPresenceOfMethod validValue) $
+            Left ErrDecodeTxMissingEncryptionMethod
+        let payloads = getEncryptedPayload validValue
+        if null payloads then
+            Left ErrDecodeTxMissingValidEncryptionPayload
+        else do
+            let extracted = extractPayload <$> payloads
+            when (T.empty `elem` extracted) $
+                Left ErrDecodeTxMissingValidEncryptionPayload
+            Right extracted
+
+    decodeFromJSON = ---use metadataValueFromJsonNoSchema when available from cardano-api
+        first (ErrDecodeTxDecryptedPayload . T.pack) .
+        Aeson.eitherDecode . BL.fromStrict
+    decrypt payload = case convertFromBase Base64 (T.encodeUtf8 payload) of
+        Right payloadBS ->
+            case AES256CBC.getSaltFromEncrypted payloadBS of
+                     Nothing -> Left ErrDecodeTxMissingSalt
+                     Just salt -> do
+                         let (secretKey, iv) =
+                                 PBKDF2.generateKey metadataPBKDF2Config pwd (Just salt)
+                         decrypted <- bimap ErrDecodeTxDecryptPayload fst
+                             (AES256CBC.decrypt WithPadding secretKey iv payloadBS)
+                         decodeFromJSON decrypted
+        Left _ ->
+            Left ErrDecodeTxEncryptedPayloadWrongBase
+
+    adjust (TxMetadata metadata') decodedElems =
+        pure $ TxMetadata $
+        Map.adjust updateMetaMap cip20MetadataKey metadata'
+      where
+        updateElem acc@(decryptedList, list) elem' = case elem' of
+            (TxMetaText k, TxMetaText v) ->
+                if k == cip83EncryptMethodKey && v == cip83EncryptPayloadValue then
+                    -- omiting this element
+                    acc
+                else
+                    (decryptedList, list ++ [elem'])
+            (TxMetaText k, v) -> case decryptedList of
+                toAdd : rest ->
+                    if k == cip83EncryptPayloadKey then
+                        (rest, list ++ [(TxMetaText k, toAdd)] )
+                    else
+                        (decryptedList, list ++ [(TxMetaText k, v)] )
+                _ -> error "we have checked already in composePayload that there is enough elements in decrypedList"
+            _ -> error "we have checked already in composePayload that there is pair (TxMetaText, something)"
+
+        updateMetaMap v = case v of
+            TxMetaMap list ->
+                TxMetaMap $ snd $ L.foldl updateElem (decodedElems,[]) list
+            _ -> error "we have checked already in composePayload that there is TxMetaMap"