From e7334bdf79fae17194c29e9a84b38d27bb909bb3 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 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 | 4 +- .../test/Test/Cardano/Api/Typed/Gen.hs | 56 +++++++++++-------- .../test/Test/Cardano/Api/Typed/Value.hs | 50 +++++++++++++---- 3 files changed, 75 insertions(+), 35 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..0aaeb35ce4e 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs +++ b/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,8 @@ import Cardano.Api.Typed import Cardano.Prelude import Control.Monad.Fail (fail) +import qualified Data.Map.Strict as Map +import Data.String import qualified Cardano.Binary as CBOR import qualified Cardano.Crypto.Hash as Crypto @@ -153,47 +157,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 = 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 + + -- -----------------------------------------------------------------------------