Fix round trip for empty Value. Add tests.

cardano-api/cardano-api.cabal

@@ -351,6 +351,7 @@ test-suite cardano-api-golden
                       , hedgehog >= 1.1
                       , hedgehog-extras ^>= 0.4.7.0
                       , microlens
+                      , parsec
                       , plutus-core ^>= 1.15
                       , plutus-ledger-api ^>= 1.15
                       , tasty
@@ -365,4 +366,6 @@ test-suite cardano-api-golden
   other-modules:        Test.Golden.Cardano.Api.Genesis
                       , Test.Golden.Cardano.Api.Ledger
                       , Test.Golden.Cardano.Api.Typed.Script
+                      , Test.Golden.Cardano.Api.Value
                       , Test.Golden.ErrorsSpec
+

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

@@ -93,6 +93,7 @@ import qualified Data.ByteString.Short as Short
 import           Data.Data (Data)
 import           Data.Function ((&))
 import           Data.Group (invert)
+import qualified Data.List as List
 import qualified Data.Map.Merge.Strict as Map
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -410,25 +411,21 @@ instance FromJSON ValueNestedRep where
 --
 
 -- | Render a textual representation of a 'Value'.
---
 renderValue :: Value -> Text
-renderValue  v =
-    Text.intercalate
-      " + "
-      (map renderAssetIdQuantityPair vals)
-  where
-    vals :: [(AssetId, Quantity)]
-    vals = valueToList v
+renderValue = renderValueSep " + "
 
 -- | Render a \"prettified\" textual representation of a 'Value'.
 renderValuePretty :: Value -> Text
-renderValuePretty v =
-    Text.intercalate
-      ("\n" <> Text.replicate 4 " " <> "+ ")
-      (map renderAssetIdQuantityPair vals)
+renderValuePretty = renderValueSep $ "\n" <> Text.replicate 4 " " <> "+ "
+
+renderValueSep :: Text -> Value -> Text
+renderValueSep sep v =
+  if List.null valueList
+    then "0 lovelace"
+    else Text.intercalate sep (map renderAssetIdQuantityPair valueList)
   where
-    vals :: [(AssetId, Quantity)]
-    vals = valueToList v
+    valueList :: [(AssetId, Quantity)]
+    valueList = valueToList v
 
 renderAssetIdQuantityPair :: (AssetId, Quantity) -> Text
 renderAssetIdQuantityPair (aId, quant) =

cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Value.hs

@@ -0,0 +1,127 @@
+module Test.Golden.Cardano.Api.Value where
+
+import           Cardano.Api (MaryEraOnwards (..), ShelleyBasedEra (..), ValueNestedBundle (..),
+                   ValueNestedRep (..), fromLedgerValue, parseValue, renderValue, renderValuePretty,
+                   valueFromNestedRep, valueToNestedRep)
+import qualified Cardano.Api as Api
+
+import           Prelude
+
+import           Data.Aeson (eitherDecode, encode)
+import           Data.List (groupBy, sort)
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
+import qualified Text.Parsec as Parsec (parse)
+
+import           Test.Gen.Cardano.Api.Typed (genAssetName, genValueDefault, genValueNestedRep)
+
+import           Hedgehog (Property, forAll, property, tripping, (===))
+import qualified Hedgehog.Extras as H
+import qualified Hedgehog.Extras.Test.Golden as H
+
+{- HLINT ignore "Use let" -}
+
+hprop_roundtrip_Value_parse_render :: Property
+hprop_roundtrip_Value_parse_render =
+  property $ do
+    ledgerValue <- forAll $ genValueDefault MaryEraOnwardsConway
+    let value = fromLedgerValue ShelleyBasedEraConway ledgerValue
+    H.noteShow_ value
+    tripping
+      value
+      renderValue
+      (Parsec.parse parseValue "" . Text.unpack)
+
+hprop_roundtrip_Value_parse_renderPretty :: Property
+hprop_roundtrip_Value_parse_renderPretty =
+  property $ do
+    ledgerValue <- forAll $ genValueDefault MaryEraOnwardsConway
+    let value = fromLedgerValue ShelleyBasedEraConway ledgerValue
+    H.noteShow_ value
+    tripping
+      value
+      renderValuePretty
+      (Parsec.parse parseValue "" . Text.unpack)
+
+
+hprop_goldenValue_1_lovelace :: Property
+hprop_goldenValue_1_lovelace =
+  H.propertyOnce $ do
+    valueList <- pure [(Api.AdaAssetId, 1)]
+    value     <- pure $ Text.unpack $ Api.renderValuePretty $ Api.valueFromList valueList
+
+    H.diffVsGoldenFile value "test/cardano-api-golden/files/golden/Cardano/Api/Value/value-ada-1.json"
+
+hprop_goldenValue1 :: Property
+hprop_goldenValue1 =
+  H.propertyOnce $ do
+    policyId  <- pure $ Api.PolicyId "a0000000000000000000000000000000000000000000000000000000"
+    assetName <- pure $ Api.AssetName "asset1"
+    valueList <- pure [(Api.AssetId policyId assetName, 1)]
+    value     <- pure $ Text.unpack $ Api.renderValuePretty $ Api.valueFromList valueList
+
+    H.diffVsGoldenFile value "test/cardano-api-golden/files/golden/Cardano/Api/Value/value-asset1-1.json"
+
+hprop_roundtrip_Value_JSON :: Property
+hprop_roundtrip_Value_JSON =
+  property $ do
+    v <- forAll $ fromLedgerValue ShelleyBasedEraConway <$> genValueDefault MaryEraOnwardsConway
+    tripping v encode eitherDecode
+
+hprop_roundtrip_Value_flatten_unflatten :: Property
+hprop_roundtrip_Value_flatten_unflatten =
+  property $ do
+    v <- forAll $ fromLedgerValue ShelleyBasedEraConway <$> genValueDefault MaryEraOnwardsConway
+    valueFromNestedRep (valueToNestedRep v) === v
+
+hprop_roundtrip_Value_unflatten_flatten :: Property
+hprop_roundtrip_Value_unflatten_flatten =
+    property $ do
+      v <- forAll genValueNestedRep
+      canonicalise v === valueToNestedRep (valueFromNestedRep v)
+
+canonicalise :: ValueNestedRep -> ValueNestedRep
+canonicalise =
+    ValueNestedRep
+  . filter (not . isZeroOrEmpty)
+  . map (filterZeros . foldl1 mergeBundle)
+  . groupBy samePolicyId
+  . sort
+  . (\(ValueNestedRep bundles) -> bundles)
+  where
+    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
+
+
+hprop_roundtrip_AssetName_JSON :: Property
+hprop_roundtrip_AssetName_JSON =
+  property $ do
+    v <- forAll genAssetName
+    tripping v encode eitherDecode
+
+hprop_roundtrip_AssetName_JSONKey :: Property
+hprop_roundtrip_AssetName_JSONKey =
+  property $ do
+    v <- forAll genAssetName
+    tripping (Map.singleton v ()) encode eitherDecode

cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-ada-1.json

@@ -0,0 +1 @@
+1 lovelace

cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-asset1-1.json

@@ -0,0 +1 @@
+1 a0000000000000000000000000000000000000000000000000000000.617373657431