Merge #2738

2738: Filling in more Alonzo API extensions for the Tx and TxBody r=dcoutts a=dcoutts



Co-authored-by: Duncan Coutts <duncan@well-typed.com>
Co-authored-by: Jordan Millar <jordan.millar@iohk.io>

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(..),
@@ -175,6 +174,7 @@ module Cardano.Api (
     TxMetadataInEra(..),
     TxAuxScripts(..),
     TxAuxScriptData(..),
+    TxExtraKeyWitnesses(..),
     TxWithdrawals(..),
     TxCertificates(..),
     TxUpdateProposal(..),
@@ -195,6 +195,7 @@ module Cardano.Api (
     ValidityLowerBoundSupportedInEra(..),
     TxMetadataSupportedInEra(..),
     AuxScriptsSupportedInEra(..),
+    TxExtraKeyWitnessesSupportedInEra(..),
     WithdrawalsSupportedInEra(..),
     CertificatesSupportedInEra(..),
     UpdateProposalSupportedInEra(..),
@@ -207,6 +208,7 @@ module Cardano.Api (
     validityLowerBoundSupportedInEra,
     txMetadataSupportedInEra,
     auxScriptsSupportedInEra,
+    extraKeyWitnessesSupportedInEra,
     withdrawalsSupportedInEra,
     certificatesSupportedInEra,
     updateProposalSupportedInEra,
@@ -225,7 +227,6 @@ module Cardano.Api (
     makeSignedTransaction,
     KeyWitness,
     makeByronKeyWitness,
-    makeByronTransaction,
     ShelleyWitnessSigningKey(..),
     makeShelleyKeyWitness,
     makeShelleyBootstrapWitness,

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
 --

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,146 @@ 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 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
+                                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 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
+  -> 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

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
 

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