Switch to type safe construction

Author: lehins

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs

@@ -25,6 +25,7 @@ import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..))
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Core
 import Cardano.Ledger.Alonzo.PParams
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo, mkSupportedPlutusScript)
 import Cardano.Ledger.Alonzo.Rules (vKeyLocked)
 import Cardano.Ledger.Alonzo.Scripts as Alonzo (
   AlonzoPlutusPurpose (..),
@@ -98,11 +99,11 @@ import Numeric.Natural (Natural)
 import qualified PlutusLedgerApi.Common as P (Data (..))
 import System.Random
 import Test.Cardano.Ledger.AllegraEraGen (genValidityInterval)
-import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysFails, alwaysSucceeds, mkPlutusScript')
+import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Binary.Random
 import Test.Cardano.Ledger.Common (tracedDiscard)
 import Test.Cardano.Ledger.MaryEraGen (addTokens, genMint, maryGenesisValue, policyIndex)
-import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
+import Test.Cardano.Ledger.Plutus (alwaysFailsPlutus, alwaysSucceedsPlutus, zeroTestingCostModels)
 import Test.Cardano.Ledger.Plutus.Examples
 import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
 import Test.Cardano.Ledger.Shelley.Generator.Core (
@@ -128,63 +129,98 @@ import Test.QuickCheck hiding ((><))
 vKeyLockedAdaOnly :: TxOut AlonzoEra -> Bool
 vKeyLockedAdaOnly txOut = vKeyLocked txOut && isAdaOnly (txOut ^. valueTxOutL)
 
-phase2scripts3Arg :: forall era. AlonzoEraScript era => [TwoPhase3ArgInfo era]
+phase2scripts3Arg :: EraPlutusTxInfo PlutusV1 era => [TwoPhase3ArgInfo era]
 phase2scripts3Arg =
-  [ mkTwoPhase3ArgInfo (alwaysSucceeds @'PlutusV1 3) (P.I 1) (P.I 1, bigMem, bigStep) True
+  [ mkTwoPhase3ArgInfo
+      (mkSupportedPlutusScript (alwaysSucceedsPlutus @'PlutusV1 3))
+      (P.I 1)
+      (P.I 1, bigMem, bigStep)
+      True
   , mkTwoPhase3ArgInfo
-      (mkPlutusScript' (redeemerSameAsDatum SPlutusV1))
+      (mkSupportedPlutusScript (redeemerSameAsDatum SPlutusV1))
       (P.I 9)
       (P.I 9, bigMem, bigStep)
       True
-  , mkTwoPhase3ArgInfo (mkPlutusScript' (evenDatum SPlutusV1)) (P.I 8) (P.I 8, bigMem, bigStep) True
-  , mkTwoPhase3ArgInfo (alwaysFails @'PlutusV1 3) (P.I 1) (P.I 1, bigMem, bigStep) False
   , mkTwoPhase3ArgInfo
-      (mkPlutusScript' (purposeIsWellformedWithDatum SPlutusV1))
+      (mkSupportedPlutusScript (evenDatum SPlutusV1))
+      (P.I 8)
+      (P.I 8, bigMem, bigStep)
+      True
+  , mkTwoPhase3ArgInfo
+      (mkSupportedPlutusScript (alwaysFailsPlutus @'PlutusV1 3))
+      (P.I 1)
+      (P.I 1, bigMem, bigStep)
+      False
+  , mkTwoPhase3ArgInfo
+      (mkSupportedPlutusScript (purposeIsWellformedWithDatum SPlutusV1))
       (P.I 3)
       (P.I 4, bigMem, bigStep)
       True
   , mkTwoPhase3ArgInfo
-      (mkPlutusScript' (datumIsWellformed SPlutusV1))
+      (mkSupportedPlutusScript (datumIsWellformed SPlutusV1))
       (P.I 5)
       (P.I 6, bigMem, bigStep)
       True
   , mkTwoPhase3ArgInfo
-      (mkPlutusScript' (inputsOutputsAreNotEmptyWithDatum SPlutusV1))
+      (mkSupportedPlutusScript (inputsOutputsAreNotEmptyWithDatum SPlutusV1))
       (P.I 7)
       (P.I 9, bigMem, bigStep)
       True
   ]
   where
-    mkTwoPhase3ArgInfo script = TwoPhase3ArgInfo script (hashScript @era script)
+    mkTwoPhase3ArgInfo plutusScript =
+      let script = fromPlutusScript plutusScript
+       in TwoPhase3ArgInfo script (hashScript script)
 
-phase2scripts2Arg :: forall era. AlonzoEraScript era => [TwoPhase2ArgInfo era]
+phase2scripts2Arg :: EraPlutusTxInfo PlutusV1 era => [TwoPhase2ArgInfo era]
 phase2scripts2Arg =
-  [ mkTwoPhase2ArgInfo (alwaysSucceeds @'PlutusV1 2) (P.I 1, bigMem, bigStep) True
-  , mkTwoPhase2ArgInfo (mkPlutusScript' (evenRedeemerNoDatum SPlutusV1)) (P.I 14, bigMem, bigStep) True
-  , mkTwoPhase2ArgInfo (alwaysFails @'PlutusV1 2) (P.I 1, bigMem, bigStep) False
+  [ mkTwoPhase2ArgInfo
+      (mkSupportedPlutusScript (alwaysSucceedsPlutus @'PlutusV1 2))
+      (P.I 1, bigMem, bigStep)
+      True
   , mkTwoPhase2ArgInfo
-      (mkPlutusScript' (purposeIsWellformedNoDatum SPlutusV1))
+      (mkSupportedPlutusScript (evenRedeemerNoDatum SPlutusV1))
       (P.I 14, bigMem, bigStep)
       True
   , mkTwoPhase2ArgInfo
-      (mkPlutusScript' (inputsOutputsAreNotEmptyNoDatum SPlutusV1))
+      (mkSupportedPlutusScript (alwaysFailsPlutus @'PlutusV1 2))
+      (P.I 1, bigMem, bigStep)
+      False
+  , mkTwoPhase2ArgInfo
+      (mkSupportedPlutusScript (purposeIsWellformedNoDatum SPlutusV1))
+      (P.I 14, bigMem, bigStep)
+      True
+  , mkTwoPhase2ArgInfo
+      (mkSupportedPlutusScript (inputsOutputsAreNotEmptyNoDatum SPlutusV1))
       (P.I 15, bigMem, bigStep)
       True
   ]
   where
-    mkTwoPhase2ArgInfo script = TwoPhase2ArgInfo script (hashScript @era script)
+    mkTwoPhase2ArgInfo plutusScript =
+      let script = fromPlutusScript plutusScript
+       in TwoPhase2ArgInfo script (hashScript script)
 
-phase2scripts3ArgSucceeds :: forall era. AlonzoEraScript era => Script era -> Bool
+phase2scripts3ArgSucceeds ::
+  forall era.
+  EraPlutusTxInfo PlutusV1 era =>
+  Script era ->
+  Bool
 phase2scripts3ArgSucceeds script =
   maybe True getSucceeds3 $
     List.find (\info -> getScript3 info == script) phase2scripts3Arg
 
-phase2scripts2ArgSucceeds :: forall era. AlonzoEraScript era => Script era -> Bool
+phase2scripts2ArgSucceeds ::
+  forall era.
+  EraPlutusTxInfo PlutusV1 era =>
+  Script era ->
+  Bool
 phase2scripts2ArgSucceeds script =
   maybe True getSucceeds2 $
     List.find (\info -> getScript2 info == script) phase2scripts2Arg
 
-genPlutus2Arg :: AlonzoEraScript era => Gen (Maybe (TwoPhase2ArgInfo era))
+genPlutus2Arg ::
+  EraPlutusTxInfo PlutusV1 era =>
+  Gen (Maybe (TwoPhase2ArgInfo era))
 genPlutus2Arg = frequency [(10, Just <$> elements phase2scripts2Arg), (90, pure Nothing)]
 
 -- | Gen a Mint value in the Alonzo Era, with a 10% chance that it includes an AlonzoScript

eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs

@@ -7,7 +7,7 @@
 
 module Test.Cardano.Ledger.Babbage.Imp (spec) where
 
-import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
+import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusTxInfo)
 import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxoPredFailure,
   AlonzoUtxosPredFailure,
@@ -17,6 +17,7 @@ import Cardano.Ledger.Babbage.Core
 import Cardano.Ledger.Babbage.Rules (BabbageUtxowPredFailure (..))
 import Cardano.Ledger.Babbage.TxInfo (BabbageContextError)
 import Cardano.Ledger.BaseTypes (Inject)
+import Cardano.Ledger.Plutus (Language (..))
 import Cardano.Ledger.Shelley.Rules (
   ShelleyDelegPredFailure,
   ShelleyUtxoPredFailure,
@@ -31,6 +32,7 @@ spec ::
   forall era.
   ( AlonzoEraImp era
   , BabbageEraTxBody era
+  , EraPlutusTxInfo PlutusV2 era
   , InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era

eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec.hs

@@ -10,7 +10,7 @@
 
 module Test.Cardano.Ledger.Babbage.Imp.UtxowSpec (spec) where
 
-import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
+import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusTxInfo, mkSupportedPlutusScript)
 import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..))
 import Cardano.Ledger.Alonzo.Rules (AlonzoUtxosPredFailure (..), AlonzoUtxowPredFailure (..))
 import Cardano.Ledger.Alonzo.Scripts
@@ -28,19 +28,19 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import Lens.Micro
-import Test.Cardano.Ledger.Alonzo.Arbitrary (mkPlutusScript')
 import Test.Cardano.Ledger.Alonzo.ImpTest
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus.Examples (redeemerSameAsDatum)
 
 spec ::
   forall era.
   ( AlonzoEraImp era
+  , BabbageEraTxBody era
+  , EraPlutusTxInfo PlutusV2 era
   , InjectRuleFailure "LEDGER" BabbageUtxowPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
   , Inject (BabbageContextError era) (ContextError era)
-  , BabbageEraTxBody era
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
 spec = describe "UTXOW" $ do
@@ -55,7 +55,7 @@ spec = describe "UTXOW" $ do
       ]
 
   it "MalformedReferenceScripts" $ do
-    let script = mkPlutusScript' @era (malformedPlutus @'PlutusV2)
+    let script = fromPlutusScript (mkSupportedPlutusScript (malformedPlutus @'PlutusV2))
     let scriptHash = hashScript script
     addr <- freshKeyAddr_
     let tx =

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs

@@ -8,7 +8,7 @@
 
 module Test.Cardano.Ledger.Conway.Imp (spec, conwaySpec) where
 
-import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (..))
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (..), EraPlutusTxInfo)
 import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxoPredFailure,
   AlonzoUtxosPredFailure,
@@ -31,6 +31,7 @@ import Cardano.Ledger.Conway.Rules (
   ConwayUtxoPredFailure,
  )
 import Cardano.Ledger.Conway.TxInfo (ConwayContextError)
+import Cardano.Ledger.Plutus (Language (..))
 import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..))
 import Cardano.Ledger.Shelley.Rules (
   ShelleyDelegPredFailure,
@@ -62,6 +63,7 @@ import Test.Cardano.Ledger.Shelley.ImpTest (ImpInit)
 spec ::
   forall era.
   ( ConwayEraImp era
+  , EraPlutusTxInfo PlutusV2 era
   , Inject (BabbageContextError era) (ContextError era)
   , Inject (ConwayContextError era) (ContextError era)
   , InjectRuleFailure "LEDGER" ConwayGovPredFailure era

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs

@@ -25,6 +25,7 @@ module Test.Cardano.Ledger.Examples.BabbageFeatures (
 ) where
 
 import Cardano.Ledger.Address (Addr (..))
+import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo, mkSupportedPlutusScript)
 import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (BadTranslation))
 import Cardano.Ledger.Alonzo.Plutus.TxInfo (
   TxOutSource (TxOutFromInput, TxOutFromOutput),
@@ -59,7 +60,6 @@ import Cardano.Ledger.Plutus.Language (
   Language (..),
   Plutus (..),
   PlutusBinary (..),
-  PlutusLanguage,
  )
 import Cardano.Ledger.Shelley.API (UTxO (..))
 import Cardano.Ledger.Shelley.LedgerState (UTxOState (..), smartUTxOState)
@@ -79,7 +79,6 @@ import qualified Data.Set as Set
 import GHC.Stack
 import Lens.Micro
 import qualified PlutusLedgerApi.V1 as PV1
-import Test.Cardano.Ledger.Alonzo.Arbitrary (mkPlutusScript')
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessVKey)
 import Test.Cardano.Ledger.Examples.STSTestUtils (
   mkGenesisTxIn,
@@ -142,9 +141,9 @@ evenData3ArgsScript proof =
     Conway -> evenData3ArgsLang @'PlutusV2
   where
     unsupported = "Plutus scripts are not supported in:" ++ show proof
-    evenData3ArgsLang :: forall l era'. (PlutusLanguage l, AlonzoEraScript era') => Script era'
+    evenData3ArgsLang :: forall l era'. EraPlutusTxInfo l era' => Script era'
     evenData3ArgsLang =
-      mkPlutusScript' . Plutus @l . PlutusBinary . SBS.pack $
+      fromPlutusScript . mkSupportedPlutusScript . Plutus @l . PlutusBinary . SBS.pack $
         concat
           [ [88, 65, 1, 0, 0, 51, 50, 34, 51, 34, 34, 37, 51, 83, 0]
           , [99, 50, 35, 51, 87, 52, 102, 225, 192, 8, 0, 64, 40, 2, 76]