Implement prop_extractAllIndexedPlutusScriptWitnesses

Author: Jimbo4350

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -125,6 +125,12 @@ module Test.Gen.Cardano.Api.Typed
   , genLedgerValueForTxOut
   , genLedgerMultiAssetValue
   , genWitnesses
+  , genScriptWitnessedTxIn
+  , genScriptWitnessedTxMintValue
+  , genScriptWitnessedTxCertificates
+  , genScriptWitnessedTxProposals
+  , genScriptWitnessedTxWithdrawals
+  , genScriptWitnesssedTxVotingProcedures
   , genWitnessNetworkIdOrByronAddress
   , genRational
   , genGovernancePoll
@@ -742,6 +748,17 @@ genTxWithdrawals =
           ]
     )
 
+genScriptWitnessedTxWithdrawals :: Exp.Era era -> Gen (TxWithdrawals BuildTx era)
+genScriptWitnessedTxWithdrawals era = do
+  num <- Gen.integral (Range.constant 0 3)
+  sAddrs <- Gen.list (Range.singleton num) genStakeAddress
+  coins <- Gen.list (Range.singleton num) genPositiveLovelace
+  sWits <-
+    Gen.list (Range.singleton num) $
+      ScriptWitness ScriptWitnessForStakeAddr <$> genApiPlutusScriptWitness WitCtxStake era
+  let withdrawals = zipWith3 (\addr c wit -> (addr, c, BuildTxWith wit)) sAddrs coins sWits
+  return $ TxWithdrawals (convert era) withdrawals
+
 genTxCertificates :: Typeable era => CardanoEra era -> Gen (TxCertificates BuildTx era)
 genTxCertificates =
   inEonForEra
@@ -755,6 +772,20 @@ genTxCertificates =
           ]
     )
 
+genScriptWitnessedTxCertificates :: Typeable era => Exp.Era era -> Gen (TxCertificates BuildTx era)
+genScriptWitnessedTxCertificates era = do
+  let w = convert era
+  num <- Gen.integral (Range.linear 0 3)
+  certs <- Gen.list (Range.singleton num) $ genCertificate w
+  plutusScriptWits <- Gen.list (Range.singleton num) $ genApiPlutusScriptWitness WitCtxStake era
+  let certsAndWits =
+        zipWith
+          (\c p -> (c, Just p))
+          certs
+          plutusScriptWits
+
+  pure $ mkTxCertificates (convert era) certsAndWits
+
 genCertificate :: forall era. Typeable era => ShelleyBasedEra era -> Gen (Certificate era)
 genCertificate sbe =
   Gen.choice $
@@ -1388,6 +1419,17 @@ genProposals w = conwayEraOnwardsConstraints w $ do
       (proposal,) <$> Gen.maybe (genScriptWitnessForStake sbe)
   pure $ mkTxProposalProcedures proposalsWithMaybeWitnesses
 
+genScriptWitnessedTxProposals
+  :: Exp.Era era
+  -> Gen (TxProposalProcedures BuildTx era)
+genScriptWitnessedTxProposals era = do
+  let w = convert era
+  num <- Gen.integral (Range.linear 0 3)
+  proposals <- Gen.list (Range.singleton num) (genProposal w)
+  sWits <- Gen.list (Range.singleton num) $ genApiPlutusScriptWitness WitCtxStake era
+  let proposalsWithMaybeWitnesses = zipWith (\p wit -> (p, Just wit)) proposals sWits
+  pure $ Exp.obtainCommonConstraints era $ mkTxProposalProcedures proposalsWithMaybeWitnesses
+
 genProposal :: ConwayEraOnwards era -> Gen (L.ProposalProcedure (ShelleyLedgerEra era))
 genProposal w =
   conwayEraOnwardsTestConstraints w Q.arbitrary
@@ -1405,6 +1447,18 @@ genVotingProcedures w = conwayEraOnwardsConstraints w $ do
     <$> Q.arbitrary
     <*> pure (pure votersWithWitnesses)
 
+genScriptWitnesssedTxVotingProcedures
+  :: Exp.Era era
+  -> Gen (Api.TxVotingProcedures BuildTx era)
+genScriptWitnesssedTxVotingProcedures era = do
+  num <- Gen.integral (Range.linear 0 3)
+  voters <- Gen.list (Range.singleton num) Q.arbitrary
+  plutusScriptWits <- Gen.list (Range.singleton num) $ genApiPlutusScriptWitness WitCtxStake era
+  let votersWithWitnesses = fromList $ zip voters plutusScriptWits
+  Api.TxVotingProcedures
+    <$> Exp.obtainCommonConstraints era Q.arbitrary
+    <*> pure (pure votersWithWitnesses)
+
 genCurrentTreasuryValue :: ConwayEraOnwards era -> Gen L.Coin
 genCurrentTreasuryValue _era = Q.arbitrary
 
@@ -1447,8 +1501,38 @@ genPlutusScriptWitness = do
 genPlutusScriptDatum :: Gen (Exp.PlutusScriptDatum lang purpose)
 genPlutusScriptDatum = return Exp.NoScriptDatum
 
