diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs index 24d16dcc8c7..7299941bf99 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs +++ b/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs @@ -42,6 +42,7 @@ import Cardano.Wallet , ErrConstructTx (..) , ErrCreateMigrationPlan (..) , ErrCreateRandomAddress (..) + , ErrDecodeTx (..) , ErrDerivePublicKey (..) , ErrFetchRewards (..) , ErrGetPolicyId (..) @@ -136,6 +137,10 @@ import Cardano.Wallet.Primitive.Ledger.Convert import Cardano.Wallet.Primitive.Slotting ( PastHorizonException ) +import Cardano.Wallet.Primitive.Types.MetadataEncryption + ( ErrMetadataDecryption (..) + , ErrMetadataEncryption (..) + ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (TokenBundle) ) @@ -478,12 +483,12 @@ instance IsServerError ErrConstructTx where , "Please delegate again (in that case, the wallet will automatically vote to abstain), " , "or make a vote transaction before the withdrawal transaction." ] - ErrConstructTxIncorrectRawMetadata -> + ErrConstructTxFromMetadataEncryption ErrIncorrectRawMetadata -> apiError err403 InvalidMetadataEncryption $ mconcat [ "It looks like the metadata does not " , "have `msg` field that is supposed to be encrypted." ] - ErrConstructTxEncryptMetadata cryptoError -> + ErrConstructTxFromMetadataEncryption (ErrCannotEncryptMetadata cryptoError) -> apiError err403 InvalidMetadataEncryption $ mconcat [ "It looks like the metadata cannot be encrypted. " , "The exact error is: " @@ -493,6 +498,46 @@ instance IsServerError ErrConstructTx where apiError err501 NotImplemented "This feature is not yet implemented." +instance IsServerError ErrDecodeTx where + toServerError = \case + ErrDecodeTxFromMetadataDecryption ErrMissingMetadataKey -> + apiError err403 InvalidMetadataDecryption $ mconcat + [ "It looks like the encrypted metadata has wrong structure. " + , "It is expected to be a map with key '674' - see CIP20." + ] + ErrDecodeTxFromMetadataDecryption ErrMissingEncryptionMethod -> + apiError err403 InvalidMetadataDecryption $ mconcat + [ "It looks like the encrypted metadata has wrong structure. " + , "It is expected to have encryption method under 'enc' key - see CIP83." + ] + ErrDecodeTxFromMetadataDecryption ErrMissingValidEncryptionPayload -> + apiError err403 InvalidMetadataDecryption $ mconcat + [ "It looks like the encrypted metadata has wrong structure. " + , "It is expected to have encryption payload under 'msg' key - see CIP83." + ] + ErrDecodeTxFromMetadataDecryption (ErrCannotAesonDecodePayload err) -> + apiError err403 InvalidMetadataDecryption $ mconcat + [ "It looks like the decrypted metadata cannot be decoded. " + , "The exact error is: " + , err + ] + ErrDecodeTxFromMetadataDecryption ErrMissingSalt -> + apiError err403 InvalidMetadataDecryption $ mconcat + [ "It looks like the decrypted metadata can be decoded, but " + , "misses salt." + ] + ErrDecodeTxFromMetadataDecryption (ErrCannotDecryptPayload cryptoError) -> + apiError err403 InvalidMetadataDecryption $ mconcat + [ "It looks like the encrypted metadata cannot be decrypted. " + , "The exact error is: " + , T.pack (show cryptoError) + ] + ErrDecodeTxFromMetadataDecryption ErrEncryptedPayloadWrongBase -> + apiError err403 InvalidMetadataDecryption $ mconcat + [ "It looks like the encrypted metadata is not represented as a list of Base64 " + , "- see CIP83." + ] + instance IsServerError ErrGetPolicyId where toServerError = \case ErrGetPolicyIdReadPolicyPubliKey e -> toServerError e diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs index 542055d8203..858ce090394 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -121,8 +121,6 @@ module Cardano.Wallet.Api.Http.Shelley.Server , rndStateChange , withWorkerCtx , getCurrentEpoch - , toMetadataEncrypted - , metadataPBKDF2Config -- * Workers , manageRewardBalance @@ -154,8 +152,6 @@ import Cardano.Address.Script import Cardano.Api ( NetworkId , SerialiseAsCBOR (..) - , TxMetadata (TxMetadata) - , TxMetadataValue (TxMetaList, TxMetaMap, TxMetaText) , toNetworkMagic , unNetworkMagic ) @@ -181,6 +177,7 @@ import Cardano.Wallet , ErrConstructSharedWallet (..) , ErrConstructTx (..) , ErrCreateMigrationPlan (..) + , ErrDecodeTx (..) , ErrGetPolicyId (..) , ErrNoSuchWallet (..) , ErrReadRewardAccount (..) @@ -359,7 +356,6 @@ import Cardano.Wallet.Api.Types , ApiDRepSpecifier (..) , ApiDecodeTransactionPostData (..) , ApiDecodedTransaction (..) - , ApiEncryptMetadata (..) , ApiExternalInput (..) , ApiFee (..) , ApiForeignStakeKey (..) @@ -611,6 +607,10 @@ import Cardano.Wallet.Primitive.Types.DRep import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) +import Cardano.Wallet.Primitive.Types.MetadataEncryption + ( fromMetadataEncrypted + , toMetadataEncrypted + ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle (..) ) @@ -721,26 +721,11 @@ import Control.Tracer ( Tracer , contramap ) -import Cryptography.Cipher.AES256CBC - ( CipherError - , CipherMode (..) - ) import Cryptography.Core ( genSalt ) -import Cryptography.Hash.Core - ( SHA256 (..) - ) -import Cryptography.KDF.PBKDF2 - ( PBKDF2Config (..) - ) import Data.Bifunctor - ( bimap - , first - ) -import Data.ByteArray.Encoding - ( Base (..) - , convertToBase + ( first ) import Data.ByteString ( ByteString @@ -822,7 +807,6 @@ import Data.Traversable ) import Data.Word ( Word32 - , Word64 ) import Fmt ( pretty @@ -919,19 +903,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 @@ -2607,12 +2586,16 @@ constructTransaction api knownPools poolStatus apiWalletId body = do metadata <- case (body ^. #encryptMetadata, body ^. #metadata) of (Just apiEncrypt, Just metadataWithSchema) -> do salt <- liftIO $ genSalt 8 - toMetadataEncrypted apiEncrypt metadataWithSchema (Just salt) + let pwd :: ByteString + pwd = BA.convert $ unPassphrase $ getApiT $ + apiEncrypt ^. #passphrase + meta = metadataWithSchema ^. #txMetadataWithSchema_metadata + toMetadataEncrypted pwd meta (Just salt) & \case Left err -> - liftHandler $ throwE err - Right meta -> - pure $ Just meta + liftHandler $ throwE $ ErrConstructTxFromMetadataEncryption err + Right meta' -> + pure $ Just meta' _ -> pure $ body ^? #metadata . traverse . #txMetadataWithSchema_metadata @@ -3004,115 +2987,6 @@ constructTransaction api knownPools poolStatus apiWalletId body = do . Map.toList . foldr (uncurry (Map.insertWith (<>))) Map.empty --- A key that identifies transaction metadata, defined in CIP-20 and used by --- CIP-83. --- --- See: --- https://github.com/cardano-foundation/CIPs/tree/master/CIP-0020 --- https://github.com/cardano-foundation/CIPs/tree/master/CIP-0083 --- -cip20MetadataKey :: Word64 -cip20MetadataKey = 674 - --- When encryption is enabled we do the following: --- (a) find field `msg` in the object of "674" label --- (b) encrypt the 'msg' value if present, if there is neither "674" label --- nor 'msg' value inside object of it emit error --- (c) update value of `msg` with the encrypted initial value(s) encoded in --- base64: --- [TxMetaText base64_1, TxMetaText base64_2, ..., TxMetaText base64_n] --- (d) add `enc` field with encryption method value 'basic' -toMetadataEncrypted - :: ApiEncryptMetadata - -> TxMetadataWithSchema - -> Maybe ByteString - -> Either ErrConstructTx TxMetadata -toMetadataEncrypted apiEncrypt payload saltM = - fmap updateTxMetadata . encryptMessage =<< extractMessage - where - pwd :: ByteString - pwd = BA.convert $ unPassphrase $ getApiT $ apiEncrypt ^. #passphrase - - secretKey, iv :: ByteString - (secretKey, iv) = PBKDF2.generateKey metadataPBKDF2Config pwd saltM - - -- `msg` is embedded at the first level - parseMessage :: TxMetadataValue -> Maybe [TxMetadataValue] - parseMessage = \case - TxMetaMap kvs -> - case mapMaybe getValue kvs of - [ ] -> Nothing - vs -> Just vs - _ -> - Nothing - where - getValue :: (TxMetadataValue, TxMetadataValue) -> Maybe TxMetadataValue - getValue (TxMetaText "msg", v) = Just v - getValue _ = Nothing - - validKeyAndMessage :: Word64 -> TxMetadataValue -> Bool - validKeyAndMessage k v = k == cip20MetadataKey && isJust (parseMessage v) - - extractMessage :: Either ErrConstructTx TxMetadataValue - extractMessage - | [v] <- F.toList filteredMap = - Right v - | otherwise = - Left ErrConstructTxIncorrectRawMetadata - where - TxMetadata themap = payload ^. #txMetadataWithSchema_metadata - filteredMap = Map.filterWithKey validKeyAndMessage themap - - encryptMessage :: TxMetadataValue -> Either ErrConstructTx TxMetadataValue - encryptMessage = \case - TxMetaMap pairs -> - TxMetaMap . reverse . L.nub . reverse . concat <$> - mapM encryptPairIfQualifies pairs - _ -> - error "encryptMessage should have TxMetaMap value" - where - encryptPairIfQualifies - :: (TxMetadataValue, TxMetadataValue) - -> Either ErrConstructTx [(TxMetadataValue, TxMetadataValue)] - encryptPairIfQualifies = \case - (TxMetaText "msg", m) -> - bimap ErrConstructTxEncryptMetadata toPair (encryptValue m) - pair -> - Right [pair] - - encryptValue :: TxMetadataValue -> Either CipherError ByteString - encryptValue - = AES256CBC.encrypt WithPadding secretKey iv saltM - . BL.toStrict - . Aeson.encode - . Cardano.metadataValueToJsonNoSchema - - toPair :: ByteString -> [(TxMetadataValue, TxMetadataValue)] - toPair encryptedMessage = - [ (TxMetaText "msg", TxMetaList (toChunks encryptedMessage)) - , (TxMetaText "enc", TxMetaText "basic") - ] - - toChunks :: ByteString -> [TxMetadataValue] - toChunks - = fmap TxMetaText - . T.chunksOf 64 - . T.decodeUtf8 - . convertToBase Base64 - - updateTxMetadata :: TxMetadataValue -> W.TxMetadata - updateTxMetadata v = TxMetadata (Map.insert cip20MetadataKey v themap) - where - TxMetadata themap = payload ^. #txMetadataWithSchema_metadata - -metadataPBKDF2Config :: PBKDF2Config SHA256 -metadataPBKDF2Config = PBKDF2Config - { hash = SHA256 - , iterations = 10000 - , keyLength = 32 - , ivLength = 16 - } - toUsignedTxWdrl :: c -> ApiWithdrawalGeneral n -> Maybe (RewardAccount, Coin, c) toUsignedTxWdrl p = \case @@ -3558,13 +3432,12 @@ decodeTransaction decodeTransaction ctx@ApiLayer{..} (ApiT wid) postData = do let ApiDecodeTransactionPostData (ApiT sealed) decryptMetadata = postData - when (isJust decryptMetadata) $ error "not implemented" era <- liftIO $ NW.currentNodeEra netLayer withWorkerCtx ctx wid liftE liftE $ \wrk -> do (k, _) <- liftHandler $ W.readPolicyPublicKey wrk let keyhash = KeyHash Policy (xpubToBytes k) - let TxExtended{..} = decodeTx tl era sealed - let Tx { txId + TxExtended{..} = decodeTx tl era sealed + Tx { txId , fee , resolvedInputs , resolvedCollateralInputs @@ -3573,7 +3446,17 @@ decodeTransaction , metadata , scriptValidity } = walletTx - let db = wrk ^. dbLayer + db = wrk ^. dbLayer + metadata' <- case (decryptMetadata, metadata) of + (Just apiDecrypt, Just meta) -> do + let pwd = BA.convert $ unPassphrase $ + getApiT $ apiDecrypt ^. #passphrase + case fromMetadataEncrypted pwd meta of + Left err -> + liftHandler $ throwE $ ErrDecodeTxFromMetadataDecryption err + Right txmetadata -> + pure . Just . ApiT $ txmetadata + _ -> pure $ ApiT <$> metadata (acct, _, acctPath) <- liftHandler $ W.shelleyOnlyReadRewardAccount @s db inputPaths <- @@ -3606,7 +3489,7 @@ decodeTransaction , depositsReturned = (ApiAmount.fromCoin . W.stakeKeyDeposit $ pp) <$ filter ourRewardAccountDeregistration certs - , metadata = ApiTxMetadata $ ApiT <$> metadata + , metadata = ApiTxMetadata metadata' , scriptValidity = ApiT <$> scriptValidity , validityInterval = ApiValidityIntervalExplicit <$> validity , witnessCount = mkApiWitnessCount $ witnessCount diff --git a/lib/api/src/Cardano/Wallet/Api/Types/Error.hs b/lib/api/src/Cardano/Wallet/Api/Types/Error.hs index f3d9514fe28..c9d9a311fdc 100644 --- a/lib/api/src/Cardano/Wallet/Api/Types/Error.hs +++ b/lib/api/src/Cardano/Wallet/Api/Types/Error.hs @@ -171,6 +171,7 @@ data ApiErrorInfo | InputsDepleted | InsufficientCollateral | InvalidCoinSelection + | InvalidMetadataDecryption | InvalidMetadataEncryption | InvalidValidityBounds | InvalidWalletType diff --git a/lib/api/src/Cardano/Wallet/Api/Types/SchemaMetadata.hs b/lib/api/src/Cardano/Wallet/Api/Types/SchemaMetadata.hs index 99ea85b0e46..b26caddf5ba 100644 --- a/lib/api/src/Cardano/Wallet/Api/Types/SchemaMetadata.hs +++ b/lib/api/src/Cardano/Wallet/Api/Types/SchemaMetadata.hs @@ -8,6 +8,8 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE StrictData #-} +{-# OPTIONS_GHC -Wno-orphans #-} + -- | -- Copyright: © 2018-2022 IOHK, 2023 Cardano Foundation -- License: Apache-2.0 @@ -25,7 +27,7 @@ import Cardano.Api.Error ( displayError ) import Cardano.Wallet.Primitive.Types.Tx - ( TxMetadata + ( TxMetadata (..) ) import Control.Applicative ( (<|>) @@ -40,6 +42,7 @@ import Data.Aeson import GHC.Generics ( Generic ) + import Prelude -- | A tag to select the json codec diff --git a/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs b/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs index 315d3deffa1..6134e95dfc5 100644 --- a/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs +++ b/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs @@ -70,9 +70,6 @@ import Cardano.Wallet.Address.Keys.WalletKey import Cardano.Wallet.Api.Hex ( fromHexText ) -import Cardano.Wallet.Api.Http.Shelley.Server - ( metadataPBKDF2Config - ) import Cardano.Wallet.Api.Types ( AddressAmount (..) , ApiAddressWithPath (..) @@ -173,6 +170,10 @@ import Cardano.Wallet.Primitive.Types.DRep import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) +import Cardano.Wallet.Primitive.Types.MetadataEncryption + ( metadataPBKDF2Config + , toMetadataEncrypted + ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount (..) ) @@ -569,10 +570,10 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do ] decodeErrorInfo rTx `shouldBe` InvalidMetadataEncryption - it "TRANS_NEW_CREATE_02c - \ + it "TRANS_NEW_CREATE_02d - \ \Correct metadata structure to be encrypted - short" $ \ctx -> runResourceT $ do - let toBeEncrypted = TxMetaText "world" + let toBeEncrypted = TxMetaList [TxMetaText "world"] let metadataRaw = TxMetadata $ Map.fromList [ (0, TxMetaText "hello") @@ -581,7 +582,7 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do ] checkMetadataEncryption ctx toBeEncrypted metadataRaw - it "TRANS_NEW_CREATE_02c - \ + it "TRANS_NEW_CREATE_02e - \ \Correct metadata structure to be encrypted - long" $ \ctx -> runResourceT $ do let toBeEncrypted = @@ -599,7 +600,7 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do ] checkMetadataEncryption ctx toBeEncrypted metadataRaw - it "TRANS_NEW_CREATE_02d - \ + it "TRANS_NEW_CREATE_02f - \ \Encrypt multiple metadata messages" $ \ctx -> runResourceT $ do wa <- fixtureWallet ctx @@ -5534,6 +5535,29 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do , expectResponseCode HTTP.status202 ] + let decodePayloadEncrypted = Json (toJSON signedTx) + let (Right expMetadataEncrypted) = + ApiT <$> toMetadataEncrypted pwd metadataRaw (Just salt) + rDecodedTxEncrypted <- request @(ApiDecodedTransaction n) ctx + (Link.decodeTransaction @'Shelley wa) Default decodePayloadEncrypted + verify rDecodedTxEncrypted + [ expectResponseCode HTTP.status202 + , expectField #metadata + (`shouldBe` (ApiTxMetadata (Just expMetadataEncrypted))) + ] + + let decodePayloadDecrypted = Json [json|{ + "decrypt_metadata": #{toJSON encryptMetadata}, + "transaction": #{serialisedTxSealed signedTx} + }|] + rDecodedTxDecrypted <- request @(ApiDecodedTransaction n) ctx + (Link.decodeTransaction @'Shelley wa) Default decodePayloadDecrypted + verify rDecodedTxDecrypted + [ expectResponseCode HTTP.status202 + , expectField #metadata + (`shouldBe` (ApiTxMetadata (Just (ApiT metadataRaw)))) + ] + burnAssetsCheck :: MonadUnliftIO m => Context diff --git a/lib/primitive/cardano-wallet-primitive.cabal b/lib/primitive/cardano-wallet-primitive.cabal index 67d2f2cc3ad..3b1fef52822 100644 --- a/lib/primitive/cardano-wallet-primitive.cabal +++ b/lib/primitive/cardano-wallet-primitive.cabal @@ -40,13 +40,15 @@ library build-depends: , aeson , array + , attoparsec , base + , base16-bytestring , bech32 , bech32-th , binary , bytestring , cardano-addresses - , cardano-api + , cardano-api:{cardano-api, internal} , cardano-binary , cardano-crypto , cardano-crypto-class @@ -112,6 +114,7 @@ library , unliftio , unliftio-core , unordered-containers + , vector exposed-modules: Cardano.Wallet.Orphans @@ -165,6 +168,7 @@ library Cardano.Wallet.Primitive.Types.FeePolicy Cardano.Wallet.Primitive.Types.GenesisParameters Cardano.Wallet.Primitive.Types.Hash + Cardano.Wallet.Primitive.Types.MetadataEncryption Cardano.Wallet.Primitive.Types.NetworkParameters Cardano.Wallet.Primitive.Types.Pool Cardano.Wallet.Primitive.Types.ProtocolMagic @@ -238,8 +242,10 @@ test-suite test , cardano-wallet-primitive:cardano-wallet-primitive , cardano-wallet-test-utils , containers + , crypto-primitives , deepseq , delta-types + , either , filepath , fmt , generic-arbitrary @@ -248,6 +254,7 @@ test-suite test , hspec-core , iohk-monitoring , lens + , memory , ouroboros-consensus , ouroboros-consensus-cardano , ouroboros-network-api @@ -276,6 +283,7 @@ test-suite test Cardano.Wallet.Primitive.Types.BlockSummarySpec Cardano.Wallet.Primitive.Types.CoinSpec Cardano.Wallet.Primitive.Types.HashSpec + Cardano.Wallet.Primitive.Types.MetadataEncryptionSpec Cardano.Wallet.Primitive.Types.PoolSpec Cardano.Wallet.Primitive.Types.RangeSpec Cardano.Wallet.Primitive.Types.TokenBundleSpec diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/MetadataEncryption.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/MetadataEncryption.hs new file mode 100644 index 00000000000..0189cbe872e --- /dev/null +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/MetadataEncryption.hs @@ -0,0 +1,442 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Cardano.Wallet.Primitive.Types.MetadataEncryption + ( metadataPBKDF2Config + , cip20MetadataKey + , cip83EncryptMethodKey + , cip83EncryptPayloadKey + , cip83EncryptPayloadValue + + , ErrMetadataDecryption (..) + , fromMetadataEncrypted + + , ErrMetadataEncryption (..) + , toMetadataEncrypted + ) +where + +import Prelude + +import Cardano.Api + ( TxMetadata (..) + , TxMetadataJsonSchemaError (..) + , TxMetadataValue (..) + , metadataValueToJsonNoSchema + ) +import Cardano.Api.Error + ( displayError + ) +import Control.Applicative + ( (<|>) + ) +import Control.Monad + ( guard + , when + ) +import Cryptography.Cipher.AES256CBC + ( CipherError + , CipherMode (..) + ) +import Cryptography.Hash.Core + ( SHA256 (..) + ) +import Cryptography.KDF.PBKDF2 + ( PBKDF2Config (..) + ) +import Data.Aeson + ( FromJSON (parseJSON) + , ToJSON (toJSON) + ) +import Data.Bifunctor + ( bimap + , first + ) +import Data.ByteArray.Encoding + ( Base (..) + , convertFromBase + , convertToBase + ) +import Data.ByteString + ( ByteString + ) +import Data.Maybe + ( fromJust + , fromMaybe + , isJust + , isNothing + , mapMaybe + ) +import Data.Text + ( Text + ) +import Data.Word + ( Word64 + ) + +import qualified Cardano.Ledger.Binary as CBOR +import qualified Cardano.Ledger.Shelley.TxAuxData as Ledger +import qualified Codec.CBOR.Magic as CBOR +import qualified Cryptography.Cipher.AES256CBC as AES256CBC +import qualified Cryptography.KDF.PBKDF2 as PBKDF2 +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as Aeson +import qualified Data.Attoparsec.ByteString.Char8 as Atto +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as BL +import qualified Data.Foldable as F +import qualified Data.List as L +import qualified Data.Map.Strict as Map +import qualified Data.Scientific as Scientific +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Vector as V + +-- CIP references: +-- https://github.com/cardano-foundation/CIPs/tree/master/CIP-0020 +-- https://github.com/cardano-foundation/CIPs/tree/master/CIP-0083 + +-- Metadata encryption/decryption config use in accordance to +-- CIP-83. +metadataPBKDF2Config :: PBKDF2Config SHA256 +metadataPBKDF2Config = PBKDF2Config + { hash = SHA256 + , iterations = 10000 + , keyLength = 32 + , ivLength = 16 + } + +-- A key that identifies transaction metadata, defined in CIP-20 and used by +-- CIP-83. +cip20MetadataKey :: Word64 +cip20MetadataKey = 674 + +cip83EncryptMethodKey :: Text +cip83EncryptMethodKey = "enc" + +cip83EncryptPayloadKey :: Text +cip83EncryptPayloadKey = "msg" + +cip83EncryptPayloadValue :: Text +cip83EncryptPayloadValue = "basic" + +data ErrMetadataEncryption = + ErrIncorrectRawMetadata + | ErrCannotEncryptMetadata CipherError + deriving (Show, Eq) + +-- When encryption is enabled we do the following: +-- (a) find field `msg` in the object of "674" label +-- (b) encrypt the 'msg' value if present, if there is neither "674" label +-- nor 'msg' value inside object of it emit error +-- (c) update value of `msg` with the encrypted initial value(s) encoded in +-- base64: +-- [TxMetaText base64_1, TxMetaText base64_2, ..., TxMetaText base64_n] +-- (d) add `enc` field with encryption method value 'basic' +toMetadataEncrypted + :: ByteString + -> TxMetadata + -> Maybe ByteString + -> Either ErrMetadataEncryption TxMetadata +toMetadataEncrypted pwd payload saltM = + fmap updateTxMetadata . encryptMessage =<< extractMessage + where + secretKey, iv :: ByteString + (secretKey, iv) = PBKDF2.generateKey metadataPBKDF2Config pwd saltM + + -- `msg` is embedded at the first level with the exact following value structure + -- TxMetaList [TxMetaText txt1, ..., TxMetaText txtN] + parseMessage :: TxMetadataValue -> Maybe [TxMetadataValue] + parseMessage = \case + TxMetaMap kvs -> + case mapMaybe getValue kvs of + [ ] -> Nothing + vs -> Just vs + _ -> + Nothing + where + isText (TxMetaText _ ) = True + isText _ = False + + valueStructure (TxMetaList txts) = + all isText txts + valueStructure _ = False + + getValue :: (TxMetadataValue, TxMetadataValue) -> Maybe TxMetadataValue + getValue (TxMetaText k, v) = + if k == cip83EncryptPayloadKey && valueStructure v then + Just v + else + Nothing + getValue _ = Nothing + + validKeyAndMessage :: Word64 -> TxMetadataValue -> Bool + validKeyAndMessage k v = k == cip20MetadataKey && isJust (parseMessage v) + + extractMessage :: Either ErrMetadataEncryption TxMetadataValue + extractMessage + | [v] <- F.toList filteredMap = + Right v + | otherwise = + Left ErrIncorrectRawMetadata + where + TxMetadata themap = payload + filteredMap = Map.filterWithKey validKeyAndMessage themap + + encryptMessage :: TxMetadataValue -> Either ErrMetadataEncryption TxMetadataValue + encryptMessage = \case + TxMetaMap pairs -> + TxMetaMap . reverse . L.nub . reverse . concat <$> + mapM encryptPairIfQualifies pairs + _ -> + error "encryptMessage should have TxMetaMap value" + where + encryptPairIfQualifies + :: (TxMetadataValue, TxMetadataValue) + -> Either ErrMetadataEncryption [(TxMetadataValue, TxMetadataValue)] + encryptPairIfQualifies = \case + (TxMetaText "msg", m) -> do + bimap ErrCannotEncryptMetadata toPair (encryptValue m) + pair -> + Right [pair] + + encryptValue :: TxMetadataValue -> Either CipherError ByteString + encryptValue + = AES256CBC.encrypt WithPadding secretKey iv saltM + . BL.toStrict + . Aeson.encode + . metadataValueToJsonNoSchema + + toPair :: ByteString -> [(TxMetadataValue, TxMetadataValue)] + toPair encryptedMessage = + [ (TxMetaText cip83EncryptPayloadKey, TxMetaList (toChunks encryptedMessage)) + , (TxMetaText cip83EncryptMethodKey, TxMetaText cip83EncryptPayloadValue) + ] + + toChunks :: ByteString -> [TxMetadataValue] + toChunks + = fmap TxMetaText + . T.chunksOf 64 + . T.decodeUtf8 + . convertToBase Base64 + + updateTxMetadata :: TxMetadataValue -> TxMetadata + updateTxMetadata v = TxMetadata (Map.insert cip20MetadataKey v themap) + where + TxMetadata themap = payload + +data ErrMetadataDecryption = + ErrMissingMetadataKey + | ErrMissingEncryptionMethod + | ErrMissingValidEncryptionPayload + | ErrCannotAesonDecodePayload Text + | ErrMissingSalt + | ErrCannotDecryptPayload CipherError + | ErrEncryptedPayloadWrongBase + deriving (Show, Eq) + +-- When decryption is enabled we do the following: +-- (a) retrieve TxMetaMap under proper key, ie.674, +-- cip20MetadataKey +-- (b) check if there is ("enc", "basic") pair +-- (c) recreate each encrypted payload from chunks that are expected under proper key, ie.msg, +-- cip83EncryptPayloadKey. So +-- expect TxMetaList [TxMetaText chunk1, ..., TxMetaText chunkN] +-- and construct payload=chunk1+chunk2+...+chunkN +-- (d) decrypt payload and decode metadata +-- (e) update structure under msg key and remove ("enc", "basic") pair +fromMetadataEncrypted + :: ByteString + -> TxMetadata + -> Either ErrMetadataDecryption 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) = Just txt + extractTxt _ = Nothing + extractPayload (TxMetaList chunks)= + let extractedTxts = extractTxt <$> chunks + in if any isNothing extractedTxts then + T.empty + else + -- we are sure there is not Nothing in the extractedTxts + foldl T.append T.empty $ fromJust <$> extractedTxts + extractPayload _ = T.empty + composePayload (TxMetadata themap) = do + validValue <- case Map.lookup cip20MetadataKey themap of + Nothing -> Left ErrMissingMetadataKey + Just v -> pure v + when (checkPresenceOfMethod validValue) $ + Left ErrMissingEncryptionMethod + let payloads = getEncryptedPayload validValue + if null payloads then + Left ErrMissingValidEncryptionPayload + else do + let extracted = extractPayload <$> payloads + when (T.empty `elem` extracted) $ + Left ErrMissingValidEncryptionPayload + Right extracted + + decodeFromJSON = + first (ErrCannotAesonDecodePayload . T.pack) . + Aeson.eitherDecode . BL.fromStrict + decrypt payload = case convertFromBase Base64 (T.encodeUtf8 payload) of + Right payloadBS -> + case AES256CBC.getSaltFromEncrypted payloadBS of + Nothing -> Left ErrMissingSalt + Just salt -> do + let (secretKey, iv) = + PBKDF2.generateKey metadataPBKDF2Config pwd (Just salt) + decrypted <- bimap ErrCannotDecryptPayload fst + (AES256CBC.decrypt WithPadding secretKey iv payloadBS) + decodeFromJSON decrypted + Left _ -> + Left ErrEncryptedPayloadWrongBase + + 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" + +instance ToJSON TxMetadataValue where + toJSON = metadataValueToJsonNoSchema + +instance FromJSON TxMetadataValue where + parseJSON = either (fail . displayError) pure . metadataValueFromJsonNoSchema + +-- when cardano-api exports metadataValueFromJsonNoSchema the below could be removed (together with cabal dependencies) +metadataValueFromJsonNoSchema + :: Aeson.Value + -> Either TxMetadataJsonSchemaError TxMetadataValue +metadataValueFromJsonNoSchema = conv + where + conv :: Aeson.Value -> Either TxMetadataJsonSchemaError TxMetadataValue + conv Aeson.Null = Left TxMetadataJsonNullNotAllowed + conv Aeson.Bool{} = Left TxMetadataJsonBoolNotAllowed + + conv (Aeson.Number d) = + case Scientific.floatingOrInteger d :: Either Double Integer of + Left n -> Left (TxMetadataJsonNumberNotInteger n) + Right n -> Right (TxMetaNumber n) + + conv (Aeson.String s) + | Just s' <- T.stripPrefix bytesPrefix s + , let bs' = T.encodeUtf8 s' + , Right bs <- B16.decode bs' + , not (B8.any (\c -> c >= 'A' && c <= 'F') bs') + = Right (TxMetaBytes bs) + + conv (Aeson.String s) = Right (TxMetaText s) + + conv (Aeson.Array vs) = + fmap TxMetaList + . traverse conv + $ V.toList vs + + conv (Aeson.Object kvs) = + fmap + ( TxMetaMap + . sortCanonicalForCbor + ) + . traverse (\(k,v) -> (,) (convKey k) <$> conv v) + . fmap (first Aeson.toText) + $ Aeson.toList kvs + + convKey :: Text -> TxMetadataValue + convKey s = + fromMaybe (TxMetaText s) $ + parseAll ((fmap TxMetaNumber pSigned <* Atto.endOfInput) + <|> (fmap TxMetaBytes pBytes <* Atto.endOfInput)) s + +bytesPrefix :: Text +bytesPrefix = "0x" + +parseAll :: Atto.Parser a -> Text -> Maybe a +parseAll p = + either (const Nothing) Just + . Atto.parseOnly p + . T.encodeUtf8 + +pUnsigned :: Atto.Parser Integer +pUnsigned = do + bs <- Atto.takeWhile1 Atto.isDigit + -- no redundant leading 0s allowed, or we cannot round-trip properly + guard (not (BS.length bs > 1 && B8.head bs == '0')) + return $! BS.foldl' step 0 bs + where + step a w = a * 10 + fromIntegral (w - 48) + +pSigned :: Atto.Parser Integer +pSigned = Atto.signed pUnsigned + +pBytes :: Atto.Parser ByteString +pBytes = do + _ <- Atto.string "0x" + remaining <- Atto.takeByteString + when (B8.any hexUpper remaining) $ fail ("Unexpected uppercase hex characters in " <> show remaining) + case B16.decode remaining of + Right bs -> return bs + _ -> fail ("Expecting base16 encoded string, found: " <> show remaining) + where + hexUpper c = c >= 'A' && c <= 'F' + +sortCanonicalForCbor + :: [(TxMetadataValue, TxMetadataValue)] -> [(TxMetadataValue, TxMetadataValue)] +sortCanonicalForCbor = + map snd + . L.sortOn fst + . map (\e@(k, _) -> (CBOR.uintegerFromBytes $ serialiseKey k, e)) + where + serialiseKey = CBOR.serialize' CBOR.shelleyProtVer . toShelleyMetadatum + +toShelleyMetadatum :: TxMetadataValue -> Ledger.Metadatum +toShelleyMetadatum (TxMetaNumber x) = Ledger.I x +toShelleyMetadatum (TxMetaBytes x) = Ledger.B x +toShelleyMetadatum (TxMetaText x) = Ledger.S x +toShelleyMetadatum (TxMetaList xs) = + Ledger.List [ toShelleyMetadatum x | x <- xs ] +toShelleyMetadatum (TxMetaMap xs) = + Ledger.Map [ (toShelleyMetadatum k, + toShelleyMetadatum v) + | (k,v) <- xs ] diff --git a/lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/MetadataEncryptionSpec.hs b/lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/MetadataEncryptionSpec.hs new file mode 100644 index 00000000000..b7d56203bdd --- /dev/null +++ b/lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/MetadataEncryptionSpec.hs @@ -0,0 +1,511 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Cardano.Wallet.Primitive.Types.MetadataEncryptionSpec + ( spec + ) where + +import Prelude + +import Cardano.Wallet.Primitive.Types.MetadataEncryption + ( ErrMetadataDecryption (..) + , ErrMetadataEncryption (..) + , cip20MetadataKey + , cip83EncryptMethodKey + , cip83EncryptPayloadKey + , cip83EncryptPayloadValue + , fromMetadataEncrypted + , toMetadataEncrypted + ) +import Data.ByteArray.Encoding + ( Base (..) + , convertFromBase + ) +import Data.ByteString + ( ByteString + ) +import Data.Either + ( isLeft + ) +import Data.Either.Combinators + ( mapLeft + , rightToMaybe + ) +import Data.Function + ( (&) + ) +import Data.Text + ( Text + ) +import Test.Hspec + ( Expectation + , Spec + , describe + , it + , shouldBe + , shouldSatisfy + ) +import Test.QuickCheck + ( Arbitrary (..) + , Property + , UnicodeString (..) + , chooseInt + , property + , suchThat + , vectorOf + , (===) + ) + +import qualified Cardano.Api as Cardano +import qualified Data.ByteString as BS +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = do + describe "metadata encrypt/decrypt roundtrips" $ do + it "fromMetadataEncrypted . toMetadataEncrypted $ payload == payload" $ + prop_roundtrip + & property + + it "fromMetadataEncrypted fails for different passphrase" $ + prop_passphrase + & property + + it "the valid result of toMetadataEncrypted exhibits the expected characteristics" $ + prop_structure_after_enc + & property + + describe "toMetadataEncrypted openssl goldens" $ do + -- echo -n '["secret data"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -nosalt + -- Fm/+xoZBA24yp8Vz548NAg== + it "short msg - no salt" $ do + let schemaBefore = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [Cardano.TxMetaText "secret data"] + ) + ] + ) + ] + schemaAfter = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [Cardano.TxMetaText "Fm/+xoZBA24yp8Vz548NAg=="] + ) + , ( Cardano.TxMetaText "enc" + , Cardano.TxMetaText "basic" + ) + ] + ) + ] + toMetadataEncrypted "cardano" schemaBefore Nothing + `shouldBe` Right schemaAfter + fromMetadataEncrypted "cardano" schemaAfter + `shouldBe` Left ErrMissingSalt + + it "short msg - no salt wrong value structure" $ do + let schemaBefore = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaText "secret data" + ) + ] + ) + ] + toMetadataEncrypted "cardano" schemaBefore Nothing + `shouldBe` Left ErrIncorrectRawMetadata + + -- $ echo -n '["secret data that is long enough to produce more than 64 bytes"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -nosalt + -- +8ruwpQolMU4wznBR5LYQEyke/SlJ7mkU+1LEXs2vSC8gegvjWESqnWK1Tw59cFt + -- CKO3g/d6fGA2jOU7JDYlC1qf+mdDKlGHbPKCV41Fofs= + it "long msg - no salt" $ do + let schemaBefore = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText + "secret data that is long enough to produce more \ + \than 64 bytes" ] + ) + ] + ) + ] + schemaAfter = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "+8ruwpQolMU4wznBR5LYQEyke/SlJ7mkU+1LEXs2vSC8gegvjWESqnWK1Tw59cFt" + , Cardano.TxMetaText "CKO3g/d6fGA2jOU7JDYlC1qf+mdDKlGHbPKCV41Fofs=" + ] + ) + , ( Cardano.TxMetaText "enc" + , Cardano.TxMetaText "basic" + ) + ] + ) + ] + toMetadataEncrypted "cardano" schemaBefore Nothing + `shouldBe` Right schemaAfter + fromMetadataEncrypted "cardano" schemaAfter + `shouldBe` Left ErrMissingSalt + + -- $ echo -n '["Invoice-No: 123456789","Order-No: 7654321","Email: john@doe.com"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -nosalt + -- IBcjjGQ7akr/CV2Zb0HtCvEPQNndZujCZ7iaFGMjOX3q3PJg5aRUvHgO3gPnDzYE + -- 7jFsGUK1bCdwsrn8kqI92NccbG8oAtPJUktZTTcO/bg= + it "cip msg - no salt" $ do + let schemaBefore = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "Invoice-No: 123456789" + , Cardano.TxMetaText "Order-No: 7654321" + , Cardano.TxMetaText "Email: john@doe.com" + ] + ) + ] + ) + ] + schemaAfter = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "IBcjjGQ7akr/CV2Zb0HtCvEPQNndZujCZ7iaFGMjOX3q3PJg5aRUvHgO3gPnDzYE" + , Cardano.TxMetaText "7jFsGUK1bCdwsrn8kqI92NccbG8oAtPJUktZTTcO/bg=" + ] + ) + , ( Cardano.TxMetaText "enc" + , Cardano.TxMetaText "basic" + ) + ] + ) + ] + toMetadataEncrypted "cardano" schemaBefore Nothing + `shouldBe` Right schemaAfter + fromMetadataEncrypted "cardano" schemaAfter + `shouldBe` Left ErrMissingSalt + + -- $ echo -n '["secret data"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -S 3030303030303030 + -- U2FsdGVkX18wMDAwMDAwMKg9+BnuLSqx880pgF+owzo= + it "short msg - salted" $ do + let schemaBefore = + Cardano.TxMetadata $ Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "secret data" ] + ) + ] + ) + ] + schemaAfter = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "U2FsdGVkX18wMDAwMDAwMKg9+BnuLSqx880pgF+owzo=" ] + ) + , ( Cardano.TxMetaText "enc" + , Cardano.TxMetaText "basic" + ) + ] + ) + ] + saltM = fromHexToM "3030303030303030" + toMetadataEncrypted "cardano" schemaBefore saltM + `shouldBe` Right schemaAfter + fromMetadataEncrypted "cardano" schemaAfter + `shouldBe` Right schemaBefore + + -- $ echo -n '["secret data that is long enough to produce more than 64 bytes"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -S 3030303030303030 + -- U2FsdGVkX18wMDAwMDAwMK3WTtGcfCw96FEEQJct+JQfvpq824MACKzRPNqul83i + -- Jxd3aOenCM/IBadPmEcDVPyg+f/tszUp0KO8uzRxKTnY1bO4rqEKEQfu1GkAz7wF + it "long msg - salted" $ do + let schemaBefore = + Cardano.TxMetadata $ Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "secret data that is long enough to produce more than 64 bytes" ] + ) + ] + ) + ] + schemaAfter = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "U2FsdGVkX18wMDAwMDAwMK3WTtGcfCw96FEEQJct+JQfvpq824MACKzRPNqul83i" + , Cardano.TxMetaText "Jxd3aOenCM/IBadPmEcDVPyg+f/tszUp0KO8uzRxKTnY1bO4rqEKEQfu1GkAz7wF" + ] + ) + , ( Cardano.TxMetaText "enc" + , Cardano.TxMetaText "basic" + ) + ] + ) + ] + saltM = fromHexToM "3030303030303030" + toMetadataEncrypted "cardano" schemaBefore saltM + `shouldBe` Right schemaAfter + fromMetadataEncrypted "cardano" schemaAfter + `shouldBe` Right schemaBefore + + -- $ $ echo -n '["Invoice-No: 123456789","Order-No: 7654321","Email: john@doe.com"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -S 3030303030303030 + -- U2FsdGVkX18wMDAwMDAwMFlOS4b0tXrZA7U5aQaHeI/sP74h84EPEjGv0wl4D8Do + -- +SIXXn04a9xkoFHk4ZH281nIfH5lpClsO16p2vRpSsdBDFO78aTPX3bsHsRE0L2A + it "cip msg - salted" $ do + let schemaBefore = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "Invoice-No: 123456789" + , Cardano.TxMetaText "Order-No: 7654321" + , Cardano.TxMetaText "Email: john@doe.com" + ] + ) + ] + ) + ] + schemaAfter = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "U2FsdGVkX18wMDAwMDAwMFlOS4b0tXrZA7U5aQaHeI/sP74h84EPEjGv0wl4D8Do" + , Cardano.TxMetaText "+SIXXn04a9xkoFHk4ZH281nIfH5lpClsO16p2vRpSsdBDFO78aTPX3bsHsRE0L2A" + ] + ) + , ( Cardano.TxMetaText "enc" + , Cardano.TxMetaText "basic" + ) + ] + ) + ] + saltM = fromHexToM "3030303030303030" + toMetadataEncrypted "cardano" schemaBefore saltM + `shouldBe` Right schemaAfter + fromMetadataEncrypted "cardano" schemaAfter + `shouldBe` Right schemaBefore + + it "msg wrong label - no salt" $ do + let schemaBefore = + Cardano.TxMetadata $ Map.fromList + [ ( 675 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "Invoice-No: 123456789" + , Cardano.TxMetaText "Order-No: 7654321" + , Cardano.TxMetaText "Email: john@doe.com" + ] + ) + ] + ) + ] + toMetadataEncrypted "cardano" schemaBefore Nothing + `shouldBe` Left ErrIncorrectRawMetadata + + it "msg without 'msg field' - no salt" $ do + let schemaBefore = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msgs" + , Cardano.TxMetaList + [ Cardano.TxMetaText "Invoice-No: 123456789" + , Cardano.TxMetaText "Order-No: 7654321" + , Cardano.TxMetaText "Email: john@doe.com" + ] + ) + ] + ) + ] + toMetadataEncrypted "cardano" schemaBefore Nothing + `shouldBe` Left ErrIncorrectRawMetadata + + describe "fromMetadataEncrypted incorrect payload" $ do + it "expecting only TxMetaText in TxMetaList of 'msg'" $ do + let schemaAfter = + Cardano.TxMetadata $ + Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList + [ Cardano.TxMetaText "Fm/+xoZBA24yp8Vz548NAg==" + , Cardano.TxMetaNumber 123 + ] + ) + , ( Cardano.TxMetaText "enc" + , Cardano.TxMetaText "basic" + ) + ] + ) + ] + fromMetadataEncrypted "cardano" schemaAfter + `shouldBe` Left ErrMissingValidEncryptionPayload + +fromHexToM :: Text -> Maybe ByteString +fromHexToM = rightToMaybe . convertFromBase Base16 . T.encodeUtf8 + +data TestingSetup = TestingSetup + { payload :: Cardano.TxMetadata + , password :: ByteString + , passwordOther :: ByteString + , salt :: ByteString + } deriving (Eq, Show) + +newtype Msg = Msg {getMsg :: Text} + deriving (Eq, Show) + +instance Arbitrary Msg where + arbitrary = do + txt <- (T.pack . getUnicodeString <$> arbitrary) `suchThat` (not . T.null) + pure $ Msg txt + +instance Arbitrary TestingSetup where + arbitrary = do + msgNum <- chooseInt (1,10) + txts <- vectorOf msgNum (getMsg <$> arbitrary) + pwdLen1 <- chooseInt (5,10) + pwdLen2 <- chooseInt (5,10) + pwd1 <- BS.pack <$> vectorOf pwdLen1 arbitrary + pwd2 <- (BS.pack <$> vectorOf pwdLen2 arbitrary) `suchThat` (/= pwd1) + salt' <- BS.pack <$> vectorOf 8 arbitrary + let metadata toEncrypt = + Cardano.TxMetadata $ Map.fromList + [ ( 674 + , Cardano.TxMetaMap + [ ( Cardano.TxMetaText "field" + , Cardano.TxMetaNumber 123 + ) + , ( Cardano.TxMetaText "msg" + , Cardano.TxMetaList toEncrypt + ) + ] + ) + ] + pure $ TestingSetup + { payload = metadata $ Cardano.TxMetaText <$> txts + , password = pwd1 + , passwordOther = pwd2 + , salt = salt' + } + +prop_roundtrip :: TestingSetup -> Property +prop_roundtrip (TestingSetup payload' pwd' _ salt') = do + (mapLeft + (const ErrMissingValidEncryptionPayload) + (toMetadataEncrypted pwd' payload' (Just salt')) + >>= fromMetadataEncrypted pwd') + === Right payload' + +prop_passphrase :: TestingSetup -> Expectation +prop_passphrase (TestingSetup payload' pwd1 pwd2 salt') = do + (mapLeft + (const ErrMissingValidEncryptionPayload) + (toMetadataEncrypted pwd1 payload' (Just salt')) + >>= fromMetadataEncrypted pwd2) + `shouldSatisfy` isLeft + +prop_structure_after_enc :: TestingSetup -> Expectation +prop_structure_after_enc (TestingSetup payload' pwd' _ salt') = do + let hasMsgWithList (Cardano.TxMetaText k, Cardano.TxMetaList _) = + k == cip83EncryptPayloadKey + hasMsgWithList _ = False + hasEncPair (Cardano.TxMetaText k, Cardano.TxMetaText v) = + k == cip83EncryptMethodKey && v == cip83EncryptPayloadValue + hasEncPair _ = False + let hasCharacteristics (Cardano.TxMetadata themap) = + case Map.lookup cip20MetadataKey themap of + Just (Cardano.TxMetaMap kvs) -> + any hasMsgWithList kvs && any hasEncPair kvs + _ -> False + + (hasCharacteristics <$> toMetadataEncrypted pwd' payload' (Just salt')) + `shouldBe` Right True diff --git a/lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs index 87157420570..7eba242c605 100644 --- a/lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/unit/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -77,9 +77,6 @@ import Cardano.Pool.Types , PoolOwner (..) , StakePoolTicker (..) ) -import Cardano.Wallet - ( ErrConstructTx (..) - ) import Cardano.Wallet.Address.Derivation ( Depth (..) , DerivationIndex (..) @@ -112,9 +109,6 @@ import Cardano.Wallet.Address.Keys.WalletKey import Cardano.Wallet.Api ( Api ) -import Cardano.Wallet.Api.Http.Shelley.Server - ( toMetadataEncrypted - ) import Cardano.Wallet.Api.Types ( AccountPostData (..) , AddressAmount (..) @@ -519,9 +513,6 @@ import Data.Aeson.QQ import Data.Bifunctor ( Bifunctor (..) ) -import Data.ByteArray.Encoding - ( convertFromBase - ) import Data.ByteString ( ByteString ) @@ -535,7 +526,6 @@ import Data.Either ) import Data.Either.Combinators ( fromRight' - , rightToMaybe ) import Data.FileEmbed ( embedFile @@ -1221,345 +1211,6 @@ spec = do _ -> "" in counterexample errStr $ res == Success SchemaApiErrorInfo - describe "toMetadataEncrypted openssl goldens" $ do - -- $ echo -n '"secret data"' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -nosalt - -- vBSywXY+WGcrckHUCyjJcQ== - it "short msg - no salt" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaText "secret data" - ) - ] - ) - ] - schemaAfter = - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [Cardano.TxMetaText "vBSywXY+WGcrckHUCyjJcQ=="] - ) - , ( Cardano.TxMetaText "enc" - , Cardano.TxMetaText "basic" - ) - ] - ) - ] - toMetadataEncrypted apiEncrypt schemaBefore Nothing - `shouldBe` Right schemaAfter - - -- $ echo -n '"secret data that is long enough to produce more than 64 bytes"' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -nosalt - -- OLSOdRF+P56rW9gUopHcs0HHcdmPP5ujhSuB+r84VJgvsMOsqmIZx2etosnkyOc8 - -- ygjbu25gCdhJh7iEpAJVaA== - it "long msg - no salt" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaText - "secret data that is long enough to produce more \ - \than 64 bytes" - ) - ] - ) - ] - schemaAfter = - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "OLSOdRF+P56rW9gUopHcs0HHcdmPP5ujhSuB+r84VJgvsMOsqmIZx2etosnkyOc8" - , Cardano.TxMetaText "ygjbu25gCdhJh7iEpAJVaA==" - ] - ) - , ( Cardano.TxMetaText "enc" - , Cardano.TxMetaText "basic" - ) - ] - ) - ] - toMetadataEncrypted apiEncrypt schemaBefore Nothing - `shouldBe` Right schemaAfter - - -- $ echo -n '["Invoice-No: 123456789","Order-No: 7654321","Email: john@doe.com"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -nosalt - -- IBcjjGQ7akr/CV2Zb0HtCvEPQNndZujCZ7iaFGMjOX3q3PJg5aRUvHgO3gPnDzYE - -- 7jFsGUK1bCdwsrn8kqI92NccbG8oAtPJUktZTTcO/bg= - it "cip msg - no salt" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "Invoice-No: 123456789" - , Cardano.TxMetaText "Order-No: 7654321" - , Cardano.TxMetaText "Email: john@doe.com" - ] - ) - ] - ) - ] - schemaAfter = - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "IBcjjGQ7akr/CV2Zb0HtCvEPQNndZujCZ7iaFGMjOX3q3PJg5aRUvHgO3gPnDzYE" - , Cardano.TxMetaText "7jFsGUK1bCdwsrn8kqI92NccbG8oAtPJUktZTTcO/bg=" - ] - ) - , ( Cardano.TxMetaText "enc" - , Cardano.TxMetaText "basic" - ) - ] - ) - ] - toMetadataEncrypted apiEncrypt schemaBefore Nothing - `shouldBe` Right schemaAfter - - -- $ $ echo -n '"secret data"' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -S 3030303030303030 - -- U2FsdGVkX18wMDAwMDAwMF0ea/2sHeptB3SvZtgc600= - it "short msg - salted" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaText "secret data" - ) - ] - ) - ] - schemaAfter = - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "U2FsdGVkX18wMDAwMDAwMF0ea/2sHeptB3SvZtgc600=" - ] - ) - , ( Cardano.TxMetaText "enc" - , Cardano.TxMetaText "basic" - ) - ] - ) - ] - saltM = fromHexToM "3030303030303030" - toMetadataEncrypted apiEncrypt schemaBefore saltM - `shouldBe` Right schemaAfter - - -- $ echo -n '"secret data that is long enough to produce more than 64 bytes"' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -S 3030303030303030 - -- U2FsdGVkX18wMDAwMDAwMPNdhZQON/Hlwqvk4+sNRCa90QrAVpIGUlWgZhgNlwKh - -- PbR/qyT2q0tejHQmsHdORif5rvZYTzJGsTutA0RIcFU= - it "long msg - salted" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaText "secret data that is long enough to produce more than 64 bytes" - ) - ] - ) - ] - schemaAfter = - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "U2FsdGVkX18wMDAwMDAwMPNdhZQON/Hlwqvk4+sNRCa90QrAVpIGUlWgZhgNlwKh" - , Cardano.TxMetaText "PbR/qyT2q0tejHQmsHdORif5rvZYTzJGsTutA0RIcFU=" - ] - ) - , ( Cardano.TxMetaText "enc" - , Cardano.TxMetaText "basic" - ) - ] - ) - ] - saltM = fromHexToM "3030303030303030" - toMetadataEncrypted apiEncrypt schemaBefore saltM - `shouldBe` Right schemaAfter - - -- $ $ echo -n '["Invoice-No: 123456789","Order-No: 7654321","Email: john@doe.com"]' | openssl enc -e -aes-256-cbc -pbkdf2 -iter 10000 -a -k "cardano" -S 3030303030303030 - -- U2FsdGVkX18wMDAwMDAwMFlOS4b0tXrZA7U5aQaHeI/sP74h84EPEjGv0wl4D8Do - -- +SIXXn04a9xkoFHk4ZH281nIfH5lpClsO16p2vRpSsdBDFO78aTPX3bsHsRE0L2A - it "cip msg - salted" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "Invoice-No: 123456789" - , Cardano.TxMetaText "Order-No: 7654321" - , Cardano.TxMetaText "Email: john@doe.com" - ] - ) - ] - ) - ] - schemaAfter = - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "U2FsdGVkX18wMDAwMDAwMFlOS4b0tXrZA7U5aQaHeI/sP74h84EPEjGv0wl4D8Do" - , Cardano.TxMetaText "+SIXXn04a9xkoFHk4ZH281nIfH5lpClsO16p2vRpSsdBDFO78aTPX3bsHsRE0L2A" - ] - ) - , ( Cardano.TxMetaText "enc" - , Cardano.TxMetaText "basic" - ) - ] - ) - ] - saltM = fromHexToM "3030303030303030" - toMetadataEncrypted apiEncrypt schemaBefore saltM - `shouldBe` Right schemaAfter - - it "msg wrong label - no salt" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ Map.fromList - [ ( 675 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msg" - , Cardano.TxMetaList - [ Cardano.TxMetaText "Invoice-No: 123456789" - , Cardano.TxMetaText "Order-No: 7654321" - , Cardano.TxMetaText "Email: john@doe.com" - ] - ) - ] - ) - ] - toMetadataEncrypted apiEncrypt schemaBefore Nothing - `shouldBe` Left ErrConstructTxIncorrectRawMetadata - - it "msg without 'msg field' - no salt" $ do - let apiEncrypt = ApiEncryptMetadata - { passphrase = ApiT $ Passphrase "cardano" - , method = Nothing - } - schemaBefore = - TxMetadataWithSchema TxMetadataNoSchema $ - Cardano.TxMetadata $ - Map.fromList - [ ( 674 - , Cardano.TxMetaMap - [ ( Cardano.TxMetaText "field" - , Cardano.TxMetaNumber 123 - ) - , ( Cardano.TxMetaText "msgs" - , Cardano.TxMetaList - [ Cardano.TxMetaText "Invoice-No: 123456789" - , Cardano.TxMetaText "Order-No: 7654321" - , Cardano.TxMetaText "Email: john@doe.com" - ] - ) - ] - ) - ] - toMetadataEncrypted apiEncrypt schemaBefore Nothing - `shouldBe` Left ErrConstructTxIncorrectRawMetadata - -fromHexToM :: Text -> Maybe ByteString -fromHexToM = rightToMaybe . convertFromBase Base16 . T.encodeUtf8 - {------------------------------------------------------------------------------- Error type encoding -------------------------------------------------------------------------------} diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index 4d6c12810dc..e2b53219c1a 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -107,6 +107,7 @@ module Cardano.Wallet , ErrReadPolicyPublicKey (..) , ErrWritePolicyPublicKey (..) , ErrGetPolicyId (..) + , ErrDecodeTx (..) , readWalletMeta , isStakeKeyRegistered , putDelegationCertificate @@ -550,6 +551,10 @@ import Cardano.Wallet.Primitive.Types.DRep import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) +import Cardano.Wallet.Primitive.Types.MetadataEncryption + ( ErrMetadataDecryption + , ErrMetadataEncryption + ) import Cardano.Wallet.Primitive.Types.Range ( Range (..) ) @@ -858,7 +863,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as TxOut import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics import qualified Cardano.Wallet.Read as Read -import qualified Cryptography.Cipher.AES256CBC as AES256CBC import qualified Data.ByteArray as BA import qualified Data.Delta.Update as Delta import qualified Data.Foldable as F @@ -3754,8 +3758,7 @@ data ErrConstructTx | ErrConstructTxDelegationInvalid | ErrConstructTxVotingInWrongEra | ErrConstructTxWithdrawalWithoutVoting - | ErrConstructTxIncorrectRawMetadata - | ErrConstructTxEncryptMetadata AES256CBC.CipherError + | ErrConstructTxFromMetadataEncryption ErrMetadataEncryption | ErrConstructTxNotImplemented deriving (Show, Eq) @@ -3765,6 +3768,11 @@ data ErrGetPolicyId | ErrGetPolicyIdWrongMintingBurningTemplate deriving (Show, Eq) +-- | Errors that can occur when decoding a transaction. +newtype ErrDecodeTx + = ErrDecodeTxFromMetadataDecryption ErrMetadataDecryption + deriving (Show, Eq) + -- | Errors that can occur when signing a transaction. data ErrWitnessTx = ErrWitnessTxSignTx ErrSignTx diff --git a/specifications/api/metadata-encrypt.md b/specifications/api/metadata-encrypt.md index b2c28530b21..18056d54c9c 100644 --- a/specifications/api/metadata-encrypt.md +++ b/specifications/api/metadata-encrypt.md @@ -6,11 +6,19 @@ In addition "Transactions New > Decode" HTTP endpoint is described in the contex ## Metadata encryption Encryption of metadata is optional and when chosen the metadata in transaction is to be encrypted -via AEAD scheme using ChaCha20 and Poly1305 (see [RFC 7539][ref]). PBKDF2 password stretching is used to get a 32-byte symmetric key -that is required for the adopted encryption algorithm. In detail, PBKDF2 encryption uses HMAC with the hash algorithm SHA512. +via AES256CBC according to [CIP-0020][cip0020] and [CIP-0083][cip0083]. +A PKCS#7 padding of payload is used before encryption as the required +input length must be a multiple of block size, ie., 16 bytes. +PBKDF2 password stretching is used to get a 32-byte symmetric key +that is required for the adopted encryption algorithm. In detail, +PBKDF2 encryption uses HMAC with the hash algorithm SHA512. + As a consequence the encrypted metadata, not its raw version, is going to be stored in blockchain. - [ref]: https://datatracker.ietf.org/doc/html/rfc7539 +However, in line with [CIP-0020][cip0020] and [CIP-0083][cip0083], only the field `674` of the `metadata` field of the transaction will be affected. + + [cip0020]: https://github.com/cardano-foundation/CIPs/tree/master/CIP-0020 + [cip0083]: https://github.com/cardano-foundation/CIPs/tree/master/CIP-0083 The "Transactions New > Construct" HTTP endpoint allows the encryption of metadata. The "Transactions New > Decode" HTTP endpoint allows for decrypting of the encrypted metadata. @@ -19,9 +27,9 @@ Specifically: 1. Creation of a transaction output that contains a metadata with encryption enabled. - In the `encrypt_metadata` field, passphrase used in encryption is established. `metadata` field to be encrypted is required. +In the `encrypt_metadata` field, passphrase used in encryption is established. `metadata` field to be encrypted is required. - Example `POST` data for the endpoint, ie., /wallets/{walletId}/transactions-construct`: +Example `POST` data for the endpoint, ie., /wallets/{walletId}/transactions-construct`: ``` { @@ -29,46 +37,68 @@ Specifically: "encrypt_metadata": { "passphrase": "my secret encryption password" }, - "metadata": "raw metadata" + "metadata": + { "674" : { + "msg": "raw metadata ... " + } + } ... } ``` - As a result we get transaction with metadata encrypted: +As a result we get transaction with metadata encrypted: ``` { ... - "metadata": "metadata encrypted" + "metadata": + { "674": + { + "enc": "basic", + "msg": + [ + "base64-string 1", "base64-string 2", "base64-string 3" ... + ] + } + } ... } ``` - The same is the case for `GET` transaction. `encrypt_metadata` is an object as we might want to introduce - optional choice of encryption method in the future. In that case the new enhancement to api will be introduced in - nonintrusive way. +The same is the case for `GET` transaction. `encrypt_metadata` is an object as we might want to introduce +optional choice of encryption method in the future. In that case the new enhancement to api will be introduced in +non-intrusive way. - Metadata encryption can be used for shared wallet style when calling `/shared-wallets/{walletId}/transactions-construct` endpoint with the same `POST` payload. +Metadata encryption can be used for shared wallet style when calling `/shared-wallets/{walletId}/transactions-construct` endpoint with the same `POST` payload. - Example: +Example: ``` { ... "encrypt_metadata": { "passphrase": "metadata-secret" }, - "metadata": {"1":"hello"} + "metadata": + { "674" : { + "msg":"world" + } + } ... } ``` - will return +will return (for the example salt "yoDCYXKaVhA=") ``` { ... - "metadata": {"0":"0x0aa4f9a016215f71ef007b60601708dec0d10b4ade6071b387295f95b4"} + "metadata": + { "674" : { + "enc": "basic", + "msg": [ "U2FsdGVkX1/KgMJhcppWEG6t0aUcMqdEJmnSHVOCgpw=" ] + } + } ... } ``` - Example: +Example: ``` { ... @@ -76,27 +106,36 @@ Specifically: { "passphrase": "metadata-secret" }, "metadata": - { "1": "Hard times create strong men." - , "2": "Strong men create good times." - , "3": "Good times create weak men." - , "4": "And, weak men create hard times." + { "674" : { + "msg": + [ "Hard times create strong men." + , "Strong men create good times." + , "Good times create weak men." + , "And, weak men create hard times." + ] + } } ... } ``` - will return +will return (for the example salt "XG1cgIw56q8=") ``` { ... - "metadata": - { "0": "0x0aa4f9a016217f75f10834367493f6d7e74197417ca25c7615cae02bc345382906fb6990daf8f138b2d9192e057d0d0b555f9d5fb287abb1842928c90f26e597" - , "1": "0x559ee85f00f1588b3ee32e81dc4c84aee208a10c1eec97fffe6e0e66c69d4e0b1e3e22d7edc1618df3b20b484527d86bc3bebad4295a2ad888d034b5fec38077" - , "2": "0x8d42154f681230124c64630ea68b841aec22f0530ec830cb662d59ef423ef23d7ff3" - } + { "674" : { + "enc": "basic", + "msg": + [ "U2FsdGVkX19cbVyAjDnqr5eksQ9gnxJDz6dWhAaXvZGQl31HdEtTpBa91osBavdQ" + , "xvOJpGuA8vQGJUgn9RVuqFbVxpggHGCspU6Z5BV5j1LlSqnp6GfHFvrTL3sZcZMq" + , "MtOMZSx+d6nPRJL6453wC3rh0cny6SnrEUt9awwxx4PDZk7pDT85h3ygQf1I8fow" + , "tYtj3GY0cBwIHfkRLrsxbg==" + ] + } + } ... } ``` - as metadata values have 64-byte limit. In that case the encrypted metadata is encoded in the successive bytes. +as metadata values have 64-byte limit. In that case the encrypted metadata is encoded in the successive bytes. ## Metadata decryption @@ -112,13 +151,17 @@ Specifically: } ``` - As a result we get decoded transaction with metadata decrypted: +As a result we get decoded transaction with metadata decrypted: ``` { ... - "metadata": "raw metadata" + "metadata": + { "674" : { + "msg": "raw metadata ... " + } + } ... } ``` - Metadata decryption can be used for shared wallet style when calling `/shared-wallets/{walletId}/transactions-decode` endpoint with the same `POST` payload. +Metadata decryption can be used for shared wallet style when calling `/shared-wallets/{walletId}/transactions-decode` endpoint with the same `POST` payload. diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index d5d2df2383b..b6e6aaad64c 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -4766,6 +4766,19 @@ x-errInvalidMetadataEncryption: &errInvalidMetadataEncryption type: string enum: ['invalid_metadata_encryption'] +x-errInvalidMetadataDecryption: &errInvalidMetadataDecryption + <<: *responsesErr + title: invalid_metadata_decryption + properties: + message: + type: string + description: | + The supplied encrypted metadata object is not compatible with standard + specified by CIP-83 (https://cips.cardano.org/cip/CIP-83). + code: + type: string + enum: ['invalid_metadata_decryption'] + x-errInputsDepleted: &errInputsDepleted <<: *responsesErr title: inputs_depleted @@ -6241,6 +6254,13 @@ x-responsesDecodedTransaction: &responsesDecodedTransaction <<: *responsesErr404WalletNotInitialized <<: *responsesErr406 <<: *responsesErr415UnsupportedMediaType + 403: + description: Forbidden + content: + application/json: + schema: + oneOf: + - <<: *errInvalidMetadataDecryption 202: description: Accepted content: