Filling in more Alonzo API extensions for the Tx and TxBody

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

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