diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index eb9af3fdbf..25199eb9fe 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -137,8 +137,8 @@ library internal Cardano.Api.SerialiseUsing Cardano.Api.SpecialByron Cardano.Api.StakePoolMetadata - Cardano.Api.Tx - Cardano.Api.TxBody + Cardano.Api.Tx.Body + Cardano.Api.Tx.Sign Cardano.Api.TxIn Cardano.Api.TxMetadata Cardano.Api.Utils @@ -162,16 +162,16 @@ library internal , cardano-crypto-class ^>= 2.1.2 , cardano-crypto-wrapper ^>= 1.5 , cardano-data >= 1.0 - , cardano-ledger-alonzo >= 1.5.0 - , cardano-ledger-allegra >= 1.2.3.1 - , cardano-ledger-api ^>= 1.7 - , cardano-ledger-babbage >= 1.5.0 - , cardano-ledger-binary - , cardano-ledger-byron >= 1.0.0.2 - , cardano-ledger-conway >= 1.10.0 - , cardano-ledger-core >= 1.8.0 - , cardano-ledger-mary >= 1.3.0.2 - , cardano-ledger-shelley >= 1.7.0 + , cardano-ledger-alonzo >= 1.6.0 + , cardano-ledger-allegra >= 1.3 + , cardano-ledger-api ^>= 1.8 + , cardano-ledger-babbage >= 1.6.0 + , cardano-ledger-binary ^>= 1.3 + , cardano-ledger-byron >= 1.0.0.4 + , cardano-ledger-conway >= 1.12.0 + , cardano-ledger-core >= 1.10 + , cardano-ledger-mary >= 1.5 + , cardano-ledger-shelley >= 1.9.0 , cardano-protocol-tpraos >= 1.0.3.6 , cardano-slotting >= 0.1 , cardano-strict-containers >= 0.1 @@ -191,19 +191,19 @@ library internal , mtl , network , optparse-applicative-fork - , ouroboros-consensus ^>= 0.14 - , ouroboros-consensus-cardano ^>= 0.12 - , ouroboros-consensus-diffusion ^>= 0.9 - , ouroboros-consensus-protocol ^>= 0.6 + , ouroboros-consensus ^>= 0.15 + , ouroboros-consensus-cardano ^>= 0.13 + , ouroboros-consensus-diffusion ^>= 0.10 + , ouroboros-consensus-protocol ^>= 0.7 , ouroboros-network - , ouroboros-network-api + , ouroboros-network-api ^>= 0.6.2 , ouroboros-network-framework , ouroboros-network-protocols , parsec - , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.15 + , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.21 , prettyprinter , prettyprinter-ansi-terminal - , prettyprinter-configurable ^>= 1.15 + , prettyprinter-configurable ^>= 1.21 , random , safe-exceptions , scientific @@ -282,10 +282,12 @@ library gen , cardano-binary >= 1.6 && < 1.8 , cardano-crypto-class ^>= 2.1.2 , cardano-crypto-test ^>= 1.5 - , cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.5.0 + , cardano-data + , cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.6.0 , cardano-ledger-byron-test >= 1.5 , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8.0 , cardano-ledger-shelley >= 1.7.0 + , cardano-ledger-conway , cardano-ledger-conway:testlib >= 1.10.0 , containers , filepath @@ -312,7 +314,7 @@ test-suite cardano-api-test , cardano-crypto-class ^>= 2.1.2 , cardano-crypto-test ^>= 1.5 , cardano-crypto-tests ^>= 2.1 - , cardano-ledger-api ^>= 1.7 + , cardano-ledger-api ^>= 1.8 , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8 , containers , directory @@ -361,7 +363,7 @@ test-suite cardano-api-golden , cardano-crypto-class ^>= 2.1.2 , cardano-data >= 1.0 , cardano-ledger-alonzo - , cardano-ledger-api ^>= 1.7 + , cardano-ledger-api ^>= 1.8 , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8 , cardano-ledger-shelley , cardano-ledger-shelley-test >= 1.2.0.1 @@ -373,8 +375,8 @@ test-suite cardano-api-golden , hedgehog-extras ^>= 0.6.0.2 , microlens , parsec - , plutus-core ^>= 1.15 - , plutus-ledger-api ^>= 1.15 + , plutus-core ^>= 1.21 + , plutus-ledger-api ^>= 1.21 , tasty , tasty-hedgehog , time diff --git a/cardano-api/gen/Test/Gen/Cardano/Api.hs b/cardano-api/gen/Test/Gen/Cardano/Api.hs index 3a706ee354..a9f167ae81 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api.hs @@ -13,6 +13,7 @@ import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.BaseTypes as Ledger import qualified Cardano.Ledger.Coin as Ledger +import qualified Cardano.Ledger.Plutus.CostModels as Plutus import qualified Cardano.Ledger.Plutus.Language as Alonzo import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..), ShelleyTxAuxData (..)) @@ -82,10 +83,7 @@ genExUnits = do genCostModels :: Gen Alonzo.CostModels genCostModels = do alonzoCostModel <- genCostModel - Alonzo.CostModels - <$> (conv <$> Gen.list (Range.linear 1 3) (return alonzoCostModel)) - <*> pure mempty - <*> pure mempty + Plutus.mkCostModels . conv <$> Gen.list (Range.linear 1 3) (return alonzoCostModel) where conv :: [Alonzo.CostModel] -> Map.Map Alonzo.Language Alonzo.CostModel conv [] = mempty @@ -105,7 +103,7 @@ genAlonzoGenesis = do return Alonzo.AlonzoGenesis { Alonzo.agCoinsPerUTxOWord = Ledger.CoinPerWord coinsPerUTxOWord - , Alonzo.agCostModels = Alonzo.CostModels mempty mempty mempty + , Alonzo.agCostModels = mempty , Alonzo.agPrices = prices' , Alonzo.agMaxTxExUnits = maxTxExUnits' , Alonzo.agMaxBlockExUnits = maxBlockExUnits' diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 392740555f..0b1cc88fad 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -151,6 +151,8 @@ import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Hash.Class as CRYPTO import qualified Cardano.Crypto.Seed as Crypto import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo +import qualified Cardano.Ledger.BaseTypes as Ledger +import qualified Cardano.Ledger.Conway.Governance as L import qualified Cardano.Ledger.Core as Ledger import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) @@ -161,9 +163,11 @@ import qualified Data.ByteString.Short as SBS import Data.Coerce import Data.Int (Int64) import Data.Maybe +import Data.OSet.Strict (OSet) +import qualified Data.OSet.Strict as OSet import Data.Ratio (Ratio, (%)) import Data.String -import Data.Word (Word64) +import Data.Word (Word16, Word32, Word64) import Numeric.Natural (Natural) import Test.Gen.Cardano.Api.Era @@ -872,6 +876,12 @@ genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n) genNat :: Gen Natural genNat = Gen.integral (Range.linear 0 10) +genWord16 :: Gen Word16 +genWord16 = Gen.integral (Range.linear 0 10) + +genWord32 :: Gen Word32 +genWord32 = Gen.integral (Range.linear 0 10) + genRational :: Gen Rational genRational = (\d -> ratioToRational (1 % d)) <$> genDenominator @@ -897,6 +907,9 @@ genRationalInt64 = genEpochNo :: Gen EpochNo genEpochNo = EpochNo <$> Gen.word64 (Range.linear 0 10) +genEpochInterval :: Gen Ledger.EpochInterval +genEpochInterval = Ledger.EpochInterval <$> Gen.word32 (Range.linear 0 10) + genPraosNonce :: Gen PraosNonce genPraosNonce = makePraosNonce <$> Gen.bytes (Range.linear 0 32) @@ -917,7 +930,7 @@ genProtocolParameters era = do protocolParamStakeAddressDeposit <- genLovelace protocolParamStakePoolDeposit <- genLovelace protocolParamMinPoolCost <- genLovelace - protocolParamPoolRetireMaxEpoch <- genEpochNo + protocolParamPoolRetireMaxEpoch <- genEpochInterval protocolParamStakePoolTargetNum <- genNat protocolParamPoolPledgeInfluence <- genRationalInt64 protocolParamMonetaryExpansion <- genRational @@ -944,16 +957,16 @@ genProtocolParametersUpdate era = do protocolUpdateProtocolVersion <- Gen.maybe ((,) <$> genNat <*> genNat) protocolUpdateDecentralization <- Gen.maybe genRational protocolUpdateExtraPraosEntropy <- Gen.maybe genMaybePraosNonce - protocolUpdateMaxBlockHeaderSize <- Gen.maybe genNat - protocolUpdateMaxBlockBodySize <- Gen.maybe genNat - protocolUpdateMaxTxSize <- Gen.maybe genNat + protocolUpdateMaxBlockHeaderSize <- Gen.maybe genWord16 + protocolUpdateMaxBlockBodySize <- Gen.maybe genWord32 + protocolUpdateMaxTxSize <- Gen.maybe genWord32 protocolUpdateTxFeeFixed <- Gen.maybe genLovelace protocolUpdateTxFeePerByte <- Gen.maybe genLovelace protocolUpdateMinUTxOValue <- Gen.maybe genLovelace protocolUpdateStakeAddressDeposit <- Gen.maybe genLovelace protocolUpdateStakePoolDeposit <- Gen.maybe genLovelace protocolUpdateMinPoolCost <- Gen.maybe genLovelace - protocolUpdatePoolRetireMaxEpoch <- Gen.maybe genEpochNo + protocolUpdatePoolRetireMaxEpoch <- Gen.maybe genEpochInterval protocolUpdateStakePoolTargetNum <- Gen.maybe genNat protocolUpdatePoolPledgeInfluence <- Gen.maybe genRationalInt64 protocolUpdateMonetaryExpansion <- Gen.maybe genRational @@ -1066,17 +1079,26 @@ genGovernancePollAnswer = genGovernancePollHash = GovernancePollHash . mkDummyHash <$> Gen.int (Range.linear 0 10) -genProposals :: forall era. ConwayEraOnwards era -> Gen [Proposal era] +genProposals :: ConwayEraOnwards era -> Gen (TxProposalProcedures BuildTx era) genProposals w = - conwayEraOnwardsTestConstraints w - $ Gen.list (Range.constant 1 10) - $ genProposal w + conwayEraOnwardsConstraints w + $ TxProposalProcedures + <$> genTxProposalsOSet w + <*> return (BuildTxWith mempty) + +genTxProposalsOSet + :: ConwayEraOnwards era + -> Gen (OSet (L.ProposalProcedure (ShelleyLedgerEra era))) +genTxProposalsOSet w = + conwayEraOnwardsConstraints w + $ OSet.fromFoldable <$> Gen.list (Range.constant 1 10) (genProposal w) -genProposal :: ConwayEraOnwards era -> Gen (Proposal era) +genProposal :: ConwayEraOnwards era -> Gen (L.ProposalProcedure (ShelleyLedgerEra era)) genProposal w = - conwayEraOnwardsTestConstraints w $ fmap Proposal Q.arbitrary + conwayEraOnwardsTestConstraints w Q.arbitrary -genVotingProcedures :: ConwayEraOnwards era -> Gen (ShelleyApi.VotingProcedures era) +-- TODO: Generate map of script witnesses +genVotingProcedures :: ConwayEraOnwards era -> Gen (Api.TxVotingProcedures BuildTx era) genVotingProcedures w = conwayEraOnwardsConstraints w - $ ShelleyApi.VotingProcedures <$> Q.arbitrary + $ Api.TxVotingProcedures <$> Q.arbitrary <*> return (BuildTxWith mempty) diff --git a/cardano-api/internal/Cardano/Api/Address.hs b/cardano-api/internal/Cardano/Api/Address.hs index d9980c26ba..cee1670820 100644 --- a/cardano-api/internal/Cardano/Api/Address.hs +++ b/cardano-api/internal/Cardano/Api/Address.hs @@ -94,10 +94,10 @@ import Cardano.Api.Utils import qualified Cardano.Chain.Common as Byron import qualified Cardano.Ledger.Address as Shelley -import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Plutus import qualified Cardano.Ledger.BaseTypes as Shelley import qualified Cardano.Ledger.Credential as Shelley import Cardano.Ledger.Crypto (StandardCrypto) +import qualified Cardano.Ledger.Plutus.TxInfo as Plutus import qualified PlutusLedgerApi.V1 as PlutusAPI import Control.Applicative ((<|>)) @@ -224,7 +224,7 @@ instance SerialiseAsRawBytes (Address ByronAddr) where $ addr deserialiseFromRawBytes (AsAddress AsByronAddr) bs = - case Shelley.deserialiseAddr bs :: Maybe (Shelley.Addr StandardCrypto) of + case Shelley.decodeAddr bs :: Maybe (Shelley.Addr StandardCrypto) of Nothing -> Left (SerialiseAsRawBytesError "Unable to deserialise Address ByronAddr") Just Shelley.Addr{} -> Left (SerialiseAsRawBytesError "Unable to deserialise Address ByronAddr") Just (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) -> @@ -235,7 +235,7 @@ instance SerialiseAsRawBytes (Address ShelleyAddr) where Shelley.serialiseAddr (Shelley.Addr nw pc scr) deserialiseFromRawBytes (AsAddress AsShelleyAddr) bs = - case Shelley.deserialiseAddr bs of + case Shelley.decodeAddr bs of Nothing -> Left (SerialiseAsRawBytesError "Unable to deserialise bootstrap Address ShelleyAddr") Just Shelley.AddrBootstrap{} -> Left (SerialiseAsRawBytesError "Unable to deserialise bootstrap Address ShelleyAddr") Just (Shelley.Addr nw pc scr) -> Right (ShelleyAddress nw pc scr) @@ -330,7 +330,7 @@ instance SerialiseAsRawBytes AddressAny where serialiseToRawBytes (AddressShelley addr) = serialiseToRawBytes addr deserialiseFromRawBytes AsAddressAny bs = - case Shelley.deserialiseAddr bs of + case Shelley.decodeAddr bs of Nothing -> Left (SerialiseAsRawBytesError "Unable to deserialise AddressAny") Just (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) -> Right (AddressByron (ByronAddress addr)) diff --git a/cardano-api/internal/Cardano/Api/Block.hs b/cardano-api/internal/Cardano/Api/Block.hs index 2c491c719e..434a29f6af 100644 --- a/cardano-api/internal/Cardano/Api/Block.hs +++ b/cardano-api/internal/Cardano/Api/Block.hs @@ -57,7 +57,7 @@ import Cardano.Api.Keys.Shelley import Cardano.Api.Modes import Cardano.Api.SerialiseRaw import Cardano.Api.SerialiseUsing -import Cardano.Api.Tx +import Cardano.Api.Tx.Sign import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Crypto.Hashing diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index 9bab83f3d6..7af695da71 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -91,12 +90,14 @@ import Cardano.Api.Utils (noInlineMaybeToStrictMaybe) import Cardano.Api.Value import Data.ByteString (ByteString) +import qualified Data.ByteString as BS import qualified Data.Foldable as Foldable import Data.IP (IPv4, IPv6) import Data.Maybe import qualified Data.Sequence.Strict as Seq import qualified Data.Set as Set import Data.Text (Text) +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Typeable import Network.Socket (PortNumber) @@ -632,13 +633,15 @@ toShelleyPoolParams StakePoolParameters { } toShelleyDnsName :: ByteString -> Ledger.DnsName - toShelleyDnsName = fromMaybe (error "toShelleyDnsName: invalid dns name. TODO: proper validation") - . Ledger.textToDns - . Text.decodeLatin1 + toShelleyDnsName name = + fromMaybe (error "toShelleyDnsName: invalid dns name. TODO: proper validation") + . Ledger.textToDns (BS.length name) + $ Text.decodeLatin1 name toShelleyUrl :: Text -> Ledger.Url - toShelleyUrl = fromMaybe (error "toShelleyUrl: invalid url. TODO: proper validation") - . Ledger.textToUrl + toShelleyUrl url = + fromMaybe (error "toShelleyUrl: invalid url. TODO: proper validation") + $ Ledger.textToUrl (Text.length url) url fromShelleyPoolParams :: Ledger.PoolParams StandardCrypto diff --git a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs index 79cc8c1790..74d451b15b 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs @@ -21,8 +21,8 @@ import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Fees import Cardano.Api.ProtocolParameters import Cardano.Api.Query -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import Cardano.Api.Utils import Cardano.Api.Value @@ -54,7 +54,7 @@ constructBalancedTx :: () -> Map.Map StakeCredential Lovelace -> Map.Map (L.Credential L.DRepRole L.StandardCrypto) Lovelace -> [ShelleyWitnessSigningKey] - -> Either TxBodyErrorAutoBalance (Tx era) + -> Either (TxBodyErrorAutoBalance era) (Tx era) constructBalancedTx sbe txbodcontent changeAddr mOverrideWits utxo lpp ledgerEpochInfo systemStart stakePools stakeDelegDeposits drepDelegDeposits shelleyWitSigningKeys = do diff --git a/cardano-api/internal/Cardano/Api/Convenience/Query.hs b/cardano-api/internal/Cardano/Api/Convenience/Query.hs index 6d87015b82..bfd6619cab 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Query.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Query.hs @@ -26,7 +26,7 @@ import Cardano.Api.NetworkId import Cardano.Api.ProtocolParameters import Cardano.Api.Query import Cardano.Api.Query.Expr -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body import Cardano.Api.Utils import Cardano.Api.Value @@ -35,6 +35,7 @@ import Cardano.Ledger.CertState (DRepState (..)) import qualified Cardano.Ledger.Credential as L import qualified Cardano.Ledger.Keys as L import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..)) +import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) import Control.Monad.Trans (MonadTrans (..)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) @@ -130,7 +131,7 @@ determineEra :: () => LocalNodeConnectInfo -> IO (Either AcquiringFailure AnyCardanoEra) determineEra localNodeConnInfo = - queryNodeLocalState localNodeConnInfo Nothing QueryCurrentEra + queryNodeLocalState localNodeConnInfo VolatileTip QueryCurrentEra -- | Execute a query against the local node. The local -- node must be in CardanoMode. @@ -155,6 +156,6 @@ executeQueryAnyMode :: forall result. () -> QueryInMode (Either EraMismatch result) -> IO (Either QueryConvenienceError result) executeQueryAnyMode localNodeConnInfo q = runExceptT $ do - lift (queryNodeLocalState localNodeConnInfo Nothing q) + lift (queryNodeLocalState localNodeConnInfo VolatileTip q) & onLeft (left . AcqFailure) & onLeft (left . QueryEraMismatch) diff --git a/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs index 0205a79138..07be578303 100644 --- a/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs @@ -81,7 +81,6 @@ type AllegraEraOnwardsConstraints era = , L.EraTxOut (ShelleyLedgerEra era) , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto , L.AllegraEraTxBody (ShelleyLedgerEra era) - , L.ShelleyEraTxBody (ShelleyLedgerEra era) , L.ShelleyEraTxCert (ShelleyLedgerEra era) , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) diff --git a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs index 45a2936339..446def6217 100644 --- a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs @@ -26,7 +26,7 @@ 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.Plutus.TxInfo as L +import qualified Cardano.Ledger.Alonzo.Plutus.Context as Plutus import qualified Cardano.Ledger.Alonzo.Scripts as L import qualified Cardano.Ledger.Alonzo.Tx as L import qualified Cardano.Ledger.Alonzo.TxWits as L @@ -35,7 +35,6 @@ 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.Mary.Value as L -import qualified Cardano.Ledger.Plutus.Language as L import qualified Cardano.Ledger.SafeHash as L import qualified Cardano.Ledger.UTxO as L import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus @@ -84,18 +83,16 @@ 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.EraTxOut (ShelleyLedgerEra era) , L.EraUTxO (ShelleyLedgerEra era) - , L.ExtendedUTxO (ShelleyLedgerEra era) , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto , L.MaryEraTxBody (ShelleyLedgerEra era) + , Plutus.EraPlutusContext (ShelleyLedgerEra era) , 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.Value (ShelleyLedgerEra era) ~ L.MaryValue L.StandardCrypto @@ -107,8 +104,8 @@ type AlonzoEraOnwardsConstraints era = , Typeable era ) -alonzoEraOnwardsConstraints :: () - => AlonzoEraOnwards era +alonzoEraOnwardsConstraints + :: AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a alonzoEraOnwardsConstraints = \case diff --git a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs index b1ef1dd450..3ad528f18d 100644 --- a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs @@ -26,7 +26,6 @@ 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.Plutus.TxInfo as L import qualified Cardano.Ledger.Alonzo.Scripts as L import qualified Cardano.Ledger.Alonzo.UTxO as L import qualified Cardano.Ledger.Api as L @@ -34,7 +33,6 @@ import qualified Cardano.Ledger.Babbage.TxOut as L import qualified Cardano.Ledger.BaseTypes as L import qualified Cardano.Ledger.Core as L import qualified Cardano.Ledger.Mary.Value as L -import qualified Cardano.Ledger.Plutus.Language as L import qualified Cardano.Ledger.SafeHash as L import qualified Cardano.Ledger.UTxO as L import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus @@ -80,18 +78,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.EraTxOut (ShelleyLedgerEra era) , L.EraUTxO (ShelleyLedgerEra era) - , L.ExtendedUTxO (ShelleyLedgerEra era) , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto , L.MaryEraTxBody (ShelleyLedgerEra era) , 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.TxOut (ShelleyLedgerEra era) ~ L.BabbageTxOut (ShelleyLedgerEra era) , L.Value (ShelleyLedgerEra era) ~ L.MaryValue L.StandardCrypto diff --git a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs index 6dd28b9512..871c6f48a0 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs @@ -26,17 +26,14 @@ 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.Plutus.TxInfo as L import qualified Cardano.Ledger.Alonzo.Scripts 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.PParams as L import qualified Cardano.Ledger.Conway.TxCert as L import qualified Cardano.Ledger.Mary.Value as L -import qualified Cardano.Ledger.Plutus.Language as L import qualified Cardano.Ledger.SafeHash as L import qualified Cardano.Ledger.UTxO as L import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus @@ -83,18 +80,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.EraTxOut (ShelleyLedgerEra era) , L.EraUTxO (ShelleyLedgerEra era) - , L.ExtendedUTxO (ShelleyLedgerEra era) , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto , L.MaryEraTxBody (ShelleyLedgerEra era) , 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) , L.Value (ShelleyLedgerEra era) ~ L.MaryValue L.StandardCrypto diff --git a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs index adecf5fba5..ca789b157e 100644 --- a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs @@ -82,7 +82,6 @@ type MaryEraOnwardsConstraints era = , L.EraUTxO (ShelleyLedgerEra era) , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto , L.MaryEraTxBody (ShelleyLedgerEra era) - , L.ShelleyEraTxBody (ShelleyLedgerEra era) , L.ShelleyEraTxCert (ShelleyLedgerEra era) , L.Value (ShelleyLedgerEra era) ~ L.MaryValue L.StandardCrypto diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs index 716e2f1423..b6382462d1 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs @@ -208,14 +208,11 @@ type ShelleyBasedEraConstraints era = , L.EraTxOut (ShelleyLedgerEra era) , L.EraUTxO (ShelleyLedgerEra era) , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto - , L.ShelleyEraTxBody (ShelleyLedgerEra era) , L.ShelleyEraTxCert (ShelleyLedgerEra era) , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) , IsCardanoEra era , IsShelleyBasedEra era - , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) , ToJSON (L.PredicateFailure (L.EraRule "LEDGER" (ShelleyLedgerEra era))) - , ToJSON (L.PredicateFailure (L.EraRule "UTXOW" (ShelleyLedgerEra era))) , Typeable era ) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 46492024f0..152e7611df 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -44,6 +45,7 @@ module Cardano.Api.Fees ( import Cardano.Api.Address import Cardano.Api.Certificate +import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra @@ -56,24 +58,21 @@ import Cardano.Api.Pretty import Cardano.Api.ProtocolParameters import Cardano.Api.Query import Cardano.Api.Script -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import Cardano.Api.Value import qualified Cardano.Binary as CBOR import qualified Cardano.Chain.Common as Byron import qualified Cardano.Ledger.Alonzo.Core as Ledger -import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Alonzo +import qualified Cardano.Ledger.Alonzo.Plutus.Context as Plutus import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo -import qualified Cardano.Ledger.Alonzo.Tx 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 Cardano.Ledger.Credential as Ledger (Credential) import qualified Cardano.Ledger.Crypto as Ledger import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Plutus.Language as Plutus -import qualified Cardano.Ledger.Shelley.API.Wallet as Ledger (evaluateTransactionFee) import qualified Ouroboros.Consensus.HardFork.History as Consensus import qualified PlutusLedgerApi.V1 as Plutus @@ -205,10 +204,11 @@ evaluateTransactionFee :: forall era. () evaluateTransactionFee _ _ _ _ byronwitcount | byronwitcount > 0 = error "evaluateTransactionFee: TODO support Byron key witnesses" -evaluateTransactionFee sbe pp txbody keywitcount _byronwitcount = +evaluateTransactionFee sbe pp txbody keywitcount byronwitcount = shelleyBasedEraConstraints sbe $ case makeSignedTransaction' (shelleyBasedToCardanoEra sbe) [] txbody of - ShelleyTx _ tx -> fromShelleyLovelace $ Ledger.evaluateTransactionFee pp tx keywitcount + ShelleyTx _ tx -> + fromShelleyLovelace $ L.estimateMinFeeTx pp tx (fromIntegral keywitcount) (fromIntegral byronwitcount) -- | Give an approximate count of the number of key witnesses (i.e. signatures) -- a transaction will need. @@ -272,15 +272,18 @@ type PlutusScriptBytes = ShortByteString data ResolvablePointers where ResolvablePointers :: ( Ledger.Era (ShelleyLedgerEra era) - , Show (Ledger.TxCert (ShelleyLedgerEra era)) + , Show (L.PlutusPurpose L.AsIndex (ShelleyLedgerEra era)) + , Show (L.PlutusPurpose L.AsItem (ShelleyLedgerEra era)) + , Show (Alonzo.PlutusScript (ShelleyLedgerEra era)) ) => ShelleyBasedEra era - -> Map - Alonzo.RdmrPtr - ( Alonzo.ScriptPurpose (ShelleyLedgerEra era) - , Maybe (PlutusScriptBytes, Plutus.Language) - , Ledger.ScriptHash Ledger.StandardCrypto - ) + -> !(Map + (L.PlutusPurpose L.AsIndex (ShelleyLedgerEra era)) + ( L.PlutusPurpose L.AsItem (ShelleyLedgerEra era) + , Maybe (PlutusScriptBytes, Plutus.Language) + , Ledger.ScriptHash Ledger.StandardCrypto + ) + ) -> ResolvablePointers deriving instance Show ResolvablePointers @@ -291,6 +294,9 @@ deriving instance Show ResolvablePointers -- The first three of these are about failures before we even get to execute -- the script, and two are the result of execution. -- +-- TODO: We should replace ScriptWitnessIndex with ledger's +-- PlutusPurpose AsIndex ledgerera. This would necessitate the +-- parameterization of ScriptExecutionError. data ScriptExecutionError = -- | The script depends on a 'TxIn' that has not been provided in the @@ -333,7 +339,7 @@ data ScriptExecutionError = -- | A redeemer pointer points to a script that does not exist. | ScriptErrorMissingScript - Alonzo.RdmrPtr -- The invalid pointer + ScriptWitnessIndex -- The invalid pointer ResolvablePointers -- A mapping a pointers that are possible to resolve -- | A cost model was missing for a language which was used. @@ -395,7 +401,7 @@ instance Error ScriptExecutionError where ScriptErrorMissingCostModel language -> "No cost model was found for language " <> pshow language -data TransactionValidityError = +data TransactionValidityError era where -- | The transaction validity interval is too far into the future. -- -- Transactions with Plutus scripts need to have a validity interval that is @@ -412,15 +418,20 @@ data TransactionValidityError = -- hours beyond the current time. This effectively means we cannot submit -- check or submit transactions that use Plutus scripts that have the end -- of their validity interval more than 36 hours into the future. - TransactionValidityIntervalError Consensus.PastHorizonException + TransactionValidityIntervalError + :: Consensus.PastHorizonException -> TransactionValidityError era - | TransactionValidityTranslationError (Alonzo.TranslationError Ledger.StandardCrypto) + TransactionValidityTranslationError + :: Plutus.EraPlutusContext (ShelleyLedgerEra era) + => Plutus.ContextError (ShelleyLedgerEra era) + -> TransactionValidityError era - | TransactionValidityCostModelError (Map AnyPlutusScriptVersion CostModel) String + TransactionValidityCostModelError + :: (Map AnyPlutusScriptVersion CostModel) -> String -> TransactionValidityError era -deriving instance Show TransactionValidityError +deriving instance Show (TransactionValidityError era) -instance Error TransactionValidityError where +instance Error (TransactionValidityError era) where prettyError = \case TransactionValidityIntervalError pastTimeHorizon -> mconcat @@ -464,7 +475,7 @@ evaluateTransactionExecutionUnits :: forall era. () -> LedgerProtocolParameters era -> UTxO era -> TxBody era - -> Either TransactionValidityError + -> Either (TransactionValidityError era) (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)) evaluateTransactionExecutionUnits era systemstart epochInfo pp utxo txbody = case makeSignedTransaction' era [] txbody of @@ -477,72 +488,84 @@ evaluateTransactionExecutionUnitsShelley :: forall era. () -> LedgerProtocolParameters era -> UTxO era -> L.Tx (ShelleyLedgerEra era) - -> Either TransactionValidityError + -> Either (TransactionValidityError era) (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)) 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) + (\w -> case alonzoEraOnwardsConstraints w $ L.evalTxExUnits pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of + Left err -> Left $ alonzoEraOnwardsConstraints w + $ TransactionValidityTranslationError err + Right exmap -> Right (fromLedgerScriptExUnitsMap w exmap) ) sbe where LedgerEpochInfo ledgerEpochInfo = epochInfo fromLedgerScriptExUnitsMap - :: Map Alonzo.RdmrPtr (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) - Alonzo.ExUnits) + :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era) + => AlonzoEraOnwards era + -> Map (L.PlutusPurpose L.AsIndex (ShelleyLedgerEra era)) + (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) Alonzo.ExUnits) -> Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits) - fromLedgerScriptExUnitsMap exmap = + fromLedgerScriptExUnitsMap aOnwards exmap = Map.fromList - [ (fromAlonzoRdmrPtr rdmrptr, - bimap fromAlonzoScriptExecutionError fromAlonzoExUnits exunitsOrFailure) + [ (toScriptIndex aOnwards rdmrptr, + bimap (fromAlonzoScriptExecutionError aOnwards) fromAlonzoExUnits exunitsOrFailure) | (rdmrptr, exunitsOrFailure) <- Map.toList exmap ] - fromAlonzoScriptExecutionError :: L.TransactionScriptFailure (ShelleyLedgerEra era) - -> ScriptExecutionError - fromAlonzoScriptExecutionError = + fromAlonzoScriptExecutionError + :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era) + => AlonzoEraOnwards era + -> L.TransactionScriptFailure (ShelleyLedgerEra era) + -> ScriptExecutionError + fromAlonzoScriptExecutionError aOnwards = shelleyBasedEraConstraints sbe $ \case L.UnknownTxIn txin -> ScriptErrorMissingTxIn txin' where txin' = fromShelleyTxIn txin L.InvalidTxIn txin -> ScriptErrorTxInWithoutDatum txin' where txin' = fromShelleyTxIn txin L.MissingDatum dh -> ScriptErrorWrongDatum (ScriptDataHash dh) - L.ValidationFailure (L.ValidationFailedV1 err logs _) -> - ScriptErrorEvaluationFailed err logs - L.ValidationFailure (L.ValidationFailedV2 err logs _) -> - ScriptErrorEvaluationFailed err logs - L.ValidationFailure (L.ValidationFailedV3 err logs _) -> - ScriptErrorEvaluationFailed err logs + L.ValidationFailure _ evalErr logs _ -> + -- TODO: Include additional information from ValidationFailure + ScriptErrorEvaluationFailed evalErr 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. - L.RedeemerNotNeeded rdmrPtr scriptHash -> - ScriptErrorNotPlutusWitnessedTxIn - (fromAlonzoRdmrPtr rdmrPtr) - (fromShelleyScriptHash scriptHash) L.RedeemerPointsToUnknownScriptHash rdmrPtr -> - ScriptErrorRedeemerPointsToUnknownScriptHash $ fromAlonzoRdmrPtr rdmrPtr + ScriptErrorRedeemerPointsToUnknownScriptHash $ toScriptIndex aOnwards 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. - L.MissingScript rdmrPtr resolveable -> - let cnv1 Plutus.Plutus - { Plutus.plutusLanguage = lang - , Plutus.plutusScript = Alonzo.BinaryPlutus bytes - } = (bytes, lang) - cnv2 (purpose, mbScript, scriptHash) = (purpose, fmap cnv1 mbScript, scriptHash) - in - ScriptErrorMissingScript rdmrPtr - $ ResolvablePointers sbe - $ Map.map cnv2 resolveable - + L.MissingScript indexOfScriptWitnessedItem resolveable -> + let scriptWitnessedItemIndex = toScriptIndex aOnwards indexOfScriptWitnessedItem + in ScriptErrorMissingScript scriptWitnessedItemIndex + $ ResolvablePointers sbe $ Map.map extractScriptBytesAndLanguage resolveable L.NoCostModelInLedgerState l -> ScriptErrorMissingCostModel l + +extractScriptBytesAndLanguage + :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era) + => ( L.PlutusPurpose L.AsItem (ShelleyLedgerEra era) + , Maybe (Alonzo.PlutusScript (ShelleyLedgerEra era)) + , L.ScriptHash Ledger.StandardCrypto + ) + -> ( L.PlutusPurpose L.AsItem (ShelleyLedgerEra era) + , Maybe (PlutusScriptBytes, Plutus.Language) + , Ledger.ScriptHash Ledger.StandardCrypto + ) +extractScriptBytesAndLanguage (purpose, mbScript, scriptHash) = + (purpose, fmap extractPlutusScriptAndLanguage mbScript, scriptHash) + + +extractPlutusScriptAndLanguage + :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era) + => Alonzo.PlutusScript (ShelleyLedgerEra era) + -> (PlutusScriptBytes, Plutus.Language) +extractPlutusScriptAndLanguage p = + let bin = Plutus.unPlutusBinary $ Alonzo.plutusScriptBinary p + l = Alonzo.plutusScriptLanguage p + in (bin, l) -- ---------------------------------------------------------------------------- -- Transaction balance -- @@ -594,7 +617,7 @@ evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits u -- | The possible errors that can arise from 'makeTransactionBodyAutoBalance'. -- -data TxBodyErrorAutoBalance = +data TxBodyErrorAutoBalance era = -- | The same errors that can arise from 'makeTransactionBody'. TxBodyError TxBodyError @@ -633,7 +656,7 @@ data TxBodyErrorAutoBalance = -- | The transaction validity interval is too far into the future. -- See 'TransactionValidityIntervalError' for details. - | TxBodyErrorValidityInterval TransactionValidityError + | TxBodyErrorValidityInterval (TransactionValidityError era) -- | The minimum spendable UTxO threshold has not been met. | TxBodyErrorMinUTxONotMet @@ -649,7 +672,7 @@ data TxBodyErrorAutoBalance = deriving Show -instance Error TxBodyErrorAutoBalance where +instance Error (TxBodyErrorAutoBalance era) where prettyError = \case TxBodyError err -> prettyError err @@ -715,7 +738,7 @@ handleExUnitsErrors :: ScriptValidity -- ^ Mark script as expected to pass or fail validation -> Map ScriptWitnessIndex ScriptExecutionError -> Map ScriptWitnessIndex ExecutionUnits - -> Either TxBodyErrorAutoBalance (Map ScriptWitnessIndex ExecutionUnits) + -> Either (TxBodyErrorAutoBalance era) (Map ScriptWitnessIndex ExecutionUnits) handleExUnitsErrors ScriptValid failuresMap exUnitsMap = if null failures then Right exUnitsMap @@ -772,7 +795,7 @@ makeTransactionBodyAutoBalance :: forall era. () -> TxBodyContent BuildTx era -> AddressInEra era -- ^ Change address -> Maybe Word -- ^ Override key witnesses - -> Either TxBodyErrorAutoBalance (BalancedTxBody era) + -> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era) makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParameters pp) poolids stakeDelegDeposits drepDelegDeposits utxo txbodycontent changeaddr mnkeys = shelleyBasedEraConstraints sbe $ do @@ -992,7 +1015,7 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame -- of the outputs _ -> rest ++ [change] - balanceCheck :: Ledger.PParams (ShelleyLedgerEra era) -> TxOutValue era -> Either TxBodyErrorAutoBalance () + balanceCheck :: Ledger.PParams (ShelleyLedgerEra era) -> TxOutValue era -> Either (TxBodyErrorAutoBalance era) () balanceCheck bpparams balance | txOutValueToLovelace balance == 0 && onlyAda (txOutValueToValue balance) = return () | txOutValueToLovelace balance < 0 = @@ -1014,7 +1037,7 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame checkMinUTxOValue :: TxOut CtxTx era -> Ledger.PParams (ShelleyLedgerEra era) - -> Either TxBodyErrorAutoBalance () + -> Either (TxBodyErrorAutoBalance era) () checkMinUTxOValue txout@(TxOut _ v _ _) bpp = do let minUTxO = calculateMinimumUTxO sbe txout bpp if txOutValueToLovelace v >= minUTxO @@ -1023,13 +1046,13 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame substituteExecutionUnits :: Map ScriptWitnessIndex ExecutionUnits -> TxBodyContent BuildTx era - -> Either TxBodyErrorAutoBalance (TxBodyContent BuildTx era) + -> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era) substituteExecutionUnits exUnitsMap = mapTxScriptWitnesses f where f :: ScriptWitnessIndex -> ScriptWitness witctx era - -> Either TxBodyErrorAutoBalance (ScriptWitness witctx era) + -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era) f _ wit@SimpleScriptWitness{} = Right wit f idx (PlutusScriptWitness langInEra version script datum redeemer _) = case Map.lookup idx exUnitsMap of @@ -1041,9 +1064,9 @@ mapTxScriptWitnesses :: forall era. (forall witctx. ScriptWitnessIndex -> ScriptWitness witctx era - -> Either TxBodyErrorAutoBalance (ScriptWitness witctx era)) + -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)) -> TxBodyContent BuildTx era - -> Either TxBodyErrorAutoBalance (TxBodyContent BuildTx era) + -> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era) mapTxScriptWitnesses f txbodycontent@TxBodyContent { txIns, txWithdrawals, @@ -1064,11 +1087,11 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent { where mapScriptWitnessesTxIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] - -> Either TxBodyErrorAutoBalance [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] + -> Either (TxBodyErrorAutoBalance era) [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] mapScriptWitnessesTxIns txins = let mappedScriptWitnesses :: [ ( TxIn - , Either TxBodyErrorAutoBalance (BuildTxWith BuildTx (Witness WitCtxTxIn era)) + , Either (TxBodyErrorAutoBalance era) (BuildTxWith BuildTx (Witness WitCtxTxIn era)) ) ] mappedScriptWitnesses = @@ -1089,13 +1112,13 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent { mapScriptWitnessesWithdrawals :: TxWithdrawals BuildTx era - -> Either TxBodyErrorAutoBalance (TxWithdrawals BuildTx era) + -> Either (TxBodyErrorAutoBalance era) (TxWithdrawals BuildTx era) mapScriptWitnessesWithdrawals TxWithdrawalsNone = Right TxWithdrawalsNone mapScriptWitnessesWithdrawals (TxWithdrawals supported withdrawals) = let mappedWithdrawals :: [( StakeAddress , Lovelace - , Either TxBodyErrorAutoBalance (BuildTxWith BuildTx (Witness WitCtxStake era)) + , Either (TxBodyErrorAutoBalance era) (BuildTxWith BuildTx (Witness WitCtxStake era)) )] mappedWithdrawals = [ (addr, withdrawal, BuildTxWith <$> mappedWitness) @@ -1111,20 +1134,20 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent { ) mappedWithdrawals where adjustWitness - :: (ScriptWitness witctx era -> Either TxBodyErrorAutoBalance (ScriptWitness witctx era)) + :: (ScriptWitness witctx era -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)) -> Witness witctx era - -> Either TxBodyErrorAutoBalance (Witness witctx era) + -> Either (TxBodyErrorAutoBalance era) (Witness witctx era) adjustWitness _ (KeyWitness ctx) = Right $ KeyWitness ctx adjustWitness g (ScriptWitness ctx witness') = ScriptWitness ctx <$> g witness' mapScriptWitnessesCertificates :: TxCertificates BuildTx era - -> Either TxBodyErrorAutoBalance (TxCertificates BuildTx era) + -> Either (TxBodyErrorAutoBalance era) (TxCertificates BuildTx era) mapScriptWitnessesCertificates TxCertificatesNone = Right TxCertificatesNone mapScriptWitnessesCertificates (TxCertificates supported certs (BuildTxWith witnesses)) = let mappedScriptWitnesses - :: [(StakeCredential, Either TxBodyErrorAutoBalance (Witness WitCtxStake era))] + :: [(StakeCredential, Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))] mappedScriptWitnesses = [ (stakecred, ScriptWitness ctx <$> witness') -- The certs are indexed in list order @@ -1143,13 +1166,13 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent { mapScriptWitnessesMinting :: TxMintValue BuildTx era - -> Either TxBodyErrorAutoBalance (TxMintValue BuildTx era) + -> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era) mapScriptWitnessesMinting TxMintNone = Right TxMintNone mapScriptWitnessesMinting (TxMintValue supported value (BuildTxWith witnesses)) = --TxMintValue supported value $ BuildTxWith $ Map.fromList let mappedScriptWitnesses - :: [(PolicyId, Either TxBodyErrorAutoBalance (ScriptWitness WitCtxMint era))] + :: [(PolicyId, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))] mappedScriptWitnesses = [ (policyid, witness') -- The minting policies are indexed in policy id order in the value diff --git a/cardano-api/internal/Cardano/Api/Genesis.hs b/cardano-api/internal/Cardano/Api/Genesis.hs index 1c292fdbae..58e8b4e6c9 100644 --- a/cardano-api/internal/Cardano/Api/Genesis.hs +++ b/cardano-api/internal/Cardano/Api/Genesis.hs @@ -118,7 +118,7 @@ shelleyGenesisDefaults = & ppMaxBHSizeL .~ 1100 -- TODO: compute from crypto & ppMaxBBSizeL .~ 64 * 1024 -- max 64kb blocks & ppMaxTxSizeL .~ 16 * 1024 -- max 16kb txs - & ppEMaxL .~ 18 + & ppEMaxL .~ EpochInterval 18 & ppMinFeeAL .~ Coin 1 -- The linear factor for the minimum fee calculation & ppMinFeeBL .~ Coin 0 -- The constant factor for the minimum fee calculation @@ -131,4 +131,3 @@ shelleyGenesisDefaults = where k = 2160 zeroTime = Time.UTCTime (Time.fromGregorian 1970 1 1) 0 -- tradition - diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs index a5280f9302..fd62840fdd 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -47,23 +47,26 @@ data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era) -- TODO: Conway - Transitiion to Ledger.GovAction data GovernanceAction era = MotionOfNoConfidence - (StrictMaybe (Ledger.PrevGovActionId Ledger.CommitteePurpose StandardCrypto)) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) | ProposeNewConstitution - (StrictMaybe (Ledger.PrevGovActionId Ledger.ConstitutionPurpose StandardCrypto)) + (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose (ShelleyLedgerEra era))) (Ledger.Anchor StandardCrypto) | ProposeNewCommittee - (StrictMaybe (Ledger.PrevGovActionId Ledger.CommitteePurpose StandardCrypto)) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) [Hash CommitteeColdKey] -- ^ Old constitutional committee (Map (Hash CommitteeColdKey) EpochNo) -- ^ New committee members with epoch number when each of them expires Rational -- ^ Quorum of the committee that is necessary for a successful vote | InfoAct - | TreasuryWithdrawal [(Network, StakeCredential, Lovelace)] + | TreasuryWithdrawal + [(Network, StakeCredential, Lovelace)] + !(StrictMaybe (Shelley.ScriptHash StandardCrypto)) -- ^ Governance policy | InitiateHardfork - (StrictMaybe (Ledger.PrevGovActionId Ledger.HardForkPurpose StandardCrypto)) + (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose (ShelleyLedgerEra era))) ProtVer | UpdatePParams - (StrictMaybe (Ledger.PrevGovActionId Ledger.PParamUpdatePurpose StandardCrypto)) + (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose (ShelleyLedgerEra era))) (Ledger.PParamsUpdate (ShelleyLedgerEra era)) + !(StrictMaybe (Shelley.ScriptHash StandardCrypto)) -- ^ Governance policy toGovernanceAction :: () => ShelleyBasedEra era @@ -90,13 +93,13 @@ toGovernanceAction sbe = $ boundRational @UnitInterval quor) InfoAct -> Gov.InfoAction - TreasuryWithdrawal withdrawals -> - let m = Map.fromList [(L.mkRwdAcnt nw (toShelleyStakeCredential sc), toShelleyLovelace l) | (nw,sc,l) <- withdrawals] - in Gov.TreasuryWithdrawals m + TreasuryWithdrawal withdrawals govPol -> + let m = Map.fromList [(L.RewardAcnt nw (toShelleyStakeCredential sc), toShelleyLovelace l) | (nw,sc,l) <- withdrawals] + in Gov.TreasuryWithdrawals m govPol InitiateHardfork prevGovId pVer -> Gov.HardForkInitiation prevGovId pVer - UpdatePParams preGovId ppup -> - Gov.ParameterChange preGovId ppup + UpdatePParams preGovId ppup govPol -> + Gov.ParameterChange preGovId ppup govPol fromGovernanceAction :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto @@ -107,15 +110,15 @@ fromGovernanceAction = \case MotionOfNoConfidence prevGovId Gov.NewConstitution prevGovId constitution -> ProposeNewConstitution prevGovId $ Gov.constitutionAnchor constitution - Gov.ParameterChange prevGovId pparams -> - UpdatePParams prevGovId pparams + Gov.ParameterChange prevGovId pparams govPolicy -> + UpdatePParams prevGovId pparams govPolicy Gov.HardForkInitiation prevGovId pVer -> InitiateHardfork prevGovId pVer - Gov.TreasuryWithdrawals withdrawlMap -> + Gov.TreasuryWithdrawals withdrawlMap govPolicy -> let res = [ (L.getRwdNetwork rwdAcnt, fromShelleyStakeCredential (L.getRwdCred rwdAcnt), fromShelleyLovelace coin) | (rwdAcnt, coin) <- Map.toList withdrawlMap ] - in TreasuryWithdrawal res + in TreasuryWithdrawal res govPolicy Gov.UpdateCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor -> ProposeNewCommittee prevGovId @@ -165,7 +168,7 @@ createProposalProcedure sbe nw dep (StakeKeyHash retAddrh) govAct anchor = shelleyBasedEraConstraints sbe $ Proposal Gov.ProposalProcedure { Gov.pProcDeposit = toShelleyLovelace dep - , Gov.pProcReturnAddr = L.mkRwdAcnt nw (L.KeyHashObj retAddrh) + , Gov.pProcReturnAddr = L.RewardAcnt nw (L.KeyHashObj retAddrh) , Gov.pProcGovAction = toGovernanceAction sbe govAct , Gov.pProcAnchor = anchor } @@ -186,11 +189,12 @@ fromProposalProcedure sbe (Proposal pp) = createPreviousGovernanceActionId - :: TxId + :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto + => TxId -> Word32 -- ^ Governance action transation index - -> Ledger.PrevGovActionId (r :: Ledger.GovActionPurpose) StandardCrypto + -> Ledger.GovPurposeId (r :: Ledger.GovActionPurpose) (ShelleyLedgerEra era) createPreviousGovernanceActionId txid index = - Ledger.PrevGovActionId $ createGovernanceActionId txid index + Ledger.GovPurposeId $ createGovernanceActionId txid index createGovernanceActionId :: TxId -> Word32 -> Gov.GovActionId StandardCrypto diff --git a/cardano-api/internal/Cardano/Api/Governance/Poll.hs b/cardano-api/internal/Cardano/Api/Governance/Poll.hs index abed47a39b..79f06865a1 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Poll.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Poll.hs @@ -45,8 +45,8 @@ import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseRaw import Cardano.Api.SerialiseTextEnvelope import Cardano.Api.SerialiseUsing -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import Cardano.Api.TxMetadata import Cardano.Api.Utils diff --git a/cardano-api/internal/Cardano/Api/IPC.hs b/cardano-api/internal/Cardano/Api/IPC.hs index 6695c6a4a4..1d32f2e58c 100644 --- a/cardano-api/internal/Cardano/Api/IPC.hs +++ b/cardano-api/internal/Cardano/Api/IPC.hs @@ -85,8 +85,8 @@ import Cardano.Api.Modes import Cardano.Api.NetworkId import Cardano.Api.Protocol import Cardano.Api.Query -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import qualified Cardano.Ledger.Api as L import qualified Ouroboros.Consensus.Block as Consensus @@ -533,7 +533,7 @@ toAcquiringFailure AcquireFailurePointNotOnChain = AFPointNotOnChain queryNodeLocalState :: forall result. () => LocalNodeConnectInfo - -> Maybe ChainPoint + -> Net.Query.Target ChainPoint -> QueryInMode result -> IO (Either AcquiringFailure result) queryNodeLocalState connctInfo mpoint query = do @@ -549,7 +549,7 @@ queryNodeLocalState connctInfo mpoint query = do atomically (takeTMVar resultVar) where singleQuery - :: Maybe ChainPoint + :: Net.Query.Target ChainPoint -> TMVar (Either AcquiringFailure result) -> Net.Query.LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO () singleQuery mPointVar' resultVar' = diff --git a/cardano-api/internal/Cardano/Api/IPC/Monad.hs b/cardano-api/internal/Cardano/Api/IPC/Monad.hs index dfe2c71151..9318478bb1 100644 --- a/cardano-api/internal/Cardano/Api/IPC/Monad.hs +++ b/cardano-api/internal/Cardano/Api/IPC/Monad.hs @@ -14,6 +14,7 @@ import Cardano.Api.IPC.Version import Cardano.Ledger.Shelley.Scripts () import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as Net.Query +import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Net.Query import Control.Concurrent.STM import Control.Monad @@ -42,10 +43,10 @@ newtype LocalStateQueryExpr block point query r m a = LocalStateQueryExpr -- | Execute a local state query expression. executeLocalStateQueryExpr :: () => LocalNodeConnectInfo - -> Maybe ChainPoint + -> Net.Query.Target ChainPoint -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a -> IO (Either AcquiringFailure a) -executeLocalStateQueryExpr connectInfo mpoint f = do +executeLocalStateQueryExpr connectInfo target f = do tmvResultLocalState <- newEmptyTMVarIO let waitResult = readTMVar tmvResultLocalState @@ -54,7 +55,7 @@ executeLocalStateQueryExpr connectInfo mpoint f = do (\ntcVersion -> LocalNodeClientProtocols { localChainSyncClient = NoLocalChainSyncClient - , localStateQueryClient = Just $ setupLocalStateQueryExpr waitResult mpoint tmvResultLocalState ntcVersion f + , localStateQueryClient = Just $ setupLocalStateQueryExpr waitResult target tmvResultLocalState ntcVersion f , localTxSubmissionClient = Nothing , localTxMonitoringClient = Nothing } @@ -68,7 +69,7 @@ setupLocalStateQueryExpr :: -- ^ An STM expression that only returns when all protocols are complete. -- Protocols must wait until 'waitDone' returns because premature exit will -- cause other incomplete protocols to abort which may lead to deadlock. - -> Maybe ChainPoint + -> Net.Query.Target ChainPoint -> TMVar (Either AcquiringFailure a) -> NodeToClientVersion -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a diff --git a/cardano-api/internal/Cardano/Api/InMode.hs b/cardano-api/internal/Cardano/Api/InMode.hs index d6a4f8f5f6..d5bc0cf28b 100644 --- a/cardano-api/internal/Cardano/Api/InMode.hs +++ b/cardano-api/internal/Cardano/Api/InMode.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -31,8 +32,8 @@ import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras import Cardano.Api.Modes import Cardano.Api.Orphans () -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import Cardano.Api.Utils (textShow) import qualified Cardano.Ledger.Api as L diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs index b015475ef6..c4d026cc50 100644 --- a/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs @@ -18,13 +18,13 @@ import Cardano.Api.Block (EpochNo) import Cardano.Api.Keys.Shelley (Hash (..), StakePoolKey) import Cardano.Api.Value (Lovelace, fromShelleyLovelace) -import Cardano.Ledger.Alonzo.Plutus.TxInfo (PlutusDebug) import qualified Cardano.Ledger.Coin as Ledger import qualified Cardano.Ledger.Conway.Governance as Ledger import qualified Cardano.Ledger.Core as Ledger.Core import qualified Cardano.Ledger.Credential as Ledger import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Keys as Ledger +import Cardano.Ledger.Plutus.Evaluate (PlutusWithContext) import Cardano.Ledger.Shelley.Rewards (Reward) import qualified Cardano.Ledger.TxIn as Ledger @@ -58,9 +58,9 @@ data LedgerEvent | -- | Pools have been reaped and deposits refunded. PoolReap PoolReapDetails -- | A number of succeeded Plutus script evaluations. - | SuccessfulPlutusScript (NonEmpty PlutusDebug) + | SuccessfulPlutusScript (NonEmpty PlutusWithContext) -- | A number of failed Plutus script evaluations. - | FailedPlutusScript (NonEmpty PlutusDebug) + | FailedPlutusScript (NonEmpty PlutusWithContext) -- Only events available on the Conway Era. diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/UTXOW.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/UTXOW.hs index 869fed1b8c..770ef24708 100644 --- a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/UTXOW.hs +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/UTXOW.hs @@ -31,6 +31,7 @@ handleAlonzoOnwardsUTxOWEvent (WrappedShelleyEraEvent (Shelley.UtxoEvent (UtxosE Alonzo.TotalDeposits{} -> Nothing Alonzo.SuccessfulPlutusScriptsEvent e -> Just $ SuccessfulPlutusScript e Alonzo.FailedPlutusScriptsEvent e -> Just $ FailedPlutusScript e + Alonzo.TxUTxODiff _ _ -> Nothing handlePreAlonzoUTxOWEvent :: Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ Shelley.UtxoEvent ledgerera @@ -40,6 +41,7 @@ handlePreAlonzoUTxOWEvent (Shelley.UtxoEvent e)= case e of Shelley.TotalDeposits{} -> Nothing Shelley.UpdateEvent (Shelley.NewEpoch _) -> Nothing + Shelley.TxUTxODiff _ _ -> Nothing handleAllegraMaryUTxOWEvent @@ -50,3 +52,4 @@ handleAllegraMaryUTxOWEvent (Shelley.UtxoEvent e)= case e of Allegra.TotalDeposits{} -> Nothing Allegra.UpdateEvent (Shelley.NewEpoch _) -> Nothing + Allegra.TxUTxODiff _ _ -> Nothing diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index a2e48dc453..72e929bcf4 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -484,7 +484,7 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = hand } -- | Defines the client side of the chain sync protocol. - chainSyncClient :: Word32 + chainSyncClient :: Word16 -- ^ The maximum number of concurrent requests. -> IORef a -- ^ State accumulator. Written to on every block. @@ -1950,7 +1950,7 @@ checkLedgerStateCondition nodeConfigFilePath socketPath validationMode terminati } -- | Defines the client side of the chain sync protocol. - chainSyncClient :: Word32 + chainSyncClient :: Word16 -- ^ The maximum number of concurrent requests. -> IORef (LedgerStateCondition, s) -- ^ State accumulator. Written to on every block. @@ -2078,4 +2078,3 @@ atTerminationEpoch terminationEpoch events = handleIOExceptions :: MonadIOTransError FoldBlocksError t m => ExceptT FoldBlocksError IO a -> t m a handleIOExceptions = liftEither <=< liftIO . fmap (join . first FoldBlocksIOException) . try . runExceptT - diff --git a/cardano-api/internal/Cardano/Api/OperationalCertificate.hs b/cardano-api/internal/Cardano/Api/OperationalCertificate.hs index 566aba1f19..2b7861fe69 100644 --- a/cardano-api/internal/Cardano/Api/OperationalCertificate.hs +++ b/cardano-api/internal/Cardano/Api/OperationalCertificate.hs @@ -29,7 +29,7 @@ import Cardano.Api.Keys.Shelley import Cardano.Api.ProtocolParameters import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseTextEnvelope -import Cardano.Api.Tx +import Cardano.Api.Tx.Sign import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Keys as Shelley diff --git a/cardano-api/internal/Cardano/Api/Orphans.hs b/cardano-api/internal/Cardano/Api/Orphans.hs index 98785b01f0..19e1ada2cb 100644 --- a/cardano-api/internal/Cardano/Api/Orphans.hs +++ b/cardano-api/internal/Cardano/Api/Orphans.hs @@ -125,11 +125,6 @@ deriving anyclass instance ToJSON L.UTxOValidationError deriving anyclass instance ToJSON L.Voting.Error deriving anyclass instance ToJSON L.VotingPeriod -deriving anyclass instance ToJSON (L.GenesisDelegCert L.StandardCrypto) -deriving anyclass instance ToJSON (L.MIRCert L.StandardCrypto) -deriving anyclass instance ToJSON (L.MIRTarget L.StandardCrypto) -deriving anyclass instance ToJSON (L.PoolCert L.StandardCrypto) -deriving anyclass instance ToJSON (L.ShelleyDelegCert L.StandardCrypto) deriving anyclass instance ( ToJSON (L.PredicateFailure (L.EraRule "UTXOW" ledgerera)) @@ -149,33 +144,22 @@ deriving anyclass instance deriving anyclass instance ( L.Crypto (L.EraCrypto ledgerera) , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) - , ToJSON (L.ScriptPurpose ledgerera) + , ToJSON (L.PlutusPurpose L.AsItem ledgerera) + , ToJSON (L.PlutusPurpose L.AsIndex ledgerera) ) => ToJSON (L.AlonzoUtxowPredFailure ledgerera) deriving anyclass instance ( L.Crypto (L.EraCrypto ledgerera) , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) , ToJSON (L.TxCert ledgerera) + , ToJSON (L.PlutusPurpose L.AsItem ledgerera) + , ToJSON (L.PlutusPurpose L.AsIndex ledgerera) ) => ToJSON (L.BabbageUtxowPredFailure ledgerera) -deriving anyclass instance - ( L.Crypto (L.EraCrypto ledgerera) - , ToJSON (L.GenesisDelegCert (Consensus.EraCrypto ledgerera)) - , ToJSON (L.MIRCert (Consensus.EraCrypto ledgerera)) - , ToJSON (L.PoolCert (Consensus.EraCrypto ledgerera)) - , ToJSON (L.ShelleyDelegCert (Consensus.EraCrypto ledgerera)) - ) => ToJSON (L.ShelleyTxCert ledgerera) - -deriving anyclass instance - ( L.Crypto (L.EraCrypto ledgerera) - , ToJSON (L.TxCert ledgerera) - ) => ToJSON (L.ScriptPurpose ledgerera) - deriving anyclass instance ( ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera)) ) => ToJSON (L.ApplyTxError ledgerera) -deriving via ShowOf (L.ConwayTxCert c) instance Show (L.ConwayTxCert c) => ToJSON (L.ConwayTxCert c) deriving via ShowOf (L.Keys.VKey L.Keys.Witness c) instance L.Crypto c => ToJSON (L.Keys.VKey L.Keys.Witness c) deriving via ShowOf (L.AllegraUtxoPredFailure ledgerera) instance Show (L.AllegraUtxoPredFailure ledgerera) => ToJSON (L.AllegraUtxoPredFailure ledgerera) @@ -187,9 +171,7 @@ deriving via ShowOf (L.ShelleyUtxoPredFailure ledgerera) instance Show (L.Shel deriving instance ToJSON a => ToJSON (L.Registration.TooLarge a) -deriving via ShowOf L.MIRPot instance ToJSON L.MIRPot deriving via ShowOf L.KeyHash instance ToJSON L.KeyHash -deriving via ShowOf L.RdmrPtr instance ToJSON L.RdmrPtr deriving via ShowOf L.ApplicationName instance ToJSONKey L.ApplicationName diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index 5304dc638e..0a9ab34162 100644 --- a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs @@ -8,6 +8,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} @@ -129,6 +130,7 @@ import qualified Cardano.Ledger.BaseTypes as Ledger import qualified Cardano.Ledger.Conway.PParams as Ledger import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Keys as Ledger +import qualified Cardano.Ledger.Plutus.CostModels as Plutus import qualified Cardano.Ledger.Plutus.Language as Plutus import qualified Cardano.Ledger.Shelley.API as Ledger import Cardano.Slotting.Slot (EpochNo (..)) @@ -146,6 +148,7 @@ import Data.Maybe (isJust) import Data.Maybe.Strict (StrictMaybe (..)) import Data.String (IsString) import Data.Text (Text) +import Data.Word import GHC.Generics import Lens.Micro import Numeric.Natural @@ -243,11 +246,11 @@ data IntroducedInConwayPParams era { icPoolVotingThresholds :: StrictMaybe Ledger.PoolVotingThresholds , icDRepVotingThresholds :: StrictMaybe Ledger.DRepVotingThresholds , icMinCommitteeSize :: StrictMaybe Natural - , icCommitteeTermLength :: StrictMaybe EpochNo - , icGovActionLifetime :: StrictMaybe EpochNo + , icCommitteeTermLength :: StrictMaybe Ledger.EpochInterval + , icGovActionLifetime :: StrictMaybe Ledger.EpochInterval , icGovActionDeposit :: StrictMaybe Ledger.Coin , icDRepDeposit :: StrictMaybe Ledger.Coin - , icDRepActivity :: StrictMaybe EpochNo + , icDRepActivity :: StrictMaybe Ledger.EpochInterval } deriving Show @@ -322,12 +325,12 @@ data CommonProtocolParametersUpdate = CommonProtocolParametersUpdate { cppMinFeeA :: StrictMaybe Ledger.Coin , cppMinFeeB :: StrictMaybe Ledger.Coin - , cppMaxBlockBodySize :: StrictMaybe Natural - , cppMaxTxSize :: StrictMaybe Natural - , cppMaxBlockHeaderSize :: StrictMaybe Natural + , cppMaxBlockBodySize :: StrictMaybe Word32 + , cppMaxTxSize :: StrictMaybe Word32 + , cppMaxBlockHeaderSize :: StrictMaybe Word16 , cppKeyDeposit :: StrictMaybe Ledger.Coin , cppPoolDeposit :: StrictMaybe Ledger.Coin - , cppPoolRetireMaxEpoch :: StrictMaybe EpochNo + , cppPoolRetireMaxEpoch :: StrictMaybe Ledger.EpochInterval , cppStakePoolTargetNum :: StrictMaybe Natural , cppPoolPledgeInfluence :: StrictMaybe Ledger.NonNegativeInterval , cppTreasuryExpansion :: StrictMaybe Ledger.UnitInterval @@ -543,7 +546,7 @@ data ProtocolParameters = -- | The maximum number of epochs into the future that stake pools -- are permitted to schedule a retirement. -- - protocolParamPoolRetireMaxEpoch :: EpochNo, + protocolParamPoolRetireMaxEpoch :: Ledger.EpochInterval, -- | The equilibrium target number of stake pools. -- @@ -719,7 +722,7 @@ data ProtocolParametersUpdate = -- Caution: setting this to be smaller than legitimate block headers is -- a sure way to brick the system! -- - protocolUpdateMaxBlockHeaderSize :: Maybe Natural, + protocolUpdateMaxBlockHeaderSize :: Maybe Word16, -- | The maximum permitted size of the block body (that is, the block -- payload, without the block header). @@ -731,7 +734,7 @@ data ProtocolParametersUpdate = -- Caution: setting this to be smaller than a transaction that can -- change the protocol parameters is a sure way to brick the system! -- - protocolUpdateMaxBlockBodySize :: Maybe Natural, + protocolUpdateMaxBlockBodySize :: Maybe Word32, -- | The maximum permitted size of a transaction. -- @@ -740,7 +743,7 @@ data ProtocolParametersUpdate = -- the current implementation does not use any sophisticated box packing -- algorithm. -- - protocolUpdateMaxTxSize :: Maybe Natural, + protocolUpdateMaxTxSize :: Maybe Word32, -- | The constant factor for the minimum fee calculation. -- @@ -771,7 +774,7 @@ data ProtocolParametersUpdate = -- | The maximum number of epochs into the future that stake pools -- are permitted to schedule a retirement. -- - protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo, + protocolUpdatePoolRetireMaxEpoch :: Maybe Ledger.EpochInterval, -- | The equilibrium target number of stake pools. -- @@ -914,6 +917,7 @@ instance Monoid ProtocolParametersUpdate where } instance ToCBOR ProtocolParametersUpdate where + toCBOR :: ProtocolParametersUpdate -> CBOR.Encoding toCBOR ProtocolParametersUpdate{..} = CBOR.encodeListLen 26 <> toCBOR protocolUpdateProtocolVersion @@ -941,7 +945,6 @@ instance ToCBOR ProtocolParametersUpdate where <> toCBOR protocolUpdateCollateralPercent <> toCBOR protocolUpdateMaxCollateralInputs <> toCBOR protocolUpdateUTxOCostPerByte - instance FromCBOR ProtocolParametersUpdate where fromCBOR = do CBOR.enforceSize "ProtocolParametersUpdate" 26 @@ -1095,7 +1098,7 @@ toAlonzoCostModels -> Either ProtocolParametersConversionError Alonzo.CostModels toAlonzoCostModels m = do f <- mapM conv $ Map.toList m - Right (Alonzo.emptyCostModels { Alonzo.costModelsValid = Map.fromList f }) + Right $ Plutus.mkCostModels $ Map.fromList f where conv :: (AnyPlutusScriptVersion, CostModel) -> Either ProtocolParametersConversionError (Plutus.Language, Alonzo.CostModel) conv (anySVer, cModel) = do @@ -1103,12 +1106,12 @@ toAlonzoCostModels m = do Right (toAlonzoScriptLanguage anySVer, alonzoCostModel) fromAlonzoCostModels - :: Alonzo.CostModels + :: Plutus.CostModels -> Map AnyPlutusScriptVersion CostModel -fromAlonzoCostModels (Alonzo.CostModels m _ _) = +fromAlonzoCostModels cModels = Map.fromList . map (bimap fromAlonzoScriptLanguage fromAlonzoCostModel) - $ Map.toList m + $ Map.toList $ Plutus.costModelsValid cModels toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Plutus.Language toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Plutus.PlutusV1 @@ -1564,9 +1567,9 @@ toShelleyCommonPParams emptyPParams & ppMinFeeAL .~ toShelleyLovelace protocolParamTxFeePerByte & ppMinFeeBL .~ toShelleyLovelace protocolParamTxFeeFixed - & ppMaxBBSizeL .~ protocolParamMaxBlockBodySize - & ppMaxTxSizeL .~ protocolParamMaxTxSize - & ppMaxBHSizeL .~ protocolParamMaxBlockHeaderSize + & ppMaxBBSizeL .~ fromIntegral protocolParamMaxBlockBodySize + & ppMaxTxSizeL .~ fromIntegral protocolParamMaxTxSize + & ppMaxBHSizeL .~ fromIntegral protocolParamMaxBlockHeaderSize & ppKeyDepositL .~ toShelleyLovelace protocolParamStakeAddressDeposit & ppPoolDepositL .~ toShelleyLovelace protocolParamStakePoolDeposit & ppEMaxL .~ protocolParamPoolRetireMaxEpoch @@ -1712,9 +1715,9 @@ fromShelleyCommonPParams pp = ProtocolParameters { protocolParamProtocolVersion = case pp ^. ppProtocolVersionL of Ledger.ProtVer a b -> (Ledger.getVersion a, b) - , protocolParamMaxBlockHeaderSize = pp ^. ppMaxBHSizeL - , protocolParamMaxBlockBodySize = pp ^. ppMaxBBSizeL - , protocolParamMaxTxSize = pp ^. ppMaxTxSizeL + , protocolParamMaxBlockHeaderSize = fromIntegral $ pp ^. ppMaxBHSizeL + , protocolParamMaxBlockBodySize = fromIntegral $ pp ^. ppMaxBBSizeL + , protocolParamMaxTxSize = fromIntegral $ pp ^. ppMaxTxSizeL , protocolParamTxFeeFixed = fromShelleyLovelace (pp ^. ppMinFeeBL) , protocolParamTxFeePerByte = fromShelleyLovelace (pp ^. ppMinFeeAL) , protocolParamStakeAddressDeposit = fromShelleyLovelace (pp ^. ppKeyDepositL) diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs index 88b1e83c51..d886b9f952 100644 --- a/cardano-api/internal/Cardano/Api/Query.hs +++ b/cardano-api/internal/Cardano/Api/Query.hs @@ -82,6 +82,7 @@ import Cardano.Api.Address import Cardano.Api.Block import Cardano.Api.Certificate import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eras.Case import Cardano.Api.Eras.Core import Cardano.Api.GenesisParameters import Cardano.Api.IPC.Version @@ -91,7 +92,7 @@ import Cardano.Api.NetworkId import Cardano.Api.ProtocolParameters import Cardano.Api.Query.Types import qualified Cardano.Api.ReexposeLedger as Ledger -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body import Cardano.Api.Value import qualified Cardano.Chain.Update.Validation.Interface as Byron.Update @@ -599,7 +600,10 @@ toConsensusQueryShelleyBased sbe = \case Some (consensusQueryInEraInMode era Consensus.GetEpochNo) QueryConstitution -> - Some (consensusQueryInEraInMode era Consensus.GetConstitution) + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "toConsensusQueryShelleyBased: QueryConstitution is only available in the Conway era") + (const $ Some (consensusQueryInEraInMode era Consensus.GetConstitution)) + sbe QueryGenesisParameters -> Some (consensusQueryInEraInMode era Consensus.GetGenesisConfig) @@ -674,17 +678,29 @@ toConsensusQueryShelleyBased sbe = \case Some (consensusQueryInEraInMode era Consensus.GetGovState) QueryDRepState creds -> - Some (consensusQueryInEraInMode era (Consensus.GetDRepState creds)) + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "toConsensusQueryShelleyBased: QueryDRepState is only available in the Conway era") + (const $ Some (consensusQueryInEraInMode era (Consensus.GetDRepState creds))) + sbe QueryDRepStakeDistr dreps -> - Some (consensusQueryInEraInMode era (Consensus.GetDRepStakeDistr dreps)) + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "toConsensusQueryShelleyBased: QueryDRepStakeDistr is only available in the Conway era") + (const $ Some (consensusQueryInEraInMode era (Consensus.GetDRepStakeDistr dreps))) + sbe QueryCommitteeMembersState coldCreds hotCreds statuses -> - Some (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses)) + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "toConsensusQueryShelleyBased: QueryCommitteeMembersState is only available in the Conway era") + (const $ Some (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses))) + sbe QueryStakeVoteDelegatees creds -> - Some (consensusQueryInEraInMode era - (Consensus.GetFilteredVoteDelegatees creds')) + caseShelleyToBabbageOrConwayEraOnwards + (const $ error "toConsensusQueryShelleyBased: QueryStakeVoteDelegatees is only available in the Conway era") + (const $ Some (consensusQueryInEraInMode era + (Consensus.GetFilteredVoteDelegatees creds'))) + sbe where creds' :: Set (Shelley.Credential Shelley.Staking StandardCrypto) creds' = Set.map toShelleyStakeCredential creds diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index 4843e049b9..ff74ef7b02 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} @@ -130,8 +129,10 @@ import qualified Cardano.Binary as CBOR import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Ledger.Allegra.Scripts as Timelock import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo +import qualified Cardano.Ledger.Babbage.Scripts as Babbage import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import qualified Cardano.Ledger.Binary as Binary (decCBOR, decodeFullAnnotator) +import qualified Cardano.Ledger.Conway.Scripts as Conway import Cardano.Ledger.Core (Era (EraCrypto)) import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Keys as Shelley @@ -691,7 +692,7 @@ data WitCtxMint -- | A tag type for the context in which a script is used in a transaction. -- -- This type tags the context as being to witness the use of stake addresses in --- both certificates and withdrawals. +-- certificates, withdrawals, voting and proposals. -- data WitCtxStake @@ -711,7 +712,11 @@ data WitCtx witctx where -- or to mint tokens. This datatype encapsulates this concept. data PlutusScriptOrReferenceInput lang = PScript (PlutusScript lang) - | PReferenceScript TxIn (Maybe ScriptHash) + | PReferenceScript + TxIn + (Maybe ScriptHash) -- ^ Needed to construct the redeemer pointer map + -- in the case of minting reference scripts where we don't + -- have direct access to the script deriving (Eq, Show) @@ -925,23 +930,10 @@ fromAlonzoExUnits Alonzo.ExUnits{Alonzo.exUnitsSteps, Alonzo.exUnitsMem} = -- Alonzo mediator pattern -- -pattern AlonzoPlutusScript :: Plutus.Language -> ShortByteString -> Alonzo.AlonzoScript era -pattern AlonzoPlutusScript lang script = Alonzo.PlutusScript (Plutus.Plutus {Plutus.plutusLanguage = lang, Plutus.plutusScript = Alonzo.BinaryPlutus script}) +pattern PlutusScriptBinary :: Plutus.PlutusLanguage l => ShortByteString -> Plutus.Plutus l +pattern PlutusScriptBinary script = Plutus.Plutus (Plutus.PlutusBinary script) -pattern AlonzoTimelockScript :: Timelock.Timelock era -> Alonzo.AlonzoScript era -pattern AlonzoTimelockScript script = Alonzo.TimelockScript script - --- | NOT EXPORTED --- --- This exists solely to cause an pattern match checker warning if --- 'Alonzo.AlonzoScript' changes, which would mean the following @COMPLETE@ --- pramga may need to be updated. -_completenessProof :: Alonzo.AlonzoScript era -> () -_completenessProof = \case - Alonzo.TimelockScript _ -> () - Alonzo.PlutusScript (Plutus.Plutus _ (Alonzo.BinaryPlutus _)) -> () - -{-# COMPLETE AlonzoTimelockScript, AlonzoPlutusScript #-} +{-# COMPLETE PlutusScriptBinary #-} -- ---------------------------------------------------------------------------- -- Script Hash @@ -984,17 +976,20 @@ hashScript (PlutusScript PlutusScriptV1 (PlutusScriptSerialised script)) = -- hash that. Later ledger eras have to be compatible anyway. ScriptHash . Ledger.hashScript @(ShelleyLedgerEra AlonzoEra) - $ AlonzoPlutusScript Plutus.PlutusV1 script + . Alonzo.PlutusScript . Alonzo.AlonzoPlutusV1 . Plutus.Plutus + $ Plutus.PlutusBinary script hashScript (PlutusScript PlutusScriptV2 (PlutusScriptSerialised script)) = ScriptHash . Ledger.hashScript @(ShelleyLedgerEra BabbageEra) - $ AlonzoPlutusScript Plutus.PlutusV2 script + . Alonzo.PlutusScript . Babbage.BabbagePlutusV2 . Plutus.Plutus + $ Plutus.PlutusBinary script hashScript (PlutusScript PlutusScriptV3 (PlutusScriptSerialised script)) = ScriptHash . Ledger.hashScript @(ShelleyLedgerEra ConwayEra) - $ AlonzoPlutusScript Plutus.PlutusV3 script + . Alonzo.PlutusScript . Conway.ConwayPlutusV1 . Plutus.Plutus + $ Plutus.PlutusBinary script toShelleyScriptHash :: ScriptHash -> Shelley.ScriptHash StandardCrypto toShelleyScriptHash (ScriptHash h) = h @@ -1106,27 +1101,33 @@ toShelleyScript (ScriptInEra langInEra (SimpleScript script)) = SimpleScriptInShelley -> either (error . show) id (toShelleyMultiSig script) SimpleScriptInAllegra -> toAllegraTimelock script SimpleScriptInMary -> toAllegraTimelock script - SimpleScriptInAlonzo -> AlonzoTimelockScript (toAllegraTimelock script) - SimpleScriptInBabbage -> AlonzoTimelockScript (toAllegraTimelock script) - SimpleScriptInConway -> AlonzoTimelockScript (toAllegraTimelock script) + SimpleScriptInAlonzo -> Alonzo.TimelockScript (toAllegraTimelock script) + SimpleScriptInBabbage -> Alonzo.TimelockScript (toAllegraTimelock script) + SimpleScriptInConway -> Alonzo.TimelockScript (toAllegraTimelock script) toShelleyScript (ScriptInEra langInEra (PlutusScript PlutusScriptV1 (PlutusScriptSerialised script))) = case langInEra of - PlutusScriptV1InAlonzo -> AlonzoPlutusScript Plutus.PlutusV1 script - PlutusScriptV1InBabbage -> AlonzoPlutusScript Plutus.PlutusV1 script - PlutusScriptV1InConway -> AlonzoPlutusScript Plutus.PlutusV1 script + PlutusScriptV1InAlonzo -> + Alonzo.PlutusScript . Alonzo.AlonzoPlutusV1 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV1InBabbage -> + Alonzo.PlutusScript . Babbage.BabbagePlutusV1 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV1InConway -> + Alonzo.PlutusScript . Conway.ConwayPlutusV1 . Plutus.Plutus $ Plutus.PlutusBinary script toShelleyScript (ScriptInEra langInEra (PlutusScript PlutusScriptV2 (PlutusScriptSerialised script))) = case langInEra of - PlutusScriptV2InBabbage -> AlonzoPlutusScript Plutus.PlutusV2 script - PlutusScriptV2InConway -> AlonzoPlutusScript Plutus.PlutusV2 script + PlutusScriptV2InBabbage -> + Alonzo.PlutusScript . Babbage.BabbagePlutusV2 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV2InConway -> + Alonzo.PlutusScript . Conway.ConwayPlutusV2 . Plutus.Plutus $ Plutus.PlutusBinary script toShelleyScript (ScriptInEra langInEra (PlutusScript PlutusScriptV3 (PlutusScriptSerialised script))) = case langInEra of - PlutusScriptV3InConway -> AlonzoPlutusScript Plutus.PlutusV3 script + PlutusScriptV3InConway -> + Alonzo.PlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script fromShelleyBasedScript :: ShelleyBasedEra era -> Ledger.Script (ShelleyLedgerEra era) @@ -1144,45 +1145,48 @@ fromShelleyBasedScript sbe script = . SimpleScript $ fromAllegraTimelock script ShelleyBasedEraAlonzo -> case script of - AlonzoTimelockScript s -> - ScriptInEra SimpleScriptInAlonzo - . SimpleScript $ fromAllegraTimelock s - AlonzoPlutusScript Plutus.PlutusV1 s -> + Alonzo.PlutusScript (Alonzo.AlonzoPlutusV1 (PlutusScriptBinary s)) -> ScriptInEra PlutusScriptV1InAlonzo . PlutusScript PlutusScriptV1 $ PlutusScriptSerialised s - AlonzoPlutusScript Plutus.PlutusV2 _ -> - error "fromShelleyBasedScript: PlutusV2 not supported in Alonzo era" - AlonzoPlutusScript Plutus.PlutusV3 _ -> - error "fromShelleyBasedScript: PlutusV3 not supported in Alonzo era" + Alonzo.TimelockScript s -> + ScriptInEra SimpleScriptInAlonzo + . SimpleScript $ fromAllegraTimelock s ShelleyBasedEraBabbage -> case script of - AlonzoTimelockScript s -> + Alonzo.PlutusScript plutusV -> + case plutusV of + Babbage.BabbagePlutusV1 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV1InBabbage + . PlutusScript PlutusScriptV1 + $ PlutusScriptSerialised s + Babbage.BabbagePlutusV2 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV2InBabbage + . PlutusScript PlutusScriptV2 + $ PlutusScriptSerialised s + Alonzo.TimelockScript s -> ScriptInEra SimpleScriptInBabbage - . SimpleScript $ fromAllegraTimelock s - AlonzoPlutusScript Plutus.PlutusV1 s -> - ScriptInEra PlutusScriptV1InBabbage - . PlutusScript PlutusScriptV1 $ PlutusScriptSerialised s - AlonzoPlutusScript Plutus.PlutusV2 s -> - ScriptInEra PlutusScriptV2InBabbage - . PlutusScript PlutusScriptV2 $ PlutusScriptSerialised s - AlonzoPlutusScript Plutus.PlutusV3 _ -> - error "fromShelleyBasedScript: PlutusV3 not supported in Babbage era" + . SimpleScript $ fromAllegraTimelock s ShelleyBasedEraConway -> case script of - AlonzoTimelockScript s -> + Alonzo.PlutusScript plutusV -> + case plutusV of + Conway.ConwayPlutusV1 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV1InConway + . PlutusScript PlutusScriptV1 + $ PlutusScriptSerialised s + Conway.ConwayPlutusV2 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV2InConway + . PlutusScript PlutusScriptV2 + $ PlutusScriptSerialised s + Conway.ConwayPlutusV3 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV3InConway + . PlutusScript PlutusScriptV3 + $ PlutusScriptSerialised s + Alonzo.TimelockScript s -> ScriptInEra SimpleScriptInConway - . SimpleScript $ fromAllegraTimelock s - AlonzoPlutusScript Plutus.PlutusV1 s -> - ScriptInEra PlutusScriptV1InConway - . PlutusScript PlutusScriptV1 $ PlutusScriptSerialised s - AlonzoPlutusScript Plutus.PlutusV2 s -> - ScriptInEra PlutusScriptV2InConway - . PlutusScript PlutusScriptV2 $ PlutusScriptSerialised s - AlonzoPlutusScript Plutus.PlutusV3 s -> - ScriptInEra PlutusScriptV3InConway - . PlutusScript PlutusScriptV3 $ PlutusScriptSerialised s + . SimpleScript $ fromAllegraTimelock s data MultiSigError = MultiSigErrorTimelockNotsupported deriving Show diff --git a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs index b4c6341cad..7bb799d6f0 100644 --- a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs +++ b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs @@ -42,7 +42,7 @@ import Cardano.Api.HasTypeProxy import Cardano.Api.IO import Cardano.Api.Pretty import Cardano.Api.SerialiseCBOR -import Cardano.Api.Tx +import Cardano.Api.Tx.Sign import Cardano.Api.Utils import qualified Cardano.Chain.UTxO as Byron diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs similarity index 84% rename from cardano-api/internal/Cardano/Api/TxBody.hs rename to cardano-api/internal/Cardano/Api/Tx/Body.hs index b4dc20c965..debb8bae1f 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -24,7 +24,7 @@ -- | Transaction bodies -- -module Cardano.Api.TxBody ( +module Cardano.Api.Tx.Body ( parseTxId, -- * Transaction bodies TxBody(.., TxBody), @@ -68,7 +68,6 @@ module Cardano.Api.TxBody ( ScriptValidity(..), scriptValidityToIsValid, isValidToScriptValidity, - scriptValidityToTxScriptValidity, txScriptValidityToIsValid, txScriptValidityToScriptValidity, @@ -113,6 +112,8 @@ module Cardano.Api.TxBody ( TxCertificates(..), TxUpdateProposal(..), TxMintValue(..), + TxVotingProcedures(..), + TxProposalProcedures(..), -- ** Building vs viewing transactions BuildTxWith(..), @@ -124,6 +125,7 @@ module Cardano.Api.TxBody ( ScriptWitnessIndex(..), renderScriptWitnessIndex, collectTxBodyScriptWitnesses, + toScriptIndex, -- * Conversion to inline data scriptDataToInlineDatum, @@ -137,8 +139,6 @@ module Cardano.Api.TxBody ( fromShelleyTxId, fromShelleyTxIn, fromShelleyTxOut, - toAlonzoRdmrPtr, - fromAlonzoRdmrPtr, fromByronTxIn, fromLedgerTxOuts, renderTxIn, @@ -175,12 +175,9 @@ import Cardano.Api.Eon.ShelleyToAllegraEra import Cardano.Api.Eon.ShelleyToBabbageEra import Cardano.Api.Eras.Case import Cardano.Api.Eras.Core -import Cardano.Api.Error +import Cardano.Api.Error (Error (..), displayError) import Cardano.Api.Feature -import Cardano.Api.Governance.Actions.ProposalProcedure -import Cardano.Api.Governance.Actions.VotingProcedure import Cardano.Api.Hash -import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Byron import Cardano.Api.Keys.Shelley import qualified Cardano.Api.Ledger.Lens as A @@ -190,10 +187,9 @@ import Cardano.Api.ProtocolParameters import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.Script import Cardano.Api.ScriptData -import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseJSON import Cardano.Api.SerialiseRaw -import Cardano.Api.SerialiseTextEnvelope +import Cardano.Api.Tx.Sign import Cardano.Api.TxIn import Cardano.Api.TxMetadata import Cardano.Api.Utils @@ -210,11 +206,9 @@ import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo (hashScriptIntegrity) import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo import qualified Cardano.Ledger.Api as L -import qualified Cardano.Ledger.Babbage.TxBody as Babbage import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Binary (Annotated (..)) import qualified Cardano.Ledger.Binary as CBOR -import qualified Cardano.Ledger.Block as Ledger import Cardano.Ledger.Core () import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Core as Ledger @@ -244,7 +238,6 @@ import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (Bifunctor (..)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as LBS import Data.Foldable (for_, toList) import Data.Function (on) import Data.Functor (($>)) @@ -255,6 +248,7 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Monoid +import Data.OSet.Strict (OSet) import qualified Data.OSet.Strict as OSet import Data.Scientific (toBoundedInteger) import qualified Data.Sequence.Strict as Seq @@ -272,60 +266,6 @@ import Text.Parsec (()) import qualified Text.Parsec.String as Parsec --- | Indicates whether a script is expected to fail or pass validation. -data ScriptValidity - = ScriptInvalid -- ^ Script is expected to fail validation. - -- Transactions marked as such can include scripts that fail validation. - -- Such transactions may be submitted to the chain, in which case the - -- collateral will be taken upon on chain script validation failure. - - | ScriptValid -- ^ Script is expected to pass validation. - -- Transactions marked as such cannot include scripts that fail validation. - - deriving (Eq, Show) - -instance CBOR.EncCBOR ScriptValidity where - encCBOR = CBOR.encCBOR . scriptValidityToIsValid - -instance CBOR.DecCBOR ScriptValidity where - decCBOR = isValidToScriptValidity <$> CBOR.decCBOR - -scriptValidityToIsValid :: ScriptValidity -> L.IsValid -scriptValidityToIsValid ScriptInvalid = L.IsValid False -scriptValidityToIsValid ScriptValid = L.IsValid True - -isValidToScriptValidity :: L.IsValid -> ScriptValidity -isValidToScriptValidity (L.IsValid False) = ScriptInvalid -isValidToScriptValidity (L.IsValid True) = ScriptValid - --- | A representation of whether the era supports tx script validity. --- --- The Alonzo and subsequent eras support script validity. --- -data TxScriptValidity era where - TxScriptValidityNone - :: TxScriptValidity era - - -- | Tx script validity is supported in transactions in the 'Alonzo' era onwards. - TxScriptValidity - :: AlonzoEraOnwards era - -> ScriptValidity - -> TxScriptValidity era - -deriving instance Eq (TxScriptValidity era) -deriving instance Show (TxScriptValidity era) - -txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity -txScriptValidityToScriptValidity TxScriptValidityNone = ScriptValid -txScriptValidityToScriptValidity (TxScriptValidity _ scriptValidity) = scriptValidity - -scriptValidityToTxScriptValidity :: ShelleyBasedEra era -> ScriptValidity -> TxScriptValidity era -scriptValidityToTxScriptValidity sbe scriptValidity = - forShelleyBasedEraInEon sbe TxScriptValidityNone $ \w -> TxScriptValidity w scriptValidity - -txScriptValidityToIsValid :: TxScriptValidity era -> L.IsValid -txScriptValidityToIsValid = scriptValidityToIsValid . txScriptValidityToScriptValidity - -- ---------------------------------------------------------------------------- -- Transaction outputs -- @@ -739,9 +679,9 @@ toAlonzoTxOutDatumHashUTxO (TxOutDatumInline{}) = SNothing toBabbageTxOutDatumUTxO :: (L.Era (ShelleyLedgerEra era), Ledger.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) - => TxOutDatum CtxUTxO era -> Babbage.Datum (ShelleyLedgerEra era) -toBabbageTxOutDatumUTxO TxOutDatumNone = Babbage.NoDatum -toBabbageTxOutDatumUTxO (TxOutDatumHash _ (ScriptDataHash dh)) = Babbage.DatumHash dh + => TxOutDatum CtxUTxO era -> Plutus.Datum (ShelleyLedgerEra era) +toBabbageTxOutDatumUTxO TxOutDatumNone = Plutus.NoDatum +toBabbageTxOutDatumUTxO (TxOutDatumHash _ (ScriptDataHash dh)) = Plutus.DatumHash dh toBabbageTxOutDatumUTxO (TxOutDatumInline _ sd) = scriptDataToInlineDatum sd @@ -805,22 +745,22 @@ toAlonzoTxOutDatumHash (TxOutDatumInTx' _ (ScriptDataHash dh) _) = SJust dh toBabbageTxOutDatum :: (L.Era (ShelleyLedgerEra era), Ledger.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) - => TxOutDatum ctx era -> Babbage.Datum (ShelleyLedgerEra era) -toBabbageTxOutDatum TxOutDatumNone = Babbage.NoDatum -toBabbageTxOutDatum (TxOutDatumHash _ (ScriptDataHash dh)) = Babbage.DatumHash dh + => TxOutDatum ctx era -> Plutus.Datum (ShelleyLedgerEra era) +toBabbageTxOutDatum TxOutDatumNone = Plutus.NoDatum +toBabbageTxOutDatum (TxOutDatumHash _ (ScriptDataHash dh)) = Plutus.DatumHash dh toBabbageTxOutDatum (TxOutDatumInline _ sd) = scriptDataToInlineDatum sd -toBabbageTxOutDatum (TxOutDatumInTx' _ (ScriptDataHash dh) _) = Babbage.DatumHash dh +toBabbageTxOutDatum (TxOutDatumInTx' _ (ScriptDataHash dh) _) = Plutus.DatumHash dh fromBabbageTxOutDatum :: (L.Era ledgerera, Ledger.EraCrypto ledgerera ~ StandardCrypto) => AlonzoEraOnwards era -> BabbageEraOnwards era - -> Babbage.Datum ledgerera + -> Plutus.Datum ledgerera -> TxOutDatum ctx era -fromBabbageTxOutDatum _ _ Babbage.NoDatum = TxOutDatumNone -fromBabbageTxOutDatum w _ (Babbage.DatumHash dh) = +fromBabbageTxOutDatum _ _ Plutus.NoDatum = TxOutDatumNone +fromBabbageTxOutDatum w _ (Plutus.DatumHash dh) = TxOutDatumHash w $ ScriptDataHash dh -fromBabbageTxOutDatum _ w (Babbage.Datum binData) = +fromBabbageTxOutDatum _ w (Plutus.Datum binData) = TxOutDatumInline w $ binaryDataToScriptData w binData @@ -1217,6 +1157,39 @@ data TxMintValue build era where deriving instance Eq (TxMintValue build era) deriving instance Show (TxMintValue build era) +-- ---------------------------------------------------------------------------- +-- Votes within transactions (era-dependent) +-- + +data TxVotingProcedures build era where + TxVotingProceduresNone :: TxVotingProcedures build era + TxVotingProcedures + :: L.VotingProcedures (ShelleyLedgerEra era) + -> BuildTxWith build (Map (Ledger.Voter (Ledger.EraCrypto (ShelleyLedgerEra era))) (ScriptWitness WitCtxStake era)) + -> TxVotingProcedures build era + + +deriving instance Eq (TxVotingProcedures build era) +deriving instance Show (TxVotingProcedures build era) + + +-- ---------------------------------------------------------------------------- +-- Proposals within transactions (era-dependent) +-- + +data TxProposalProcedures build era where + TxProposalProceduresNone :: TxProposalProcedures build era + TxProposalProcedures + :: Ledger.EraPParams (ShelleyLedgerEra era) + => OSet (L.ProposalProcedure (ShelleyLedgerEra era)) + -> BuildTxWith build (Map (L.ProposalProcedure (ShelleyLedgerEra era)) (ScriptWitness WitCtxStake era)) + -> TxProposalProcedures build era + + +deriving instance Eq (TxProposalProcedures build era) +deriving instance Show (TxProposalProcedures build era) + + -- ---------------------------------------------------------------------------- -- Transaction body content -- @@ -1241,8 +1214,8 @@ data TxBodyContent build era = txUpdateProposal :: TxUpdateProposal era, txMintValue :: TxMintValue build era, txScriptValidity :: TxScriptValidity era, - txProposalProcedures :: Maybe (Featured ConwayEraOnwards era [Proposal era]), - txVotingProcedures :: Maybe (Featured ConwayEraOnwards era (VotingProcedures era)) + txProposalProcedures :: Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era)), + txVotingProcedures :: Maybe (Featured ConwayEraOnwards era (TxVotingProcedures build era)) } deriving (Eq, Show) @@ -1338,360 +1311,7 @@ setTxMintValue v txBodyContent = txBodyContent { txMintValue = v } setTxScriptValidity :: TxScriptValidity era -> TxBodyContent build era -> TxBodyContent build era setTxScriptValidity v txBodyContent = txBodyContent { txScriptValidity = v } --- ---------------------------------------------------------------------------- --- Transaction bodies --- - -data TxBody era where - ShelleyTxBody - :: ShelleyBasedEra era - -> Ledger.TxBody (ShelleyLedgerEra era) - - -- We include the scripts along with the tx body, rather than the - -- witnesses set, since they need to be known when building the body. - -> [Ledger.Script (ShelleyLedgerEra era)] - - -- The info for each use of each script: the script input data, both - -- the UTxO input data (called the "datum") and the supplied input - -- data (called the "redeemer") and the execution units. - -> TxBodyScriptData era - - -- The 'L.TxAuxData' consists of one or several things, - -- depending on era: - -- + transaction metadata (in Shelley and later) - -- + auxiliary scripts (in Allegra and later) - -- Note that there is no auxiliary script data as such, because the - -- extra script data has to be passed to scripts and hence is needed - -- for validation. It is thus part of the witness data, not the - -- auxiliary data. - -> Maybe (L.TxAuxData (ShelleyLedgerEra era)) - - -> TxScriptValidity era -- ^ Mark script as expected to pass or fail validation - - -> TxBody era - -- The 'ShelleyBasedEra' GADT tells us what era we are in. - -- The 'ShelleyLedgerEra' type family maps that to the era type from the - -- ledger lib. The 'Ledger.TxBody' type family maps that to a specific - -- tx body type, which is different for each Shelley-based era. - - -data TxBodyScriptData era where - TxBodyNoScriptData :: TxBodyScriptData era - TxBodyScriptData :: AlonzoEraOnwards era - -> Alonzo.TxDats (ShelleyLedgerEra era) - -> Alonzo.Redeemers (ShelleyLedgerEra era) - -> TxBodyScriptData era - -deriving instance Eq (TxBodyScriptData era) -deriving instance L.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto => Show (TxBodyScriptData era) - - --- The GADT in the ShelleyTxBody case requires a custom instance -instance Eq (TxBody era) where - (==) (ShelleyTxBody sbe txbodyA txscriptsA redeemersA txmetadataA scriptValidityA) - (ShelleyTxBody _ txbodyB txscriptsB redeemersB txmetadataB scriptValidityB) = - case sbe of - ShelleyBasedEraShelley -> txbodyA == txbodyB - && txscriptsA == txscriptsB - && txmetadataA == txmetadataB - - ShelleyBasedEraAllegra -> txbodyA == txbodyB - && txscriptsA == txscriptsB - && txmetadataA == txmetadataB - - ShelleyBasedEraMary -> txbodyA == txbodyB - && txscriptsA == txscriptsB - && txmetadataA == txmetadataB - - ShelleyBasedEraAlonzo -> txbodyA == txbodyB - && txscriptsA == txscriptsB - && redeemersA == redeemersB - && txmetadataA == txmetadataB - && scriptValidityA == scriptValidityB - - ShelleyBasedEraBabbage -> txbodyA == txbodyB - && txscriptsA == txscriptsB - && redeemersA == redeemersB - && txmetadataA == txmetadataB - && scriptValidityA == scriptValidityB - - ShelleyBasedEraConway -> txbodyA == txbodyB - && txscriptsA == txscriptsB - && redeemersA == redeemersB - && txmetadataA == txmetadataB - && scriptValidityA == scriptValidityB - --- The GADT in the ShelleyTxBody case requires a custom instance -instance Show (TxBody era) where - showsPrec p (ShelleyTxBody ShelleyBasedEraShelley - txbody txscripts redeemers txmetadata scriptValidity) = - showParen (p >= 11) - ( showString "ShelleyTxBody ShelleyBasedEraShelley " - . showsPrec 11 txbody - . showChar ' ' - . showsPrec 11 txscripts - . showChar ' ' - . showsPrec 11 redeemers - . showChar ' ' - . showsPrec 11 txmetadata - . showChar ' ' - . showsPrec 11 scriptValidity - ) - - showsPrec p (ShelleyTxBody ShelleyBasedEraAllegra - txbody txscripts redeemers txmetadata scriptValidity) = - showParen (p >= 11) - ( showString "ShelleyTxBody ShelleyBasedEraAllegra " - . showsPrec 11 txbody - . showChar ' ' - . showsPrec 11 txscripts - . showChar ' ' - . showsPrec 11 redeemers - . showChar ' ' - . showsPrec 11 txmetadata - . showChar ' ' - . showsPrec 11 scriptValidity - ) - - showsPrec p (ShelleyTxBody ShelleyBasedEraMary - txbody txscripts redeemers txmetadata scriptValidity) = - showParen (p >= 11) - ( showString "ShelleyTxBody ShelleyBasedEraMary " - . showsPrec 11 txbody - . showChar ' ' - . showsPrec 11 txscripts - . showChar ' ' - . showsPrec 11 redeemers - . showChar ' ' - . showsPrec 11 txmetadata - . showChar ' ' - . showsPrec 11 scriptValidity - ) - - showsPrec p (ShelleyTxBody ShelleyBasedEraAlonzo - txbody txscripts redeemers txmetadata scriptValidity) = - showParen (p >= 11) - ( showString "ShelleyTxBody ShelleyBasedEraAlonzo " - . showsPrec 11 txbody - . showChar ' ' - . showsPrec 11 txscripts - . showChar ' ' - . showsPrec 11 redeemers - . showChar ' ' - . showsPrec 11 txmetadata - . showChar ' ' - . showsPrec 11 scriptValidity - ) - - showsPrec p (ShelleyTxBody ShelleyBasedEraBabbage - txbody txscripts redeemers txmetadata scriptValidity) = - showParen (p >= 11) - ( showString "ShelleyTxBody ShelleyBasedEraBabbage " - . showsPrec 11 txbody - . showChar ' ' - . showsPrec 11 txscripts - . showChar ' ' - . showsPrec 11 redeemers - . showChar ' ' - . showsPrec 11 txmetadata - . showChar ' ' - . showsPrec 11 scriptValidity - ) - - showsPrec p (ShelleyTxBody ShelleyBasedEraConway - txbody txscripts redeemers txmetadata scriptValidity) = - showParen (p >= 11) - ( showString "ShelleyTxBody ShelleyBasedEraConway " - . showsPrec 11 txbody - . showChar ' ' - . showsPrec 11 txscripts - . showChar ' ' - . showsPrec 11 redeemers - . showChar ' ' - . showsPrec 11 txmetadata - . showChar ' ' - . showsPrec 11 scriptValidity - ) - - -instance HasTypeProxy era => HasTypeProxy (TxBody era) where - data AsType (TxBody era) = AsTxBody (AsType era) - proxyToAsType _ = AsTxBody (proxyToAsType (Proxy :: Proxy era)) - -pattern AsByronTxBody :: AsType (TxBody ByronEra) -pattern AsByronTxBody = AsTxBody AsByronEra -{-# COMPLETE AsByronTxBody #-} - -pattern AsShelleyTxBody :: AsType (TxBody ShelleyEra) -pattern AsShelleyTxBody = AsTxBody AsShelleyEra -{-# COMPLETE AsShelleyTxBody #-} - -pattern AsMaryTxBody :: AsType (TxBody MaryEra) -pattern AsMaryTxBody = AsTxBody AsMaryEra -{-# COMPLETE AsMaryTxBody #-} - -instance IsShelleyBasedEra era => SerialiseAsCBOR (TxBody era) where - serialiseToCBOR (ShelleyTxBody sbe txbody txscripts redeemers txmetadata scriptValidity) = - serialiseShelleyBasedTxBody sbe txbody txscripts redeemers txmetadata scriptValidity - - deserialiseFromCBOR _ = deserialiseShelleyBasedTxBody shelleyBasedEra - --- | The serialisation format for the different Shelley-based eras are not the --- same, but they can be handled generally with one overloaded implementation. -serialiseShelleyBasedTxBody :: forall era. () - => ShelleyBasedEra era - -> Ledger.TxBody (ShelleyLedgerEra era) - -> [Ledger.Script (ShelleyLedgerEra era)] - -> TxBodyScriptData era - -> Maybe (L.TxAuxData (ShelleyLedgerEra era)) - -> TxScriptValidity era -- ^ Mark script as expected to pass or fail validation - -> ByteString -serialiseShelleyBasedTxBody sbe txbody txscripts - TxBodyNoScriptData txmetadata scriptValidity = - caseShelleyToMaryOrAlonzoEraOnwards - (const $ CBOR.serialize' (L.eraProtVerLow @(ShelleyLedgerEra era)) $ mconcat - [ CBOR.encodeListLen 3 - , CBOR.encCBOR txbody - , CBOR.encCBOR txscripts - , CBOR.encodeNullMaybe CBOR.encCBOR txmetadata - ] - ) - (const $ CBOR.serialize' (L.eraProtVerLow @(ShelleyLedgerEra era)) $ mconcat - [ CBOR.encodeListLen 4 - , CBOR.encCBOR txbody - , CBOR.encCBOR txscripts - , CBOR.encCBOR (txScriptValidityToScriptValidity scriptValidity) - , CBOR.encodeNullMaybe CBOR.encCBOR txmetadata - ] - ) - sbe - -serialiseShelleyBasedTxBody _ txbody txscripts - (TxBodyScriptData w datums redeemers) - txmetadata txBodyScriptValidity = - alonzoEraOnwardsConstraints w $ - CBOR.serialize' (L.eraProtVerLow @(ShelleyLedgerEra era)) $ mconcat - [ CBOR.encodeListLen 6 - , CBOR.encCBOR txbody - , CBOR.encCBOR txscripts - , CBOR.encCBOR datums - , CBOR.encCBOR redeemers - , CBOR.encCBOR (txScriptValidityToScriptValidity txBodyScriptValidity) - , CBOR.encodeNullMaybe CBOR.encCBOR txmetadata - ] -deserialiseShelleyBasedTxBody :: forall era. () - => ShelleyBasedEra era - -> ByteString - -> Either CBOR.DecoderError (TxBody era) -deserialiseShelleyBasedTxBody sbe bs = - shelleyBasedEraConstraints sbe $ - CBOR.decodeFullAnnotator - (L.eraProtVerLow @(ShelleyLedgerEra era)) - "Shelley TxBody" - decodeAnnotatedTuple - (LBS.fromStrict bs) - where - decodeAnnotatedTuple :: CBOR.Decoder s (CBOR.Annotator (TxBody era)) - decodeAnnotatedTuple = shelleyBasedEraConstraints sbe $ do - len <- CBOR.decodeListLen - - case len of - -- Backwards compat for pre-Alonzo era tx body files - 2 -> do - txbody <- CBOR.decCBOR - txmetadata <- CBOR.decodeNullMaybe CBOR.decCBOR - return $ CBOR.Annotator $ \fbs -> - ShelleyTxBody sbe - (flip CBOR.runAnnotator fbs txbody) - [] -- scripts - (flip CBOR.runAnnotator fbs (return TxBodyNoScriptData)) - (fmap (flip CBOR.runAnnotator fbs) txmetadata) - (flip CBOR.runAnnotator fbs (return TxScriptValidityNone)) - 3 -> do - txbody <- CBOR.decCBOR - txscripts <- CBOR.decCBOR - txmetadata <- CBOR.decodeNullMaybe CBOR.decCBOR - return $ CBOR.Annotator $ \fbs -> - ShelleyTxBody sbe - (flip CBOR.runAnnotator fbs txbody) - (map (flip CBOR.runAnnotator fbs) txscripts) - (flip CBOR.runAnnotator fbs (return TxBodyNoScriptData)) - (fmap (flip CBOR.runAnnotator fbs) txmetadata) - (flip CBOR.runAnnotator fbs (return TxScriptValidityNone)) - 4 -> do - sValiditySupported <- - forShelleyBasedEraInEon sbe - ( fail $ mconcat - [ "deserialiseShelleyBasedTxBody: Expected an era that supports the " - , "script validity flag but got: " - , show sbe - ] - ) - pure - - txbody <- CBOR.decCBOR - txscripts <- CBOR.decCBOR - scriptValidity <- CBOR.decCBOR - txmetadata <- CBOR.decodeNullMaybe CBOR.decCBOR - return $ CBOR.Annotator $ \fbs -> - ShelleyTxBody sbe - (flip CBOR.runAnnotator fbs txbody) - (map (flip CBOR.runAnnotator fbs) txscripts) - (flip CBOR.runAnnotator fbs (return TxBodyNoScriptData)) - (fmap (flip CBOR.runAnnotator fbs) txmetadata) - (flip CBOR.runAnnotator fbs (return $ TxScriptValidity sValiditySupported scriptValidity)) - 6 -> do - sDataSupported <- - forEraInEon (shelleyBasedToCardanoEra sbe) - ( fail $ mconcat - [ "deserialiseShelleyBasedTxBody: Expected an era that supports script" - , " data but got: " - , show sbe - ] - ) - pure - - sValiditySupported <- - forShelleyBasedEraInEon sbe - ( fail $ mconcat - [ "deserialiseShelleyBasedTxBody: Expected an era that supports the " - , "script validity flag but got: " - , show sbe - ] - ) - pure - - txbody <- CBOR.decCBOR - txscripts <- CBOR.decCBOR - datums <- CBOR.decCBOR - redeemers <- CBOR.decCBOR - scriptValidity <- CBOR.decCBOR - txmetadata <- CBOR.decodeNullMaybe CBOR.decCBOR - - let txscriptdata = CBOR.Annotator $ \fbs -> - TxBodyScriptData sDataSupported - (flip CBOR.runAnnotator fbs datums) - (flip CBOR.runAnnotator fbs redeemers) - - return $ CBOR.Annotator $ \fbs -> - ShelleyTxBody sbe - (flip CBOR.runAnnotator fbs txbody) - (map (flip CBOR.runAnnotator fbs) txscripts) - (flip CBOR.runAnnotator fbs txscriptdata) - (fmap (flip CBOR.runAnnotator fbs) txmetadata) - (flip CBOR.runAnnotator fbs (return $ TxScriptValidity sValiditySupported scriptValidity)) - _ -> fail $ "expected tx body tuple of size 2, 3, 4 or 6, got " <> show len - -instance IsShelleyBasedEra era => HasTextEnvelope (TxBody era) where - textEnvelopeType _ = - case shelleyBasedEra :: ShelleyBasedEra era of - ShelleyBasedEraShelley -> "TxUnsignedShelley" - ShelleyBasedEraAllegra -> "TxBodyAllegra" - ShelleyBasedEraMary -> "TxBodyMary" - ShelleyBasedEraAlonzo -> "TxBodyAlonzo" - ShelleyBasedEraBabbage -> "TxBodyBabbage" - ShelleyBasedEraConway -> "TxBodyConway" getTxIdByron :: Byron.ATxAux ByteString -> TxId @@ -1720,7 +1340,7 @@ getTxIdShelley _ tx = TxId . Crypto.castHash . (\(Ledger.TxId txhash) -> SafeHash.extractHash txhash) - $ Ledger.txid tx + $ Ledger.txIdTxBody tx -- ---------------------------------------------------------------------------- -- Constructing transaction bodies @@ -2057,25 +1677,26 @@ fromLedgerTxBody sbe scriptValidity body scriptdata mAux = fromLedgerProposalProcedures :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) - -> Maybe (Featured ConwayEraOnwards era [Proposal era]) + -> Maybe (Featured ConwayEraOnwards era (TxProposalProcedures ViewTx era)) fromLedgerProposalProcedures sbe body = forShelleyBasedEraInEonMaybe sbe $ \w -> conwayEraOnwardsConstraints w $ Featured w - $ fmap Proposal - $ toList - $ body ^. L.proposalProceduresTxBodyL + $ TxProposalProcedures + (body ^. L.proposalProceduresTxBodyL) + ViewTx fromLedgerVotingProcedures :: () => ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) - -> Maybe (Featured ConwayEraOnwards era (VotingProcedures era)) + -> Maybe (Featured ConwayEraOnwards era (TxVotingProcedures ViewTx era)) fromLedgerVotingProcedures sbe body = forShelleyBasedEraInEonMaybe sbe $ \w -> conwayEraOnwardsConstraints w $ Featured w - $ VotingProcedures - $ body ^. L.votingProceduresTxBodyL + $ TxVotingProcedures + (body ^. L.votingProceduresTxBodyL) + ViewTx fromLedgerTxIns :: forall era. @@ -2156,9 +1777,13 @@ fromLedgerTxOuts sbe body scriptdata = | let txdatums = selectTxDatums scriptdata , txouts <- toList (body ^. L.outputsTxBodyL) ] - where - selectTxDatums TxBodyNoScriptData = Map.empty - selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums + +selectTxDatums + :: TxBodyScriptData era + -> Map (L.DataHash StandardCrypto) (L.Data (ShelleyLedgerEra era)) +selectTxDatums TxBodyNoScriptData = Map.empty +selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums + fromAlonzoTxOut :: () => AlonzoEraOnwards era @@ -2540,10 +2165,12 @@ convScriptData sbe txOuts scriptWitnesses = let redeemers = Alonzo.Redeemers $ Map.fromList - [ (toAlonzoRdmrPtr idx, (toAlonzoData d, toAlonzoExUnits e)) + [ (i, (toAlonzoData d, toAlonzoExUnits e)) | (idx, AnyScriptWitness (PlutusScriptWitness _ _ _ _ d e)) <- scriptWitnesses + , Just i <- [fromScriptWitnessIndex w idx] ] + datums = Alonzo.TxDats $ Map.fromList @@ -2590,6 +2217,16 @@ convReferenceInputs txInsReference = TxInsReferenceNone -> mempty TxInsReference _ refTxins -> Set.fromList $ map toShelleyTxIn refTxins +convProposalProcedures :: TxProposalProcedures build era -> OSet (L.ProposalProcedure (ShelleyLedgerEra era)) +convProposalProcedures TxProposalProceduresNone = OSet.empty +convProposalProcedures (TxProposalProcedures procedures _) = procedures + +convVotingProcedures :: TxVotingProcedures build era -> L.VotingProcedures (ShelleyLedgerEra era) +convVotingProcedures txVotingProcedures = + case txVotingProcedures of + TxVotingProceduresNone -> L.VotingProcedures Map.empty + TxVotingProcedures vps _ -> vps + guardShelleyTxInsOverflow :: [TxIn] -> Either TxBodyError () guardShelleyTxInsOverflow txIns = do for_ txIns $ \txin@(TxIn _ (TxIx txix)) -> @@ -2765,7 +2402,6 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraAlonzo let aOn = AllegraEraOnwardsAlonzo let s2b = ShelleyToBabbageEraAlonzo let mOn = MaryEraOnwardsAlonzo - let azOn = AlonzoEraOnwardsAlonzo validateTxBodyContent sbe txbodycontent update <- convTxUpdateProposal sbe txUpdateProposal let scriptIntegrityHash = @@ -2791,6 +2427,8 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraAlonzo txAuxData txScriptValidity where + azOn = AlonzoEraOnwardsAlonzo + witnesses :: [(ScriptWitnessIndex, AnyScriptWitness AlonzoEra)] witnesses = collectTxBodyScriptWitnesses sbe txbodycontent @@ -2820,9 +2458,10 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraAlonzo redeemers = Alonzo.Redeemers $ Map.fromList - [ (toAlonzoRdmrPtr idx, (toAlonzoData d, toAlonzoExUnits e)) + [ (i, (toAlonzoData d, toAlonzoExUnits e)) | (idx, AnyScriptWitness (PlutusScriptWitness _ _ _ _ d e)) <- witnesses + , Just i <- [fromScriptWitnessIndex azOn idx] ] languages :: Set Plutus.Language @@ -2858,7 +2497,6 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraBabbage } = do let aOn = AllegraEraOnwardsBabbage let mOn = MaryEraOnwardsBabbage - let azOn = AlonzoEraOnwardsBabbage let bOn = BabbageEraOnwardsBabbage let s2b = ShelleyToBabbageEraBabbage validateTxBodyContent sbe txbodycontent @@ -2893,6 +2531,8 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraBabbage txAuxData txScriptValidity where + azOn = AlonzoEraOnwardsBabbage + witnesses :: [(ScriptWitnessIndex, AnyScriptWitness BabbageEra)] witnesses = collectTxBodyScriptWitnesses sbe txbodycontent @@ -2924,9 +2564,10 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraBabbage redeemers = Alonzo.Redeemers $ Map.fromList - [ (toAlonzoRdmrPtr idx, (toAlonzoData d, toAlonzoExUnits e)) + [ (i, (toAlonzoData d, toAlonzoExUnits e)) | (idx, AnyScriptWitness (PlutusScriptWitness _ _ _ _ d e)) <- witnesses + , Just i <- [fromScriptWitnessIndex azOn idx] ] languages :: Set Plutus.Language @@ -2971,7 +2612,6 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway let cOn = ConwayEraOnwardsConway let mOn = MaryEraOnwardsConway let bOn = BabbageEraOnwardsConway - let azOn = AlonzoEraOnwardsConway validateTxBodyContent sbe txbodycontent let scriptIntegrityHash = convPParamsToScriptIntegrityHash AlonzoEraOnwardsConway txProtocolParams redeemers datums languages @@ -2990,8 +2630,8 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway & A.reqSignerHashesTxBodyL azOn .~ convExtraKeyWitnesses txExtraKeyWits & A.mintTxBodyL mOn .~ convMintValue txMintValue & A.scriptIntegrityHashTxBodyL azOn .~ scriptIntegrityHash - & A.votingProceduresTxBodyL cOn .~ unVotingProcedures @era (maybe emptyVotingProcedures unFeatured txVotingProcedures) - & A.proposalProceduresTxBodyL cOn .~ OSet.fromSet (Set.fromList (fmap unProposal (maybe [] unFeatured txProposalProcedures))) + & A.votingProceduresTxBodyL cOn .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured txVotingProcedures) + & A.proposalProceduresTxBodyL cOn .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured txProposalProcedures) -- TODO Conway: support optional network id in TxBodyContent -- & L.networkIdTxBodyL .~ SNothing ) ^. A.txBodyL @@ -3004,6 +2644,8 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway txAuxData txScriptValidity where + azOn = AlonzoEraOnwardsConway + witnesses :: [(ScriptWitnessIndex, AnyScriptWitness ConwayEra)] witnesses = collectTxBodyScriptWitnesses sbe txbodycontent @@ -3034,9 +2676,10 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway redeemers = Alonzo.Redeemers $ Map.fromList - [ (toAlonzoRdmrPtr idx, (toAlonzoData d, toAlonzoExUnits e)) + [ (i, (toAlonzoData d, toAlonzoExUnits e)) | (idx, AnyScriptWitness (PlutusScriptWitness _ _ _ _ d e)) <- witnesses + , Just i <- [fromScriptWitnessIndex azOn idx] ] languages :: Set Plutus.Language @@ -3111,41 +2754,56 @@ deriving instance Show (AnyScriptWitness era) data ScriptWitnessIndex = -- | The n'th transaction input, in the order of the 'TxId's. - ScriptWitnessIndexTxIn !Word + ScriptWitnessIndexTxIn !Word32 -- | The n'th minting 'PolicyId', in the order of the 'PolicyId's. - | ScriptWitnessIndexMint !Word + | ScriptWitnessIndexMint !Word32 -- | The n'th certificate, in the list order of the certificates. - | ScriptWitnessIndexCertificate !Word + | ScriptWitnessIndexCertificate !Word32 -- | The n'th withdrawal, in the order of the 'StakeAddress's. - | ScriptWitnessIndexWithdrawal !Word + | ScriptWitnessIndexWithdrawal !Word32 + + -- | The n'th vote, in the order of the votes. + | ScriptWitnessIndexVoting !Word32 + + -- | The n'th proposal, in the order of the proposals. + | ScriptWitnessIndexProposing !Word32 deriving (Eq, Ord, Show) instance ToJSON ScriptWitnessIndex where toJSON = \case ScriptWitnessIndexTxIn n -> object - [ "kind" .= Aeson.String "ScriptWitnessIndexTxIn" - , "value" .= n - ] + [ "kind" .= Aeson.String "ScriptWitnessIndexTxIn" + , "value" .= n + ] ScriptWitnessIndexMint n -> object - [ "kind" .= Aeson.String "ScriptWitnessIndexMint" - , "value" .= n - ] + [ "kind" .= Aeson.String "ScriptWitnessIndexMint" + , "value" .= n + ] ScriptWitnessIndexCertificate n -> object - [ "kind" .= Aeson.String "ScriptWitnessIndexCertificate" - , "value" .= n - ] + [ "kind" .= Aeson.String "ScriptWitnessIndexCertificate" + , "value" .= n + ] ScriptWitnessIndexWithdrawal n -> object - [ "kind" .= Aeson.String "ScriptWitnessIndexWithdrawal" - , "value" .= n - ] - + [ "kind" .= Aeson.String "ScriptWitnessIndexWithdrawal" + , "value" .= n + ] + ScriptWitnessIndexVoting n -> + object + [ "kind" .= Aeson.String "ScriptWitnessIndexVoting" + , "value" .= n + ] + ScriptWitnessIndexProposing n -> + object + [ "kind" .= Aeson.String "ScriptWitnessIndexProposing" + , "value" .= n + ] renderScriptWitnessIndex :: ScriptWitnessIndex -> String renderScriptWitnessIndex (ScriptWitnessIndexTxIn index) = "transaction input " <> show index <> " (in ascending order of the TxIds)" @@ -3155,22 +2813,82 @@ renderScriptWitnessIndex (ScriptWitnessIndexCertificate index) = "certificate " <> show index <> " (in the list order of the certificates)" renderScriptWitnessIndex (ScriptWitnessIndexWithdrawal index) = "withdrawal " <> show index <> " (in ascending order of the StakeAddresses)" +renderScriptWitnessIndex (ScriptWitnessIndexVoting index) = + "vote " <> show index <> " (in ascending order of the votes)" +renderScriptWitnessIndex (ScriptWitnessIndexProposing index) = + "proposal " <> show index <> " (in ascending order of the proposals)" -toAlonzoRdmrPtr :: ScriptWitnessIndex -> Alonzo.RdmrPtr -toAlonzoRdmrPtr widx = - case widx of - ScriptWitnessIndexTxIn n -> Alonzo.RdmrPtr Alonzo.Spend (fromIntegral n) - ScriptWitnessIndexMint n -> Alonzo.RdmrPtr Alonzo.Mint (fromIntegral n) - ScriptWitnessIndexCertificate n -> Alonzo.RdmrPtr Alonzo.Cert (fromIntegral n) - ScriptWitnessIndexWithdrawal n -> Alonzo.RdmrPtr Alonzo.Rewrd (fromIntegral n) - -fromAlonzoRdmrPtr :: Alonzo.RdmrPtr -> ScriptWitnessIndex -fromAlonzoRdmrPtr (Alonzo.RdmrPtr tag n) = - case tag of - Alonzo.Spend -> ScriptWitnessIndexTxIn (fromIntegral n) - Alonzo.Mint -> ScriptWitnessIndexMint (fromIntegral n) - Alonzo.Cert -> ScriptWitnessIndexCertificate (fromIntegral n) - Alonzo.Rewrd -> ScriptWitnessIndexWithdrawal (fromIntegral n) +fromScriptWitnessIndex + :: AlonzoEraOnwards era + -> ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIndex (ShelleyLedgerEra era)) +fromScriptWitnessIndex aOnwards widx = + case aOnwards of + AlonzoEraOnwardsAlonzo -> fromScriptWitnessIndexAlonzo widx + AlonzoEraOnwardsBabbage -> fromScriptWitnessIndexBabbage widx + AlonzoEraOnwardsConway -> fromScriptWitnessIndexConway widx + +fromScriptWitnessIndexAlonzo + :: ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIndex (ShelleyLedgerEra AlonzoEra)) +fromScriptWitnessIndexAlonzo i = + case i of + ScriptWitnessIndexTxIn n -> Just $ L.AlonzoSpending (L.AsIndex n) + ScriptWitnessIndexMint n -> Just $ L.AlonzoMinting (L.AsIndex n) + ScriptWitnessIndexCertificate n -> Just $ L.AlonzoCertifying (L.AsIndex n) + ScriptWitnessIndexWithdrawal n -> Just $ L.AlonzoRewarding (L.AsIndex n) + _ -> Nothing + +fromScriptWitnessIndexBabbage + :: ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIndex (ShelleyLedgerEra BabbageEra)) +fromScriptWitnessIndexBabbage i = + case i of + ScriptWitnessIndexTxIn n -> Just $ L.AlonzoSpending (L.AsIndex n) + ScriptWitnessIndexMint n -> Just $ L.AlonzoMinting (L.AsIndex n) + ScriptWitnessIndexCertificate n -> Just $ L.AlonzoCertifying (L.AsIndex n) + ScriptWitnessIndexWithdrawal n -> Just $ L.AlonzoRewarding (L.AsIndex n) + _ -> Nothing + +fromScriptWitnessIndexConway + :: ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIndex (ShelleyLedgerEra ConwayEra)) +fromScriptWitnessIndexConway i = + case i of + ScriptWitnessIndexTxIn n -> Just $ L.ConwaySpending (L.AsIndex n) + ScriptWitnessIndexMint n -> Just $ L.ConwayMinting (L.AsIndex n) + ScriptWitnessIndexCertificate n -> Just $ L.ConwayCertifying (L.AsIndex n) + ScriptWitnessIndexWithdrawal n -> Just $ L.ConwayRewarding (L.AsIndex n) + ScriptWitnessIndexVoting n -> Just $ L.ConwayVoting (L.AsIndex n) + ScriptWitnessIndexProposing n -> Just $ L.ConwayProposing (L.AsIndex n) + +toScriptIndex + :: AlonzoEraOnwards era + -> L.PlutusPurpose L.AsIndex (ShelleyLedgerEra era) + -> ScriptWitnessIndex +toScriptIndex sbe scriptPurposeIndex = + case sbe of + AlonzoEraOnwardsAlonzo -> toScriptIndexAlonzo scriptPurposeIndex + AlonzoEraOnwardsBabbage -> toScriptIndexAlonzo scriptPurposeIndex + AlonzoEraOnwardsConway -> toScriptIndexConway scriptPurposeIndex + +toScriptIndexAlonzo + :: L.AlonzoPlutusPurpose L.AsIndex (ShelleyLedgerEra era) + -> ScriptWitnessIndex +toScriptIndexAlonzo scriptPurposeIndex = + case scriptPurposeIndex of + L.AlonzoSpending (L.AsIndex i) -> ScriptWitnessIndexTxIn i + L.AlonzoMinting (L.AsIndex i) -> ScriptWitnessIndexMint i + L.AlonzoCertifying (L.AsIndex i) -> ScriptWitnessIndexCertificate i + L.AlonzoRewarding (L.AsIndex i) -> ScriptWitnessIndexWithdrawal i + +toScriptIndexConway + :: L.ConwayPlutusPurpose L.AsIndex (ShelleyLedgerEra era) + -> ScriptWitnessIndex +toScriptIndexConway scriptPurposeIndex = + case scriptPurposeIndex of + L.ConwaySpending (L.AsIndex i) -> ScriptWitnessIndexTxIn i + L.ConwayMinting (L.AsIndex i) -> ScriptWitnessIndexMint i + L.ConwayCertifying (L.AsIndex i) -> ScriptWitnessIndexCertificate i + L.ConwayRewarding (L.AsIndex i) -> ScriptWitnessIndexWithdrawal i + L.ConwayVoting (L.AsIndex i) -> ScriptWitnessIndexVoting i + L.ConwayProposing (L.AsIndex i) -> ScriptWitnessIndexProposing i collectTxBodyScriptWitnesses :: forall era. ShelleyBasedEra era -> TxBodyContent BuildTx era @@ -3179,13 +2897,17 @@ collectTxBodyScriptWitnesses _ TxBodyContent { txIns, txWithdrawals, txCertificates, - txMintValue + txMintValue, + txVotingProcedures, + txProposalProcedures } = concat [ scriptWitnessesTxIns txIns , scriptWitnessesWithdrawals txWithdrawals , scriptWitnessesCertificates txCertificates , scriptWitnessesMinting txMintValue + , scriptWitnessesVoting (maybe TxVotingProceduresNone unFeatured txVotingProcedures) + , scriptWitnessesProposing (maybe TxProposalProceduresNone unFeatured txProposalProcedures) ] where scriptWitnessesTxIns @@ -3234,6 +2956,32 @@ collectTxBodyScriptWitnesses _ TxBodyContent { , witness <- maybeToList (Map.lookup policyid witnesses) ] + scriptWitnessesVoting + :: TxVotingProcedures BuildTx era + -> [(ScriptWitnessIndex, AnyScriptWitness era)] + scriptWitnessesVoting TxVotingProceduresNone = [] + scriptWitnessesVoting (TxVotingProcedures (L.VotingProcedures votes) (BuildTxWith witnesses)) = + [ (ScriptWitnessIndexVoting ix, AnyScriptWitness witness) + | let voterList = Map.toList votes + , (ix, (voter, _) ) <- zip [0..] voterList + , witness <- maybeToList (Map.lookup voter witnesses) + ] + + scriptWitnessesProposing + :: TxProposalProcedures BuildTx era + -> [(ScriptWitnessIndex, AnyScriptWitness era)] + scriptWitnessesProposing TxProposalProceduresNone = [] + scriptWitnessesProposing (TxProposalProcedures proposalProcedures (BuildTxWith mScriptWitnesses)) + | Map.null mScriptWitnesses = [] + | otherwise = + [ (ScriptWitnessIndexProposing ix, AnyScriptWitness witness) + | let proposalsList = Set.toList $ OSet.toSet proposalProcedures + , (ix, proposal) <- zip [0..] proposalsList + , witness <- maybeToList (Map.lookup proposal mScriptWitnesses) + ] + + + -- This relies on the TxId Ord instance being consistent with the -- Ledger.TxId Ord instance via the toShelleyTxId conversion -- This is checked by prop_ord_distributive_TxId @@ -3246,7 +2994,7 @@ orderTxIns = sortBy (compare `on` fst) orderStakeAddrs :: [(StakeAddress, x, v)] -> [(StakeAddress, x, v)] orderStakeAddrs = sortBy (compare `on` (\(k, _, _) -> k)) - +-- TODO: Investigate if we need toShelleyWithdrawal :: [(StakeAddress, Lovelace, a)] -> L.Withdrawals StandardCrypto toShelleyWithdrawal withdrawals = L.Withdrawals $ diff --git a/cardano-api/internal/Cardano/Api/Tx.hs b/cardano-api/internal/Cardano/Api/Tx/Sign.hs similarity index 75% rename from cardano-api/internal/Cardano/Api/Tx.hs rename to cardano-api/internal/Cardano/Api/Tx/Sign.hs index ff0b203cb3..5793ec498a 100644 --- a/cardano-api/internal/Cardano/Api/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Sign.hs @@ -5,11 +5,13 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} + -- The Shelley ledger uses promoted data kinds which we have to use, but we do -- not export any from this API. We also use them unticked as nature intended. {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} @@ -18,7 +20,7 @@ -- | Complete, signed transactions -- -module Cardano.Api.Tx ( +module Cardano.Api.Tx.Sign ( -- * Signing transactions -- | Creating transaction witnesses one by one, or all in one go. @@ -52,11 +54,23 @@ module Cardano.Api.Tx ( -- * Data family instances AsType(AsTx, AsByronTx, AsShelleyTx, AsMaryTx, AsAllegraTx, AsAlonzoTx, - AsKeyWitness, AsByronWitness, AsShelleyWitness), + AsKeyWitness, AsByronWitness, AsShelleyWitness ,AsTxId, AsTxBody, + AsByronTxBody, AsShelleyTxBody, AsMaryTxBody), + + TxBody(..), + + TxScriptValidity(..), + scriptValidityToIsValid, + isValidToScriptValidity, + txScriptValidityToIsValid, + txScriptValidityToScriptValidity, + + TxBodyScriptData(..), ) where import Cardano.Api.Address import Cardano.Api.Certificate +import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras import Cardano.Api.HasTypeProxy @@ -66,7 +80,6 @@ import Cardano.Api.Keys.Shelley import Cardano.Api.NetworkId import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseTextEnvelope -import Cardano.Api.TxBody import qualified Cardano.Chain.Common as Byron import qualified Cardano.Chain.UTxO as Byron @@ -77,6 +90,7 @@ import qualified Cardano.Crypto.Signing as Byron import qualified Cardano.Crypto.Util as Crypto import qualified Cardano.Crypto.Wallet as Crypto.HD import qualified Cardano.Ledger.Alonzo.Core as L +import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo import qualified Cardano.Ledger.Api as L import Cardano.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe) import Cardano.Ledger.Binary (Annotated (..)) @@ -85,7 +99,6 @@ import qualified Cardano.Ledger.Binary.Plain as Plain import qualified Cardano.Ledger.Core as Ledger import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Keys as Shelley -import qualified Cardano.Ledger.Keys.Bootstrap as Shelley import qualified Cardano.Ledger.SafeHash as Ledger import Data.ByteString (ByteString) @@ -98,6 +111,8 @@ import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) import qualified Data.Vector as Vector import Lens.Micro + + -- ---------------------------------------------------------------------------- -- Signed transactions -- @@ -170,6 +185,8 @@ instance HasTypeProxy era => HasTypeProxy (Tx era) where data AsType (Tx era) = AsTx (AsType era) proxyToAsType _ = AsTx (proxyToAsType (Proxy :: Proxy era)) + + {-# DEPRECATED AsByronTx "Use AsTx AsByronEra instead." #-} pattern AsByronTx :: AsType (Tx ByronEra) pattern AsByronTx = AsTx AsByronEra @@ -192,6 +209,7 @@ pattern AsAlonzoTx :: AsType (Tx AlonzoEra) pattern AsAlonzoTx = AsTx AsAlonzoEra {-# COMPLETE AsAlonzoTx #-} + instance IsShelleyBasedEra era => SerialiseAsCBOR (Tx era) where serialiseToCBOR (ShelleyTx sbe tx) = shelleyBasedEraConstraints sbe $ serialiseShelleyBasedTx tx @@ -219,6 +237,39 @@ deserialiseShelleyBasedTx mkTx bs = (L.eraProtVerLow @ledgerera) "Shelley Tx" CBOR.decCBOR (LBS.fromStrict bs) +-- NB: This is called in getTxBodyAndWitnesses which is fine as +-- getTxBodyAndWitnesses is only called in the context of a +-- shelley based era anyways. ByronTx will eventually be removed. +getTxBody :: Tx era -> TxBody era +getTxBody (ShelleyTx sbe tx) = + caseShelleyToMaryOrAlonzoEraOnwards + ( const $ + let txBody = tx ^. L.bodyTxL + txAuxData = tx ^. L.auxDataTxL + scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL + in ShelleyTxBody sbe txBody + (Map.elems scriptWits) + TxBodyNoScriptData + (strictMaybeToMaybe txAuxData) + TxScriptValidityNone + ) + (\w -> + let txBody = tx ^. L.bodyTxL + txAuxData = tx ^. L.auxDataTxL + scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL + datsWits = tx ^. L.witsTxL . L.datsTxWitsL + redeemerWits = tx ^. L.witsTxL . L.rdmrsTxWitsL + isValid = tx ^. L.isValidTxL + in ShelleyTxBody sbe txBody + (Map.elems scriptWits) + (TxBodyScriptData w datsWits redeemerWits) + (strictMaybeToMaybe txAuxData) + (TxScriptValidity w (isValidToScriptValidity isValid)) + ) + sbe + + + instance IsShelleyBasedEra era => HasTextEnvelope (Tx era) where textEnvelopeType _ = case shelleyBasedEra :: ShelleyBasedEra era of @@ -229,6 +280,257 @@ instance IsShelleyBasedEra era => HasTextEnvelope (Tx era) where ShelleyBasedEraBabbage -> "Tx BabbageEra" ShelleyBasedEraConway -> "Tx ConwayEra" + + +-- ---------------------------------------------------------------------------- +-- Transaction bodies +-- +-- TODO: We can use Ledger.Tx era here however we would need to rename TxBody +-- as technically it is not strictly a transaction body. +data TxBody era where + ShelleyTxBody + :: ShelleyBasedEra era + -> Ledger.TxBody (ShelleyLedgerEra era) + + -- We include the scripts along with the tx body, rather than the + -- witnesses set, since they need to be known when building the body. + -> [Ledger.Script (ShelleyLedgerEra era)] + + -- The info for each use of each script: the script input data, both + -- the UTxO input data (called the "datum") and the supplied input + -- data (called the "redeemer") and the execution units. + -> TxBodyScriptData era + + -- The 'L.TxAuxData' consists of one or several things, + -- depending on era: + -- + transaction metadata (in Shelley and later) + -- + auxiliary scripts (in Allegra and later) + -- Note that there is no auxiliary script data as such, because the + -- extra script data has to be passed to scripts and hence is needed + -- for validation. It is thus part of the witness data, not the + -- auxiliary data. + -> Maybe (L.TxAuxData (ShelleyLedgerEra era)) + + -> TxScriptValidity era -- ^ Mark script as expected to pass or fail validation + + -> TxBody era + -- The 'ShelleyBasedEra' GADT tells us what era we are in. + -- The 'ShelleyLedgerEra' type family maps that to the era type from the + -- ledger lib. The 'Ledger.TxBody' type family maps that to a specific + -- tx body type, which is different for each Shelley-based era. + + +-- The GADT in the ShelleyTxBody case requires a custom instance +instance Eq (TxBody era) where + (==) (ShelleyTxBody sbe txbodyA txscriptsA redeemersA txmetadataA scriptValidityA) + (ShelleyTxBody _ txbodyB txscriptsB redeemersB txmetadataB scriptValidityB) = + caseShelleyToMaryOrAlonzoEraOnwards + (const $ txbodyA == txbodyB + && txscriptsA == txscriptsB + && txmetadataA == txmetadataB + ) + (const $ txbodyA == txbodyB + && txscriptsA == txscriptsB + && redeemersA == redeemersB + && txmetadataA == txmetadataB + && scriptValidityA == scriptValidityB + ) sbe + + +-- The GADT in the ShelleyTxBody case requires a custom instance +instance Show (TxBody era) where + showsPrec p (ShelleyTxBody ShelleyBasedEraShelley + txbody txscripts redeemers txmetadata scriptValidity) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraShelley " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraAllegra + txbody txscripts redeemers txmetadata scriptValidity) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraAllegra " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraMary + txbody txscripts redeemers txmetadata scriptValidity) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraMary " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraAlonzo + txbody txscripts redeemers txmetadata scriptValidity) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraAlonzo " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraBabbage + txbody txscripts redeemers txmetadata scriptValidity) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraBabbage " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraConway + txbody txscripts redeemers txmetadata scriptValidity) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraConway " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) + + +instance HasTypeProxy era => HasTypeProxy (TxBody era) where + data AsType (TxBody era) = AsTxBody (AsType era) + proxyToAsType _ = AsTxBody (proxyToAsType (Proxy :: Proxy era)) + +pattern AsByronTxBody :: AsType (TxBody ByronEra) +pattern AsByronTxBody = AsTxBody AsByronEra +{-# COMPLETE AsByronTxBody #-} + +pattern AsShelleyTxBody :: AsType (TxBody ShelleyEra) +pattern AsShelleyTxBody = AsTxBody AsShelleyEra +{-# COMPLETE AsShelleyTxBody #-} + +pattern AsMaryTxBody :: AsType (TxBody MaryEra) +pattern AsMaryTxBody = AsTxBody AsMaryEra +{-# COMPLETE AsMaryTxBody #-} + +instance IsShelleyBasedEra era => SerialiseAsCBOR (TxBody era) where + serialiseToCBOR body = serialiseToCBOR $ signShelleyTransaction shelleyBasedEra body mempty + + deserialiseFromCBOR _ bs = + fst . getTxBodyAndWitnesses + <$> shelleyBasedEraConstraints (shelleyBasedEra :: ShelleyBasedEra era) + (deserialiseShelleyBasedTx (ShelleyTx shelleyBasedEra) bs) + + + +instance IsShelleyBasedEra era => HasTextEnvelope (TxBody era) where + textEnvelopeType _ = + case shelleyBasedEra :: ShelleyBasedEra era of + ShelleyBasedEraShelley -> "TxUnsignedShelley" + ShelleyBasedEraAllegra -> "TxBodyAllegra" + ShelleyBasedEraMary -> "TxBodyMary" + ShelleyBasedEraAlonzo -> "TxBodyAlonzo" + ShelleyBasedEraBabbage -> "TxBodyBabbage" + ShelleyBasedEraConway -> "TxBodyConway" + +data TxBodyScriptData era where + TxBodyNoScriptData :: TxBodyScriptData era + TxBodyScriptData + :: AlonzoEraOnwardsConstraints era + => AlonzoEraOnwards era + -> Alonzo.TxDats (ShelleyLedgerEra era) + -> Alonzo.Redeemers (ShelleyLedgerEra era) + -> TxBodyScriptData era + +deriving instance Eq (TxBodyScriptData era) +deriving instance L.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto => Show (TxBodyScriptData era) + + +-- | Indicates whether a script is expected to fail or pass validation. +data ScriptValidity + = ScriptInvalid -- ^ Script is expected to fail validation. + -- Transactions marked as such can include scripts that fail validation. + -- Such transactions may be submitted to the chain, in which case the + -- collateral will be taken upon on chain script validation failure. + + | ScriptValid -- ^ Script is expected to pass validation. + -- Transactions marked as such cannot include scripts that fail validation. + + deriving (Eq, Show) + +instance CBOR.EncCBOR ScriptValidity where + encCBOR = CBOR.encCBOR . scriptValidityToIsValid + +instance CBOR.DecCBOR ScriptValidity where + decCBOR = isValidToScriptValidity <$> CBOR.decCBOR + +scriptValidityToIsValid :: ScriptValidity -> L.IsValid +scriptValidityToIsValid ScriptInvalid = L.IsValid False +scriptValidityToIsValid ScriptValid = L.IsValid True + +isValidToScriptValidity :: L.IsValid -> ScriptValidity +isValidToScriptValidity (L.IsValid False) = ScriptInvalid +isValidToScriptValidity (L.IsValid True) = ScriptValid + +-- | A representation of whether the era supports tx script validity. +-- +-- The Alonzo and subsequent eras support script validity. +-- +data TxScriptValidity era where + TxScriptValidityNone + :: TxScriptValidity era + + -- | Tx script validity is supported in transactions in the 'Alonzo' era onwards. + TxScriptValidity + :: AlonzoEraOnwards era + -> ScriptValidity + -> TxScriptValidity era + +deriving instance Eq (TxScriptValidity era) +deriving instance Show (TxScriptValidity era) + +txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity +txScriptValidityToScriptValidity TxScriptValidityNone = ScriptValid +txScriptValidityToScriptValidity (TxScriptValidity _ scriptValidity) = scriptValidity + +txScriptValidityToIsValid :: TxScriptValidity era -> L.IsValid +txScriptValidityToIsValid = scriptValidityToIsValid . txScriptValidityToScriptValidity + + + data KeyWitness era where ByronKeyWitness @@ -411,48 +713,113 @@ instance IsCardanoEra era => HasTextEnvelope (KeyWitness era) where BabbageEra -> "TxWitness BabbageEra" ConwayEra -> "TxWitness ConwayEra" + +getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era]) +getTxBodyAndWitnesses tx = (getTxBody tx, getTxWitnesses tx) + pattern Tx :: TxBody era -> [KeyWitness era] -> Tx era pattern Tx txbody ws <- (getTxBodyAndWitnesses -> (txbody, ws)) where Tx txbody ws = makeSignedTransaction ws txbody {-# COMPLETE Tx #-} -getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era]) -getTxBodyAndWitnesses tx = (getTxBody tx, getTxWitnesses tx) + + +data ShelleyWitnessSigningKey = + WitnessPaymentKey (SigningKey PaymentKey) + | WitnessPaymentExtendedKey (SigningKey PaymentExtendedKey) + | WitnessStakeKey (SigningKey StakeKey) + | WitnessStakeExtendedKey (SigningKey StakeExtendedKey) + | WitnessStakePoolKey (SigningKey StakePoolKey) + | WitnessGenesisKey (SigningKey GenesisKey) + | WitnessGenesisExtendedKey (SigningKey GenesisExtendedKey) + | WitnessGenesisDelegateKey (SigningKey GenesisDelegateKey) + | WitnessGenesisDelegateExtendedKey + (SigningKey GenesisDelegateExtendedKey) + | WitnessGenesisUTxOKey (SigningKey GenesisUTxOKey) + | WitnessCommitteeColdKey (SigningKey CommitteeColdKey) + | WitnessCommitteeHotKey (SigningKey CommitteeHotKey) + | WitnessDRepKey (SigningKey DRepKey) + | WitnessDRepExtendedKey (SigningKey DRepExtendedKey) + + +-- | We support making key witnesses with both normal and extended signing keys. +-- +data ShelleySigningKey = + -- | A normal ed25519 signing key + ShelleyNormalSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + + -- | An extended ed25519 signing key + | ShelleyExtendedSigningKey Crypto.HD.XPrv + +makeShelleySignature + :: Crypto.SignableRepresentation tosign + => tosign + -> ShelleySigningKey + -> Shelley.SignedDSIGN StandardCrypto tosign +makeShelleySignature tosign (ShelleyNormalSigningKey sk) = + Crypto.signedDSIGN () tosign sk + +makeShelleySignature tosign (ShelleyExtendedSigningKey sk) = + fromXSignature $ + Crypto.HD.sign + BS.empty -- passphrase for (unused) in-memory encryption + sk + (Crypto.getSignableRepresentation tosign) + where + fromXSignature :: Crypto.HD.XSignature + -> Shelley.SignedDSIGN StandardCrypto b + fromXSignature = + Crypto.SignedDSIGN + . fromMaybe impossible + . Crypto.rawDeserialiseSigDSIGN + . Crypto.HD.unXSignature + + impossible = + error "makeShelleyKeyWitnessSignature: byron and shelley signature sizes do not match" + +makeSignedTransaction' :: () + => CardanoEra era + -> [KeyWitness era] + -> TxBody era + -> Tx era +makeSignedTransaction' _ = makeSignedTransaction + +makeSignedByronTransaction :: [KeyWitness era] -> Annotated Byron.Tx ByteString -> Byron.ATxAux ByteString +makeSignedByronTransaction witnesses txbody = + Byron.annotateTxAux + $ Byron.mkTxAux + (unAnnotated txbody) + (Vector.fromList [ w | ByronKeyWitness w <- witnesses ]) + +-- order of signing keys must match txins +signByronTransaction :: NetworkId + -> Annotated Byron.Tx ByteString + -> [SigningKey ByronKey] + -> Byron.ATxAux ByteString +signByronTransaction nw txbody sks = + makeSignedByronTransaction witnesses txbody + where + witnesses = map (makeByronKeyWitness nw txbody) sks + +-- signing keys is a set +signShelleyTransaction :: () + => ShelleyBasedEra era + -> TxBody era + -> [ShelleyWitnessSigningKey] + -> Tx era +signShelleyTransaction sbe txbody sks = + makeSignedTransaction witnesses txbody + where + witnesses = map (makeShelleyKeyWitness sbe txbody) sks + + + getByronTxBody :: Byron.ATxAux ByteString -> Annotated Byron.Tx ByteString getByronTxBody (Byron.ATxAux { Byron.aTaTx = txbody }) = txbody --- NB: This is called in getTxBodyAndWitnesses which is fine as --- getTxBodyAndWitnesses is only called in the context of a --- shelley based era anyways. ByronTx will eventually be removed. -getTxBody :: Tx era -> TxBody era -getTxBody (ShelleyTx sbe tx) = - caseShelleyToMaryOrAlonzoEraOnwards - ( const $ - let txBody = tx ^. L.bodyTxL - txAuxData = tx ^. L.auxDataTxL - scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL - in ShelleyTxBody sbe txBody - (Map.elems scriptWits) - TxBodyNoScriptData - (strictMaybeToMaybe txAuxData) - TxScriptValidityNone - ) - (\w -> - let txBody = tx ^. L.bodyTxL - txAuxData = tx ^. L.auxDataTxL - scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL - datsWits = tx ^. L.witsTxL . L.datsTxWitsL - redeemerWits = tx ^. L.witsTxL . L.rdmrsTxWitsL - isValid = tx ^. L.isValidTxL - in ShelleyTxBody sbe txBody - (Map.elems scriptWits) - (TxBodyScriptData w datsWits redeemerWits) - (strictMaybeToMaybe txAuxData) - (TxScriptValidity w (isValidToScriptValidity isValid)) - ) - sbe + getTxWitnessesByron :: Byron.ATxAux ByteString -> [KeyWitness ByronEra] getTxWitnessesByron (Byron.ATxAux { Byron.aTaWitness = witnesses }) = @@ -484,19 +851,7 @@ getTxWitnesses (ShelleyTx sbe tx') = -> [KeyWitness era] getAlonzoTxWitnesses = getShelleyTxWitnesses -makeSignedTransaction' :: () - => CardanoEra era - -> [KeyWitness era] - -> TxBody era - -> Tx era -makeSignedTransaction' _ = makeSignedTransaction -makeSignedByronTransaction :: [KeyWitness era] -> Annotated Byron.Tx ByteString -> Byron.ATxAux ByteString -makeSignedByronTransaction witnesses txbody = - Byron.annotateTxAux - $ Byron.mkTxAux - (unAnnotated txbody) - (Vector.fromList [ w | ByronKeyWitness w <- witnesses ]) makeSignedTransaction :: forall era. [KeyWitness era] @@ -696,25 +1051,6 @@ makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody (ByronSigningKey sk) = (Byron.aaNetworkMagic . unAddrAttrs) eitherNwOrAddr - -data ShelleyWitnessSigningKey = - WitnessPaymentKey (SigningKey PaymentKey) - | WitnessPaymentExtendedKey (SigningKey PaymentExtendedKey) - | WitnessStakeKey (SigningKey StakeKey) - | WitnessStakeExtendedKey (SigningKey StakeExtendedKey) - | WitnessStakePoolKey (SigningKey StakePoolKey) - | WitnessGenesisKey (SigningKey GenesisKey) - | WitnessGenesisExtendedKey (SigningKey GenesisExtendedKey) - | WitnessGenesisDelegateKey (SigningKey GenesisDelegateKey) - | WitnessGenesisDelegateExtendedKey - (SigningKey GenesisDelegateExtendedKey) - | WitnessGenesisUTxOKey (SigningKey GenesisUTxOKey) - | WitnessCommitteeColdKey (SigningKey CommitteeColdKey) - | WitnessCommitteeHotKey (SigningKey CommitteeHotKey) - | WitnessDRepKey (SigningKey DRepKey) - | WitnessDRepExtendedKey (SigningKey DRepExtendedKey) - - makeShelleyKeyWitness :: forall era. () => ShelleyBasedEra era -> TxBody era @@ -736,14 +1072,7 @@ makeShelleyKeyWitness sbe = \case L.WitVKey vk signature --- | We support making key witnesses with both normal and extended signing keys. --- -data ShelleySigningKey = - -- | A normal ed25519 signing key - ShelleyNormalSigningKey (Shelley.SignKeyDSIGN StandardCrypto) - -- | An extended ed25519 signing key - | ShelleyExtendedSigningKey Crypto.HD.XPrv toShelleySigningKey :: ShelleyWitnessSigningKey -> ShelleySigningKey @@ -770,7 +1099,6 @@ toShelleySigningKey key = case key of WitnessDRepExtendedKey (DRepExtendedSigningKey sk) -> ShelleyExtendedSigningKey sk - getShelleyKeyWitnessVerificationKey :: ShelleySigningKey -> Shelley.VKey Shelley.Witness StandardCrypto @@ -791,53 +1119,3 @@ getShelleyKeyWitnessVerificationKey (ShelleyExtendedSigningKey sk) = . getVerificationKey . PaymentExtendedSigningKey $ sk - - -makeShelleySignature - :: Crypto.SignableRepresentation tosign - => tosign - -> ShelleySigningKey - -> Shelley.SignedDSIGN StandardCrypto tosign -makeShelleySignature tosign (ShelleyNormalSigningKey sk) = - Crypto.signedDSIGN () tosign sk - -makeShelleySignature tosign (ShelleyExtendedSigningKey sk) = - fromXSignature $ - Crypto.HD.sign - BS.empty -- passphrase for (unused) in-memory encryption - sk - (Crypto.getSignableRepresentation tosign) - where - fromXSignature :: Crypto.HD.XSignature - -> Shelley.SignedDSIGN StandardCrypto b - fromXSignature = - Crypto.SignedDSIGN - . fromMaybe impossible - . Crypto.rawDeserialiseSigDSIGN - . Crypto.HD.unXSignature - - impossible = - error "makeShelleyKeyWitnessSignature: byron and shelley signature sizes do not match" - - --- order of signing keys must match txins -signByronTransaction :: NetworkId - -> Annotated Byron.Tx ByteString - -> [SigningKey ByronKey] - -> Byron.ATxAux ByteString -signByronTransaction nw txbody sks = - makeSignedByronTransaction witnesses txbody - where - witnesses = map (makeByronKeyWitness nw txbody) sks - --- signing keys is a set -signShelleyTransaction :: () - => ShelleyBasedEra era - -> TxBody era - -> [ShelleyWitnessSigningKey] - -> Tx era -signShelleyTransaction sbe txbody sks = - makeSignedTransaction witnesses txbody - where - witnesses = map (makeShelleyKeyWitness sbe txbody) sks - diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 9c9fe5e80f..e29bc4753b 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -373,6 +373,8 @@ module Cardano.Api ( TxCertificates(..), TxUpdateProposal(..), TxMintValue(..), + TxVotingProcedures(..), + TxProposalProcedures(..), -- ** Building vs viewing transactions BuildTxWith(..), @@ -404,7 +406,6 @@ module Cardano.Api ( TxBodyErrorAutoBalance(..), TxScriptValidity(..), ScriptValidity(..), - scriptValidityToTxScriptValidity, txScriptValidityToScriptValidity, -- * Signing transactions @@ -1042,8 +1043,8 @@ import Cardano.Api.SerialiseRaw import Cardano.Api.SerialiseTextEnvelope import Cardano.Api.SerialiseUsing import Cardano.Api.StakePoolMetadata -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import Cardano.Api.TxMetadata import Cardano.Api.Utils import Cardano.Api.Value diff --git a/cardano-api/src/Cardano/Api/Byron.hs b/cardano-api/src/Cardano/Api/Byron.hs index ffede061c3..997a5abe43 100644 --- a/cardano-api/src/Cardano/Api/Byron.hs +++ b/cardano-api/src/Cardano/Api/Byron.hs @@ -95,6 +95,6 @@ import Cardano.Api.Keys.Byron import Cardano.Api.NetworkId import Cardano.Api.SerialiseLedgerCddl import Cardano.Api.SpecialByron -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import Cardano.Api.Value diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index feb6354fef..78c5f238b8 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -144,8 +144,7 @@ module Cardano.Api.Shelley fromAlonzoPrices, toAlonzoExUnits, fromAlonzoExUnits, - toAlonzoRdmrPtr, - fromAlonzoRdmrPtr, + toScriptIndex, scriptDataFromJsonDetailedSchema, scriptDataToJsonDetailedSchema, calculateExecutionUnitsLovelace, @@ -314,7 +313,7 @@ import Cardano.Api.Query import Cardano.Api.Script import Cardano.Api.ScriptData import Cardano.Api.StakePoolMetadata -import Cardano.Api.Tx -import Cardano.Api.TxBody +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign import Cardano.Api.TxMetadata import Cardano.Api.Value diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs index c762e1d5c0..358e3322ae 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs @@ -44,8 +44,8 @@ exampleShelleyGenesis = , sgMaxLovelaceSupply = 71 , sgProtocolParams = emptyPParams & ppDL .~ unsafeBoundRational 1.9e-2 - & ppMaxBBSizeL .~ 239857 - & ppMaxBHSizeL .~ 217569 + & ppMaxBBSizeL .~ 65535 + & ppMaxBHSizeL .~ 65535 , sgGenDelegs = Map.fromList [( genesisVerKeyHash , GenDelegPair delegVerKeyHash delegVrfKeyHash) diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs index 011141f91b..9e6048a008 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs @@ -36,9 +36,9 @@ import Cardano.Api.Shelley import Cardano.Binary as CBOR import qualified Cardano.Crypto.Seed as Crypto import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Ledger -import qualified Cardano.Ledger.Alonzo.Scripts as Ledger -import qualified Cardano.Ledger.Alonzo.TxWits as Ledger +import qualified Cardano.Ledger.Api.Era as Ledger import qualified Cardano.Ledger.Coin as L +import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Plutus.Language as Plutus import qualified PlutusCore.Evaluation.Machine.CostModelInterface as Plutus import qualified PlutusLedgerApi.Common as Plutus hiding (PlutusV2) @@ -243,7 +243,7 @@ test_ScriptExecutionError = , ("ScriptErrorExecutionUnitsOverflow", ScriptErrorExecutionUnitsOverflow) , ("ScriptErrorNotPlutusWitnessedTxIn", ScriptErrorNotPlutusWitnessedTxIn (ScriptWitnessIndexTxIn 0) scriptHash) , ("ScriptErrorRedeemerPointsToUnknownScriptHash", ScriptErrorRedeemerPointsToUnknownScriptHash (ScriptWitnessIndexTxIn 0)) - , ("ScriptErrorMissingScript", ScriptErrorMissingScript (Ledger.RdmrPtr Ledger.Mint 0) (ResolvablePointers ShelleyBasedEraBabbage Map.empty)) -- TODO CIP-1694 make work in all eras + , ("ScriptErrorMissingScript", ScriptErrorMissingScript (ScriptWitnessIndexMint 0) (ResolvablePointers ShelleyBasedEraBabbage Map.empty)) -- TODO CIP-1694 make work in all eras , ("ScriptErrorMissingCostModel", ScriptErrorMissingCostModel Plutus.PlutusV2) ] @@ -273,10 +273,13 @@ test_TextEnvelopeError = , TextEnvelopeAesonDecodeError string ] +testPastHorizonValue :: Ledger.AlonzoContextError (Ledger.AlonzoEra StandardCrypto) +testPastHorizonValue = Ledger.TimeTranslationPastHorizon text + test_TransactionValidityError :: TestTree test_TransactionValidityError = testAllErrorMessages_ "Cardano.Api.Fees" "TransactionValidityError" - [ ("TransactionValidityTranslationError", TransactionValidityTranslationError $ Ledger.TimeTranslationPastHorizon text) + [ ("TransactionValidityTranslationError", TransactionValidityTranslationError testPastHorizonValue) , ("TransactionValidityCostModelError", TransactionValidityCostModelError (Map.fromList [(AnyPlutusScriptVersion PlutusScriptV2, costModel)]) string) @@ -293,7 +296,7 @@ test_TransactionValidityError = test_TxBodyError :: TestTree test_TxBodyError = - testAllErrorMessages_ "Cardano.Api.TxBody" "TxBodyError" + testAllErrorMessages_ "Cardano.Api.Tx.Body" "TxBodyError" [ ("TxBodyEmptyTxIns", TxBodyEmptyTxIns) , ("TxBodyEmptyTxInsCollateral", TxBodyEmptyTxInsCollateral) , ("TxBodyEmptyTxOuts", TxBodyEmptyTxOuts) diff --git a/cardano-api/test/cardano-api-golden/files/golden/ShelleyGenesis b/cardano-api/test/cardano-api-golden/files/golden/ShelleyGenesis index e681db0ac3..3b8f60bdd4 100644 --- a/cardano-api/test/cardano-api-golden/files/golden/ShelleyGenesis +++ b/cardano-api/test/cardano-api-golden/files/golden/ShelleyGenesis @@ -11,13 +11,13 @@ "maxTxSize": 2048, "minPoolCost": 0, "minFeeA": 0, - "maxBlockBodySize": 239857, + "maxBlockBodySize": 65535, "minFeeB": 0, "eMax": 0, "extraEntropy": { "tag": "NeutralNonce" }, - "maxBlockHeaderSize": 217569, + "maxBlockHeaderSize": 65535, "keyDeposit": 0, "nOpt": 100, "rho": 0, diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorMissingScript.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorMissingScript.txt index f38a8bc169..3fbadfe43b 100644 --- a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorMissingScript.txt +++ b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorMissingScript.txt @@ -1,2 +1,2 @@ -The redeemer pointer: RdmrPtr Mint 0 points to a Plutus script that does not exist. +The redeemer pointer: ScriptWitnessIndexMint 0 points to a Plutus script that does not exist. The pointers that can be resolved are: ResolvablePointers ShelleyBasedEraBabbage (fromList []) \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.TxBodyErrorAutoBalance/TxBodyScriptExecutionError.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.TxBodyErrorAutoBalance/TxBodyScriptExecutionError.txt index e9071ef545..950e37d559 100644 --- a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.TxBodyErrorAutoBalance/TxBodyScriptExecutionError.txt +++ b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.TxBodyErrorAutoBalance/TxBodyScriptExecutionError.txt @@ -1,3 +1,3 @@ The following scripts have execution failures: the script for transaction input 1 (in ascending order of the TxIds) failed with: -The execution units required by this Plutus script overflows a 64bit word. In a properly configured chain this should be practically impossible. So this probably indicates a chain configuration problem, perhaps with the values in the cost model. +The execution units required by this Plutus script overflows a 64bit word. In a properly configured chain this should be practically impossible. So this probably indicates a chain configuration problem, perhaps with the values in the cost model. \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyEmptyTxIns.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyEmptyTxIns.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyEmptyTxIns.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyEmptyTxIns.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyEmptyTxInsCollateral.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyEmptyTxInsCollateral.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyEmptyTxInsCollateral.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyEmptyTxInsCollateral.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyEmptyTxOuts.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyEmptyTxOuts.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyEmptyTxOuts.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyEmptyTxOuts.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyInIxOverflow.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyInIxOverflow.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyInIxOverflow.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyInIxOverflow.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyMetadataError.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMetadataError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyMetadataError.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMetadataError.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyMintAdaError.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMintAdaError.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyMintAdaError.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMintAdaError.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyMissingProtocolParams.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMissingProtocolParams.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyMissingProtocolParams.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMissingProtocolParams.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputNegative.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyOutputNegative.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputNegative.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyOutputNegative.txt diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputOverflow.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyOutputOverflow.txt similarity index 100% rename from cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputOverflow.txt rename to cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyOutputOverflow.txt diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Ledger.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Ledger.hs index 9cb07b925f..7024d035f4 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Ledger.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Ledger.hs @@ -8,8 +8,8 @@ module Test.Cardano.Api.Ledger import Cardano.Api import Cardano.Api.Shelley -import Cardano.Ledger.Address (deserialiseAddr, serialiseAddr) import qualified Cardano.Ledger.Api as L +import Cardano.Ledger.Api.Tx.Address import Cardano.Ledger.Crypto import Cardano.Ledger.SafeHash @@ -32,7 +32,7 @@ prop_roundtrip_Address_CBOR :: Property prop_roundtrip_Address_CBOR = H.property $ do -- If this fails, FundPair and ShelleyGenesis can also fail. addr <- H.forAll (arbitrary @(L.Addr StandardCrypto)) - H.tripping addr serialiseAddr deserialiseAddr + H.tripping addr serialiseAddr decodeAddrEither -- prop_original_scriptdata_bytes_preserved and prop_roundtrip_scriptdata_plutusdata -- allow us to generate a 'HashableScriptData' value from JSON with the original bytes being