From cf059f73eeddf0c62090c478d7fc24851eef97bc Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Tue, 25 May 2021 20:21:07 +0100 Subject: [PATCH 1/8] Add TxBodyRedeemers to the TxBody This is a further step along the path to Alonzo support in the API. The TxBody's ShelleyTxBody constructor holds all the info that goes with the tx body. This includes scripts and aux data. For Alonzo it now also has to include the script data, which the ledger calls the redeemers. This is a big mapping of each use of a script to the script redeemer data and execution units. This patch adds it to the TxBody but does not yet do the main conversion step of constructing the redeemer pointer mapping. --- cardano-api/src/Cardano/Api/Eras.hs | 8 + cardano-api/src/Cardano/Api/Tx.hs | 28 ++-- cardano-api/src/Cardano/Api/TxBody.hs | 163 ++++++++++++++------ cardano-cli/src/Cardano/CLI/Run/Friendly.hs | 8 +- 4 files changed, 142 insertions(+), 65 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Eras.hs b/cardano-api/src/Cardano/Api/Eras.hs index 7bac6b01212..9aaa071554c 100644 --- a/cardano-api/src/Cardano/Api/Eras.hs +++ b/cardano-api/src/Cardano/Api/Eras.hs @@ -29,6 +29,7 @@ module Cardano.Api.Eras , ShelleyBasedEra(..) , IsShelleyBasedEra(..) , InAnyShelleyBasedEra(..) + , shelleyBasedToCardanoEra -- ** Mapping to era types from the Shelley ledger library , ShelleyLedgerEra @@ -276,6 +277,13 @@ data InAnyShelleyBasedEra thing where -> InAnyShelleyBasedEra thing +shelleyBasedToCardanoEra :: ShelleyBasedEra era -> CardanoEra era +shelleyBasedToCardanoEra ShelleyBasedEraShelley = ShelleyEra +shelleyBasedToCardanoEra ShelleyBasedEraAllegra = AllegraEra +shelleyBasedToCardanoEra ShelleyBasedEraMary = MaryEra +shelleyBasedToCardanoEra ShelleyBasedEraAlonzo = AlonzoEra + + -- ---------------------------------------------------------------------------- -- Cardano eras factored as Byron vs Shelley-based -- diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index ab16db49e26..dd2b7430b96 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -412,7 +412,7 @@ getTxBody (ShelleyTx era tx) = ShelleyBasedEraShelley -> getShelleyTxBody tx ShelleyBasedEraAllegra -> getShelleyTxBody tx ShelleyBasedEraMary -> getShelleyTxBody tx - ShelleyBasedEraAlonzo -> getAlonzoTxBody tx + ShelleyBasedEraAlonzo -> getAlonzoTxBody ScriptDataInAlonzoEra tx where getShelleyTxBody :: forall ledgerera. ShelleyLedgerEra era ~ ledgerera @@ -430,30 +430,32 @@ getTxBody (ShelleyTx era tx) = } = ShelleyTxBody era txbody (Map.elems msigWits) + TxBodyNoRedeemers (strictMaybeToMaybe txAuxiliaryData) getAlonzoTxBody :: forall ledgerera. ShelleyLedgerEra era ~ ledgerera => Ledger.Witnesses ledgerera ~ Alonzo.TxWitness ledgerera => Shelley.ShelleyBased ledgerera - => Ledger.Tx ledgerera + => ScriptDataSupportedInEra era + -> Ledger.Tx ledgerera -> TxBody era - getAlonzoTxBody Shelley.Tx { + getAlonzoTxBody scriptDataInEra + Shelley.Tx { Shelley.body = txbody, Shelley.wits = Alonzo.TxWitness' _addrWits _bootWits txscripts _txdats - _txrdmrs, + redeemers, Shelley.auxiliaryData = auxiliaryData } = ShelleyTxBody era txbody (Map.elems txscripts) + (fromAlonzoRedeemers scriptDataInEra redeemers) (strictMaybeToMaybe auxiliaryData) - --TODO: we will probably want to put the Alonzo data and - -- redeemer in the tx body here, and so that will use - -- the _txdats and _txrdmrs above. + getTxWitnesses :: forall era. Tx era -> [KeyWitness era] getTxWitnesses (ByronTx Byron.ATxAux { Byron.aTaWitness = witnesses }) = @@ -516,7 +518,9 @@ makeSignedTransaction witnesses (ByronTxBody txbody) = (unAnnotated txbody) (Vector.fromList [ w | ByronKeyWitness w <- witnesses ]) -makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata) = +makeSignedTransaction witnesses (ShelleyTxBody era txbody + txscripts redeemers + txmetadata) = case era of ShelleyBasedEraShelley -> makeShelleySignedTransaction txbody ShelleyBasedEraAllegra -> makeShelleySignedTransaction txbody @@ -564,7 +568,7 @@ makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata) (Map.fromList [ (Ledger.hashScript @ledgerera sw, sw) | sw <- txscripts ]) (error "TODO alonzo: makeAlonzoSignedTransaction: datums") - (error "TODO alonzo: makeAlonzoSignedTransaction: redeemers")) + (toAlonzoRedeemers redeemers)) (maybeToStrictMaybe txmetadata) @@ -574,7 +578,7 @@ makeByronKeyWitness :: forall key. -> TxBody ByronEra -> SigningKey key -> KeyWitness ByronEra -makeByronKeyWitness _ (ShelleyTxBody era _ _ _) = case era of {} +makeByronKeyWitness _ (ShelleyTxBody era _ _ _ _) = case era of {} makeByronKeyWitness nw (ByronTxBody txbody) = let txhash :: Byron.Hash Byron.Tx txhash = Byron.hashDecoded txbody @@ -625,7 +629,7 @@ makeShelleyBootstrapWitness :: forall era. makeShelleyBootstrapWitness _ ByronTxBody{} _ = case shelleyBasedEra :: ShelleyBasedEra era of {} -makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody era txbody _ _) sk = +makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody era txbody _ _ _) sk = case era of ShelleyBasedEraShelley -> makeShelleyBasedBootstrapWitness era nwOrAddr txbody sk @@ -738,7 +742,7 @@ makeShelleyKeyWitness :: forall era => TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era -makeShelleyKeyWitness (ShelleyTxBody era txbody _ _) = +makeShelleyKeyWitness (ShelleyTxBody era txbody _ _ _) = case era of ShelleyBasedEraShelley -> makeShelleyBasedKeyWitness txbody ShelleyBasedEraAllegra -> makeShelleyBasedKeyWitness txbody diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index b00474e66c9..17f52fbdf4c 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -26,6 +26,7 @@ module Cardano.Api.TxBody ( makeTransactionBody, TxBodyContent(..), TxBodyError(..), + TxBodyRedeemers(..), -- ** Transitional utils makeByronTransaction, @@ -98,6 +99,8 @@ module Cardano.Api.TxBody ( fromShelleyTxIn, fromShelleyTxOut, fromTxOut, + toAlonzoRedeemers, + fromAlonzoRedeemers, -- * Data family instances AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody, AsMaryTxBody), @@ -172,6 +175,7 @@ import qualified Cardano.Ledger.Alonzo as Alonzo import qualified Cardano.Ledger.Alonzo.Data as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo +import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo import Cardano.Api.Address import Cardano.Api.Certificate @@ -239,7 +243,7 @@ getTxId (ByronTxBody tx) = impossible = error "getTxId: byron and shelley hash sizes do not match" -getTxId (ShelleyTxBody era tx _ _) = +getTxId (ShelleyTxBody era tx _ _ _) = case era of ShelleyBasedEraShelley -> getTxIdShelley tx ShelleyBasedEraAllegra -> getTxIdShelley tx @@ -538,7 +542,7 @@ validityUpperBoundSupportedInEra ShelleyEra = Just ValidityUpperBoundInShelleyEr validityUpperBoundSupportedInEra AllegraEra = Just ValidityUpperBoundInAllegraEra validityUpperBoundSupportedInEra MaryEra = Just ValidityUpperBoundInMaryEra validityUpperBoundSupportedInEra AlonzoEra = Just ValidityUpperBoundInAlonzoEra - + -- | A representation of whether the era supports transactions having /no/ -- upper bound on the range of slots in which they are valid. @@ -989,8 +993,9 @@ data TxBody era where -- witnesses set, since they need to be known when building the body. -> [Ledger.Script (ShelleyLedgerEra era)] - -- TODO alonzo: we will probably want to or need to put the Alonzo data and - -- redeemers in the tx body here + -- The info for each use of each script: the script input data + -- (called the "redeemer") and the execution units. + -> TxBodyRedeemers era -- The 'Ledger.AuxiliaryData' consists of one or several things, -- depending on era: @@ -1006,13 +1011,23 @@ data TxBody era where -- tx body type, which is different for each Shelley-based era. +data TxBodyRedeemers era where + TxBodyNoRedeemers :: TxBodyRedeemers era + TxBodyRedeemers :: ScriptDataSupportedInEra era + -> Alonzo.Redeemers (ShelleyLedgerEra era) + -> TxBodyRedeemers era + +deriving instance Eq (TxBodyRedeemers era) +deriving instance Show (TxBodyRedeemers era) + + -- The GADT in the ShelleyTxBody case requires a custom instance instance Eq (TxBody era) where (==) (ByronTxBody txbodyA) (ByronTxBody txbodyB) = txbodyA == txbodyB - (==) (ShelleyTxBody era txbodyA txscriptsA txmetadataA) - (ShelleyTxBody _ txbodyB txscriptsB txmetadataB) = + (==) (ShelleyTxBody era txbodyA txscriptsA redeemersA txmetadataA) + (ShelleyTxBody _ txbodyB txscriptsB redeemersB txmetadataB) = case era of ShelleyBasedEraShelley -> txbodyA == txbodyB && txscriptsA == txscriptsB @@ -1025,11 +1040,13 @@ instance Eq (TxBody era) where ShelleyBasedEraMary -> txbodyA == txbodyB && txscriptsA == txscriptsB && txmetadataA == txmetadataB + ShelleyBasedEraAlonzo -> txbodyA == txbodyB && txscriptsA == txscriptsB + && redeemersA == redeemersB && txmetadataA == txmetadataB - (==) ByronTxBody{} (ShelleyTxBody era _ _ _) = case era of {} + (==) ByronTxBody{} (ShelleyTxBody era _ _ _ _) = case era of {} -- The GADT in the ShelleyTxBody case requires a custom instance @@ -1041,46 +1058,54 @@ instance Show (TxBody era) where ) showsPrec p (ShelleyTxBody ShelleyBasedEraShelley - txbody txscripts txmetadata) = + txbody txscripts redeemers txmetadata) = showParen (p >= 11) ( showString "ShelleyTxBody ShelleyBasedEraShelley " . showsPrec 11 txbody . showChar ' ' . showsPrec 11 txscripts . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' . showsPrec 11 txmetadata ) showsPrec p (ShelleyTxBody ShelleyBasedEraAllegra - txbody txscripts txmetadata) = + txbody txscripts redeemers txmetadata) = showParen (p >= 11) ( showString "ShelleyTxBody ShelleyBasedEraAllegra " . showsPrec 11 txbody . showChar ' ' . showsPrec 11 txscripts . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' . showsPrec 11 txmetadata ) showsPrec p (ShelleyTxBody ShelleyBasedEraMary - txbody txscripts txmetadata) = + txbody txscripts redeemers txmetadata) = showParen (p >= 11) ( showString "ShelleyTxBody ShelleyBasedEraMary " . showsPrec 11 txbody . showChar ' ' . showsPrec 11 txscripts . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' . showsPrec 11 txmetadata ) showsPrec p (ShelleyTxBody ShelleyBasedEraAlonzo - txbody txscripts txmetadata) = + txbody txscripts redeemers txmetadata) = showParen (p >= 11) ( showString "ShelleyTxBody ShelleyBasedEraMary " . showsPrec 11 txbody . showChar ' ' . showsPrec 11 txscripts . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' . showsPrec 11 txmetadata ) @@ -1106,13 +1131,17 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where serialiseToCBOR (ByronTxBody txbody) = recoverBytes txbody - serialiseToCBOR (ShelleyTxBody era txbody txscripts txmetadata) = + serialiseToCBOR (ShelleyTxBody era txbody txscripts redeemers txmetadata) = case era of -- Use the same serialisation impl, but at different types: - ShelleyBasedEraShelley -> serialiseShelleyBasedTxBody txbody txscripts txmetadata - ShelleyBasedEraAllegra -> serialiseShelleyBasedTxBody txbody txscripts txmetadata - ShelleyBasedEraMary -> serialiseShelleyBasedTxBody txbody txscripts txmetadata - ShelleyBasedEraAlonzo -> serialiseShelleyBasedTxBody txbody txscripts txmetadata + ShelleyBasedEraShelley -> serialiseShelleyBasedTxBody + era txbody txscripts redeemers txmetadata + ShelleyBasedEraAllegra -> serialiseShelleyBasedTxBody + era txbody txscripts redeemers txmetadata + ShelleyBasedEraMary -> serialiseShelleyBasedTxBody + era txbody txscripts redeemers txmetadata + ShelleyBasedEraAlonzo -> serialiseShelleyBasedTxBody + era txbody txscripts redeemers txmetadata deserialiseFromCBOR _ bs = case cardanoEra :: CardanoEra era of @@ -1124,55 +1153,72 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where (LBS.fromStrict bs) -- Use the same derialisation impl, but at different types: - ShelleyEra -> deserialiseShelleyBasedTxBody - (ShelleyTxBody ShelleyBasedEraShelley) bs - AllegraEra -> deserialiseShelleyBasedTxBody - (ShelleyTxBody ShelleyBasedEraAllegra) bs - MaryEra -> deserialiseShelleyBasedTxBody - (ShelleyTxBody ShelleyBasedEraMary) bs - AlonzoEra -> deserialiseShelleyBasedTxBody - (ShelleyTxBody ShelleyBasedEraAlonzo) bs + ShelleyEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraShelley bs + AllegraEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraAllegra bs + MaryEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraMary bs + AlonzoEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraAlonzo bs -- | 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 txbody script metadata. - (ToCBOR txbody, ToCBOR script, ToCBOR metadata) - => txbody - -> [script] - -> Maybe metadata - -> ByteString -serialiseShelleyBasedTxBody txbody txscripts txmetadata = +serialiseShelleyBasedTxBody + :: forall era ledgerera. + ShelleyLedgerEra era ~ ledgerera + => ToCBOR (Ledger.TxBody ledgerera) + => ToCBOR (Ledger.Script ledgerera) + => ToCBOR (Alonzo.Redeemers ledgerera) + => ToCBOR (Ledger.AuxiliaryData ledgerera) + => ShelleyBasedEra era + -> Ledger.TxBody ledgerera + -> [Ledger.Script ledgerera] + -> TxBodyRedeemers era + -> Maybe (Ledger.AuxiliaryData ledgerera) + -> ByteString +serialiseShelleyBasedTxBody _era txbody txscripts redeemers txmetadata = CBOR.serializeEncoding' $ - CBOR.encodeListLen 3 + CBOR.encodeListLen 4 <> CBOR.toCBOR txbody <> CBOR.toCBOR txscripts + <> (case redeemers of + TxBodyNoRedeemers -> CBOR.encodeNull + TxBodyRedeemers _ rs -> CBOR.toCBOR rs) <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata -deserialiseShelleyBasedTxBody :: forall txbody script metadata pair. - (FromCBOR (CBOR.Annotator txbody), - FromCBOR (CBOR.Annotator script), - FromCBOR (CBOR.Annotator metadata)) - => (txbody -> [script] -> Maybe metadata -> pair) - -> ByteString - -> Either CBOR.DecoderError pair -deserialiseShelleyBasedTxBody mkTxBody bs = +deserialiseShelleyBasedTxBody + :: forall era ledgerera. + ShelleyLedgerEra era ~ ledgerera + => FromCBOR (CBOR.Annotator (Ledger.TxBody ledgerera)) + => FromCBOR (CBOR.Annotator (Ledger.Script ledgerera)) + => FromCBOR (CBOR.Annotator (Alonzo.Redeemers ledgerera)) + => FromCBOR (CBOR.Annotator (Ledger.AuxiliaryData ledgerera)) + => ShelleyBasedEra era + -> ByteString + -> Either CBOR.DecoderError (TxBody era) +deserialiseShelleyBasedTxBody era bs = CBOR.decodeAnnotator "Shelley TxBody" decodeAnnotatedTuple (LBS.fromStrict bs) where - decodeAnnotatedTuple :: CBOR.Decoder s (CBOR.Annotator pair) - decodeAnnotatedTuple = do - CBOR.decodeListLenOf 3 + decodeAnnotatedTuple :: CBOR.Decoder s (CBOR.Annotator (TxBody era)) + decodeAnnotatedTuple = do + len <- CBOR.decodeListLen txbody <- fromCBOR txscripts <- fromCBOR + redeemers <- + -- Backwards compat for pre-Alonzo era tx body files + case len of + 3 -> return (return TxBodyNoRedeemers) + 4 -> case scriptDataSupportedInEra (shelleyBasedToCardanoEra era) of + Nothing -> return TxBodyNoRedeemers <$ CBOR.decodeNull + Just supported -> fmap (TxBodyRedeemers supported) <$> fromCBOR + _ -> fail "expected tx body tuple of size 3 or 4" txmetadata <- CBOR.decodeNullMaybe fromCBOR return $ CBOR.Annotator $ \fbs -> - mkTxBody - (CBOR.runAnnotator txbody fbs) - (map (`CBOR.runAnnotator` fbs) txscripts) - (CBOR.runAnnotator <$> txmetadata <*> pure fbs) + ShelleyTxBody era + (flip CBOR.runAnnotator fbs txbody) + (map (flip CBOR.runAnnotator fbs) txscripts) + (flip CBOR.runAnnotator fbs redeemers) + (fmap (flip CBOR.runAnnotator fbs) txmetadata) instance IsCardanoEra era => HasTextEnvelope (TxBody era) where textEnvelopeType _ = @@ -1183,6 +1229,21 @@ instance IsCardanoEra era => HasTextEnvelope (TxBody era) where MaryEra -> "TxBodyMary" AlonzoEra -> "TxBodyAlonzo" +toAlonzoRedeemers :: Ledger.Era (ShelleyLedgerEra era) + => TxBodyRedeemers era + -> Alonzo.Redeemers (ShelleyLedgerEra era) +toAlonzoRedeemers TxBodyNoRedeemers = Alonzo.Redeemers Map.empty +toAlonzoRedeemers (TxBodyRedeemers _ r) = r + +fromAlonzoRedeemers :: Ledger.Era (ShelleyLedgerEra era) + => ScriptDataSupportedInEra era + -> Alonzo.Redeemers (ShelleyLedgerEra era) + -> TxBodyRedeemers era +fromAlonzoRedeemers scriptDataInEra redeemers@(Alonzo.Redeemers r) + | Map.null r = TxBodyNoRedeemers + | otherwise = TxBodyRedeemers scriptDataInEra redeemers + + -- ---------------------------------------------------------------------------- -- Constructing transaction bodies @@ -1238,7 +1299,7 @@ getTransactionBodyContent getTransactionBodyContent = \case ByronTxBody body -> Right $ getByronTxBodyContent body - ShelleyTxBody era body _scripts mAux -> + ShelleyTxBody era body _scripts _redeemers mAux -> fromLedgerTxBody era body mAux @@ -1676,6 +1737,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraShelley (maybeToStrictMaybe (Ledger.hashAuxiliaryData @StandardShelley <$> txAuxData))) (map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent)) + TxBodyNoRedeemers txAuxData where txAuxData :: Maybe (Ledger.AuxiliaryData StandardShelley) @@ -1740,6 +1802,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAllegra (Ledger.hashAuxiliaryData @StandardAllegra <$> txAuxData)) mempty) -- No minting in Allegra, only Mary (map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent)) + TxBodyNoRedeemers txAuxData where txAuxData :: Maybe (Ledger.AuxiliaryData StandardAllegra) @@ -1820,6 +1883,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraMary TxMintNone -> mempty TxMintValue _ v _ -> toMaryValue v)) (map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent)) + TxBodyNoRedeemers txAuxData where txAuxData :: Maybe (Ledger.AuxiliaryData StandardMary) @@ -1904,6 +1968,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo (Ledger.hashAuxiliaryData @StandardAlonzo <$> txAuxData)) (error "TODO alonzo: optional network")) (map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent)) + TxBodyNoRedeemers --TODO alonzo: provide the redeemers here txAuxData where txAuxData :: Maybe (Ledger.AuxiliaryData StandardAlonzo) diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs index 4e4a1d5a756..4df73420bfe 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -44,13 +44,13 @@ friendlyTxBody era txbody = <> case txbody of ByronTxBody body -> friendlyTxBodyByron body - ShelleyTxBody ShelleyBasedEraShelley body _scripts aux -> + ShelleyTxBody ShelleyBasedEraShelley body _scripts _ aux -> addAuxData aux $ friendlyTxBodyShelley body - ShelleyTxBody ShelleyBasedEraAllegra body _scripts aux -> + ShelleyTxBody ShelleyBasedEraAllegra body _scripts _ aux -> addAuxData aux $ friendlyTxBodyAllegra body - ShelleyTxBody ShelleyBasedEraMary body _scripts aux -> + ShelleyTxBody ShelleyBasedEraMary body _scripts _ aux -> addAuxData aux $ friendlyTxBodyMary body - ShelleyTxBody ShelleyBasedEraAlonzo _ _ _ -> + ShelleyTxBody ShelleyBasedEraAlonzo _ _ _ _ -> panic "friendlyTxBody: Alonzo not implemented yet" -- TODO alonzo addAuxData :: Show a => Maybe a -> Object -> Object From 6ba64b9fa9a673514513d7e6bc0c72eb58df49ed Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Wed, 26 May 2021 00:01:32 +0100 Subject: [PATCH 2/8] Build the Alonzo redeemer pointer mapping Based on the script witnesses used within the tx body. Co-authored-by: Jordan Millar --- cardano-api/src/Cardano/Api/TxBody.hs | 115 +++++++++++++++++++++++++- 1 file changed, 113 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 17f52fbdf4c..e8cf211d292 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -123,7 +123,7 @@ import Data.List (intercalate) import qualified Data.List.NonEmpty as NonEmpty import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, catMaybes, maybeToList) import qualified Data.Sequence.Strict as Seq import qualified Data.Set as Set import Data.String (IsString) @@ -173,6 +173,7 @@ import Cardano.Ledger.Val (isZero) import qualified Cardano.Ledger.Alonzo as Alonzo import qualified Cardano.Ledger.Alonzo.Data as Alonzo +import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo @@ -1968,9 +1969,14 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo (Ledger.hashAuxiliaryData @StandardAlonzo <$> txAuxData)) (error "TODO alonzo: optional network")) (map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent)) - TxBodyNoRedeemers --TODO alonzo: provide the redeemers here + (fromAlonzoRedeemers ScriptDataInAlonzoEra redeemers) txAuxData where + redeemers :: Alonzo.Redeemers StandardAlonzo + redeemers = makeAlonzoRedeemers + txIns txWithdrawals + txCertificates txMintValue + txAuxData :: Maybe (Ledger.AuxiliaryData StandardAlonzo) txAuxData | Map.null ms @@ -1995,6 +2001,111 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo -- must assume Ledger.PParamsDelta ledgerera ~ Alonzo.PParamsDelta ledgerera +makeAlonzoRedeemers :: Ledger.Era (ShelleyLedgerEra era) + => [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] + -> TxWithdrawals BuildTx era + -> TxCertificates BuildTx era + -> TxMintValue BuildTx era + -> Alonzo.Redeemers (ShelleyLedgerEra era) +makeAlonzoRedeemers txIns txWithdrawals + txCertificates txMintValue = + Alonzo.Redeemers $ + makeAlonzoRedeemersTxIns txIns + <> makeAlonzoRedeemersWithdrawals txWithdrawals + <> makeAlonzoRedeemersCertificates txCertificates + <> makeAlonzoRedeemersMinting txMintValue + + +type RedeemerMap era = + Map Alonzo.RdmrPtr (Alonzo.Data (ShelleyLedgerEra era), Alonzo.ExUnits) + +redeemerMapEntry :: Alonzo.Tag + -> Word64 + -> Witness witctx era + -> Maybe ( Alonzo.RdmrPtr + , (Alonzo.Data ledgerera, Alonzo.ExUnits) + ) +redeemerMapEntry _ _ KeyWitness{} = Nothing +redeemerMapEntry _ _ (ScriptWitness _ SimpleScriptWitness{}) = Nothing +redeemerMapEntry tag ix (ScriptWitness _ + (PlutusScriptWitness _ _ _ _ scriptdata exunits)) = + Just (redmrptr, (scriptdata', exunits')) + where + redmrptr = Alonzo.RdmrPtr tag ix + scriptdata' = toAlonzoScriptData scriptdata + exunits' = toAlonzoExUnits exunits + + +makeAlonzoRedeemersTxIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] + -> RedeemerMap era +makeAlonzoRedeemersTxIns txins = + Map.fromList $ + catMaybes + [ redeemerMapEntry Alonzo.Spend ix witness + -- The tx ins are indexed in the map order by txid + | (ix, BuildTxWith witness) <- zip [0..] (sortNub txins) + ] + where + -- This relies on the TxId Ord instance being consistent with the + -- Shelley.TxId Ord instance via the toShelleyTxId conversion + -- TODO: add a QC property to ensure this + sortNub :: Ord k => [(k, v)] -> [v] + sortNub = Map.elems . Map.fromList + + +makeAlonzoRedeemersWithdrawals :: TxWithdrawals BuildTx era + -> RedeemerMap era +makeAlonzoRedeemersWithdrawals TxWithdrawalsNone = Map.empty +makeAlonzoRedeemersWithdrawals (TxWithdrawals _ withdrawals) = + Map.fromList $ + catMaybes + [ redeemerMapEntry Alonzo.Rewrd ix witness + -- The withdrawals are indexed in the map order by stake credential + | (ix, BuildTxWith witness) <- zip [0..] (sortNub withdrawals) + ] + where + -- This relies on the StakeAddress Ord instance being consistent with the + -- Shelley.RewardAcnt Ord instance via the toShelleyStakeAddr conversion + -- TODO: add a QC property to ensure this + sortNub :: Ord k => [(k, x, v)] -> [v] + sortNub = Map.elems . Map.fromList . map (\(k, _, v) -> (k, v)) + + +makeAlonzoRedeemersCertificates :: TxCertificates BuildTx era + -> RedeemerMap era +makeAlonzoRedeemersCertificates TxCertificatesNone = Map.empty +makeAlonzoRedeemersCertificates (TxCertificates _ certs (BuildTxWith witnesses)) = + Map.fromList $ + catMaybes + [ redeemerMapEntry Alonzo.Cert ix witness + -- The certs are indexed in list order + | (ix, cert) <- zip [0..] certs + , witness <- maybeToList $ do + stakecred <- selectStakeCredential cert + Map.lookup stakecred witnesses + ] + where + selectStakeCredential cert = + case cert of + StakeAddressDeregistrationCertificate stakecred -> Just stakecred + StakeAddressDelegationCertificate stakecred _ -> Just stakecred + _ -> Nothing + + +makeAlonzoRedeemersMinting :: TxMintValue BuildTx era + -> RedeemerMap era +makeAlonzoRedeemersMinting TxMintNone = Map.empty +makeAlonzoRedeemersMinting (TxMintValue _ value (BuildTxWith witnesses)) = + Map.fromList $ + catMaybes + [ redeemerMapEntry Alonzo.Mint ix witness + -- The minting policies are indexed in policy id order in the value + | let ValueNestedRep bundle = valueToNestedRep value + , (ix, ValueNestedBundle policyid _) <- zip [0..] bundle + , witness <- maybeToList (Map.lookup policyid witnesses) + ] + + data SimpleScriptInEra era where SimpleScriptInEra :: ScriptLanguageInEra lang era -> SimpleScriptVersion lang From c8248927503e85329d7cdccde308939e166c50a0 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Thu, 27 May 2021 01:31:57 +0100 Subject: [PATCH 3/8] Make getTransactionBodyContent total and add TxBody pattern The getTransactionBodyContent function and the functions it was calling were doing unnecessary checks that made them partial. We do not need to validate when converting from a ledger transaction, only when building one. By eliminating unnecessary checks and making this pure we can now introduce a TxBody pattern that lets one get at the TxBodyContent. This makes for a nicer API. Also eliminate a couple deprecated functions that will be awkward to update for new features, and are no longer used. --- cardano-api/src/Cardano/Api.hs | 4 +- cardano-api/src/Cardano/Api/TxBody.hs | 130 +++++++------------------- 2 files changed, 36 insertions(+), 98 deletions(-) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 43bc75ccfec..90801bcf45f 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -146,8 +146,7 @@ module Cardano.Api ( -- | Constructing and inspecting transactions -- ** Transaction bodies - TxBody, - getTransactionBodyContent, + TxBody(TxBody), makeTransactionBody, TxBodyContent(..), TxBodyError(..), @@ -225,7 +224,6 @@ module Cardano.Api ( makeSignedTransaction, KeyWitness, makeByronKeyWitness, - makeByronTransaction, ShelleyWitnessSigningKey(..), makeShelleyKeyWitness, makeShelleyBootstrapWitness, diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index e8cf211d292..312444ec988 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -14,6 +14,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} -- | Transaction bodies @@ -21,16 +22,12 @@ module Cardano.Api.TxBody ( -- * Transaction bodies - TxBody(..), - getTransactionBodyContent, + TxBody(.., TxBody), makeTransactionBody, TxBodyContent(..), TxBodyError(..), TxBodyRedeemers(..), - -- ** Transitional utils - makeByronTransaction, - -- * Transaction Ids TxId(..), getTxId, @@ -1295,12 +1292,12 @@ makeTransactionBody = ShelleyBasedEra era -> makeShelleyTransactionBody era -getTransactionBodyContent - :: TxBody era -> Either (TxBodyError era) (TxBodyContent ViewTx era) -getTransactionBodyContent = \case - ByronTxBody body -> - Right $ getByronTxBodyContent body - ShelleyTxBody era body _scripts _redeemers mAux -> +pattern TxBody :: TxBodyContent ViewTx era -> TxBody era +pattern TxBody txbodycontent <- (getTxBodyContent -> txbodycontent) + +getTxBodyContent :: TxBody era -> TxBodyContent ViewTx era +getTxBodyContent (ByronTxBody body) = getByronTxBodyContent body +getTxBodyContent (ShelleyTxBody era body _scripts _redeemers mAux) = fromLedgerTxBody era body mAux @@ -1308,11 +1305,8 @@ fromLedgerTxBody :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> Maybe (Ledger.AuxiliaryData (ShelleyLedgerEra era)) - -> Either (TxBodyError era) (TxBodyContent ViewTx era) -fromLedgerTxBody era body mAux = do - checkAuxiliaryDataHash era body mAux - txMintValue <- fromLedgerTxMintValue era body - pure + -> TxBodyContent ViewTx era +fromLedgerTxBody era body mAux = TxBodyContent { txIns = fromLedgerTxIns era body , txOuts = fromLedgerTxOuts era body @@ -1321,7 +1315,7 @@ fromLedgerTxBody era body mAux = do , txWithdrawals = fromLedgerTxWithdrawals era body , txCertificates = fromLedgerTxCertificates era body , txUpdateProposal = fromLedgerTxUpdateProposal era body - , txMintValue + , txMintValue = fromLedgerTxMintValue era body , txMetadata , txAuxScripts } @@ -1330,30 +1324,6 @@ fromLedgerTxBody era body mAux = do -- TODO alonzo ^^ also return TxAuxScriptData as 3rd component -checkAuxiliaryDataHash - :: ShelleyBasedEra era - -> Ledger.TxBody (ShelleyLedgerEra era) - -> Maybe (Ledger.AuxiliaryData (ShelleyLedgerEra era)) - -> Either (TxBodyError era) () -checkAuxiliaryDataHash era body mAux = - guard hashEquality ?! TxBodyAuxDataHashInvalidError - where - mAux' = maybeToStrictMaybe mAux - hashEquality = - case era of - ShelleyBasedEraShelley -> - Shelley._mdHash body == - (Ledger.hashAuxiliaryData @StandardShelley <$> mAux') - ShelleyBasedEraAllegra -> - Allegra.adHash' body == - (Ledger.hashAuxiliaryData @StandardAllegra <$> mAux') - ShelleyBasedEraMary -> - Mary.adHash' body == - (Ledger.hashAuxiliaryData @StandardMary <$> mAux') - ShelleyBasedEraAlonzo -> - Alonzo.adHash' body == - (Ledger.hashAuxiliaryData @StandardAlonzo <$> mAux') - fromLedgerTxIns :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) @@ -1627,26 +1597,22 @@ fromLedgerTxUpdateProposal era body = fromLedgerTxMintValue :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) - -> Either (TxBodyError era) (TxMintValue ViewTx era) + -> TxMintValue ViewTx era fromLedgerTxMintValue era body = case era of - ShelleyBasedEraShelley -> pure TxMintNone - - ShelleyBasedEraAllegra -> - TxMintNone <$ - guard (isZero $ Allegra.mint' body) ?! TxBodyMintBeforeMaryError - + ShelleyBasedEraShelley -> TxMintNone + ShelleyBasedEraAllegra -> TxMintNone ShelleyBasedEraMary - | isZero mint -> pure TxMintNone - | otherwise -> - pure $ TxMintValue MultiAssetInMaryEra (fromMaryValue mint) ViewTx + | isZero mint -> TxMintNone + | otherwise -> TxMintValue MultiAssetInMaryEra + (fromMaryValue mint) ViewTx where mint = Mary.mint' body ShelleyBasedEraAlonzo - | isZero mint -> pure TxMintNone - | otherwise -> - pure $ TxMintValue MultiAssetInAlonzoEra (fromMaryValue mint) ViewTx + | isZero mint -> TxMintNone + | otherwise -> TxMintValue MultiAssetInAlonzoEra + (fromMaryValue mint) ViewTx where mint = Alonzo.mint' body @@ -1686,9 +1652,21 @@ makeByronTransactionBody TxBodyContent { txIns, txOuts } = do getByronTxBodyContent :: Annotated Byron.Tx ByteString -> TxBodyContent ViewTx ByronEra getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = - makeByronTransactionBodyContent - [(fromByronTxIn input, ViewTx) | input <- toList txInputs] - (fromByronTxOut <$> toList txOutputs) + TxBodyContent { + txIns = [ (fromByronTxIn input, ViewTx) + | input <- toList txInputs], + txOuts = fromByronTxOut <$> toList txOutputs, + txFee = TxFeeImplicit TxFeesImplicitInByronEra, + txValidityRange = (TxValidityNoLowerBound, + TxValidityNoUpperBound + ValidityNoUpperBoundInByronEra), + txMetadata = TxMetadataNone, + txAuxScripts = TxAuxScriptsNone, + txWithdrawals = TxWithdrawalsNone, + txCertificates = TxCertificatesNone, + txUpdateProposal = TxUpdateProposalNone, + txMintValue = TxMintNone + } makeShelleyTransactionBody :: ShelleyBasedEra era -> TxBodyContent BuildTx era @@ -2216,44 +2194,6 @@ toAlonzoAuxiliaryData m ss ds = (Set.fromList (map toAlonzoScriptData ds)) --- ---------------------------------------------------------------------------- --- Transitional utility functions for making transaction bodies --- - --- | Transitional function to help the CLI move to the updated TxBody API. --- -makeByronTransaction :: [TxIn] - -> [TxOut ByronEra] - -> Either (TxBodyError ByronEra) (TxBody ByronEra) -makeByronTransaction txIns txOuts = - makeTransactionBody $ - makeByronTransactionBodyContent - [(txin, BuildTxWith (KeyWitness KeyWitnessForSpending)) | txin <- txIns] - txOuts -{-# DEPRECATED makeByronTransaction "Use makeTransactionBody" #-} - - -makeByronTransactionBodyContent - :: [(TxIn, BuildTxWith build (Witness WitCtxTxIn ByronEra))] - -> [TxOut ByronEra] - -> TxBodyContent build ByronEra -makeByronTransactionBodyContent txIns txOuts = - TxBodyContent { - txIns, - txOuts, - txFee = TxFeeImplicit TxFeesImplicitInByronEra, - txValidityRange = (TxValidityNoLowerBound, - TxValidityNoUpperBound - ValidityNoUpperBoundInByronEra), - txMetadata = TxMetadataNone, - txAuxScripts = TxAuxScriptsNone, - txWithdrawals = TxWithdrawalsNone, - txCertificates = TxCertificatesNone, - txUpdateProposal = TxUpdateProposalNone, - txMintValue = TxMintNone - } - - -- ---------------------------------------------------------------------------- -- Other utilities helpful with making transaction bodies -- From 3e92a3772137654a13bdde7a8877b05c7cc4e28b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 21 May 2021 08:28:28 +0100 Subject: [PATCH 4/8] Add toLedgerPParams conversion function It will be needed for the Alonzo tx construction. Co-authored-by: Duncan Coutts --- .../src/Cardano/Api/ProtocolParameters.hs | 93 +++++++++++++++++++ 1 file changed, 93 insertions(+) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 7f65af529b6..b8b5fa927b1 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -43,6 +43,7 @@ module Cardano.Api.ProtocolParameters ( toShelleyPParamsUpdate, toShelleyProposedPPUpdates, toShelleyUpdate, + toLedgerPParams, fromShelleyPParams, fromShelleyPParamsUpdate, fromShelleyProposedPPUpdates, @@ -73,6 +74,7 @@ import Control.Monad import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.!=), (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson +import Data.Bifunctor (bimap) import qualified Cardano.Binary as CBOR import qualified Cardano.Crypto.Hash.Class as Crypto @@ -89,11 +91,14 @@ import qualified Shelley.Spec.Ledger.Genesis as Shelley import qualified Shelley.Spec.Ledger.Keys as Shelley import qualified Shelley.Spec.Ledger.PParams as Shelley +import qualified Cardano.Ledger.Alonzo.Language as Alonzo +import qualified Cardano.Ledger.Alonzo.PParams as Alonzo import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo -- TODO alonzo: eliminate this import and use things re-exported from the ledger lib import qualified Plutus.V1.Ledger.Api as Plutus import Cardano.Api.Address +import Cardano.Api.Eras import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.Hash @@ -892,6 +897,94 @@ fromShelleyPParamsUpdate } +toLedgerPParams + :: ShelleyBasedEra era + -> ProtocolParameters + -> Ledger.PParams (ShelleyLedgerEra era) +toLedgerPParams sbe pparams = + case sbe of + ShelleyBasedEraShelley -> toShelleyPParams pparams + ShelleyBasedEraAllegra -> toShelleyPParams pparams + ShelleyBasedEraMary -> toShelleyPParams pparams + ShelleyBasedEraAlonzo -> toAlonzoPParams pparams + +toShelleyPParams :: ProtocolParameters -> Shelley.PParams ledgerera +toShelleyPParams pparams = + Shelley.PParams + { Shelley._protocolVersion = let (maj, minor) = protocolParamProtocolVersion pparams + in Shelley.ProtVer maj minor + , Shelley._d = Shelley.unitIntervalFromRational $ protocolParamDecentralization pparams + , Shelley._extraEntropy = toShelleyNonce $ protocolParamExtraPraosEntropy pparams + , Shelley._maxBHSize = protocolParamMaxBlockHeaderSize pparams + , Shelley._maxBBSize = protocolParamMaxBlockBodySize pparams + , Shelley._maxTxSize = protocolParamMaxTxSize pparams + , Shelley._minfeeB = protocolParamTxFeeFixed pparams + , Shelley._minfeeA = protocolParamTxFeePerByte pparams + , Shelley._minUTxOValue = toShelleyLovelace $ protocolParamMinUTxOValue pparams + , Shelley._keyDeposit = toShelleyLovelace $ protocolParamStakeAddressDeposit pparams + , Shelley._poolDeposit = toShelleyLovelace $ protocolParamStakePoolDeposit pparams + , Shelley._minPoolCost = toShelleyLovelace $ protocolParamMinPoolCost pparams + , Shelley._eMax = protocolParamPoolRetireMaxEpoch pparams + , Shelley._nOpt = protocolParamStakePoolTargetNum pparams + , Shelley._a0 = protocolParamPoolPledgeInfluence pparams + , Shelley._rho = Shelley.unitIntervalFromRational $ protocolParamMonetaryExpansion pparams + , Shelley._tau = Shelley.unitIntervalFromRational $ protocolParamTreasuryCut pparams + } + +toAlonzoPParams :: ProtocolParameters -> Alonzo.PParams ledgerera +toAlonzoPParams pparams = + Alonzo.PParams + { Alonzo._protocolVersion = let (maj, minor) = protocolParamProtocolVersion pparams + in Alonzo.ProtVer maj minor + , Alonzo._d = Shelley.unitIntervalFromRational $ protocolParamDecentralization pparams + , Alonzo._extraEntropy = toShelleyNonce $ protocolParamExtraPraosEntropy pparams + , Alonzo._maxBHSize = protocolParamMaxBlockHeaderSize pparams + , Alonzo._maxBBSize = protocolParamMaxBlockBodySize pparams + , Alonzo._maxTxSize = protocolParamMaxTxSize pparams + , Alonzo._minfeeB = protocolParamTxFeeFixed pparams + , Alonzo._minfeeA = protocolParamTxFeePerByte pparams + , Alonzo._keyDeposit = toShelleyLovelace $ protocolParamStakeAddressDeposit pparams + , Alonzo._poolDeposit = toShelleyLovelace $ protocolParamStakePoolDeposit pparams + , Alonzo._minPoolCost = toShelleyLovelace $ protocolParamMinPoolCost pparams + , Alonzo._eMax = protocolParamPoolRetireMaxEpoch pparams + , Alonzo._nOpt = protocolParamStakePoolTargetNum pparams + , Alonzo._a0 = protocolParamPoolPledgeInfluence pparams + , Alonzo._rho = Shelley.unitIntervalFromRational $ protocolParamMonetaryExpansion pparams + , Alonzo._tau = Shelley.unitIntervalFromRational $ protocolParamTreasuryCut pparams + , Alonzo._adaPerUTxOWord = case protocolParamUTxOCostPerWord pparams of + Just costPerByte -> toShelleyLovelace costPerByte + Nothing -> error "fromProtocolParamsAlonzo: Must specify _adaPerUTxOByte" + , Alonzo._costmdls = toAlonzoCostModels $ protocolParamCostModels pparams + , Alonzo._prices = case protocolParamPrices pparams of + Just prices -> toAlonzoPrices prices + Nothing -> error "fromProtocolParamsAlonzo: Must specify _prices" + , Alonzo._maxTxExUnits = case protocolParamMaxTxExUnits pparams of + Just eUnits -> toAlonzoExUnits eUnits + Nothing -> error "fromProtocolParamsAlonzo: Must specify _maxTxExUnits" + , Alonzo._maxBlockExUnits = case protocolParamMaxBlockExUnits pparams of + Just eUnits -> toAlonzoExUnits eUnits + Nothing -> error "fromProtocolParamsAlonzo: Must specify _maxBlockExUnits" + , Alonzo._maxValSize = case protocolParamMaxValueSize pparams of + Just maxSize -> maxSize + Nothing -> error "fromProtocolParamsAlonzo: Must specify _maxValSize" + , Alonzo._collateralPercentage = error "TODO alonzo: toAlonzoPParams collateralPercentage" + , Alonzo._maxCollateralInputs = error "TODO alonzo: toAlonzoPParams maxCollateralInputs" + } + +toAlonzoCostModels + :: Map AnyPlutusScriptVersion CostModel + -> Map Alonzo.Language Alonzo.CostModel +toAlonzoCostModels = + Map.fromList + . map (bimap toAlonzoScriptLanguage toAlonzoCostModel) + . Map.toList + +toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Alonzo.Language +toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Alonzo.PlutusV1 + +toAlonzoCostModel :: CostModel -> Alonzo.CostModel +toAlonzoCostModel (CostModel m) = Alonzo.CostModel m + fromShelleyPParams :: Shelley.PParams ledgerera -> ProtocolParameters fromShelleyPParams From a4222e7239c58e4a4062e9628a1ef668c5c2bf47 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Thu, 27 May 2021 01:37:55 +0100 Subject: [PATCH 5/8] Add optional ProtocolParameters to the TxBodyContent Needed to construct the hash of the script-relevant protocol params and the redeemers. It is only supplied when building the transaction and is not available when viewing it. --- cardano-api/src/Cardano/Api/Script.hs | 12 +++- cardano-api/src/Cardano/Api/TxBody.hs | 70 ++++++++++++++++++- .../test/Test/Cardano/Api/Typed/Gen.hs | 2 + cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 2 + .../Cardano/CLI/Shelley/Run/Transaction.hs | 1 + 5 files changed, 85 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 42bc46717b3..c15830e357b 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -78,6 +78,8 @@ module Cardano.Api.Script ( fromShelleyScriptHash, toAlonzoScriptData, fromAlonzoScriptData, + toAlonzoLanguage, + fromAlonzoLanguage, -- * Data family instances AsType(..), @@ -125,8 +127,9 @@ import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import qualified Shelley.Spec.Ledger.Keys as Shelley import qualified Shelley.Spec.Ledger.Scripts as Shelley -import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Data as Alonzo +import qualified Cardano.Ledger.Alonzo.Language as Alonzo +import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import Cardano.Api.Eras import Cardano.Api.HasTypeProxy @@ -300,6 +303,13 @@ instance Aeson.ToJSONKey AnyPlutusScriptVersion where toText (AnyPlutusScriptVersion PlutusScriptV1) = "PlutusScriptV1" toAesonEncoding = Aeson.text . toText +toAlonzoLanguage :: AnyPlutusScriptVersion -> Alonzo.Language +toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Alonzo.PlutusV1 + +fromAlonzoLanguage :: Alonzo.Language -> AnyPlutusScriptVersion +fromAlonzoLanguage Alonzo.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 + + class HasTypeProxy lang => IsScriptLanguage lang where scriptLanguage :: ScriptLanguage lang diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 312444ec988..0c318c90c53 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -122,6 +122,7 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, catMaybes, maybeToList) import qualified Data.Sequence.Strict as Seq +import Data.Set (Set) import qualified Data.Set as Set import Data.String (IsString) import Data.Text (Text) @@ -170,6 +171,7 @@ import Cardano.Ledger.Val (isZero) import qualified Cardano.Ledger.Alonzo as Alonzo import qualified Cardano.Ledger.Alonzo.Data as Alonzo +import qualified Cardano.Ledger.Alonzo.Language as Alonzo import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo @@ -966,6 +968,7 @@ data TxBodyContent build era = txMetadata :: TxMetadataInEra era, txAuxScripts :: TxAuxScripts era, --txAuxScriptData :: TxAuxScriptData era, -- TODO alonzo + txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters), txWithdrawals :: TxWithdrawals build era, txCertificates :: TxCertificates build era, txUpdateProposal :: TxUpdateProposal era, @@ -1256,6 +1259,7 @@ data TxBodyError era = | TxBodyMintAdaError | TxBodyAuxDataHashInvalidError | TxBodyMintBeforeMaryError + | TxBodyMissingProtocolParams deriving Show instance Error (TxBodyError era) where @@ -1280,6 +1284,9 @@ instance Error (TxBodyError era) where "Transaction can mint in Mary era or later" displayError TxBodyAuxDataHashInvalidError = "Auxiliary data hash is invalid" + displayError TxBodyMissingProtocolParams = + "Transaction uses Plutus scripts but does not provide the protocol " ++ + "parameters to hash" makeTransactionBody :: forall era. @@ -1316,6 +1323,7 @@ fromLedgerTxBody era body mAux = , txCertificates = fromLedgerTxCertificates era body , txUpdateProposal = fromLedgerTxUpdateProposal era body , txMintValue = fromLedgerTxMintValue era body + , txProtocolParams = ViewTx , txMetadata , txAuxScripts } @@ -1662,6 +1670,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = ValidityNoUpperBoundInByronEra), txMetadata = TxMetadataNone, txAuxScripts = TxAuxScriptsNone, + txProtocolParams = ViewTx, txWithdrawals = TxWithdrawalsNone, txCertificates = TxCertificatesNone, txUpdateProposal = TxUpdateProposalNone, @@ -1886,6 +1895,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo txValidityRange = (lowerBound, upperBound), txMetadata, txAuxScripts, + txProtocolParams, txWithdrawals, txCertificates, txUpdateProposal, @@ -1911,6 +1921,10 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo case txMintValue of TxMintNone -> return () TxMintValue _ v _ -> guard (selectLovelace v == 0) ?! TxBodyMintAdaError + case txProtocolParams of + BuildTxWith Just{} -> return () + BuildTxWith Nothing -> guard (not (Set.null languages)) + ?! TxBodyMissingProtocolParams return $ ShelleyTxBody era @@ -1942,7 +1956,13 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo (case txMintValue of TxMintNone -> mempty TxMintValue _ v _ -> toMaryValue v) - (error "TODO: Alonzo optional protocol param hash") + (case txProtocolParams of + BuildTxWith Nothing -> SNothing + BuildTxWith (Just pparams) -> + Alonzo.hashWitnessPPData + (toLedgerPParams ShelleyBasedEraAlonzo pparams) + languages + redeemers) (maybeToStrictMaybe (Ledger.hashAuxiliaryData @StandardAlonzo <$> txAuxData)) (error "TODO alonzo: optional network")) @@ -1955,6 +1975,12 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo txIns txWithdrawals txCertificates txMintValue + languages :: Set Alonzo.Language + languages = Set.map toAlonzoLanguage $ + collectTxBodyPlutusScriptVersions + txIns txWithdrawals + txCertificates txMintValue + txAuxData :: Maybe (Ledger.AuxiliaryData StandardAlonzo) txAuxData | Map.null ms @@ -1978,6 +2004,48 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo -- and\/or merge it with toShelleyUpdate to make it era-generic -- must assume Ledger.PParamsDelta ledgerera ~ Alonzo.PParamsDelta ledgerera +collectTxBodyPlutusScriptVersions + :: forall era. + [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] + -> TxWithdrawals BuildTx era + -> TxCertificates BuildTx era + -> TxMintValue BuildTx era + -> Set AnyPlutusScriptVersion +collectTxBodyPlutusScriptVersions txIns txWithdrawals + txCertificates txMintValue = + mconcat + [ scriptWitnessVersions witness + | (_, BuildTxWith witness) <- txIns ] + <> mconcat + [ scriptWitnessVersions witness + | TxWithdrawals _ withdrawals <- pure txWithdrawals + , (_, _, BuildTxWith witness) <- withdrawals ] + <> mconcat + [ scriptWitnessVersions witness + | TxCertificates _ certs (BuildTxWith witnesses) <- pure txCertificates + , cert <- certs + , witness <- maybeToList $ do + stakecred <- selectStakeCredential cert + Map.lookup stakecred witnesses + ] + <> mconcat + [ scriptWitnessVersions witness + | TxMintValue _ value (BuildTxWith witnesses) <- pure txMintValue + , let ValueNestedRep bundle = valueToNestedRep value + , ValueNestedBundle policyid _ <- bundle + , witness <- maybeToList (Map.lookup policyid witnesses) + ] + where + scriptWitnessVersions :: forall witctx. Witness witctx era -> Set AnyPlutusScriptVersion + scriptWitnessVersions (ScriptWitness _ (PlutusScriptWitness _ v _ _ _ _)) = + Set.singleton (AnyPlutusScriptVersion v) + scriptWitnessVersions _ = Set.empty + + selectStakeCredential cert = + case cert of + StakeAddressDeregistrationCertificate stakecred -> Just stakecred + StakeAddressDelegationCertificate stakecred _ -> Just stakecred + _ -> Nothing makeAlonzoRedeemers :: Ledger.Era (ShelleyLedgerEra era) => [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs index 28a41973f60..ab3b79565e9 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs @@ -514,6 +514,7 @@ genTxBodyContent era = do validityRange <- genTxValidityRange era txMd <- genTxMetadataInEra era auxScripts <- genTxAuxScripts era + mpparams <- Gen.maybe genProtocolParameters withdrawals <- genTxWithdrawals era certs <- genTxCertificates era updateProposal <- genTxUpdateProposal era @@ -526,6 +527,7 @@ genTxBodyContent era = do , txValidityRange = validityRange , txMetadata = txMd , txAuxScripts = auxScripts + , txProtocolParams = BuildTxWith mpparams , txWithdrawals = withdrawals , txCertificates = certs , txUpdateProposal = updateProposal diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 9ad45e0de50..6af48dd4fea 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -159,6 +159,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do ) TxMetadataNone TxAuxScriptsNone + (BuildTxWith Nothing) TxWithdrawalsNone TxCertificatesNone TxUpdateProposalNone @@ -194,6 +195,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do ) TxMetadataNone TxAuxScriptsNone + (BuildTxWith Nothing) TxWithdrawalsNone TxCertificatesNone TxUpdateProposalNone diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 148aaad6874..3079e5a8459 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -260,6 +260,7 @@ runTxBuildRaw (AnyCardanoEra era) inputsAndScripts txouts mLowerBound <*> validateTxValidityUpperBound era mUpperBound) <*> validateTxMetadataInEra era metadataSchema metadataFiles <*> validateTxAuxScripts era scriptFiles + <*> pure (BuildTxWith Nothing) --TODO alonzo: support this <*> validateTxWithdrawals era withdrawals <*> validateTxCertificates era certFiles <*> validateTxUpdateProposal era mUpdatePropFile From a7280d8fbdbb89d47dcc4303d6488cf34d21d7fd Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 21 May 2021 11:07:54 +0100 Subject: [PATCH 6/8] Fill in network magic in Alonzo tx body construction For now always fill it in with Nothing. This is a rarely used feature that we can complete at the end. It is a bit annoying however: it needs a Shelley network identifier, which is not the same as the API NetworkId type, since that also contains the NetworkMagic. That means we cannot use that type since we would not be able to round-trip it to/from a ledger transaction. So this will need some extension and/or refactoring of the NetworkId type and utils. Co-authored-by: Duncan Coutts --- cardano-api/src/Cardano/Api/TxBody.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 0c318c90c53..49e942d0767 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -1965,7 +1965,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo redeemers) (maybeToStrictMaybe (Ledger.hashAuxiliaryData @StandardAlonzo <$> txAuxData)) - (error "TODO alonzo: optional network")) + SNothing) -- TODO alonzo: support optional network id in TxBodyContent (map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent)) (fromAlonzoRedeemers ScriptDataInAlonzoEra redeemers) txAuxData From ecfaa6336a42081f74c92bb3ef8e51ebdd4c4a03 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 24 May 2021 15:15:47 +0100 Subject: [PATCH 7/8] Add TxExtraKeyWitnesses to TxBodyContent These specify that extra key witnesses are required, and this fact is visible to Plutus scripts. It thereby provides a mechaism for Plutus scripts to check that the transaction has been signed by a particular key. Co-authored-by: Duncan Coutts --- cardano-api/src/Cardano/Api.hs | 3 + cardano-api/src/Cardano/Api/TxBody.hs | 65 ++++++++++++++++++- .../test/Test/Cardano/Api/Typed/Gen.hs | 1 + cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 2 + .../Cardano/CLI/Shelley/Run/Transaction.hs | 1 + 5 files changed, 71 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 90801bcf45f..a4b3ebf5c04 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -174,6 +174,7 @@ module Cardano.Api ( TxMetadataInEra(..), TxAuxScripts(..), TxAuxScriptData(..), + TxExtraKeyWitnesses(..), TxWithdrawals(..), TxCertificates(..), TxUpdateProposal(..), @@ -194,6 +195,7 @@ module Cardano.Api ( ValidityLowerBoundSupportedInEra(..), TxMetadataSupportedInEra(..), AuxScriptsSupportedInEra(..), + TxExtraKeyWitnessesSupportedInEra(..), WithdrawalsSupportedInEra(..), CertificatesSupportedInEra(..), UpdateProposalSupportedInEra(..), @@ -206,6 +208,7 @@ module Cardano.Api ( validityLowerBoundSupportedInEra, txMetadataSupportedInEra, auxScriptsSupportedInEra, + extraKeyWitnessesSupportedInEra, withdrawalsSupportedInEra, certificatesSupportedInEra, updateProposalSupportedInEra, diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 49e942d0767..680eff25a47 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -50,6 +50,7 @@ module Cardano.Api.TxBody ( TxMetadataInEra(..), TxAuxScripts(..), TxAuxScriptData(..), + TxExtraKeyWitnesses(..), TxWithdrawals(..), TxCertificates(..), TxUpdateProposal(..), @@ -70,6 +71,7 @@ module Cardano.Api.TxBody ( ValidityLowerBoundSupportedInEra(..), TxMetadataSupportedInEra(..), AuxScriptsSupportedInEra(..), + TxExtraKeyWitnessesSupportedInEra(..), ScriptDataSupportedInEra(..), WithdrawalsSupportedInEra(..), CertificatesSupportedInEra(..), @@ -83,6 +85,7 @@ module Cardano.Api.TxBody ( validityLowerBoundSupportedInEra, txMetadataSupportedInEra, auxScriptsSupportedInEra, + extraKeyWitnessesSupportedInEra, scriptDataSupportedInEra, withdrawalsSupportedInEra, certificatesSupportedInEra, @@ -643,6 +646,30 @@ auxScriptsSupportedInEra MaryEra = Just AuxScriptsInMaryEra auxScriptsSupportedInEra AlonzoEra = Just AuxScriptsInAlonzoEra +-- | A representation of whether the era supports transactions that specify +-- in the body that they need extra key witnesses, and where this fact is +-- visible to scripts. +-- +-- Extra key witnesses visible to scripts are supported from the Alonzo era +-- onwards. +-- +data TxExtraKeyWitnessesSupportedInEra era where + + ExtraKeyWitnessesInAlonzoEra :: TxExtraKeyWitnessesSupportedInEra AlonzoEra + + +deriving instance Eq (TxExtraKeyWitnessesSupportedInEra era) +deriving instance Show (TxExtraKeyWitnessesSupportedInEra era) + +extraKeyWitnessesSupportedInEra :: CardanoEra era + -> Maybe (TxExtraKeyWitnessesSupportedInEra era) +extraKeyWitnessesSupportedInEra ByronEra = Nothing +extraKeyWitnessesSupportedInEra ShelleyEra = Nothing +extraKeyWitnessesSupportedInEra AllegraEra = Nothing +extraKeyWitnessesSupportedInEra MaryEra = Nothing +extraKeyWitnessesSupportedInEra AlonzoEra = Just ExtraKeyWitnessesInAlonzoEra + + -- | A representation of whether the era supports multi-asset transactions. -- -- The Mary and subsequent eras support multi-asset transactions. @@ -869,6 +896,20 @@ data TxAuxScripts era where deriving instance Eq (TxAuxScripts era) deriving instance Show (TxAuxScripts era) +-- ---------------------------------------------------------------------------- +-- Optionally required signatures (era-dependent) +-- + +data TxExtraKeyWitnesses era where + + TxExtraKeyWitnessesNone :: TxExtraKeyWitnesses era + + TxExtraKeyWitnesses :: TxExtraKeyWitnessesSupportedInEra era + -> [Hash PaymentKey] + -> TxExtraKeyWitnesses era + +deriving instance Eq (TxExtraKeyWitnesses era) +deriving instance Show (TxExtraKeyWitnesses era) -- ---------------------------------------------------------------------------- -- Auxiliary script data (era-dependent) @@ -967,6 +1008,7 @@ data TxBodyContent build era = TxValidityUpperBound era), txMetadata :: TxMetadataInEra era, txAuxScripts :: TxAuxScripts era, + txExtraKeyWits :: TxExtraKeyWitnesses era, --txAuxScriptData :: TxAuxScriptData era, -- TODO alonzo txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters), txWithdrawals :: TxWithdrawals build era, @@ -1323,6 +1365,7 @@ fromLedgerTxBody era body mAux = , txCertificates = fromLedgerTxCertificates era body , txUpdateProposal = fromLedgerTxUpdateProposal era body , txMintValue = fromLedgerTxMintValue era body + , txExtraKeyWits = fromLedgerTxExtraKeyWitnesses era body , txProtocolParams = ViewTx , txMetadata , txAuxScripts @@ -1486,6 +1529,20 @@ fromLedgerTxAuxiliaryData era (Just auxData) = (ms, ss) = fromLedgerAuxiliaryData era auxData +fromLedgerTxExtraKeyWitnesses :: ShelleyBasedEra era + -> Ledger.TxBody (ShelleyLedgerEra era) + -> TxExtraKeyWitnesses era +fromLedgerTxExtraKeyWitnesses sbe body = + case sbe of + ShelleyBasedEraShelley -> TxExtraKeyWitnessesNone + ShelleyBasedEraAllegra -> TxExtraKeyWitnessesNone + ShelleyBasedEraMary -> TxExtraKeyWitnessesNone + ShelleyBasedEraAlonzo -> TxExtraKeyWitnesses + ExtraKeyWitnessesInAlonzoEra + [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) + | let keyhashes = Alonzo.reqSignerHashes body + , keyhash <- Set.toList keyhashes ] + fromLedgerTxWithdrawals :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) @@ -1670,6 +1727,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = ValidityNoUpperBoundInByronEra), txMetadata = TxMetadataNone, txAuxScripts = TxAuxScriptsNone, + txExtraKeyWits = TxExtraKeyWitnessesNone, txProtocolParams = ViewTx, txWithdrawals = TxWithdrawalsNone, txCertificates = TxCertificatesNone, @@ -1895,6 +1953,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo txValidityRange = (lowerBound, upperBound), txMetadata, txAuxScripts, + txExtraKeyWits, txProtocolParams, txWithdrawals, txCertificates, @@ -1952,7 +2011,11 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo (case txUpdateProposal of TxUpdateProposalNone -> SNothing TxUpdateProposal _ p -> SJust (toAlonzoUpdate p)) - (error "TODO alonzo: extra key hashes for required witnesses") + (case txExtraKeyWits of + TxExtraKeyWitnessesNone -> Set.empty + TxExtraKeyWitnesses _ khs -> Set.fromList + [ Shelley.coerceKeyRole kh + | PaymentKeyHash kh <- khs ]) (case txMintValue of TxMintNone -> mempty TxMintValue _ v _ -> toMaryValue v) diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs index ab3b79565e9..1c16dbbdde1 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs @@ -527,6 +527,7 @@ genTxBodyContent era = do , txValidityRange = validityRange , txMetadata = txMd , txAuxScripts = auxScripts + , txExtraKeyWits = TxExtraKeyWitnessesNone --TODO: Alonzo era: Generate witness key hashes , txProtocolParams = BuildTxWith mpparams , txWithdrawals = withdrawals , txCertificates = certs diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 6af48dd4fea..c73a3e13181 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -159,6 +159,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do ) TxMetadataNone TxAuxScriptsNone + TxExtraKeyWitnessesNone (BuildTxWith Nothing) TxWithdrawalsNone TxCertificatesNone @@ -195,6 +196,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do ) TxMetadataNone TxAuxScriptsNone + TxExtraKeyWitnessesNone (BuildTxWith Nothing) TxWithdrawalsNone TxCertificatesNone diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 3079e5a8459..43116ef7f9e 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -260,6 +260,7 @@ runTxBuildRaw (AnyCardanoEra era) inputsAndScripts txouts mLowerBound <*> validateTxValidityUpperBound era mUpperBound) <*> validateTxMetadataInEra era metadataSchema metadataFiles <*> validateTxAuxScripts era scriptFiles + <*> pure TxExtraKeyWitnessesNone --TODO alonzo: support this <*> pure (BuildTxWith Nothing) --TODO alonzo: support this <*> validateTxWithdrawals era withdrawals <*> validateTxCertificates era certFiles From 6544ca84170974906413bc22c030a0688c26efa3 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Thu, 27 May 2021 15:33:51 +0100 Subject: [PATCH 8/8] Address review feedback: layout and hlint --- .../src/Cardano/Api/ProtocolParameters.hs | 166 ++++++++++++------ cardano-api/src/Cardano/Api/TxBody.hs | 4 +- 2 files changed, 112 insertions(+), 58 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index b8b5fa927b1..88160aac2b2 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -909,67 +909,119 @@ toLedgerPParams sbe pparams = ShelleyBasedEraAlonzo -> toAlonzoPParams pparams toShelleyPParams :: ProtocolParameters -> Shelley.PParams ledgerera -toShelleyPParams pparams = +toShelleyPParams ProtocolParameters { + protocolParamProtocolVersion, + protocolParamDecentralization, + protocolParamExtraPraosEntropy, + protocolParamMaxBlockHeaderSize, + protocolParamMaxBlockBodySize, + protocolParamMaxTxSize, + protocolParamTxFeeFixed, + protocolParamTxFeePerByte, + protocolParamMinUTxOValue, + protocolParamStakeAddressDeposit, + protocolParamStakePoolDeposit, + protocolParamMinPoolCost, + protocolParamPoolRetireMaxEpoch, + protocolParamStakePoolTargetNum, + protocolParamPoolPledgeInfluence, + protocolParamMonetaryExpansion, + protocolParamTreasuryCut + } = Shelley.PParams - { Shelley._protocolVersion = let (maj, minor) = protocolParamProtocolVersion pparams - in Shelley.ProtVer maj minor - , Shelley._d = Shelley.unitIntervalFromRational $ protocolParamDecentralization pparams - , Shelley._extraEntropy = toShelleyNonce $ protocolParamExtraPraosEntropy pparams - , Shelley._maxBHSize = protocolParamMaxBlockHeaderSize pparams - , Shelley._maxBBSize = protocolParamMaxBlockBodySize pparams - , Shelley._maxTxSize = protocolParamMaxTxSize pparams - , Shelley._minfeeB = protocolParamTxFeeFixed pparams - , Shelley._minfeeA = protocolParamTxFeePerByte pparams - , Shelley._minUTxOValue = toShelleyLovelace $ protocolParamMinUTxOValue pparams - , Shelley._keyDeposit = toShelleyLovelace $ protocolParamStakeAddressDeposit pparams - , Shelley._poolDeposit = toShelleyLovelace $ protocolParamStakePoolDeposit pparams - , Shelley._minPoolCost = toShelleyLovelace $ protocolParamMinPoolCost pparams - , Shelley._eMax = protocolParamPoolRetireMaxEpoch pparams - , Shelley._nOpt = protocolParamStakePoolTargetNum pparams - , Shelley._a0 = protocolParamPoolPledgeInfluence pparams - , Shelley._rho = Shelley.unitIntervalFromRational $ protocolParamMonetaryExpansion pparams - , Shelley._tau = Shelley.unitIntervalFromRational $ protocolParamTreasuryCut pparams + { Shelley._protocolVersion + = let (maj, minor) = protocolParamProtocolVersion + in Shelley.ProtVer maj minor + , Shelley._d = Shelley.unitIntervalFromRational + protocolParamDecentralization + , Shelley._extraEntropy = toShelleyNonce protocolParamExtraPraosEntropy + , Shelley._maxBHSize = protocolParamMaxBlockHeaderSize + , Shelley._maxBBSize = protocolParamMaxBlockBodySize + , Shelley._maxTxSize = protocolParamMaxTxSize + , Shelley._minfeeB = protocolParamTxFeeFixed + , Shelley._minfeeA = protocolParamTxFeePerByte + , Shelley._minUTxOValue = toShelleyLovelace protocolParamMinUTxOValue + , Shelley._keyDeposit = toShelleyLovelace protocolParamStakeAddressDeposit + , Shelley._poolDeposit = toShelleyLovelace protocolParamStakePoolDeposit + , Shelley._minPoolCost = toShelleyLovelace protocolParamMinPoolCost + , Shelley._eMax = protocolParamPoolRetireMaxEpoch + , Shelley._nOpt = protocolParamStakePoolTargetNum + , Shelley._a0 = protocolParamPoolPledgeInfluence + , Shelley._rho = Shelley.unitIntervalFromRational + protocolParamMonetaryExpansion + , Shelley._tau = Shelley.unitIntervalFromRational + protocolParamTreasuryCut } toAlonzoPParams :: ProtocolParameters -> Alonzo.PParams ledgerera -toAlonzoPParams pparams = - Alonzo.PParams - { Alonzo._protocolVersion = let (maj, minor) = protocolParamProtocolVersion pparams - in Alonzo.ProtVer maj minor - , Alonzo._d = Shelley.unitIntervalFromRational $ protocolParamDecentralization pparams - , Alonzo._extraEntropy = toShelleyNonce $ protocolParamExtraPraosEntropy pparams - , Alonzo._maxBHSize = protocolParamMaxBlockHeaderSize pparams - , Alonzo._maxBBSize = protocolParamMaxBlockBodySize pparams - , Alonzo._maxTxSize = protocolParamMaxTxSize pparams - , Alonzo._minfeeB = protocolParamTxFeeFixed pparams - , Alonzo._minfeeA = protocolParamTxFeePerByte pparams - , Alonzo._keyDeposit = toShelleyLovelace $ protocolParamStakeAddressDeposit pparams - , Alonzo._poolDeposit = toShelleyLovelace $ protocolParamStakePoolDeposit pparams - , Alonzo._minPoolCost = toShelleyLovelace $ protocolParamMinPoolCost pparams - , Alonzo._eMax = protocolParamPoolRetireMaxEpoch pparams - , Alonzo._nOpt = protocolParamStakePoolTargetNum pparams - , Alonzo._a0 = protocolParamPoolPledgeInfluence pparams - , Alonzo._rho = Shelley.unitIntervalFromRational $ protocolParamMonetaryExpansion pparams - , Alonzo._tau = Shelley.unitIntervalFromRational $ protocolParamTreasuryCut pparams - , Alonzo._adaPerUTxOWord = case protocolParamUTxOCostPerWord pparams of - Just costPerByte -> toShelleyLovelace costPerByte - Nothing -> error "fromProtocolParamsAlonzo: Must specify _adaPerUTxOByte" - , Alonzo._costmdls = toAlonzoCostModels $ protocolParamCostModels pparams - , Alonzo._prices = case protocolParamPrices pparams of - Just prices -> toAlonzoPrices prices - Nothing -> error "fromProtocolParamsAlonzo: Must specify _prices" - , Alonzo._maxTxExUnits = case protocolParamMaxTxExUnits pparams of - Just eUnits -> toAlonzoExUnits eUnits - Nothing -> error "fromProtocolParamsAlonzo: Must specify _maxTxExUnits" - , Alonzo._maxBlockExUnits = case protocolParamMaxBlockExUnits pparams of - Just eUnits -> toAlonzoExUnits eUnits - Nothing -> error "fromProtocolParamsAlonzo: Must specify _maxBlockExUnits" - , Alonzo._maxValSize = case protocolParamMaxValueSize pparams of - Just maxSize -> maxSize - Nothing -> error "fromProtocolParamsAlonzo: Must specify _maxValSize" - , Alonzo._collateralPercentage = error "TODO alonzo: toAlonzoPParams collateralPercentage" - , Alonzo._maxCollateralInputs = error "TODO alonzo: toAlonzoPParams maxCollateralInputs" - } +toAlonzoPParams ProtocolParameters { + protocolParamProtocolVersion, + protocolParamDecentralization, + protocolParamExtraPraosEntropy, + protocolParamMaxBlockHeaderSize, + protocolParamMaxBlockBodySize, + protocolParamMaxTxSize, + protocolParamTxFeeFixed, + protocolParamTxFeePerByte, + protocolParamStakeAddressDeposit, + protocolParamStakePoolDeposit, + protocolParamMinPoolCost, + protocolParamPoolRetireMaxEpoch, + protocolParamStakePoolTargetNum, + protocolParamPoolPledgeInfluence, + protocolParamMonetaryExpansion, + protocolParamTreasuryCut, + protocolParamUTxOCostPerWord = Just utxoCostPerWord, + protocolParamCostModels, + protocolParamPrices = Just prices, + protocolParamMaxTxExUnits = Just maxTxExUnits, + protocolParamMaxBlockExUnits = Just maxBlockExUnits, + protocolParamMaxValueSize = Just maxValueSize + } = + Alonzo.PParams { + Alonzo._protocolVersion + = let (maj, minor) = protocolParamProtocolVersion + in Alonzo.ProtVer maj minor + , Alonzo._d = Shelley.unitIntervalFromRational + protocolParamDecentralization + , Alonzo._extraEntropy = toShelleyNonce protocolParamExtraPraosEntropy + , Alonzo._maxBHSize = protocolParamMaxBlockHeaderSize + , Alonzo._maxBBSize = protocolParamMaxBlockBodySize + , Alonzo._maxTxSize = protocolParamMaxTxSize + , Alonzo._minfeeB = protocolParamTxFeeFixed + , Alonzo._minfeeA = protocolParamTxFeePerByte + , Alonzo._keyDeposit = toShelleyLovelace protocolParamStakeAddressDeposit + , Alonzo._poolDeposit = toShelleyLovelace protocolParamStakePoolDeposit + , Alonzo._minPoolCost = toShelleyLovelace protocolParamMinPoolCost + , Alonzo._eMax = protocolParamPoolRetireMaxEpoch + , Alonzo._nOpt = protocolParamStakePoolTargetNum + , Alonzo._a0 = protocolParamPoolPledgeInfluence + , Alonzo._rho = Shelley.unitIntervalFromRational + protocolParamMonetaryExpansion + , Alonzo._tau = Shelley.unitIntervalFromRational + protocolParamTreasuryCut + + -- New params in Alonzo: + , Alonzo._adaPerUTxOWord = toShelleyLovelace utxoCostPerWord + , Alonzo._costmdls = toAlonzoCostModels protocolParamCostModels + , Alonzo._prices = toAlonzoPrices prices + , Alonzo._maxTxExUnits = toAlonzoExUnits maxTxExUnits + , Alonzo._maxBlockExUnits = toAlonzoExUnits maxBlockExUnits + , Alonzo._maxValSize = maxValueSize + , Alonzo._collateralPercentage = error "TODO alonzo: toAlonzoPParams collateralPercentage" + , Alonzo._maxCollateralInputs = error "TODO alonzo: toAlonzoPParams maxCollateralInputs" + } +toAlonzoPParams ProtocolParameters { protocolParamUTxOCostPerWord = Nothing } = + error "fromProtocolParamsAlonzo: must specify protocolParamUTxOCostPerWord" +toAlonzoPParams ProtocolParameters { protocolParamPrices = Nothing } = + error "fromProtocolParamsAlonzo: must specify protocolParamPrices" +toAlonzoPParams ProtocolParameters { protocolParamMaxTxExUnits = Nothing } = + error "fromProtocolParamsAlonzo: must specify protocolParamMaxTxExUnits" +toAlonzoPParams ProtocolParameters { protocolParamMaxBlockExUnits = Nothing } = + error "fromProtocolParamsAlonzo: must specify protocolParamMaxBlockExUnits" +toAlonzoPParams ProtocolParameters { protocolParamMaxValueSize = Nothing } = + error "fromProtocolParamsAlonzo: must specify protocolParamMaxValueSize" + toAlonzoCostModels :: Map AnyPlutusScriptVersion CostModel diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 680eff25a47..ff411bf1bae 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -7,7 +7,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -199,6 +198,9 @@ import Cardano.Api.TxMetadata import Cardano.Api.Utils import Cardano.Api.Value +{- HLINT ignore "Redundant flip" -} +{- HLINT ignore "Use section" -} + -- ---------------------------------------------------------------------------- -- Transaction Ids