diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 217a3f6595..4d4ba0a35d 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -437,6 +437,7 @@ test-suite cardano-api-golden buildable: False build-depends: aeson, + aeson-pretty, base64-bytestring, bech32 >=1.1.0, bytestring, @@ -475,5 +476,6 @@ test-suite cardano-api-golden Test.Golden.Cardano.Api.Genesis Test.Golden.Cardano.Api.Ledger Test.Golden.Cardano.Api.Script + Test.Golden.Cardano.Api.TxOut Test.Golden.Cardano.Api.Value Test.Golden.ErrorsSpec diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 86db0828c3..05be0fc8e8 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -90,6 +90,7 @@ where import Cardano.Api.Byron.Internal.Key import Cardano.Api.Era +import Cardano.Api.Experimental.Era qualified as Exp import Cardano.Api.HasTypeProxy import Cardano.Api.Key.Internal import Cardano.Api.Monad.Error @@ -370,12 +371,14 @@ data AddressInEra era where instance NFData (AddressInEra era) where rnf (AddressInEra t a) = deepseq (deepseq t a) () -instance IsCardanoEra era => ToJSON (AddressInEra era) where - toJSON = Aeson.String . serialiseAddress +instance Exp.IsEra era => ToJSON (AddressInEra era) where + toJSON = + Exp.obtainCommonConstraints (Exp.useEra @era) $ + Aeson.String . serialiseAddress -instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where +instance Exp.IsEra era => FromJSON (AddressInEra era) where parseJSON = - let sbe = shelleyBasedEra @era + let sbe = convert (Exp.useEra @era) in withText "AddressInEra" $ \txt -> do addressAny <- P.runParserFail parseAddressAny txt pure $ anyAddressInShelleyBasedEra sbe addressAny diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index 8c30f37b44..2be0699f4a 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -125,6 +125,7 @@ import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error +import Cardano.Api.Experimental.Era qualified as Exp import Cardano.Api.HasTypeProxy import Cardano.Api.Hash import Cardano.Api.Key.Internal @@ -1647,16 +1648,14 @@ deriving instance Eq (ReferenceScript era) deriving instance Show (ReferenceScript era) -instance IsCardanoEra era => ToJSON (ReferenceScript era) where +instance Exp.IsEra era => ToJSON (ReferenceScript era) where toJSON (ReferenceScript _ s) = object ["referenceScript" .= s] toJSON ReferenceScriptNone = Aeson.Null -instance IsCardanoEra era => FromJSON (ReferenceScript era) where +instance Exp.IsEra era => FromJSON (ReferenceScript era) where parseJSON = Aeson.withObject "ReferenceScript" $ \o -> - caseByronToAlonzoOrBabbageEraOnwards - (const (pure ReferenceScriptNone)) - (\w -> ReferenceScript w <$> o .: "referenceScript") - (cardanoEra :: CardanoEra era) + let w = Exp.convert (Exp.useEra @era) + in ReferenceScript w <$> o .: "referenceScript" refScriptToShelleyScript :: ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs index 92184b820e..8730d5f11d 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs @@ -63,6 +63,7 @@ import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.Convert import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards +import Cardano.Api.Era.Internal.Eon.MaryEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error (Error (..), displayError) import Cardano.Api.Experimental.Era qualified as Exp @@ -413,149 +414,58 @@ txOutToJsonValue era (TxOut addr val dat refScript) = ReferenceScript _ s -> toJSON s ReferenceScriptNone -> Aeson.Null -instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where +instance Exp.IsEra era => FromJSON (TxOut CtxTx era) where parseJSON = withObject "TxOut" $ \o -> do - case shelleyBasedEra :: ShelleyBasedEra era of - ShelleyBasedEraShelley -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraMary -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAllegra -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAlonzo -> alonzoTxOutParser AlonzoEraOnwardsAlonzo o - ShelleyBasedEraBabbage -> do - alonzoTxOutInBabbage <- alonzoTxOutParser AlonzoEraOnwardsBabbage o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - mInlineDatum <- - case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> do - case scriptDataJsonToHashable ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right hashableData -> do - if hashScriptDataBytes hashableData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - mReferenceScript <- o .:? "referenceScript" - - reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript - ShelleyBasedEraConway -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsConway o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - mInlineDatum <- - case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsConway sData - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript - ShelleyBasedEraDijkstra -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - mInlineDatum <- - case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsDijkstra sData - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript + let era = Exp.useEra @era + alonzoW = convert era :: AlonzoEraOnwards era + babbageW = convert era :: BabbageEraOnwards era + conwayW = convert era :: ConwayEraOnwards era + + alonzoTxOut <- alonzoTxOutParser alonzoW o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + inlineDatum <- o .:? "inlineDatum" + mInlineDatum <- + case (inlineDatum, inlineDatumHash) of + (Just dVal, Just h) -> + case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of + Left err -> + fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> + if hashScriptDataBytes sData /= h + then fail "Inline datum not equivalent to inline datum hash" + else return $ TxOutDatumInline babbageW sData + (Nothing, Nothing) -> return TxOutDatumNone + (_, _) -> + fail + "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + mReferenceScript <- o .:? "referenceScript" + + reconcileDatums conwayW alonzoTxOut mInlineDatum mReferenceScript where - reconcileBabbage - :: TxOut CtxTx BabbageEra - -- \^ Alonzo era datum in Babbage era - -> TxOutDatum CtxTx BabbageEra - -- \^ Babbage inline datum - -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxTx BabbageEra) - reconcileBabbage top@(TxOut addr v dat r) babbageDatum mBabRefScript = do - -- We check for conflicting datums - finalDat <- case (dat, babbageDatum) of - (TxOutDatumNone, bDatum) -> return bDatum - (anyDat, TxOutDatumNone) -> return anyDat - (alonzoDat, babbageDat) -> - fail $ - "Parsed an Alonzo era datum and a Babbage era datum " - <> "TxOut: " - <> show top - <> "Alonzo datum: " - <> show alonzoDat - <> "Babbage dat: " - <> show babbageDat - finalRefScript <- case mBabRefScript of - Nothing -> return r - Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsBabbage anyScript - return $ TxOut addr v finalDat finalRefScript - - reconcileConway + reconcileDatums :: ConwayEraOnwards era -> TxOut CtxTx era - -- \^ Alonzo era datum in Conway era + -- \^ Alonzo era datum -> TxOutDatum CtxTx era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang -> Aeson.Parser (TxOut CtxTx era) - reconcileConway w top@(TxOut addr v dat r) babbageDatum mBabRefScript = do + reconcileDatums w top@(TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum (anyDat, TxOutDatumNone) -> return anyDat (alonzoDat, babbageDat) -> fail $ - "Parsed an Alonzo era datum and a Conway era datum " + "Parsed an Alonzo era datum and a Babbage era datum " <> "TxOut: " <> show top <> "Alonzo datum: " <> show alonzoDat - <> "Conway dat: " + <> "Babbage dat: " <> show babbageDat finalRefScript <- case mBabRefScript of Nothing -> return r @@ -596,138 +506,52 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where -- Note: ReferenceScript is always None for Alonzo-era parsing pure $ TxOut parsedAddress parsedValue txOutDatum ReferenceScriptNone -instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where +instance Exp.IsEra era => FromJSON (TxOut CtxUTxO era) where parseJSON = withObject "TxOut" $ \o -> do - case shelleyBasedEra :: ShelleyBasedEra era of - ShelleyBasedEraShelley -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraMary -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAllegra -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAlonzo -> alonzoTxOutParser AlonzoEraOnwardsAlonzo o - ShelleyBasedEraBabbage -> do - alonzoTxOutInBabbage <- alonzoTxOutParser AlonzoEraOnwardsBabbage o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - mInlineDatum <- - case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> do - case scriptDataJsonToHashable ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right hashableData -> do - if hashScriptDataBytes hashableData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - -- We check for a reference script - mReferenceScript <- o .:? "referenceScript" - - reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript - ShelleyBasedEraConway -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsConway o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - mInlineDatum <- - case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsConway sData - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - -- We check for a reference script - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript - ShelleyBasedEraDijkstra -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - mInlineDatum <- - case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsDijkstra sData - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - -- We check for a reference script - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript + let era = Exp.useEra @era + alonzoW = convert era :: AlonzoEraOnwards era + babbageW = convert era :: BabbageEraOnwards era + conwayW = convert era :: ConwayEraOnwards era + + alonzoTxOut <- alonzoTxOutParser alonzoW o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + inlineDatum <- o .:? "inlineDatum" + mInlineDatum <- + case (inlineDatum, inlineDatumHash) of + (Just dVal, Just h) -> + case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of + Left err -> + fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> + if hashScriptDataBytes sData /= h + then fail "Inline datum not equivalent to inline datum hash" + else return $ TxOutDatumInline babbageW sData + (Nothing, Nothing) -> return TxOutDatumNone + (_, _) -> + fail + "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + -- We check for a reference script + mReferenceScript <- o .:? "referenceScript" + + reconcileDatums conwayW alonzoTxOut mInlineDatum mReferenceScript where - reconcileBabbage - :: TxOut CtxUTxO BabbageEra - -- \^ Alonzo era datum in Babbage era - -> TxOutDatum CtxUTxO BabbageEra - -- \^ Babbage inline datum - -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxUTxO BabbageEra) - reconcileBabbage (TxOut addr v dat r) babbageDatum mBabRefScript = do - -- We check for conflicting datums - finalDat <- case (dat, babbageDatum) of - (TxOutDatumNone, bDatum) -> return bDatum - (anyDat, TxOutDatumNone) -> return anyDat - (_, _) -> fail "Parsed an Alonzo era datum and a Babbage era datum" - finalRefScript <- case mBabRefScript of - Nothing -> return r - Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsBabbage anyScript - - return $ TxOut addr v finalDat finalRefScript - - reconcileConway + reconcileDatums :: ConwayEraOnwards era -> TxOut CtxUTxO era - -- \^ Alonzo era datum in Conway era + -- \^ Alonzo era datum -> TxOutDatum CtxUTxO era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang -> Aeson.Parser (TxOut CtxUTxO era) - reconcileConway w (TxOut addr v dat r) babbageDatum mBabRefScript = do + reconcileDatums w (TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum (anyDat, TxOutDatumNone) -> return anyDat - (_, _) -> fail "Parsed an Alonzo era datum and a Conway era datum" + (_, _) -> fail "Parsed an Alonzo era datum and a Babbage era datum" finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> @@ -940,35 +764,25 @@ deriving instance Eq (TxOutValue era) deriving instance Show (TxOutValue era) -instance IsCardanoEra era => ToJSON (TxOutValue era) where +instance Exp.IsEra era => ToJSON (TxOutValue era) where toJSON = \case TxOutValueByron ll -> toJSON ll TxOutValueShelleyBased sbe val -> shelleyBasedEraConstraints sbe $ toJSON (fromLedgerValue sbe val) -instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where - parseJSON = withObject "TxOutValue" $ \o -> - caseShelleyToAllegraOrMaryEraOnwards - ( \shelleyToAlleg -> do - ll <- o .: "lovelace" - let sbe = convert shelleyToAlleg - pure $ - shelleyBasedEraConstraints sbe $ - TxOutValueShelleyBased sbe $ - A.mkAdaValue sbe ll - ) - ( \w -> do - let l = toList o - sbe = convert w - vals <- mapM decodeAssetId l - pure $ - shelleyBasedEraConstraints sbe $ - TxOutValueShelleyBased sbe $ - toLedgerValue w $ - mconcat vals - ) - (shelleyBasedEra @era) +instance Exp.IsEra era => FromJSON (TxOutValue era) where + parseJSON = withObject "TxOutValue" $ \o -> do + let era = Exp.useEra @era + maryW = convert era :: MaryEraOnwards era + sbe = convert era :: ShelleyBasedEra era + l = toList o + vals <- mapM decodeAssetId l + pure $ + shelleyBasedEraConstraints sbe $ + TxOutValueShelleyBased sbe $ + toLedgerValue maryW $ + mconcat vals where decodeAssetId :: (Aeson.Key, Aeson.Value) -> Aeson.Parser Value decodeAssetId (polid, Aeson.Object assetNameHm) = do diff --git a/cardano-api/src/Cardano/Api/UTxO.hs b/cardano-api/src/Cardano/Api/UTxO.hs index 481c66a3c1..46e136a06e 100644 --- a/cardano-api/src/Cardano/Api/UTxO.hs +++ b/cardano-api/src/Cardano/Api/UTxO.hs @@ -82,8 +82,7 @@ module Cardano.Api.UTxO where import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra - ( IsShelleyBasedEra - , ShelleyBasedEra + ( ShelleyBasedEra , ShelleyLedgerEra ) import Cardano.Api.Experimental.Era qualified as Exp @@ -137,7 +136,7 @@ instance Exp.IsEra era => ToJSON (UTxO era) where toJSON (UTxO m) = toJSON m toEncoding (UTxO m) = toEncoding m -instance IsShelleyBasedEra era => FromJSON (UTxO era) where +instance Exp.IsEra era => FromJSON (UTxO era) where parseJSON = Aeson.withObject "UTxO" $ \hm -> do let l = GHC.toList $ KeyMap.toHashMapText hm res <- mapM toTxIn l diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/TxOut.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/TxOut.hs new file mode 100644 index 0000000000..ff42a1457f --- /dev/null +++ b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/TxOut.hs @@ -0,0 +1,323 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Golden tests for TxOut, TxOutValue, AddressInEra, and ReferenceScript JSON serialization. +-- +-- These tests ensure backwards compatibility of the JSON format for types whose +-- ToJSON/FromJSON instances were migrated from IsShelleyBasedEra/IsCardanoEra +-- constraints to Exp.IsEra constraints. +module Test.Golden.Cardano.Api.TxOut + ( -- * TxOut golden tests + tasty_golden_TxOut_ConwayEra_simple + , tasty_golden_TxOut_ConwayEra_datumHash + , tasty_golden_TxOut_ConwayEra_inlineDatum + , tasty_golden_TxOut_ConwayEra_referenceScript + , tasty_golden_TxOut_ConwayEra_full + + -- * TxOutValue golden tests + , tasty_golden_TxOutValue_ConwayEra_lovelaceOnly + , tasty_golden_TxOutValue_ConwayEra_multiAsset + + -- * AddressInEra golden tests + , tasty_golden_AddressInEra_ConwayEra + + -- * ReferenceScript golden tests + , tasty_golden_ReferenceScript_ConwayEra + + -- * UTxO golden tests + , tasty_golden_UTxO_ConwayEra + ) +where + +import Cardano.Api +import Cardano.Api.Ledger qualified as L + +import Control.Error.Util (hush) +import Data.Aeson qualified as Aeson +import Data.Aeson.Encode.Pretty (encodePretty) +import Data.ByteString (ByteString) +import Data.ByteString.Lazy.Char8 qualified as BL8 +import Data.Maybe (fromJust) +import GHC.Exts (IsList (..)) +import System.FilePath (()) + +import Hedgehog.Extras (UnitIO) +import Hedgehog.Extras qualified as H + +-- ----------------------------------------------------------------------------- +-- Test data construction helpers +-- ----------------------------------------------------------------------------- + +goldenPath :: FilePath +goldenPath = "test/cardano-api-golden/files/TxOut" + +-- | Helper to encode value as pretty JSON string +toJsonString :: Aeson.ToJSON a => a -> String +toJsonString a = BL8.unpack (encodePretty a) + +-- | Create a simple payment address for testing +mkTestAddress :: ShelleyBasedEra era -> AddressInEra era +mkTestAddress sbe = + shelleyAddressInEra sbe $ + makeShelleyAddress + Mainnet + (PaymentCredentialByKey testPaymentKeyHash) + NoStakeAddress + +testPaymentKeyHash :: Hash PaymentKey +testPaymentKeyHash = + fromJust $ + hush $ + deserialiseFromRawBytesHex "1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5" + +-- | Create a test TxOutValue with only lovelace +mkLovelaceValue :: ShelleyBasedEra era -> L.Coin -> TxOutValue era +mkLovelaceValue = lovelaceToTxOutValue + +-- | Create a test TxOutValue with multi-assets +mkMultiAssetValue :: ShelleyBasedEra era -> TxOutValue era +mkMultiAssetValue sbe = + shelleyBasedEraConstraints sbe $ + TxOutValueShelleyBased sbe $ + toLedgerValue (maryEraOnwardsToMaryEraOnwards sbe) testMultiAssetValue + where + maryEraOnwardsToMaryEraOnwards :: ShelleyBasedEra era -> MaryEraOnwards era + maryEraOnwardsToMaryEraOnwards = \case + ShelleyBasedEraConway -> MaryEraOnwardsConway + ShelleyBasedEraDijkstra -> MaryEraOnwardsDijkstra + _ -> error "mkMultiAssetValue: unsupported era" + +testMultiAssetValue :: Value +testMultiAssetValue = + fromList + [ (AdaAssetId, Quantity 2_000_000) + , (AssetId testPolicyId testAssetName, Quantity 100) + ] + +testPolicyId :: PolicyId +testPolicyId = + fromJust $ + hush $ + deserialiseFromRawBytesHex "a0000000000000000000000000000000000000000000000000000000" + +testAssetName :: AssetName +testAssetName = + fromJust $ + hush $ + deserialiseFromRawBytes AsAssetName "TestToken" + +-- | Create a test datum hash +testDatumHash :: Hash ScriptData +testDatumHash = + fromJust $ + hush $ + deserialiseFromRawBytesHex "ffd29f3e52e7cf2eb451a59448fd55f9c64e4c1ad1ab0e500d6ceb6d7ff97e9c" + +-- | Create test inline datum (ScriptData) +testScriptData :: HashableScriptData +testScriptData = + fromJust $ + hush $ + deserialiseFromCBOR AsHashableScriptData testScriptDataCBOR + where + -- CBOR encoding of ScriptDataNumber 42 + testScriptDataCBOR :: ByteString + testScriptDataCBOR = "\24\42" + +-- | Create a test simple script for reference script testing +testSimpleScript :: Script SimpleScript' +testSimpleScript = + SimpleScript $ + RequireAllOf + [ RequireSignature testPaymentKeyHash + ] + +-- | Create a test reference script +mkTestReferenceScript :: ShelleyBasedEra era -> ReferenceScript era +mkTestReferenceScript = \case + ShelleyBasedEraConway -> + ReferenceScript BabbageEraOnwardsConway (ScriptInAnyLang SimpleScriptLanguage testSimpleScript) + ShelleyBasedEraDijkstra -> + ReferenceScript BabbageEraOnwardsDijkstra (ScriptInAnyLang SimpleScriptLanguage testSimpleScript) + _ -> error "mkTestReferenceScript: unsupported era" + +-- ----------------------------------------------------------------------------- +-- TxOut golden tests - Conway Era +-- ----------------------------------------------------------------------------- + +tasty_golden_TxOut_ConwayEra_simple :: UnitIO () +tasty_golden_TxOut_ConwayEra_simple = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-simple.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 1_000_000)) + TxOutDatumNone + ReferenceScriptNone + +tasty_golden_TxOut_ConwayEra_datumHash :: UnitIO () +tasty_golden_TxOut_ConwayEra_datumHash = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-datumhash.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 2_000_000)) + (TxOutDatumHash AlonzoEraOnwardsConway testDatumHash) + ReferenceScriptNone + +tasty_golden_TxOut_ConwayEra_inlineDatum :: UnitIO () +tasty_golden_TxOut_ConwayEra_inlineDatum = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-inlinedatum.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 3_000_000)) + (TxOutDatumInline BabbageEraOnwardsConway testScriptData) + ReferenceScriptNone + +tasty_golden_TxOut_ConwayEra_referenceScript :: UnitIO () +tasty_golden_TxOut_ConwayEra_referenceScript = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-referencescript.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 4_000_000)) + TxOutDatumNone + (mkTestReferenceScript ShelleyBasedEraConway) + +tasty_golden_TxOut_ConwayEra_full :: UnitIO () +tasty_golden_TxOut_ConwayEra_full = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-full.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkMultiAssetValue ShelleyBasedEraConway) + (TxOutDatumInline BabbageEraOnwardsConway testScriptData) + (mkTestReferenceScript ShelleyBasedEraConway) + +-- ----------------------------------------------------------------------------- +-- TxOutValue golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_TxOutValue_ConwayEra_lovelaceOnly :: UnitIO () +tasty_golden_TxOutValue_ConwayEra_lovelaceOnly = + H.diffVsGoldenFile + (toJsonString txOutValue) + (goldenPath "conway" "txoutvalue-lovelace.json") + where + txOutValue :: TxOutValue ConwayEra + txOutValue = mkLovelaceValue ShelleyBasedEraConway (L.Coin 5_000_000) + +tasty_golden_TxOutValue_ConwayEra_multiAsset :: UnitIO () +tasty_golden_TxOutValue_ConwayEra_multiAsset = + H.diffVsGoldenFile + (toJsonString txOutValue) + (goldenPath "conway" "txoutvalue-multiasset.json") + where + txOutValue :: TxOutValue ConwayEra + txOutValue = mkMultiAssetValue ShelleyBasedEraConway + +-- ----------------------------------------------------------------------------- +-- AddressInEra golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_AddressInEra_ConwayEra :: UnitIO () +tasty_golden_AddressInEra_ConwayEra = + H.diffVsGoldenFile + (toJsonString addr) + (goldenPath "conway" "address.json") + where + addr :: AddressInEra ConwayEra + addr = mkTestAddress ShelleyBasedEraConway + +-- ----------------------------------------------------------------------------- +-- ReferenceScript golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_ReferenceScript_ConwayEra :: UnitIO () +tasty_golden_ReferenceScript_ConwayEra = + H.diffVsGoldenFile + (toJsonString refScript) + (goldenPath "conway" "referencescript.json") + where + refScript :: ReferenceScript ConwayEra + refScript = mkTestReferenceScript ShelleyBasedEraConway + +-- ----------------------------------------------------------------------------- +-- UTxO golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_UTxO_ConwayEra :: UnitIO () +tasty_golden_UTxO_ConwayEra = + H.diffVsGoldenFile + (toJsonString utxo) + (goldenPath "conway" "utxo.json") + where + utxo :: UTxO ConwayEra + utxo = + UTxO $ + fromList + [ (testTxIn, txOut1) + , (testTxIn2, txOut2) + ] + + txOut1 :: TxOut CtxUTxO ConwayEra + txOut1 = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 1_000_000)) + TxOutDatumNone + ReferenceScriptNone + + txOut2 :: TxOut CtxUTxO ConwayEra + txOut2 = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkMultiAssetValue ShelleyBasedEraConway) + (TxOutDatumHash AlonzoEraOnwardsConway testDatumHash) + ReferenceScriptNone + + testTxIn :: TxIn + testTxIn = + TxIn testTxId1 (TxIx 0) + + testTxIn2 :: TxIn + testTxIn2 = + TxIn testTxId2 (TxIx 1) + + testTxId1 :: TxId + testTxId1 = + fromJust $ + hush $ + deserialiseFromRawBytesHex "0000000000000000000000000000000000000000000000000000000000000001" + + testTxId2 :: TxId + testTxId2 = + fromJust $ + hush $ + deserialiseFromRawBytesHex "0000000000000000000000000000000000000000000000000000000000000002" diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/address.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/address.json new file mode 100644 index 0000000000..680c6e2384 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/address.json @@ -0,0 +1 @@ +"addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2" \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/referencescript.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/referencescript.json new file mode 100644 index 0000000000..f9aa421a61 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/referencescript.json @@ -0,0 +1,10 @@ +{ + "referenceScript": { + "script": { + "cborHex": "8201818200581c1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5", + "description": "", + "type": "SimpleScript" + }, + "scriptLanguage": "SimpleScriptLanguage" + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-datumhash.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-datumhash.json new file mode 100644 index 0000000000..fb5ba205be --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-datumhash.json @@ -0,0 +1,11 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": "ffd29f3e52e7cf2eb451a59448fd55f9c64e4c1ad1ab0e500d6ceb6d7ff97e9c", + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "lovelace": 2000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-full.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-full.json new file mode 100644 index 0000000000..f92bc6f68b --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-full.json @@ -0,0 +1,23 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "inlineDatum": { + "int": 42 + }, + "inlineDatumRaw": "182a", + "inlineDatumhash": "9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b", + "referenceScript": { + "script": { + "cborHex": "8201818200581c1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5", + "description": "", + "type": "SimpleScript" + }, + "scriptLanguage": "SimpleScriptLanguage" + }, + "value": { + "a0000000000000000000000000000000000000000000000000000000": { + "54657374546f6b656e": 100 + }, + "lovelace": 2000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-inlinedatum.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-inlinedatum.json new file mode 100644 index 0000000000..8ef3dbd168 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-inlinedatum.json @@ -0,0 +1,13 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "inlineDatum": { + "int": 42 + }, + "inlineDatumRaw": "182a", + "inlineDatumhash": "9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b", + "referenceScript": null, + "value": { + "lovelace": 3000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-referencescript.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-referencescript.json new file mode 100644 index 0000000000..ac63ea41f7 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-referencescript.json @@ -0,0 +1,18 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": null, + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": { + "script": { + "cborHex": "8201818200581c1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5", + "description": "", + "type": "SimpleScript" + }, + "scriptLanguage": "SimpleScriptLanguage" + }, + "value": { + "lovelace": 4000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-simple.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-simple.json new file mode 100644 index 0000000000..ab302534e0 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-simple.json @@ -0,0 +1,11 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": null, + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "lovelace": 1000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-lovelace.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-lovelace.json new file mode 100644 index 0000000000..4dbf163d41 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-lovelace.json @@ -0,0 +1,3 @@ +{ + "lovelace": 5000000 +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-multiasset.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-multiasset.json new file mode 100644 index 0000000000..776699cf92 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-multiasset.json @@ -0,0 +1,6 @@ +{ + "a0000000000000000000000000000000000000000000000000000000": { + "54657374546f6b656e": 100 + }, + "lovelace": 2000000 +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/utxo.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/utxo.json new file mode 100644 index 0000000000..c63a574a33 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/utxo.json @@ -0,0 +1,27 @@ +{ + "0000000000000000000000000000000000000000000000000000000000000001#0": { + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": null, + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "lovelace": 1000000 + } + }, + "0000000000000000000000000000000000000000000000000000000000000002#1": { + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": "ffd29f3e52e7cf2eb451a59448fd55f9c64e4c1ad1ab0e500d6ceb6d7ff97e9c", + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "a0000000000000000000000000000000000000000000000000000000": { + "54657374546f6b656e": 100 + }, + "lovelace": 2000000 + } + } +} \ No newline at end of file