From 294bcd8fce3f2c7bfa865f0cf5796195cdbf0769 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Tue, 8 Jun 2021 01:47:40 +0100 Subject: [PATCH] Ensure the Ord for TxMetadataValue matches the ledger Ord instance Fix the order so this is true. Check it with prop_ord_distributive_TxMetadata --- cardano-api/src/Cardano/Api/Shelley.hs | 2 + cardano-api/src/Cardano/Api/TxMetadata.hs | 55 ++++++++++--------- cardano-api/test/Test/Cardano/Api/Metadata.hs | 1 + .../test/Test/Cardano/Api/Typed/Ord.hs | 5 ++ 4 files changed, 38 insertions(+), 25 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index aa4079fa779..77ffbf007b9 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -86,6 +86,8 @@ module Cardano.Api.Shelley -- | Embedding additional structured data within transactions. toShelleyMetadata, fromShelleyMetadata, + toShelleyMetadatum, + fromShelleyMetadatum, -- * Protocol parameters ProtocolParameters(..), diff --git a/cardano-api/src/Cardano/Api/TxMetadata.hs b/cardano-api/src/Cardano/Api/TxMetadata.hs index 3086bfc4402..7513fc2d23d 100644 --- a/cardano-api/src/Cardano/Api/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/TxMetadata.hs @@ -26,6 +26,8 @@ module Cardano.Api.TxMetadata ( -- * Internal conversion functions toShelleyMetadata, fromShelleyMetadata, + toShelleyMetadatum, + fromShelleyMetadatum, -- * Shared parsing utils parseAll, @@ -83,12 +85,15 @@ import Cardano.Api.SerialiseCBOR newtype TxMetadata = TxMetadata (Map Word64 TxMetadataValue) deriving (Eq, Show) -data TxMetadataValue = TxMetaNumber Integer -- -2^64 .. 2^64-1 +data TxMetadataValue = TxMetaMap [(TxMetadataValue, TxMetadataValue)] + | TxMetaList [TxMetadataValue] + | TxMetaNumber Integer -- -2^64 .. 2^64-1 | TxMetaBytes ByteString | TxMetaText Text - | TxMetaList [TxMetadataValue] - | TxMetaMap [(TxMetadataValue, TxMetadataValue)] deriving (Eq, Ord, Show) + -- Note the order of constructors is the same as the ledger definitions + -- so that the Ord instance is consistent with the ledger one. + -- This is checked by prop_ord_distributive_TxMetadata -- | Merge metadata maps. When there are clashing entries the left hand side -- takes precedence. @@ -131,31 +136,31 @@ makeTransactionMetadata = TxMetadata toShelleyMetadata :: Map Word64 TxMetadataValue -> Map Word64 Shelley.Metadatum toShelleyMetadata = Map.map toShelleyMetadatum - where - toShelleyMetadatum :: TxMetadataValue -> Shelley.Metadatum - toShelleyMetadatum (TxMetaNumber x) = Shelley.I x - toShelleyMetadatum (TxMetaBytes x) = Shelley.B x - toShelleyMetadatum (TxMetaText x) = Shelley.S x - toShelleyMetadatum (TxMetaList xs) = Shelley.List - [ toShelleyMetadatum x | x <- xs ] - toShelleyMetadatum (TxMetaMap xs) = Shelley.Map - [ (toShelleyMetadatum k, - toShelleyMetadatum v) - | (k,v) <- xs ] + +toShelleyMetadatum :: TxMetadataValue -> Shelley.Metadatum +toShelleyMetadatum (TxMetaNumber x) = Shelley.I x +toShelleyMetadatum (TxMetaBytes x) = Shelley.B x +toShelleyMetadatum (TxMetaText x) = Shelley.S x +toShelleyMetadatum (TxMetaList xs) = Shelley.List + [ toShelleyMetadatum x | x <- xs ] +toShelleyMetadatum (TxMetaMap xs) = Shelley.Map + [ (toShelleyMetadatum k, + toShelleyMetadatum v) + | (k,v) <- xs ] fromShelleyMetadata :: Map Word64 Shelley.Metadatum -> Map Word64 TxMetadataValue fromShelleyMetadata = Map.Lazy.map fromShelleyMetadatum - where - fromShelleyMetadatum :: Shelley.Metadatum -> TxMetadataValue - fromShelleyMetadatum (Shelley.I x) = TxMetaNumber x - fromShelleyMetadatum (Shelley.B x) = TxMetaBytes x - fromShelleyMetadatum (Shelley.S x) = TxMetaText x - fromShelleyMetadatum (Shelley.List xs) = TxMetaList - [ fromShelleyMetadatum x | x <- xs ] - fromShelleyMetadatum (Shelley.Map xs) = TxMetaMap - [ (fromShelleyMetadatum k, - fromShelleyMetadatum v) - | (k,v) <- xs ] + +fromShelleyMetadatum :: Shelley.Metadatum -> TxMetadataValue +fromShelleyMetadatum (Shelley.I x) = TxMetaNumber x +fromShelleyMetadatum (Shelley.B x) = TxMetaBytes x +fromShelleyMetadatum (Shelley.S x) = TxMetaText x +fromShelleyMetadatum (Shelley.List xs) = TxMetaList + [ fromShelleyMetadatum x | x <- xs ] +fromShelleyMetadatum (Shelley.Map xs) = TxMetaMap + [ (fromShelleyMetadatum k, + fromShelleyMetadatum v) + | (k,v) <- xs ] -- ---------------------------------------------------------------------------- diff --git a/cardano-api/test/Test/Cardano/Api/Metadata.hs b/cardano-api/test/Test/Cardano/Api/Metadata.hs index 0d35b92f748..7a2eb1e8e6a 100644 --- a/cardano-api/test/Test/Cardano/Api/Metadata.hs +++ b/cardano-api/test/Test/Cardano/Api/Metadata.hs @@ -3,6 +3,7 @@ module Test.Cardano.Api.Metadata ( tests , genTxMetadata + , genTxMetadataValue ) where import Cardano.Prelude diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs b/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs index 153f6c90c91..0b42ad3e349 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs @@ -15,6 +15,7 @@ import Test.Tasty (TestTree) import Test.Tasty.Hedgehog.Group (fromGroup) import Test.Cardano.Api.Typed.Gen +import Test.Cardano.Api.Metadata (genTxMetadataValue) {- HLINT ignore "Use camelCase" -} @@ -47,6 +48,10 @@ prop_ord_distributive_StakeAddress :: Property prop_ord_distributive_StakeAddress = ord_distributive genStakeAddress toShelleyStakeAddr +prop_ord_distributive_TxMetadata :: Property +prop_ord_distributive_TxMetadata = + ord_distributive genTxMetadataValue toShelleyMetadatum + prop_ord_distributive_ScriptData :: Property prop_ord_distributive_ScriptData = ord_distributive genScriptData toPlutusData