diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 46cd9286a4..801a43cff7 100644 --- a/cardano-api/cardano-api.cabal +++ b/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 + diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index 62380b2e91..44b983b312 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/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) = diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Value.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Value.hs new file mode 100644 index 0000000000..c32d5ffdbe --- /dev/null +++ b/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 diff --git a/cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-ada-1.json b/cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-ada-1.json new file mode 100644 index 0000000000..dfb6c450d4 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-ada-1.json @@ -0,0 +1 @@ +1 lovelace \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-asset1-1.json b/cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-asset1-1.json new file mode 100644 index 0000000000..f0461a4f07 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/golden/Cardano/Api/Value/value-asset1-1.json @@ -0,0 +1 @@ +1 a0000000000000000000000000000000000000000000000000000000.617373657431 \ No newline at end of file