diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs index e6208cb4a05..5e83abe9ae4 100644 --- a/cardano-api/src/Cardano/Api/Fees.hs +++ b/cardano-api/src/Cardano/Api/Fees.hs @@ -68,29 +68,27 @@ import qualified Cardano.Ledger.Coin as Ledger import Cardano.Ledger.Core (EraTx (sizeTxF)) import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Crypto as Ledger -import qualified Cardano.Ledger.Era as Ledger.Era (Crypto) + import qualified Cardano.Ledger.Keys as Ledger import Cardano.Ledger.Mary.Value (MaryValue) -import qualified Cardano.Ledger.Shelley.API as Ledger (CLI) import qualified Cardano.Ledger.Shelley.API.Wallet as Ledger (evaluateTransactionBalance, evaluateTransactionFee) import qualified Cardano.Ledger.Shelley.API.Wallet as Shelley -import Cardano.Ledger.Shelley.PParams (ShelleyPParamsHKD (..)) import Cardano.Ledger.Shelley.TxBody (ShelleyEraTxBody) import qualified Cardano.Ledger.Alonzo as Alonzo import qualified Cardano.Ledger.Alonzo.Language as Alonzo -import Cardano.Ledger.Alonzo.PParams (AlonzoPParamsHKD (..)) import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo +import qualified Cardano.Ledger.Alonzo.Scripts as L import qualified Cardano.Ledger.Alonzo.Tools as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo -import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo +import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo +import qualified Cardano.Ledger.Api.Scripts as L import qualified Cardano.Ledger.Babbage as Babbage -import Cardano.Ledger.Babbage.PParams (BabbagePParamsHKD (..)) import qualified Cardano.Ledger.Conway as Conway import qualified Ouroboros.Consensus.HardFork.History as Consensus @@ -253,8 +251,8 @@ evaluateTransactionFee bpparams txbody keywitcount _byronwitcount = where evalShelleyBasedEra :: forall ledgerera. ShelleyLedgerEra era ~ ledgerera - => Ledger.CLI ledgerera - => Ledger.Tx ledgerera + => ShelleyBasedEra era + -> Ledger.Tx ledgerera -> Lovelace evalShelleyBasedEra tx = fromShelleyLovelace $ @@ -267,7 +265,7 @@ evaluateTransactionFee bpparams txbody keywitcount _byronwitcount = withLedgerConstraints :: ShelleyLedgerEra era ~ ledgerera => ShelleyBasedEra era - -> ( Ledger.CLI ledgerera + -> ( () -- Ledger.CLI ledgerera => a) -> a withLedgerConstraints ShelleyBasedEraShelley f = f @@ -630,30 +628,30 @@ evaluateTransactionExecutionUnits systemstart epochInfo bpp utxo txbody = -> ScriptExecutionError fromAlonzoScriptExecutionError failure = case failure of - Alonzo.UnknownTxIn txin -> ScriptErrorMissingTxIn txin' + L.UnknownTxIn txin -> ScriptErrorMissingTxIn txin' where txin' = fromShelleyTxIn txin - Alonzo.InvalidTxIn txin -> ScriptErrorTxInWithoutDatum txin' + L.InvalidTxIn txin -> ScriptErrorTxInWithoutDatum txin' where txin' = fromShelleyTxIn txin - Alonzo.MissingDatum dh -> ScriptErrorWrongDatum (ScriptDataHash dh) - Alonzo.ValidationFailedV1 err logs -> ScriptErrorEvaluationFailed err logs - Alonzo.ValidationFailedV2 err logs -> ScriptErrorEvaluationFailed err logs - Alonzo.IncompatibleBudget _ -> ScriptErrorExecutionUnitsOverflow + L.MissingDatum dh -> ScriptErrorWrongDatum (ScriptDataHash dh) + L.ValidationFailedV1 err logs -> ScriptErrorEvaluationFailed err logs + L.ValidationFailedV2 err logs -> ScriptErrorEvaluationFailed err logs + L.IncompatibleBudget _ -> ScriptErrorExecutionUnitsOverflow -- This is only possible for spending scripts and occurs when -- we attempt to spend a key witnessed tx input with a Plutus -- script witness. - Alonzo.RedeemerNotNeeded rdmrPtr scriptHash -> + L.RedeemerNotNeeded rdmrPtr scriptHash -> ScriptErrorNotPlutusWitnessedTxIn (fromAlonzoRdmrPtr rdmrPtr) (fromShelleyScriptHash scriptHash) - Alonzo.RedeemerPointsToUnknownScriptHash rdmrPtr -> + L.RedeemerPointsToUnknownScriptHash rdmrPtr -> ScriptErrorRedeemerPointsToUnknownScriptHash $ fromAlonzoRdmrPtr rdmrPtr -- This should not occur while using cardano-cli because we zip together -- the Plutus script and the use site (txin, certificate etc). Therefore -- the redeemer pointer will always point to a Plutus script. - Alonzo.MissingScript rdmrPtr resolveable -> ScriptErrorMissingScript rdmrPtr resolveable + L.MissingScript rdmrPtr resolveable -> ScriptErrorMissingScript rdmrPtr resolveable - Alonzo.NoCostModelInLedgerState l -> ScriptErrorMissingCostModel l + L.NoCostModelInLedgerState l -> ScriptErrorMissingCostModel l obtainHasFieldConstraint @@ -762,8 +760,8 @@ evaluateTransactionBalance bpp poolids utxo withLedgerConstraints ShelleyBasedEraConway _ f = f MultiAssetInConwayEra type LedgerEraConstraints ledgerera = - ( Ledger.Era.Crypto ledgerera ~ Ledger.StandardCrypto - , Ledger.CLI ledgerera + ( Ledger.EraCrypto ledgerera ~ Ledger.StandardCrypto + -- , Ledger.CLI ledgerera ) type LedgerAdaOnlyConstraints ledgerera = diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 74157cca67f..68ab0e055a5 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -1519,7 +1519,7 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState poolid (Vr markSnapshotPoolDistr :: Map (SL.KeyHash 'SL.StakePool Shelley.StandardCrypto) (SL.IndividualPoolStake Shelley.StandardCrypto) markSnapshotPoolDistr = ShelleyAPI.unPoolDistr . ShelleyAPI.calculatePoolDistr $ snapshot - let pp = unbundleLedgerShelleyBasedProtocolParams pParams + let pp = unbundleLedgerShelleyBasedProtocolParams sbe bpp slotRangeOfInterest = Set.filter (not . Ledger.isOverlaySlot firstSlotOfEpoch (pp ^. Core.ppDG)) $ Set.fromList [firstSlotOfEpoch .. lastSlotofEpoch] diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 7380879e8a8..1017853ed41 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -147,7 +147,7 @@ import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import qualified Cardano.Ledger.Alonzo.Language as Alonzo import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo -import qualified Cardano.Ledger.Binary as Binary (decCBOR, decodeFullAnnotator, shelleyProtVer) +import qualified Cardano.Ledger.Binary as Binary (decCBOR, decodeFullAnnotator) import qualified PlutusLedgerApi.Test.Examples as Plutus @@ -398,7 +398,7 @@ instance HasTypeProxy lang => HasTypeProxy (Script lang) where instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where serialiseToCBOR (SimpleScript s) = - CBOR.serialize' (toAllegraTimelock s :: Timelock.Timelock StandardCrypto) + CBOR.serialize' (toAllegraTimelock s :: Timelock.Timelock (ShelleyLedgerEra AllegraEra)) serialiseToCBOR (PlutusScript PlutusScriptV1 s) = CBOR.serialize' s @@ -409,8 +409,9 @@ instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where deserialiseFromCBOR _ bs = case scriptLanguage :: ScriptLanguage lang of SimpleScriptLanguage -> - SimpleScript . fromAllegraTimelock - <$> CBOR.decodeAnnotator "Script" fromCBOR (LBS.fromStrict bs) + let version = Ledger.eraProtVerLow @(ShelleyLedgerEra AllegraEra) + in SimpleScript . fromAllegraTimelock @(ShelleyLedgerEra AllegraEra) + <$> Binary.decodeFullAnnotator version "Script" Binary.decCBOR (LBS.fromStrict bs) PlutusScriptLanguage PlutusScriptV1 -> PlutusScript PlutusScriptV1 @@ -912,7 +913,7 @@ hashScript (SimpleScript s) = -- Later ledger eras have to be compatible anyway. ScriptHash . Ledger.hashScript @(ShelleyLedgerEra AllegraEra) - . (toAllegraTimelock :: SimpleScript -> Timelock.Timelock StandardCrypto) + . (toAllegraTimelock :: SimpleScript -> Timelock.Timelock (ShelleyLedgerEra AllegraEra)) $ s hashScript (PlutusScript PlutusScriptV1 (PlutusScriptSerialised script)) = @@ -1138,7 +1139,7 @@ fromShelleyMultiSig = go -- | Conversion for the 'Timelock.Timelock' language that is shared between the -- Allegra and Mary eras. -- -toAllegraTimelock :: forall era lang. +toAllegraTimelock :: forall era. (Era era, EraCrypto era ~ StandardCrypto) => SimpleScript -> Timelock.Timelock era toAllegraTimelock = go