From c1d3bebde4ef1e3e232e09339686573faa366e05 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 24 Nov 2020 10:29:57 +0000 Subject: [PATCH] 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 | 4 +- .../test/Test/Cardano/Api/Typed/Gen.hs | 50 ++++++++++++++----- .../test/Test/Cardano/Api/Typed/Value.hs | 50 +++++++++++++++---- 3 files changed, 80 insertions(+), 24 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index a0d4937e047..e09cfc5c0c2 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/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) diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs index d123ab9af25..c343cc8dc46 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs +++ b/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 = diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Value.hs b/cardano-api/test/Test/Cardano/Api/Typed/Value.hs index 93259c4e30f..776b67f32ef 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Value.hs +++ b/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 + + -- -----------------------------------------------------------------------------