+genScriptWitnessedTxIn
+  :: Exp.Era era -> Gen [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
+genScriptWitnessedTxIn era = do
+  num <- Gen.integral (Range.linear 0 3)
+  sWits <-
+    map (ScriptWitness ScriptWitnessForSpending)
+      <$> Gen.list (Range.singleton num) (genApiPlutusScriptWitness WitCtxTxIn era)
+  txIns <- Gen.list (Range.singleton num) genTxIn
+  pure $ zip txIns (BuildTxWith <$> sWits)
+
+genScriptWitnessedTxMintValue
+  :: Exp.Era era -> Gen (TxMintValue BuildTx era)
+genScriptWitnessedTxMintValue era = do
+  let w = convert era
+  num <- Gen.integral (Range.linear 0 3)
+  sWits <-
+    Gen.list (Range.singleton num) (genApiPlutusScriptWitness WitCtxMint era)
+
+  policies <- Gen.list (Range.singleton num) genPolicyId
+  mintValues <- Gen.list (Range.singleton num) genPolicyAssets
+  let assets =
+        [ (p, mintValue, BuildTxWith s)
+        | p <- policies
+        , s <- sWits
+        , mintValue <- mintValues
+        ]
+
+  pure $ mkTxMintValue w assets
+
 -- | This generator does not generate a valid witness - just a random one.
-genScriptWitnessForStake :: ShelleyBasedEra era -> Gen (Api.ScriptWitness WitCtxStake era)
+genScriptWitnessForStake
+  :: ShelleyBasedEra era -> Gen (Api.ScriptWitness WitCtxStake era)
 genScriptWitnessForStake sbe = do
   ScriptInEra scriptLangInEra script' <- genScriptInEra sbe
   case script' of
@@ -1474,6 +1558,50 @@ genScriptWitnessForStake sbe = do
         scriptRedeemer
         <$> genExecutionUnits
 
+genAnyPlutusScriptVersion :: Gen AnyPlutusScriptVersion
+genAnyPlutusScriptVersion = do
+  Gen.element [minBound .. maxBound]
+
+plutusScriptLangaugeInEra
+  :: Exp.Era era -> PlutusScriptVersion lang -> ScriptLanguageInEra lang era
+plutusScriptLangaugeInEra Exp.ConwayEra l =
+  case l of
+    PlutusScriptV1 -> PlutusScriptV1InConway
+    PlutusScriptV2 -> PlutusScriptV2InConway
+    PlutusScriptV3 -> PlutusScriptV3InConway
+
+genApiPlutusScriptWitness
+  :: WitCtx witctx -> Exp.Era era -> Gen (Api.ScriptWitness witctx era)
+genApiPlutusScriptWitness witCtx era = do
+  dat <- case witCtx of
+    WitCtxTxIn -> do
+      datum <- Gen.maybe genHashableScriptData
+
+      Gen.element [ScriptDatumForTxIn datum, InlineScriptDatum]
+    WitCtxMint -> do
+      pure NoScriptDatumForMint
+    WitCtxStake -> do
+      pure NoScriptDatumForStake
+
+  AnyPlutusScriptVersion lang <- genAnyPlutusScriptVersion
+  PlutusScript plutusScriptVersion' plutusScript <-
+    PlutusScript lang <$> genValidPlutusScript lang
+
+  plutusScriptOrReferenceInput <-
+    Gen.choice
+      [ pure $ PScript plutusScript
+      , PReferenceScript <$> genTxIn
+      ]
+
+  scriptRedeemer <- genHashableScriptData
+  PlutusScriptWitness
+    (plutusScriptLangaugeInEra era lang)
+    plutusScriptVersion'
+    plutusScriptOrReferenceInput
+    dat
+    scriptRedeemer
+    <$> genExecutionUnits
+
 genScriptWitnessForMint :: ShelleyBasedEra era -> Gen (Api.ScriptWitness WitCtxMint era)
 genScriptWitnessForMint sbe = do
   ScriptInEra scriptLangInEra script' <- genScriptInEra sbe

cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs

@@ -22,6 +22,7 @@ where
 import Cardano.Api.Consensus.Internal.Mode
 import Cardano.Api.Era.Internal.Core
 import Cardano.Api.Era.Internal.Eon.AllegraEraOnwards (AllegraEraOnwards (..))
+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.ShelleyBasedEra
@@ -83,6 +84,9 @@ instance Convert ConwayEraOnwards AllegraEraOnwards where
   convert = \case
     ConwayEraOnwardsConway -> AllegraEraOnwardsConway
 
+instance Convert ConwayEraOnwards AlonzoEraOnwards where
+  convert ConwayEraOnwardsConway = AlonzoEraOnwardsConway
+
 instance Convert ConwayEraOnwards BabbageEraOnwards where
   convert = \case
     ConwayEraOnwardsConway -> BabbageEraOnwardsConway

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs

@@ -10,7 +10,6 @@ where
 import Cardano.Api.Address
 import Cardano.Api.Certificate.Internal
 import Cardano.Api.Era.Internal.Eon.Convert
-import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Experimental.Era
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
 import Cardano.Api.Plutus
@@ -68,12 +67,8 @@ estimateBalancedTxBody
       Fee.estimateBalancedTxBody
         (convert w)
         txbodycontent
-        (ledgerPParamsShim w pparams)
+        pparams
         poolids
         stakeDelegDeposits
         drepDelegDeposits
         (Map.mapKeys (toScriptIndex (convert w)) exUnitsMap)
-
-ledgerPParamsShim
-  :: Era era -> L.PParams (LedgerEra era) -> L.PParams (ShelleyLedgerEra era)
-ledgerPParamsShim ConwayEra pp = pp