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

Mostly sample the PolicyId and AssetName from a smaller range of values
so that for things like Value we get more "interesting" values with
duplicate policy ids or asset names.

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

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Test.Cardano.Api.Typed.Gen
   ( genAddressByron
   , genAddressShelley
@@ -30,6 +32,7 @@ import           Cardano.Api.Typed
 import           Cardano.Prelude
 
 import           Control.Monad.Fail (fail)
+import           Data.String
 
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash as Crypto
@@ -153,47 +156,53 @@ genMultiSigScriptsMary =
     ]
 
 genAssetName :: Gen AssetName
-genAssetName = AssetName <$> Gen.utf8 (Range.constant 1 15) Gen.alphaNum
+genAssetName =
+  Gen.frequency
+    -- mostly from a small number of choices, so we get plenty of repetition
+    [ (9, Gen.element ["", "a", "b", "c"])
+    , (1, AssetName <$> Gen.utf8 (Range.singleton  32) Gen.alphaNum)
+    , (1, AssetName <$> Gen.utf8 (Range.constant 1 31) Gen.alphaNum)
+    ]
 
 genPolicyId :: Gen PolicyId
-genPolicyId = PolicyId <$> genScriptHash
+genPolicyId =
+  Gen.frequency
+      -- mostly from a small number of choices, so we get plenty of repetition
+    [ (9, Gen.element [ fromString (x : replicate 55 '0') | x <- ['a'..'c'] ])
+
+       -- and some from the full range of the type
+    , (1, PolicyId <$> genScriptHash)
+    ]
 
 genAssetId :: Gen AssetId
 genAssetId = Gen.choice [ AssetId <$> genPolicyId <*> genAssetName
                         , return AdaAssetId
                         ]
+
 genQuantity :: Gen Quantity
-genQuantity =
-  fromInteger <$> Gen.integral_ (Range.exponential 0 (toInteger (maxBound :: Int64)))
+genQuantity = fromInteger <$> Gen.integral (Range.constantFrom 0 (-2) 2)
 
 genValue :: Gen Value
-genValue =
-  valueFromList <$> Gen.list (Range.constant 0 10) ((,)
-                <$> genAssetId <*> genQuantity)
+genValue = do
+  valueFromList <$>
+    Gen.list (Range.constant 0 10)
+             ((,) <$> genAssetId <*> genQuantity)
+
 
 -- 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 =
-  Gen.choice [ genValueNestedBundleAda
-             , genValueNestedBundleNonAda
-             ]
-
-genValueNestedBundleAda :: Gen ValueNestedBundle
-genValueNestedBundleAda = ValueNestedBundleAda <$> genQuantity
-
-genValueNestedBundleNonAda :: Gen ValueNestedBundle
-genValueNestedBundleNonAda =
-  ValueNestedBundle
-    <$> genPolicyId
-    <*> Gen.map (Range.singleton 1) ((,) <$> genAssetName <*> genQuantity)
+  Gen.choice
+    [ ValueNestedBundleAda <$> genQuantity
+    , ValueNestedBundle <$> genPolicyId
+                        <*> Gen.map (Range.constant 0 5)
+                                    ((,) <$> genAssetName <*> genQuantity)
+    ]
 
 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
+
+
 
 -- -----------------------------------------------------------------------------