Merge #2799

2799: Ensure the Ord for TxMetadataValue matches the ledger Ord instance r=Jimbo4350 a=dcoutts Fix the order so this is true. Check it with prop_ord_distributive_TxMetadata Co-authored-by: Duncan Coutts <duncan@well-typed.com>
IntersectMBO · Jun 8, 2021 · 1038002 · 1038002
2 parents b3cabae + 294bcd8
commit 1038002
Show file tree

Hide file tree

Showing 4 changed files with 38 additions and 25 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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