diff --git a/cardano-api/gen/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Gen/Cardano/Api/Typed.hs index 5efa3b0c20b..935e955243c 100644 --- a/cardano-api/gen/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Gen/Cardano/Api/Typed.hs @@ -179,27 +179,23 @@ genLovelace = Lovelace <$> Gen.integral (Range.linear 0 5000) -- genScript :: ScriptLanguage lang -> Gen (Script lang) -genScript (SimpleScriptLanguage lang) = - SimpleScript lang <$> genSimpleScript lang +genScript SimpleScriptLanguage = + SimpleScript <$> genSimpleScript genScript (PlutusScriptLanguage lang) = PlutusScript lang <$> genPlutusScript lang -genSimpleScript :: SimpleScriptVersion lang -> Gen (SimpleScript lang) -genSimpleScript lang = +genSimpleScript :: Gen SimpleScript +genSimpleScript = genTerm where genTerm = Gen.recursive Gen.choice nonRecursive recursive -- Non-recursive generators nonRecursive = - (RequireSignature . verificationKeyHash <$> - genVerificationKey AsPaymentKey) - - : [ RequireTimeBefore supported <$> genSlotNo - | supported <- maybeToList (timeLocksSupported lang) ] - - ++ [ RequireTimeAfter supported <$> genSlotNo - | supported <- maybeToList (timeLocksSupported lang) ] + [ RequireSignature . verificationKeyHash <$> genVerificationKey AsPaymentKey + , RequireTimeBefore <$> genSlotNo + , RequireTimeAfter <$> genSlotNo + ] -- Recursive generators recursive = diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 9f8cac2d175..f8be9aec65c 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -336,18 +336,15 @@ module Cardano.Api ( -- | Both 'PaymentCredential's and 'StakeCredential's can use scripts. -- ** Script languages - SimpleScriptV1, - SimpleScriptV2, + SimpleScript', PlutusScriptV1, PlutusScriptV2, ScriptLanguage(..), - SimpleScriptVersion(..), PlutusScriptVersion(..), AnyScriptLanguage(..), AnyPlutusScriptVersion(..), IsPlutusScriptLanguage(..), IsScriptLanguage(..), - IsSimpleScriptLanguage(..), -- ** Scripts in a specific language Script(..), @@ -388,9 +385,6 @@ module Cardano.Api ( -- ** Simple scripts -- | Making multi-signature and time-lock scripts. SimpleScript(..), - TimeLocksSupported(..), - timeLocksSupported, - adjustSimpleScriptVersion, -- ** Plutus scripts PlutusScript, diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 3b0ced80a13..94ac9e4eca1 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -15,18 +16,15 @@ module Cardano.Api.Script ( -- * Languages - SimpleScriptV1, - SimpleScriptV2, + SimpleScript', PlutusScriptV1, PlutusScriptV2, ScriptLanguage(..), - SimpleScriptVersion(..), PlutusScriptVersion(..), AnyScriptLanguage(..), AnyPlutusScriptVersion(..), IsPlutusScriptLanguage(..), IsScriptLanguage(..), - IsSimpleScriptLanguage(..), -- * Scripts in a specific language Script(..), @@ -65,9 +63,6 @@ module Cardano.Api.Script ( -- * The simple script language SimpleScript(..), - TimeLocksSupported(..), - timeLocksSupported, - adjustSimpleScriptVersion, SimpleScriptOrReferenceInput(..), -- * The Plutus script language @@ -174,6 +169,8 @@ import Cardano.Api.Utils (failEitherWith) -- Types for script language and version -- +data SimpleScript' + -- | The original simple script language which supports -- -- * require a signature from a given key (by verification key hash) @@ -183,17 +180,18 @@ import Cardano.Api.Utils (failEitherWith) -- -- This version of the language was introduced in the 'ShelleyEra'. -- -data SimpleScriptV1 -- | The second version of the simple script language. It has all the features --- of 'SimpleScriptV1' plus new atomic predicates: +-- of the original simple script language plus new atomic predicates: -- -- * require the time be before a given slot number -- * require the time be after a given slot number -- -- This version of the language was introduced in the 'AllegraEra'. -- -data SimpleScriptV2 +-- However we opt for a single type level tag 'SimpleScript\'' as the second version of +-- of the language introduced in the Allegra era is a superset of the language introduced +-- in the Shelley era. -- | Place holder type to show what the pattern is to extend to multiple -- languages, not just multiple versions of a single language. @@ -201,16 +199,13 @@ data SimpleScriptV2 data PlutusScriptV1 data PlutusScriptV2 -instance HasTypeProxy SimpleScriptV1 where - data AsType SimpleScriptV1 = AsSimpleScriptV1 - proxyToAsType _ = AsSimpleScriptV1 - -instance HasTypeProxy SimpleScriptV2 where - data AsType SimpleScriptV2 = AsSimpleScriptV2 - proxyToAsType _ = AsSimpleScriptV2 +instance HasTypeProxy SimpleScript' where + data AsType SimpleScript' = AsSimpleScript + proxyToAsType _ = AsSimpleScript instance HasTypeProxy PlutusScriptV1 where data AsType PlutusScriptV1 = AsPlutusScriptV1 + proxyToAsType :: Proxy PlutusScriptV1 -> AsType PlutusScriptV1 proxyToAsType _ = AsPlutusScriptV1 instance HasTypeProxy PlutusScriptV2 where @@ -222,7 +217,7 @@ instance HasTypeProxy PlutusScriptV2 where -- data ScriptLanguage lang where - SimpleScriptLanguage :: SimpleScriptVersion lang -> ScriptLanguage lang + SimpleScriptLanguage :: ScriptLanguage SimpleScript' PlutusScriptLanguage :: PlutusScriptVersion lang -> ScriptLanguage lang @@ -230,8 +225,7 @@ deriving instance (Eq (ScriptLanguage lang)) deriving instance (Show (ScriptLanguage lang)) instance TestEquality ScriptLanguage where - testEquality (SimpleScriptLanguage lang) - (SimpleScriptLanguage lang') = testEquality lang lang' + testEquality SimpleScriptLanguage SimpleScriptLanguage = Just Refl testEquality (PlutusScriptLanguage lang) (PlutusScriptLanguage lang') = testEquality lang lang' @@ -239,20 +233,6 @@ instance TestEquality ScriptLanguage where testEquality _ _ = Nothing -data SimpleScriptVersion lang where - - SimpleScriptV1 :: SimpleScriptVersion SimpleScriptV1 - SimpleScriptV2 :: SimpleScriptVersion SimpleScriptV2 - -deriving instance (Eq (SimpleScriptVersion lang)) -deriving instance (Show (SimpleScriptVersion lang)) - -instance TestEquality SimpleScriptVersion where - testEquality SimpleScriptV1 SimpleScriptV1 = Just Refl - testEquality SimpleScriptV2 SimpleScriptV2 = Just Refl - testEquality _ _ = Nothing - - data PlutusScriptVersion lang where PlutusScriptV1 :: PlutusScriptVersion PlutusScriptV1 PlutusScriptV2 :: PlutusScriptVersion PlutusScriptV2 @@ -278,19 +258,17 @@ instance Ord AnyScriptLanguage where compare a b = compare (fromEnum a) (fromEnum b) instance Enum AnyScriptLanguage where - toEnum 0 = AnyScriptLanguage (SimpleScriptLanguage SimpleScriptV1) - toEnum 1 = AnyScriptLanguage (SimpleScriptLanguage SimpleScriptV2) - toEnum 2 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV1) - toEnum 3 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2) + toEnum 0 = AnyScriptLanguage SimpleScriptLanguage + toEnum 1 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV1) + toEnum 2 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2) toEnum err = error $ "AnyScriptLanguage.toEnum: bad argument: " <> show err - fromEnum (AnyScriptLanguage (SimpleScriptLanguage SimpleScriptV1)) = 0 - fromEnum (AnyScriptLanguage (SimpleScriptLanguage SimpleScriptV2)) = 1 - fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV1)) = 2 - fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2)) = 3 + fromEnum (AnyScriptLanguage SimpleScriptLanguage) = 0 + fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV1)) = 1 + fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2)) = 2 instance Bounded AnyScriptLanguage where - minBound = AnyScriptLanguage (SimpleScriptLanguage SimpleScriptV1) + minBound = AnyScriptLanguage SimpleScriptLanguage maxBound = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2) @@ -367,11 +345,8 @@ fromAlonzoLanguage Alonzo.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 class HasTypeProxy lang => IsScriptLanguage lang where scriptLanguage :: ScriptLanguage lang -instance IsScriptLanguage SimpleScriptV1 where - scriptLanguage = SimpleScriptLanguage SimpleScriptV1 - -instance IsScriptLanguage SimpleScriptV2 where - scriptLanguage = SimpleScriptLanguage SimpleScriptV2 +instance IsScriptLanguage SimpleScript' where + scriptLanguage = SimpleScriptLanguage instance IsScriptLanguage PlutusScriptV1 where scriptLanguage = PlutusScriptLanguage PlutusScriptV1 @@ -379,17 +354,6 @@ instance IsScriptLanguage PlutusScriptV1 where instance IsScriptLanguage PlutusScriptV2 where scriptLanguage = PlutusScriptLanguage PlutusScriptV2 - -class IsScriptLanguage lang => IsSimpleScriptLanguage lang where - simpleScriptVersion :: SimpleScriptVersion lang - -instance IsSimpleScriptLanguage SimpleScriptV1 where - simpleScriptVersion = SimpleScriptV1 - -instance IsSimpleScriptLanguage SimpleScriptV2 where - simpleScriptVersion = SimpleScriptV2 - - class IsScriptLanguage lang => IsPlutusScriptLanguage lang where plutusScriptVersion :: PlutusScriptVersion lang @@ -416,9 +380,8 @@ instance IsPlutusScriptLanguage PlutusScriptV2 where -- data Script lang where - SimpleScript :: !(SimpleScriptVersion lang) - -> !(SimpleScript lang) - -> Script lang + SimpleScript :: !SimpleScript + -> Script SimpleScript' PlutusScript :: !(PlutusScriptVersion lang) -> !(PlutusScript lang) @@ -432,10 +395,7 @@ instance HasTypeProxy lang => HasTypeProxy (Script lang) where proxyToAsType _ = AsScript (proxyToAsType (Proxy :: Proxy lang)) instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where - serialiseToCBOR (SimpleScript SimpleScriptV1 s) = - CBOR.serialize' (toShelleyMultiSig s) - - serialiseToCBOR (SimpleScript SimpleScriptV2 s) = + serialiseToCBOR (SimpleScript s) = CBOR.serialize' (toAllegraTimelock s :: Timelock.Timelock StandardCrypto) serialiseToCBOR (PlutusScript PlutusScriptV1 s) = @@ -446,16 +406,8 @@ instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where deserialiseFromCBOR _ bs = case scriptLanguage :: ScriptLanguage lang of - SimpleScriptLanguage SimpleScriptV1 -> - SimpleScript SimpleScriptV1 - . fromShelleyMultiSig - <$> CBOR.decodeAnnotator "Script" fromCBOR (LBS.fromStrict bs) - - SimpleScriptLanguage SimpleScriptV2 -> - SimpleScript SimpleScriptV2 - . (fromAllegraTimelock TimeLocksInSimpleScriptV2 - :: Timelock.Timelock StandardCrypto - -> SimpleScript SimpleScriptV2) + SimpleScriptLanguage -> + SimpleScript .(fromAllegraTimelock :: Timelock.Timelock StandardCrypto -> SimpleScript) <$> CBOR.decodeAnnotator "Script" fromCBOR (LBS.fromStrict bs) PlutusScriptLanguage PlutusScriptV1 -> @@ -469,8 +421,7 @@ instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where instance IsScriptLanguage lang => HasTextEnvelope (Script lang) where textEnvelopeType _ = case scriptLanguage :: ScriptLanguage lang of - SimpleScriptLanguage SimpleScriptV1 -> "SimpleScriptV1" - SimpleScriptLanguage SimpleScriptV2 -> "SimpleScriptV2" + SimpleScriptLanguage -> "SimpleScript" PlutusScriptLanguage PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptLanguage PlutusScriptV2 -> "PlutusScriptV2" @@ -511,8 +462,7 @@ instance ToJSON ScriptInAnyLang where :: ScriptLanguage lang -> (IsScriptLanguage lang => a) -> a - obtainScriptLangConstraint (SimpleScriptLanguage SimpleScriptV1) f = f - obtainScriptLangConstraint (SimpleScriptLanguage SimpleScriptV2) f = f + obtainScriptLangConstraint SimpleScriptLanguage f = f obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV1) f = f obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV2) f = f @@ -530,8 +480,8 @@ instance FromJSON ScriptInAnyLang where -- field within the 'ScriptInAnyLang' constructor. -- toScriptInAnyLang :: Script lang -> ScriptInAnyLang -toScriptInAnyLang s@(SimpleScript v _) = - ScriptInAnyLang (SimpleScriptLanguage v) s +toScriptInAnyLang s@(SimpleScript _) = + ScriptInAnyLang SimpleScriptLanguage s toScriptInAnyLang s@(PlutusScript v _) = ScriptInAnyLang (PlutusScriptLanguage v) s @@ -563,16 +513,11 @@ instance Eq (ScriptInEra era) where data ScriptLanguageInEra lang era where - SimpleScriptV1InShelley :: ScriptLanguageInEra SimpleScriptV1 ShelleyEra - SimpleScriptV1InAllegra :: ScriptLanguageInEra SimpleScriptV1 AllegraEra - SimpleScriptV1InMary :: ScriptLanguageInEra SimpleScriptV1 MaryEra - SimpleScriptV1InAlonzo :: ScriptLanguageInEra SimpleScriptV1 AlonzoEra - SimpleScriptV1InBabbage :: ScriptLanguageInEra SimpleScriptV1 BabbageEra - - SimpleScriptV2InAllegra :: ScriptLanguageInEra SimpleScriptV2 AllegraEra - SimpleScriptV2InMary :: ScriptLanguageInEra SimpleScriptV2 MaryEra - SimpleScriptV2InAlonzo :: ScriptLanguageInEra SimpleScriptV2 AlonzoEra - SimpleScriptV2InBabbage :: ScriptLanguageInEra SimpleScriptV2 BabbageEra + SimpleScriptInShelley :: ScriptLanguageInEra SimpleScript' ShelleyEra + SimpleScriptInAllegra :: ScriptLanguageInEra SimpleScript' AllegraEra + SimpleScriptInMary :: ScriptLanguageInEra SimpleScript' MaryEra + SimpleScriptInAlonzo :: ScriptLanguageInEra SimpleScript' AlonzoEra + SimpleScriptInBabbage :: ScriptLanguageInEra SimpleScript' BabbageEra PlutusScriptV1InAlonzo :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra PlutusScriptV1InBabbage :: ScriptLanguageInEra PlutusScriptV1 BabbageEra @@ -601,36 +546,24 @@ scriptLanguageSupportedInEra :: CardanoEra era -> Maybe (ScriptLanguageInEra lang era) scriptLanguageSupportedInEra era lang = case (era, lang) of - (ShelleyEra, SimpleScriptLanguage SimpleScriptV1) -> - Just SimpleScriptV1InShelley - - (AllegraEra, SimpleScriptLanguage SimpleScriptV1) -> - Just SimpleScriptV1InAllegra + (ShelleyEra, SimpleScriptLanguage) -> + Just SimpleScriptInShelley - (MaryEra, SimpleScriptLanguage SimpleScriptV1) -> - Just SimpleScriptV1InMary + (AllegraEra, SimpleScriptLanguage) -> + Just SimpleScriptInAllegra - (AllegraEra, SimpleScriptLanguage SimpleScriptV2) -> - Just SimpleScriptV2InAllegra + (MaryEra, SimpleScriptLanguage) -> + Just SimpleScriptInMary - (MaryEra, SimpleScriptLanguage SimpleScriptV2) -> - Just SimpleScriptV2InMary + (AlonzoEra, SimpleScriptLanguage) -> + Just SimpleScriptInAlonzo - (AlonzoEra, SimpleScriptLanguage SimpleScriptV1) -> - Just SimpleScriptV1InAlonzo - - (AlonzoEra, SimpleScriptLanguage SimpleScriptV2) -> - Just SimpleScriptV2InAlonzo + (BabbageEra, SimpleScriptLanguage) -> + Just SimpleScriptInBabbage (AlonzoEra, PlutusScriptLanguage PlutusScriptV1) -> Just PlutusScriptV1InAlonzo - (BabbageEra, SimpleScriptLanguage SimpleScriptV1) -> - Just SimpleScriptV1InBabbage - - (BabbageEra, SimpleScriptLanguage SimpleScriptV2) -> - Just SimpleScriptV2InBabbage - (BabbageEra, PlutusScriptLanguage PlutusScriptV1) -> Just PlutusScriptV1InBabbage @@ -643,16 +576,11 @@ languageOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> ScriptLanguage lang languageOfScriptLanguageInEra langInEra = case langInEra of - SimpleScriptV1InShelley -> SimpleScriptLanguage SimpleScriptV1 - SimpleScriptV1InAllegra -> SimpleScriptLanguage SimpleScriptV1 - SimpleScriptV1InMary -> SimpleScriptLanguage SimpleScriptV1 - SimpleScriptV1InAlonzo -> SimpleScriptLanguage SimpleScriptV1 - SimpleScriptV1InBabbage -> SimpleScriptLanguage SimpleScriptV1 - - SimpleScriptV2InAllegra -> SimpleScriptLanguage SimpleScriptV2 - SimpleScriptV2InMary -> SimpleScriptLanguage SimpleScriptV2 - SimpleScriptV2InAlonzo -> SimpleScriptLanguage SimpleScriptV2 - SimpleScriptV2InBabbage -> SimpleScriptLanguage SimpleScriptV2 + SimpleScriptInShelley -> SimpleScriptLanguage + SimpleScriptInAllegra -> SimpleScriptLanguage + SimpleScriptInMary -> SimpleScriptLanguage + SimpleScriptInAlonzo -> SimpleScriptLanguage + SimpleScriptInBabbage -> SimpleScriptLanguage PlutusScriptV1InAlonzo -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV1InBabbage -> PlutusScriptLanguage PlutusScriptV1 @@ -662,22 +590,16 @@ eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> ShelleyBasedEra era eraOfScriptLanguageInEra langInEra = case langInEra of - SimpleScriptV1InShelley -> ShelleyBasedEraShelley + SimpleScriptInShelley -> ShelleyBasedEraShelley - SimpleScriptV1InAllegra -> ShelleyBasedEraAllegra - SimpleScriptV2InAllegra -> ShelleyBasedEraAllegra + SimpleScriptInAllegra -> ShelleyBasedEraAllegra - SimpleScriptV1InMary -> ShelleyBasedEraMary - SimpleScriptV2InMary -> ShelleyBasedEraMary - - SimpleScriptV1InAlonzo -> ShelleyBasedEraAlonzo - SimpleScriptV2InAlonzo -> ShelleyBasedEraAlonzo + SimpleScriptInMary -> ShelleyBasedEraMary + SimpleScriptInAlonzo -> ShelleyBasedEraAlonzo PlutusScriptV1InAlonzo -> ShelleyBasedEraAlonzo - SimpleScriptV1InBabbage -> ShelleyBasedEraBabbage - SimpleScriptV2InBabbage -> ShelleyBasedEraBabbage - + SimpleScriptInBabbage -> ShelleyBasedEraBabbage PlutusScriptV1InBabbage -> ShelleyBasedEraBabbage PlutusScriptV2InBabbage -> ShelleyBasedEraBabbage @@ -736,7 +658,7 @@ data PlutusScriptOrReferenceInput lang data SimpleScriptOrReferenceInput lang - = SScript (SimpleScript lang) + = SScript SimpleScript | SReferenceScript TxIn (Maybe ScriptHash) deriving (Eq, Show) @@ -755,13 +677,12 @@ data SimpleScriptOrReferenceInput lang -- data ScriptWitness witctx era where - SimpleScriptWitness :: ScriptLanguageInEra lang era - -> SimpleScriptVersion lang - -> SimpleScriptOrReferenceInput lang + SimpleScriptWitness :: ScriptLanguageInEra SimpleScript' era + -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness witctx era - PlutusScriptWitness :: ScriptLanguageInEra lang era - -> PlutusScriptVersion lang + PlutusScriptWitness :: ScriptLanguageInEra lang era + -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum witctx -> ScriptRedeemer @@ -772,12 +693,12 @@ deriving instance Show (ScriptWitness witctx era) -- The GADT in the SimpleScriptWitness constructor requires a custom instance instance Eq (ScriptWitness witctx era) where - (==) (SimpleScriptWitness langInEra version script) - (SimpleScriptWitness langInEra' version' script') = + (==) (SimpleScriptWitness langInEra script) + (SimpleScriptWitness langInEra' script') = case testEquality (languageOfScriptLanguageInEra langInEra) (languageOfScriptLanguageInEra langInEra') of Nothing -> False - Just Refl -> version == version' && script == script' + Just Refl -> script == script' (==) (PlutusScriptWitness langInEra version script datum redeemer execUnits) @@ -809,14 +730,27 @@ deriving instance Show (ScriptDatum witctx) -- Reference scripts exist in the UTxO, so without access to the UTxO we cannot -- retrieve the script. scriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era) -scriptWitnessScript (SimpleScriptWitness langInEra version (SScript script)) = - Just $ ScriptInEra langInEra (SimpleScript version script) +scriptWitnessScript (SimpleScriptWitness SimpleScriptInShelley (SScript script)) = + Just $ ScriptInEra SimpleScriptInShelley (SimpleScript script) + +scriptWitnessScript (SimpleScriptWitness SimpleScriptInAllegra (SScript script)) = + Just $ ScriptInEra SimpleScriptInAllegra (SimpleScript script) + +scriptWitnessScript (SimpleScriptWitness SimpleScriptInMary (SScript script)) = + Just $ ScriptInEra SimpleScriptInMary (SimpleScript script) + +scriptWitnessScript (SimpleScriptWitness SimpleScriptInAlonzo (SScript script)) = + Just $ ScriptInEra SimpleScriptInAlonzo (SimpleScript script) + +scriptWitnessScript (SimpleScriptWitness SimpleScriptInBabbage (SScript script)) = + Just $ ScriptInEra SimpleScriptInBabbage (SimpleScript script) scriptWitnessScript (PlutusScriptWitness langInEra version (PScript script) _ _ _) = Just $ ScriptInEra langInEra (PlutusScript version script) -scriptWitnessScript (SimpleScriptWitness _ _ (SReferenceScript _ _)) = +scriptWitnessScript (SimpleScriptWitness _ (SReferenceScript _ _)) = Nothing + scriptWitnessScript (PlutusScriptWitness _ _ (PReferenceScript _ _) _ _ _) = Nothing @@ -943,21 +877,12 @@ instance SerialiseAsRawBytes ScriptHash where hashScript :: Script lang -> ScriptHash -hashScript (SimpleScript SimpleScriptV1 s) = - -- For V1, we convert to the Shelley-era version specifically and hash that. - -- Later ledger eras have to be compatible anyway. - ScriptHash - . Ledger.hashScript @(ShelleyLedgerEra ShelleyEra) - . toShelleyMultiSig - $ s - -hashScript (SimpleScript SimpleScriptV2 s) = - -- For V2, we convert to the Allegra-era version specifically and hash that. +hashScript (SimpleScript s) = + -- We convert to the Allegra-era version specifically and hash that. -- Later ledger eras have to be compatible anyway. ScriptHash . Ledger.hashScript @(ShelleyLedgerEra AllegraEra) - . (toAllegraTimelock :: SimpleScript SimpleScriptV2 - -> Timelock.Timelock StandardCrypto) + . (toAllegraTimelock :: SimpleScript -> Timelock.Timelock StandardCrypto) $ s hashScript (PlutusScript PlutusScriptV1 (PlutusScriptSerialised script)) = @@ -983,75 +908,14 @@ fromShelleyScriptHash = ScriptHash -- The simple script language -- -data SimpleScript lang where - - RequireSignature :: !(Hash PaymentKey) - -> SimpleScript lang - - RequireTimeBefore :: !(TimeLocksSupported lang) - -> !SlotNo - -> SimpleScript lang - - RequireTimeAfter :: !(TimeLocksSupported lang) - -> !SlotNo - -> SimpleScript lang - - RequireAllOf :: [SimpleScript lang] -> SimpleScript lang - RequireAnyOf :: [SimpleScript lang] -> SimpleScript lang - RequireMOf :: Int -> [SimpleScript lang] -> SimpleScript lang - -deriving instance Eq (SimpleScript lang) -deriving instance Show (SimpleScript lang) - -instance HasTypeProxy lang => HasTypeProxy (SimpleScript lang) where - data AsType (SimpleScript lang) = AsSimpleScript (AsType lang) - proxyToAsType _ = AsSimpleScript (proxyToAsType (Proxy :: Proxy lang)) - - --- | Time lock feature in the 'SimpleScript' language. --- --- The constructors of this type serve as evidence that the timelocks feature --- is supported in particular versions of the language. --- -data TimeLocksSupported lang where - TimeLocksInSimpleScriptV2 :: TimeLocksSupported SimpleScriptV2 - -deriving instance Eq (TimeLocksSupported lang) -deriving instance Show (TimeLocksSupported lang) - -timeLocksSupported :: SimpleScriptVersion lang - -> Maybe (TimeLocksSupported lang) -timeLocksSupported SimpleScriptV1 = Nothing -timeLocksSupported SimpleScriptV2 = Just TimeLocksInSimpleScriptV2 - - --- | Try converting the 'SimpleScript' into a different version of the language. --- --- This will work when the script only uses the features of the target language --- version. For example converting from 'SimpleScriptV2' to 'SimpleScriptV1' --- will work if the script happens not to use time locks feature. On the other --- hand converting 'SimpleScriptV1' to 'SimpleScriptV2' will always work because --- it is backwards compatible. --- -adjustSimpleScriptVersion :: SimpleScriptVersion lang' - -> SimpleScript lang - -> Maybe (SimpleScript lang') -adjustSimpleScriptVersion target = go - where - go (RequireSignature sig) = pure (RequireSignature sig) - - go (RequireTimeBefore _ slot) = do - supported <- timeLocksSupported target - pure (RequireTimeBefore supported slot) - - go (RequireTimeAfter _ slot) = do - supported <- timeLocksSupported target - pure (RequireTimeAfter supported slot) - - go (RequireAllOf ss) = RequireAllOf <$> traverse go ss - go (RequireAnyOf ss) = RequireAnyOf <$> traverse go ss - go (RequireMOf m ss) = RequireMOf m <$> traverse go ss - +data SimpleScript + = RequireSignature !(Hash PaymentKey) + | RequireTimeBefore !SlotNo + | RequireTimeAfter !SlotNo + | RequireAllOf ![SimpleScript] + | RequireAnyOf ![SimpleScript] + | RequireMOf !Int ![SimpleScript] + deriving (Eq, Show) -- ---------------------------------------------------------------------------- -- The Plutus script language @@ -1138,20 +1002,13 @@ scriptArityForWitCtx WitCtxStake = 2 -- toShelleyScript :: ScriptInEra era -> Ledger.Script (ShelleyLedgerEra era) -toShelleyScript (ScriptInEra langInEra (SimpleScript SimpleScriptV1 script)) = +toShelleyScript (ScriptInEra langInEra (SimpleScript script)) = case langInEra of - SimpleScriptV1InShelley -> toShelleyMultiSig script - SimpleScriptV1InAllegra -> toAllegraTimelock script - SimpleScriptV1InMary -> toAllegraTimelock script - SimpleScriptV1InAlonzo -> Alonzo.TimelockScript (toAllegraTimelock script) - SimpleScriptV1InBabbage -> Alonzo.TimelockScript (toAllegraTimelock script) - -toShelleyScript (ScriptInEra langInEra (SimpleScript SimpleScriptV2 script)) = - case langInEra of - SimpleScriptV2InAllegra -> toAllegraTimelock script - SimpleScriptV2InMary -> toAllegraTimelock script - SimpleScriptV2InAlonzo -> Alonzo.TimelockScript (toAllegraTimelock script) - SimpleScriptV2InBabbage -> Alonzo.TimelockScript (toAllegraTimelock script) + SimpleScriptInShelley -> toShelleyMultiSig script + SimpleScriptInAllegra -> toAllegraTimelock script + SimpleScriptInMary -> toAllegraTimelock script + SimpleScriptInAlonzo -> Alonzo.TimelockScript (toAllegraTimelock script) + SimpleScriptInBabbage -> Alonzo.TimelockScript (toAllegraTimelock script) toShelleyScript (ScriptInEra langInEra (PlutusScript PlutusScriptV1 (PlutusScriptSerialised script))) = @@ -1170,62 +1027,56 @@ fromShelleyBasedScript :: ShelleyBasedEra era fromShelleyBasedScript era script = case era of ShelleyBasedEraShelley -> - ScriptInEra SimpleScriptV1InShelley $ - SimpleScript SimpleScriptV1 $ - fromShelleyMultiSig script + ScriptInEra SimpleScriptInShelley + . SimpleScript $ fromShelleyMultiSig script ShelleyBasedEraAllegra -> - ScriptInEra SimpleScriptV2InAllegra $ - SimpleScript SimpleScriptV2 $ - fromAllegraTimelock TimeLocksInSimpleScriptV2 script + ScriptInEra SimpleScriptInAllegra + . SimpleScript $ fromAllegraTimelock script ShelleyBasedEraMary -> - ScriptInEra SimpleScriptV2InMary $ - SimpleScript SimpleScriptV2 $ - fromAllegraTimelock TimeLocksInSimpleScriptV2 script + ScriptInEra SimpleScriptInMary + . SimpleScript $ fromAllegraTimelock script ShelleyBasedEraAlonzo -> case script of Alonzo.TimelockScript s -> - ScriptInEra SimpleScriptV2InAlonzo $ - SimpleScript SimpleScriptV2 $ - fromAllegraTimelock TimeLocksInSimpleScriptV2 s + ScriptInEra SimpleScriptInAlonzo + . SimpleScript $ fromAllegraTimelock s Alonzo.PlutusScript Alonzo.PlutusV1 s -> - ScriptInEra PlutusScriptV1InAlonzo $ - PlutusScript PlutusScriptV1 $ - PlutusScriptSerialised s + ScriptInEra PlutusScriptV1InAlonzo + . PlutusScript PlutusScriptV1 + $ PlutusScriptSerialised s Alonzo.PlutusScript Alonzo.PlutusV2 _ -> error "fromShelleyBasedScript: PlutusV2 not supported in Alonzo era" ShelleyBasedEraBabbage -> case script of Alonzo.TimelockScript s -> - ScriptInEra SimpleScriptV2InBabbage $ - SimpleScript SimpleScriptV2 $ - fromAllegraTimelock TimeLocksInSimpleScriptV2 s + ScriptInEra SimpleScriptInBabbage + . SimpleScript $ fromAllegraTimelock s Alonzo.PlutusScript Alonzo.PlutusV1 s -> - ScriptInEra PlutusScriptV1InBabbage $ - PlutusScript PlutusScriptV1 $ - PlutusScriptSerialised s + ScriptInEra PlutusScriptV1InBabbage + . PlutusScript PlutusScriptV1 $ PlutusScriptSerialised s Alonzo.PlutusScript Alonzo.PlutusV2 s -> - ScriptInEra PlutusScriptV2InBabbage $ - PlutusScript PlutusScriptV2 $ - PlutusScriptSerialised s + ScriptInEra PlutusScriptV2InBabbage + . PlutusScript PlutusScriptV2 $ PlutusScriptSerialised s -- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era. -- -toShelleyMultiSig :: SimpleScript SimpleScriptV1 - -> Shelley.MultiSig StandardCrypto +toShelleyMultiSig :: SimpleScript -> Shelley.MultiSig StandardCrypto toShelleyMultiSig = go where - go :: SimpleScript SimpleScriptV1 -> Shelley.MultiSig StandardCrypto + go :: SimpleScript -> Shelley.MultiSig StandardCrypto go (RequireSignature (PaymentKeyHash kh)) = Shelley.RequireSignature (Shelley.coerceKeyRole kh) go (RequireAllOf s) = Shelley.RequireAllOf (map go s) go (RequireAnyOf s) = Shelley.RequireAnyOf (map go s) go (RequireMOf m s) = Shelley.RequireMOf m (map go s) + go timelock = error $ "toShelleyMultiSig: " <> show timelock <> + " not supported in MultiSig scripts." -- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era. -- -fromShelleyMultiSig :: Shelley.MultiSig StandardCrypto -> SimpleScript lang +fromShelleyMultiSig :: Shelley.MultiSig StandardCrypto -> SimpleScript fromShelleyMultiSig = go where go (Shelley.RequireSignature kh) @@ -1238,31 +1089,28 @@ fromShelleyMultiSig = go -- | Conversion for the 'Timelock.Timelock' language that is shared between the -- Allegra and Mary eras. -- -toAllegraTimelock :: forall lang. - SimpleScript lang -> Timelock.Timelock StandardCrypto +toAllegraTimelock :: SimpleScript -> Timelock.Timelock StandardCrypto toAllegraTimelock = go where - go :: SimpleScript lang -> Timelock.Timelock StandardCrypto + go :: SimpleScript -> Timelock.Timelock StandardCrypto go (RequireSignature (PaymentKeyHash kh)) = Timelock.RequireSignature (Shelley.coerceKeyRole kh) go (RequireAllOf s) = Timelock.RequireAllOf (Seq.fromList (map go s)) go (RequireAnyOf s) = Timelock.RequireAnyOf (Seq.fromList (map go s)) go (RequireMOf m s) = Timelock.RequireMOf m (Seq.fromList (map go s)) - go (RequireTimeBefore _ t) = Timelock.RequireTimeExpire t - go (RequireTimeAfter _ t) = Timelock.RequireTimeStart t + go (RequireTimeBefore t) = Timelock.RequireTimeExpire t + go (RequireTimeAfter t) = Timelock.RequireTimeStart t -- | Conversion for the 'Timelock.Timelock' language that is shared between the -- Allegra and Mary eras. -- -fromAllegraTimelock :: TimeLocksSupported lang - -> Timelock.Timelock StandardCrypto - -> SimpleScript lang -fromAllegraTimelock timelocks = go +fromAllegraTimelock :: Timelock.Timelock StandardCrypto -> SimpleScript +fromAllegraTimelock = go where go (Timelock.RequireSignature kh) = RequireSignature (PaymentKeyHash (Shelley.coerceKeyRole kh)) - go (Timelock.RequireTimeExpire t) = RequireTimeBefore timelocks t - go (Timelock.RequireTimeStart t) = RequireTimeAfter timelocks t + go (Timelock.RequireTimeExpire t) = RequireTimeBefore t + go (Timelock.RequireTimeStart t) = RequireTimeAfter t go (Timelock.RequireAllOf s) = RequireAllOf (map go (toList s)) go (Timelock.RequireAnyOf s) = RequireAnyOf (map go (toList s)) go (Timelock.RequireMOf i s) = RequireMOf i (map go (toList s)) @@ -1279,16 +1127,16 @@ fromAllegraTimelock timelocks = go -- Because of this the 'Script' type also does not have any JSON instances, but -- the 'SimpleScript' type does. -instance ToJSON (SimpleScript lang) where +instance ToJSON SimpleScript where toJSON (RequireSignature pKeyHash) = object [ "type" .= String "sig" , "keyHash" .= serialiseToRawBytesHexText pKeyHash ] - toJSON (RequireTimeBefore _ slot) = + toJSON (RequireTimeBefore slot) = object [ "type" .= String "before" , "slot" .= slot ] - toJSON (RequireTimeAfter _ slot) = + toJSON (RequireTimeAfter slot) = object [ "type" .= String "after" , "slot" .= slot ] @@ -1303,42 +1151,38 @@ instance ToJSON (SimpleScript lang) where ] -instance IsSimpleScriptLanguage lang => FromJSON (SimpleScript lang) where - parseJSON = parseSimpleScript simpleScriptVersion - +instance FromJSON SimpleScript where + parseJSON = parseSimpleScript -parseSimpleScript :: SimpleScriptVersion lang - -> Value -> Aeson.Parser (SimpleScript lang) -parseSimpleScript lang v = parseScriptSig v - <|> parseScriptBefore lang v - <|> parseScriptAfter lang v - <|> parseScriptAny lang v - <|> parseScriptAll lang v - <|> parseScriptAtLeast lang v +-- TODO: Left off here. You need to comb through cardano-api's property tests concerning simple scripts +parseSimpleScript :: Value -> Aeson.Parser SimpleScript +parseSimpleScript v = parseScriptSig v <|> + parseScriptBefore v <|> + parseScriptAfter v <|> + parseScriptAny v <|> + parseScriptAll v <|> + parseScriptAtLeast v -parseScriptAny :: SimpleScriptVersion lang - -> Value -> Aeson.Parser (SimpleScript lang) -parseScriptAny lang = +parseScriptAny :: Value -> Aeson.Parser SimpleScript +parseScriptAny = Aeson.withObject "any" $ \obj -> do t <- obj .: "type" case t :: Text of "any" -> do vs <- obj .: "scripts" - RequireAnyOf <$> gatherSimpleScriptTerms lang vs + RequireAnyOf <$> gatherSimpleScriptTerms vs _ -> fail "\"any\" script value not found" -parseScriptAll :: SimpleScriptVersion lang - -> Value -> Aeson.Parser (SimpleScript lang) -parseScriptAll lang = +parseScriptAll :: Value -> Aeson.Parser SimpleScript +parseScriptAll = Aeson.withObject "all" $ \obj -> do t <- obj .: "type" case t :: Text of "all" -> do vs <- obj .: "scripts" - RequireAllOf <$> gatherSimpleScriptTerms lang vs + RequireAllOf <$> gatherSimpleScriptTerms vs _ -> fail "\"all\" script value not found" -parseScriptAtLeast :: SimpleScriptVersion lang - -> Value -> Aeson.Parser (SimpleScript lang) -parseScriptAtLeast lang = +parseScriptAtLeast :: Value -> Aeson.Parser SimpleScript +parseScriptAtLeast = Aeson.withObject "atLeast" $ \obj -> do v <- obj .: "type" case v :: Text of @@ -1349,7 +1193,7 @@ parseScriptAtLeast lang = Number sci -> case toBoundedInteger sci of Just reqInt -> - do scripts <- gatherSimpleScriptTerms lang vs + do scripts <- gatherSimpleScriptTerms vs let numScripts = length scripts when (reqInt > numScripts) @@ -1362,11 +1206,10 @@ parseScriptAtLeast lang = _ -> fail "\"required\" value should be an integer" _ -> fail "\"atLeast\" script value not found" -gatherSimpleScriptTerms :: SimpleScriptVersion lang - -> Vector Value -> Aeson.Parser [SimpleScript lang] -gatherSimpleScriptTerms lang = mapM (parseSimpleScript lang) . Vector.toList +gatherSimpleScriptTerms :: Vector Value -> Aeson.Parser [SimpleScript] +gatherSimpleScriptTerms = mapM parseSimpleScript . Vector.toList -parseScriptSig :: Value -> Aeson.Parser (SimpleScript lang) +parseScriptSig :: Value -> Aeson.Parser SimpleScript parseScriptSig = Aeson.withObject "sig" $ \obj -> do v <- obj .: "type" @@ -1375,28 +1218,20 @@ parseScriptSig = RequireSignature <$> parsePaymentKeyHash k _ -> fail "\"sig\" script value not found" -parseScriptBefore :: SimpleScriptVersion lang - -> Value -> Aeson.Parser (SimpleScript lang) -parseScriptBefore lang = +parseScriptBefore :: Value -> Aeson.Parser SimpleScript +parseScriptBefore = Aeson.withObject "before" $ \obj -> do v <- obj .: "type" case v :: Text of - "before" -> - case timeLocksSupported lang of - Just supported -> RequireTimeBefore supported <$> obj .: "slot" - Nothing -> fail ("type \"before\" not supported in " ++ show lang) + "before" -> RequireTimeBefore <$> obj .: "slot" _ -> fail "\"before\" script value not found" -parseScriptAfter :: SimpleScriptVersion lang - -> Value -> Aeson.Parser (SimpleScript lang) -parseScriptAfter lang = +parseScriptAfter :: Value -> Aeson.Parser SimpleScript +parseScriptAfter = Aeson.withObject "after" $ \obj -> do v <- obj .: "type" case v :: Text of - "after" -> - case timeLocksSupported lang of - Just supported -> RequireTimeAfter supported <$> obj .: "slot" - Nothing -> fail ("type \"after\" not supported in " ++ show lang) + "after" -> RequireTimeAfter <$> obj .: "slot" _ -> fail "\"after\" script value not found" parsePaymentKeyHash :: Text -> Aeson.Parser (Hash PaymentKey) @@ -1492,10 +1327,8 @@ textEnvelopeToScript = deserialiseFromTextEnvelopeAnyOf textEnvTypes where textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang] textEnvTypes = - [ FromSomeType (AsScript AsSimpleScriptV1) - (ScriptInAnyLang (SimpleScriptLanguage SimpleScriptV1)) - , FromSomeType (AsScript AsSimpleScriptV2) - (ScriptInAnyLang (SimpleScriptLanguage SimpleScriptV2)) + [ FromSomeType (AsScript AsSimpleScript) + (ScriptInAnyLang SimpleScriptLanguage) , FromSomeType (AsScript AsPlutusScriptV1) (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV1)) , FromSomeType (AsScript AsPlutusScriptV2) diff --git a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs index dc59bedcc16..b7874e65140 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs @@ -128,13 +128,13 @@ prop_roundtrip_signing_key_kes_CBOR = prop_roundtrip_script_SimpleScriptV1_CBOR :: Property prop_roundtrip_script_SimpleScriptV1_CBOR = - roundtrip_CBOR (AsScript AsSimpleScriptV1) - (genScript (SimpleScriptLanguage SimpleScriptV1)) + roundtrip_CBOR (AsScript AsSimpleScript) + (genScript SimpleScriptLanguage) prop_roundtrip_script_SimpleScriptV2_CBOR :: Property prop_roundtrip_script_SimpleScriptV2_CBOR = - roundtrip_CBOR (AsScript AsSimpleScriptV2) - (genScript (SimpleScriptLanguage SimpleScriptV2)) + roundtrip_CBOR (AsScript AsSimpleScript) + (genScript SimpleScriptLanguage) prop_roundtrip_script_PlutusScriptV1_CBOR :: Property prop_roundtrip_script_PlutusScriptV1_CBOR = diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Script.hs b/cardano-api/test/Test/Cardano/Api/Typed/Script.hs index 16c26a96b5c..ddd7e8c8456 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Script.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/Script.hs @@ -16,7 +16,7 @@ import qualified Hedgehog as H {- HLINT ignore "Use camelCase" -} -exampleSimpleScriptV1_All :: SimpleScript SimpleScriptV1 +exampleSimpleScriptV1_All :: SimpleScript exampleSimpleScriptV1_All = RequireAllOf [ RequireSignature "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a" @@ -29,7 +29,7 @@ exampleSimpleScriptV1_All = , RequireSignature "6b732c60c267bab894854d6dd57a04a94e603fcc4c36274c9ed75952" ] -exampleSimpleScriptV1_Any :: SimpleScript SimpleScriptV1 +exampleSimpleScriptV1_Any :: SimpleScript exampleSimpleScriptV1_Any = RequireAnyOf [ RequireSignature "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09" @@ -40,7 +40,7 @@ exampleSimpleScriptV1_Any = , RequireSignature "622be5fab3b5c3f371a50a535e4d3349c942a98cecee93b24e2fd11d" ] -exampleSimpleScriptV1_MofN :: SimpleScript SimpleScriptV1 +exampleSimpleScriptV1_MofN :: SimpleScript exampleSimpleScriptV1_MofN = RequireMOf 2 [ RequireSignature "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413" @@ -50,26 +50,26 @@ exampleSimpleScriptV1_MofN = ] -exampleSimpleScriptV2_All :: SimpleScript SimpleScriptV2 +exampleSimpleScriptV2_All :: SimpleScript exampleSimpleScriptV2_All = RequireAllOf [ RequireSignature "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a" - , RequireTimeBefore TimeLocksInSimpleScriptV2 (SlotNo 42) + , RequireTimeBefore (SlotNo 42) ] -exampleSimpleScriptV2_Any :: SimpleScript SimpleScriptV2 +exampleSimpleScriptV2_Any :: SimpleScript exampleSimpleScriptV2_Any = RequireAnyOf [ RequireSignature "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09" - , RequireTimeAfter TimeLocksInSimpleScriptV2 (SlotNo 42) + , RequireTimeAfter (SlotNo 42) ] -exampleSimpleScriptV2_MofN :: SimpleScript SimpleScriptV2 +exampleSimpleScriptV2_MofN :: SimpleScript exampleSimpleScriptV2_MofN = RequireMOf 1 [ RequireSignature "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413" , RequireSignature "f856c0c5839bab22673747d53f1ae9eed84afafb085f086e8e988614" - , RequireTimeBefore TimeLocksInSimpleScriptV2 (SlotNo 42) + , RequireTimeBefore (SlotNo 42) ] -- ----------------------------------------------------------------------------- @@ -105,16 +105,10 @@ prop_golden_SimpleScriptV2_MofN = "test/Golden/Script/SimpleV2/atleast" -prop_roundtrip_SimpleScriptV1_JSON :: Property -prop_roundtrip_SimpleScriptV1_JSON = +prop_roundtrip_SimpleScript_JSON :: Property +prop_roundtrip_SimpleScript_JSON = H.property $ do - mss <- H.forAll $ genSimpleScript SimpleScriptV1 - H.tripping mss encode eitherDecode - -prop_roundtrip_SimpleScriptV2_JSON :: Property -prop_roundtrip_SimpleScriptV2_JSON = - H.property $ do - mss <- H.forAll $ genSimpleScript SimpleScriptV2 + mss <- H.forAll $ genSimpleScript H.tripping mss encode eitherDecode prop_roundtrip_ScriptData :: Property @@ -133,7 +127,6 @@ tests = testGroup "Test.Cardano.Api.Typed.Script" , testPropertyNamed "golden SimpleScriptV2 All" "golden SimpleScriptV2 All" prop_golden_SimpleScriptV2_All , testPropertyNamed "golden SimpleScriptV2 Any" "golden SimpleScriptV2 Any" prop_golden_SimpleScriptV2_Any , testPropertyNamed "golden SimpleScriptV2 MofN" "golden SimpleScriptV2 MofN" prop_golden_SimpleScriptV2_MofN - , testPropertyNamed "roundtrip SimpleScriptV1 JSON" "roundtrip SimpleScriptV1 JSON" prop_roundtrip_SimpleScriptV1_JSON - , testPropertyNamed "roundtrip SimpleScriptV2 JSON" "roundtrip SimpleScriptV2 JSON" prop_roundtrip_SimpleScriptV2_JSON + , testPropertyNamed "roundtrip SimpleScript JSON" "roundtrip SimpleScriptV1 JSON" prop_roundtrip_SimpleScript_JSON , testPropertyNamed "roundtrip ScriptData" "roundtrip ScriptData" prop_roundtrip_ScriptData ] diff --git a/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs b/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs index 22acc86eb0f..63bf9080d27 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs @@ -64,10 +64,10 @@ prop_roundtrip_txbodycontent_txouts = a === b isSimpleScriptV1 :: ReferenceScript era -> Bool - isSimpleScriptV1 = isLang (SimpleScriptLanguage SimpleScriptV1) + isSimpleScriptV1 = isLang SimpleScriptLanguage isSimpleScriptV2 :: ReferenceScript era -> Bool - isSimpleScriptV2 = isLang (SimpleScriptLanguage SimpleScriptV2) + isSimpleScriptV2 = isLang SimpleScriptLanguage isLang :: ScriptLanguage a -> ReferenceScript era -> Bool isLang expected = \case