Merge pull request #271 from input-output-hk/newhoggy/replace-Collate…

…ralSupportedInEra

Replace `CollateralSupportedInEra` with `AlonzoEraOnwards`

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

@@ -687,13 +687,14 @@ genTxBodyContent era = do
     }
 
 genTxInsCollateral :: CardanoEra era -> Gen (TxInsCollateral era)
-genTxInsCollateral era =
-    case collateralSupportedInEra era of
-      Nothing        -> pure TxInsCollateralNone
-      Just supported -> Gen.choice
-                          [ pure TxInsCollateralNone
-                          , TxInsCollateral supported <$> Gen.list (Range.linear 0 10) genTxIn
-                          ]
+genTxInsCollateral =
+  inEonForEra
+    (pure TxInsCollateralNone)
+    (\w -> Gen.choice
+      [ pure TxInsCollateralNone
+      , TxInsCollateral w <$> Gen.list (Range.linear 0 10) genTxIn
+      ]
+    )
 
 genTxInsReference :: CardanoEra era -> Gen (TxInsReference BuildTx era)
 genTxInsReference =

cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs

@@ -26,10 +26,17 @@ import           Cardano.Binary
 import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
 import qualified Cardano.Crypto.Hash.Class as C
 import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Alonzo.Language as L
+import qualified Cardano.Ledger.Alonzo.Scripts as L
+import qualified Cardano.Ledger.Alonzo.Tx as L
+import qualified Cardano.Ledger.Alonzo.TxInfo as L
+import qualified Cardano.Ledger.Alonzo.TxWits as L
+import qualified Cardano.Ledger.Alonzo.UTxO as L
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Core as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
@@ -75,10 +82,15 @@ type AlonzoEraOnwardsConstraints era =
   , L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
   , L.Era (ShelleyLedgerEra era)
   , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
+  , L.EraPlutusContext 'L.PlutusV1 (ShelleyLedgerEra era)
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
+  , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)
 

cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs

@@ -26,10 +26,15 @@ import           Cardano.Binary
 import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
 import qualified Cardano.Crypto.Hash.Class as C
 import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Alonzo.Language as L
+import qualified Cardano.Ledger.Alonzo.Scripts as L
+import qualified Cardano.Ledger.Alonzo.TxInfo as L
+import qualified Cardano.Ledger.Alonzo.UTxO as L
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Core as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
@@ -71,10 +76,15 @@ type BabbageEraOnwardsConstraints era =
   , L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
   , L.Era (ShelleyLedgerEra era)
   , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
+  , L.EraPlutusContext 'L.PlutusV1 (ShelleyLedgerEra era)
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
+  , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)
 

cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs

@@ -26,12 +26,17 @@ import           Cardano.Binary
 import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
 import qualified Cardano.Crypto.Hash.Class as C
 import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Alonzo.Language as L
+import qualified Cardano.Ledger.Alonzo.Scripts as L
+import qualified Cardano.Ledger.Alonzo.TxInfo as L
+import qualified Cardano.Ledger.Alonzo.UTxO as L
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Conway.Core as L
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.TxCert as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
@@ -74,10 +79,15 @@ type ConwayEraOnwardsConstraints era =
   , L.Era (ShelleyLedgerEra era)
   , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
   , L.EraGov (ShelleyLedgerEra era)
+  , L.EraPlutusContext 'L.PlutusV1 (ShelleyLedgerEra era)
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
+  , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)
   , L.TxCert (ShelleyLedgerEra era) ~ L.ConwayTxCert (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Fees.hs

@@ -72,7 +72,6 @@ import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo
 import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.Coin as Ledger
-import qualified Cardano.Ledger.Conway as Conway
 import           Cardano.Ledger.Credential as Ledger (Credential)
 import qualified Cardano.Ledger.Crypto as Ledger
 import qualified Cardano.Ledger.Keys as Ledger
@@ -499,80 +498,18 @@ evaluateTransactionExecutionUnitsShelley :: forall era. ()
   -> L.Tx (ShelleyLedgerEra era)
   -> Either TransactionValidityError
             (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits))
-evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx' =
-        case sbe of
-          ShelleyBasedEraShelley -> evalPreAlonzo
-          ShelleyBasedEraAllegra -> evalPreAlonzo
-          ShelleyBasedEraMary    -> evalPreAlonzo
-          ShelleyBasedEraAlonzo  -> evalAlonzo sbe tx'
-          ShelleyBasedEraBabbage ->
-            case collateralSupportedInEra $ shelleyBasedToCardanoEra sbe of
-              Just supp -> obtainBabbageEraPParams supp $ evalBabbage sbe tx'
-              Nothing -> return mempty
-          ShelleyBasedEraConway ->
-            case collateralSupportedInEra $ shelleyBasedToCardanoEra sbe of
-              Just supp -> obtainBabbageEraPParams supp $ evalConway sbe tx'
-              Nothing -> return mempty
+evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx =
+  caseShelleyToMaryOrAlonzoEraOnwards
+    (const (Right Map.empty))
+    (\_ ->
+      case L.evalTxExUnits pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of
+        Left err    -> Left (TransactionValidityTranslationError err)
+        Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
+    )
+    sbe
   where
     LedgerEpochInfo ledgerEpochInfo = epochInfo
 
-    -- | Pre-Alonzo eras do not support languages with execution unit accounting.
-    evalPreAlonzo :: Either TransactionValidityError
-                            (Map ScriptWitnessIndex
-                                  (Either ScriptExecutionError ExecutionUnits))
-    evalPreAlonzo = Right Map.empty
-
-
-    evalAlonzo :: ShelleyLedgerEra era ~ L.Alonzo
-               => ShelleyBasedEra era
-               -> Ledger.Tx L.Alonzo
-               -> Either TransactionValidityError
-                         (Map ScriptWitnessIndex
-                              (Either ScriptExecutionError ExecutionUnits))
-    evalAlonzo sbe' tx = do
-      case L.evalTxExUnits
-             pp
-             tx
-             (toLedgerUTxO sbe' utxo)
-             ledgerEpochInfo
-             systemstart
-        of Left err -> Left (TransactionValidityTranslationError err)
-           Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
-
-    evalBabbage :: ShelleyLedgerEra era ~ L.Babbage
-                => ShelleyBasedEra era
-                -> Ledger.Tx L.Babbage
-                -> Either TransactionValidityError
-                          (Map ScriptWitnessIndex
-                               (Either ScriptExecutionError ExecutionUnits))
-    evalBabbage sbe' tx = do
-      case L.evalTxExUnits
-             pp
-             tx
-             (toLedgerUTxO sbe' utxo)
-             ledgerEpochInfo
-             systemstart
-        of Left err    -> Left (TransactionValidityTranslationError err)
-           Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
-
-    evalConway :: forall ledgerera.
-                  ShelleyLedgerEra era ~ ledgerera
-               => ledgerera ~ Conway.ConwayEra Ledger.StandardCrypto
-               => ShelleyBasedEra era
-               -> Ledger.Tx ledgerera
-               -> Either TransactionValidityError
-                         (Map ScriptWitnessIndex
-                              (Either ScriptExecutionError ExecutionUnits))
-    evalConway sbe' tx = do
-      case L.evalTxExUnits
-             pp
-             tx
-             (toLedgerUTxO sbe' utxo)
-             ledgerEpochInfo
-             systemstart
-        of Left err    -> Left (TransactionValidityTranslationError err)
-           Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
-
     fromLedgerScriptExUnitsMap
       :: Map Alonzo.RdmrPtr (Either (L.TransactionScriptFailure (ShelleyLedgerEra era))
                                     Alonzo.ExUnits)
@@ -625,15 +562,6 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc
 
         L.NoCostModelInLedgerState l -> ScriptErrorMissingCostModel l
 
-
-    obtainBabbageEraPParams
-      :: ShelleyLedgerEra era ~ ledgerera
-      => CollateralSupportedInEra era
-      -> (Ledger.EraPParams ledgerera => a) ->  a
-    obtainBabbageEraPParams CollateralInAlonzoEra f =  f
-    obtainBabbageEraPParams CollateralInBabbageEra f =  f
-    obtainBabbageEraPParams CollateralInConwayEra f =  f
-
 -- ----------------------------------------------------------------------------
 -- Transaction balance
 --

cardano-api/internal/Cardano/Api/TxBody.hs

@@ -113,11 +113,6 @@ module Cardano.Api.TxBody (
     ViewTx,
 
     -- * Era-dependent transaction body features
-    CollateralSupportedInEra(..),
-    AuxScriptsSupportedInEra(..),
-
-    -- ** Feature availability functions
-    collateralSupportedInEra,
     auxScriptsSupportedInEra,
 
     -- * Inspecting 'ScriptWitness'es
@@ -850,30 +845,6 @@ fromBabbageTxOutDatum _ w (Babbage.Datum binData) =
 -- Era-dependent transaction body features
 --
 
--- | A representation of whether the era supports transactions with inputs used
--- only for collateral for script fees.
---
--- The Alonzo and subsequent eras support collateral inputs.
---
-data CollateralSupportedInEra era where
-
-     CollateralInAlonzoEra  :: CollateralSupportedInEra AlonzoEra
-     CollateralInBabbageEra :: CollateralSupportedInEra BabbageEra
-     CollateralInConwayEra  :: CollateralSupportedInEra ConwayEra
-
-deriving instance Eq   (CollateralSupportedInEra era)
-deriving instance Show (CollateralSupportedInEra era)
-
-collateralSupportedInEra :: CardanoEra era
-                         -> Maybe (CollateralSupportedInEra era)
-collateralSupportedInEra ByronEra   = Nothing
-collateralSupportedInEra ShelleyEra = Nothing
-collateralSupportedInEra AllegraEra = Nothing
-collateralSupportedInEra MaryEra    = Nothing
-collateralSupportedInEra AlonzoEra  = Just CollateralInAlonzoEra
-collateralSupportedInEra BabbageEra = Just CollateralInBabbageEra
-collateralSupportedInEra ConwayEra = Just CollateralInConwayEra
-
 -- | A representation of whether the era supports auxiliary scripts in
 -- transactions.
 --
@@ -927,12 +898,13 @@ deriving instance Show a => Show (BuildTxWith build a)
 type TxIns build era = [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))]
 
 data TxInsCollateral era where
+  TxInsCollateralNone
+    :: TxInsCollateral era
 
-     TxInsCollateralNone :: TxInsCollateral era
-
-     TxInsCollateral     :: CollateralSupportedInEra era
-                         -> [TxIn] -- Only key witnesses, no scripts.
-                         -> TxInsCollateral era
+  TxInsCollateral
+    :: AlonzoEraOnwards era
+    -> [TxIn] -- Only key witnesses, no scripts.
+    -> TxInsCollateral era
 
 deriving instance Eq   (TxInsCollateral era)
 deriving instance Show (TxInsCollateral era)
@@ -2350,19 +2322,10 @@ fromLedgerTxInsCollateral
   -> Ledger.TxBody (ShelleyLedgerEra era)
   -> TxInsCollateral era
 fromLedgerTxInsCollateral sbe body =
-    case collateralSupportedInEra (shelleyBasedToCardanoEra sbe) of
-      Nothing        -> TxInsCollateralNone
-      Just supported ->
-        TxInsCollateral supported $ map fromShelleyTxIn collateral_
-  where
-    collateral_ :: [Ledger.TxIn StandardCrypto]
-    collateral_ = case sbe of
-      ShelleyBasedEraShelley -> []
-      ShelleyBasedEraAllegra -> []
-      ShelleyBasedEraMary    -> []
-      ShelleyBasedEraAlonzo  -> toList $ body ^. L.collateralInputsTxBodyL
-      ShelleyBasedEraBabbage -> toList $ body ^. L.collateralInputsTxBodyL
-      ShelleyBasedEraConway  -> toList $ body ^. L.collateralInputsTxBodyL
+  caseShelleyToMaryOrAlonzoEraOnwards
+    (const TxInsCollateralNone)
+    (\w -> TxInsCollateral w $ map fromShelleyTxIn $ toList $ body ^. L.collateralInputsTxBodyL)
+    sbe
 
 fromLedgerTxInsReference
   :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxInsReference ViewTx era

cardano-api/src/Cardano/Api.hs

@@ -381,11 +381,6 @@ module Cardano.Api (
     ViewTx,
 
     -- ** Era-dependent transaction body features
-    CollateralSupportedInEra(..),
-    AuxScriptsSupportedInEra(..),
-
-    -- ** Feature availability functions
-    collateralSupportedInEra,
     auxScriptsSupportedInEra,
 
     -- ** Era-dependent protocol features