canonicalise function

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

@@ -124,8 +124,8 @@ instance FromJSONKey AssetName where
   fromJSONKey = FromJSONKeyText (AssetName . Text.encodeUtf8)
 
 
-data AssetId = AssetId !PolicyId !AssetName
-             | AdaAssetId
+data AssetId = AdaAssetId
+             | AssetId !PolicyId !AssetName
   deriving (Eq, Ord, Show)
 
 newtype Value = Value (Map AssetId Quantity)
@@ -252,7 +252,7 @@ instance FromJSON ValueNestedRep where
       parsePid ("lovelace", q) = ValueNestedBundleAda <$> parseJSON q
       parsePid (pid, q) =
         case deserialiseFromRawBytesHex AsScriptHash (Text.encodeUtf8 pid) of
-          Just sHash -> ValueNestedBundle (PolicyId sHash) <$> (parseJSON q)
+          Just sHash -> ValueNestedBundle (PolicyId sHash) <$> parseJSON q
           Nothing -> fail $ "Failure when deserialising PolicyId: "
                          <> Text.unpack pid
 

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

@@ -6,6 +6,7 @@ module Test.Cardano.Api.Typed.Value
 
 import           Cardano.Prelude
 import           Data.Aeson
+import qualified Data.Map.Strict as Map
 
 import           Cardano.Api.Typed
 
@@ -26,20 +27,56 @@ 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'
-  where
-    equiv (ValueNestedRep a) (ValueNestedRep b) = sort a === sort b
+      canonicalise v === valueToNestedRep (valueFromNestedRep v)
+
+canonicalise :: ValueNestedRep -> ValueNestedRep
+canonicalise (ValueNestedRep bundles) =
+  ValueNestedRep $ mergeDuplicates bundles
+ where
+  mergeDuplicates :: [ValueNestedBundle] -> [ValueNestedBundle]
+  mergeDuplicates bundles' =
+    let cleanedBundles :: [ValueNestedBundle]
+        cleanedBundles = removeEmptyNestedBundles bundles'
+
+        folded :: (Quantity, [ValueNestedBundle])
+        folded = foldl
+                   (\(adaAcc, mintAcc) b ->
+                     case b of
+                       ValueNestedBundleAda q -> (adaAcc + q, mintAcc)
+                       ValueNestedBundle pid aMap -> (adaAcc, ValueNestedBundle pid aMap : mintAcc)
+                   )
+                   (0,[])
+                   cleanedBundles
+
+        summedAda = fst folded
+        summedMinted = snd folded
+
+    in if summedAda == 0
+       then sort summedMinted
+       else ValueNestedBundleAda summedAda : sort summedMinted
+
+  removeEmptyNestedBundles :: [ValueNestedBundle] -> [ValueNestedBundle]
+  removeEmptyNestedBundles [] = []
+  removeEmptyNestedBundles (vNb : rest) =
+    case vNb of
+      ValueNestedBundleAda v ->
+        if v == 0
+        then removeEmptyNestedBundles rest
+        else vNb : removeEmptyNestedBundles rest
+      ValueNestedBundle pid m ->
+        -- All AssetNames have 0 quantity in a given PolicyId
+        if all (\(_, quantity) -> quantity == 0) $ Map.toList m
+        then removeEmptyNestedBundles rest
+        else ValueNestedBundle pid (removeAssetWithZeroQuantity m) : removeEmptyNestedBundles rest
+
+  removeAssetWithZeroQuantity :: Map AssetName Quantity -> Map AssetName Quantity
+  removeAssetWithZeroQuantity m = Map.filter (\q -> q /= 0) m
+
+
 
 -- -----------------------------------------------------------------------------