Improve Value and ValueNestedRep generators and fix the round-trip test

Add a canonicalise function for ValueNestedRep which should be the
equivalent of converting from ValueNestedRep to Value and back.

This also required adjusting the ValueNestedBundle sort order to match
the AssetId order.

cardano-api/src/Cardano/Api/Value.hs

@@ -257,8 +257,8 @@ newtype ValueNestedRep = ValueNestedRep [ValueNestedBundle]
 -- | A bundle within a 'ValueNestedRep' for a single 'PolicyId', or for the
 -- special case of ada.
 --
-data ValueNestedBundle = ValueNestedBundle PolicyId (Map AssetName Quantity)
-                       | ValueNestedBundleAda Quantity
+data ValueNestedBundle = ValueNestedBundleAda Quantity
+                       | ValueNestedBundle PolicyId (Map AssetName Quantity)
   deriving (Eq, Ord, Show)
 
 

cardano-api/test/Test/Cardano/Api/Typed/Gen.hs

@@ -30,6 +30,7 @@ import           Cardano.Api.Typed
 import           Cardano.Prelude
 
 import           Control.Monad.Fail (fail)
+import qualified Data.Map.Strict as Map
 
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash as Crypto
@@ -162,23 +163,32 @@ genAssetId :: Gen AssetId
 genAssetId = Gen.choice [ AssetId <$> genPolicyId <*> genAssetName
                         , return AdaAssetId
                         ]
+
 genQuantity :: Gen Quantity
 genQuantity =
-  fromInteger <$> Gen.integral_ (Range.exponential 0 (toInteger (maxBound :: Int64)))
+  fromInteger <$> Gen.integral_ (Range.exponential (negate 2) 2)
 
 genValue :: Gen Value
-genValue =
-  valueFromList <$> Gen.list (Range.constant 0 10) ((,)
-                <$> genAssetId <*> genQuantity)
+genValue = do
+  aId <- genAssetId
+  qs <- Gen.list (Range.constant 0 5) genQuantity
+  let duplicates = zip (repeat aId) qs
+      dupValues = valueFromList duplicates
+
+  mixedValues <- valueFromList <$> Gen.list (Range.constant 0 10) ((,)
+                               <$> genAssetId <*> genQuantity)
+
+  Gen.choice [ return $ dupValues <> mixedValues
+             , return dupValues
+             , return mixedValues
+             ]
+
 
 -- We do not generate duplicate keys as 'ValueNestedRep' is created via
 -- flattening a 'Map'
 genValueNestedRep :: Gen ValueNestedRep
 genValueNestedRep =
-  Gen.choice
-    [ ValueNestedRep <$> Gen.list (Range.singleton 1) genValueNestedBundle
-    , ValueNestedRep <$> sequenceA [genValueNestedBundle, genValueNestedBundleAda]
-    ]
+  ValueNestedRep <$> Gen.list (Range.constant 0 5) genValueNestedBundle
 
 genValueNestedBundle :: Gen ValueNestedBundle
 genValueNestedBundle =
@@ -190,10 +200,26 @@ genValueNestedBundleAda :: Gen ValueNestedBundle
 genValueNestedBundleAda = ValueNestedBundleAda <$> genQuantity
 
 genValueNestedBundleNonAda :: Gen ValueNestedBundle
-genValueNestedBundleNonAda =
-  ValueNestedBundle
-    <$> genPolicyId
-    <*> Gen.map (Range.singleton 1) ((,) <$> genAssetName <*> genQuantity)
+genValueNestedBundleNonAda = do
+  pId <- genPolicyId
+  aName <- genAssetName
+  qs <- Gen.list (Range.constant 0 5) genQuantity
+  let duplicatesList = zip (repeat aName) qs
+      duplicates = Map.fromList duplicatesList
+      dupNestedBundles = ValueNestedBundle pId duplicates
+
+  mixed <- ValueNestedBundle
+             <$> genPolicyId
+             <*> Gen.map (Range.singleton 1) ((,) <$> genAssetName <*> genQuantity)
+
+  m <- Gen.list (Range.constant 0 5) ((,) <$> genAssetName <*> genQuantity)
+  let dupAndMixed = Map.fromList $ duplicatesList ++ m
+      dupAndMixedNestedBundles = ValueNestedBundle pId dupAndMixed
+
+  Gen.choice [ return dupNestedBundles
+             , return mixed
+             , return dupAndMixedNestedBundles
+             ]
 
 genAllRequiredSig :: Gen (MultiSigScript ShelleyEra)
 genAllRequiredSig =

cardano-api/test/Test/Cardano/Api/Typed/Value.hs

@@ -4,8 +4,11 @@ module Test.Cardano.Api.Typed.Value
   ( tests
   ) where
 
-import           Cardano.Prelude
+import           Prelude
+
+import           Data.List (sort, groupBy)
 import           Data.Aeson
+import qualified Data.Map.Strict as Map
 
 import           Cardano.Api.Typed
 
@@ -26,20 +29,47 @@ prop_roundtrip_Value_flatten_unflatten =
   property $ do v <- forAll genValue
                 valueFromNestedRep (valueToNestedRep v) === v
 
--- Note when going from ValueNestedRep -> Value (via fromValueNestedRep)
--- we merge maps, which combines all common keys. Therefore
--- we must generate an ValueNestedRep with no duplicate values.
--- Remember that Maps cannot have duplicate keys and therefore
--- we will never go from Value -> ValueNestedRep (via toValueNestedRep) to a
--- ValueNestedRep with duplicate values.
 prop_roundtrip_Value_unflatten_flatten :: Property
 prop_roundtrip_Value_unflatten_flatten =
     property $ do
       v <- forAll genValueNestedRep
-      let v' = valueToNestedRep (valueFromNestedRep v)
-      v `equiv` v'
+      canonicalise v === valueToNestedRep (valueFromNestedRep v)
+
+canonicalise :: ValueNestedRep -> ValueNestedRep
+canonicalise =
+    ValueNestedRep
+  . filter (not . isZeroOrEmpty)
+  . map filterZeros
+  . map (foldl1 mergeBundle)
+  . groupBy samePolicyId
+  . sort
+  . (\(ValueNestedRep bundles) -> bundles)
   where
-    equiv (ValueNestedRep a) (ValueNestedRep b) = sort a === sort b
+    samePolicyId ValueNestedBundleAda{}
+                 ValueNestedBundleAda{} = True
+    samePolicyId (ValueNestedBundle pid _)
+                 (ValueNestedBundle pid' _) = pid == pid'
+    samePolicyId _ _ = False
+
+    -- Merge together bundles that have already been grouped by same PolicyId:
+    mergeBundle (ValueNestedBundleAda q)
+                (ValueNestedBundleAda q') =
+      ValueNestedBundleAda (q <> q')
+
+    mergeBundle (ValueNestedBundle pid  as)
+                (ValueNestedBundle pid' as') | pid == pid' =
+      ValueNestedBundle pid (Map.unionWith (<>) as as')
+
+    mergeBundle _ _ = error "canonicalise.mergeBundle: impossible"
+
+    filterZeros b@ValueNestedBundleAda{} = b
+    filterZeros (ValueNestedBundle pid as) =
+      ValueNestedBundle pid (Map.filter (/=0) as)
+
+    isZeroOrEmpty (ValueNestedBundleAda q) = q == 0
+    isZeroOrEmpty (ValueNestedBundle _ as) = Map.null as
+
+
 
 -- -----------------------------------------------------------------------------