Merge pull request #333 from input-output-hk/newhoggy/simplify-create…

…TransactionBody

Simplify `createTransactionBody`

cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs

@@ -79,6 +79,7 @@ type AlonzoEraOnwardsConstraints era =
   , L.AlonzoEraTx (ShelleyLedgerEra era)
   , L.AlonzoEraTxBody (ShelleyLedgerEra era)
   , L.AlonzoEraTxOut (ShelleyLedgerEra era)
+  , L.AlonzoEraTxOut (ShelleyLedgerEra era)
   , L.AlonzoEraTxWits (ShelleyLedgerEra era)
   , L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
   , L.Era (ShelleyLedgerEra era)
@@ -90,6 +91,7 @@ type AlonzoEraOnwardsConstraints era =
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.MaryEraTxBody (ShelleyLedgerEra era)
   , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
   , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Eon/BabbageEraOnly.hs

@@ -1,10 +1,12 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Cardano.Api.Eon.BabbageEraOnly
   ( BabbageEraOnly(..)
@@ -14,8 +16,30 @@ module Cardano.Api.Eon.BabbageEraOnly
   , BabbageEraOnlyConstraints
   ) where
 
+import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Core
+import           Cardano.Api.Modes
+import           Cardano.Api.Query.Types
 
+import           Cardano.Binary
+import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
+import qualified Cardano.Crypto.Hash.Class as C
+import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Alonzo.Language as L
+import qualified Cardano.Ledger.Alonzo.Scripts as L
+import qualified Cardano.Ledger.Alonzo.TxInfo as L
+import qualified Cardano.Ledger.Alonzo.UTxO as L
+import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.BaseTypes as L
+import qualified Cardano.Ledger.Core as L
+import qualified Cardano.Ledger.Mary.Value as L
+import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
+import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
+import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
+
+import           Data.Aeson
 import           Data.Typeable (Typeable)
 
 data BabbageEraOnly era where
@@ -39,7 +63,38 @@ instance ToCardanoEra BabbageEraOnly where
     BabbageEraOnlyBabbage  -> BabbageEra
 
 type BabbageEraOnlyConstraints era =
-  ( IsCardanoEra era
+  ( L.AlonzoEraTxOut (ShelleyLedgerEra era)
+  , C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era)))
+  , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed
+  , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
+  , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era)
+  , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.AlonzoEraTxOut (ShelleyLedgerEra era)
+  , L.BabbageEraPParams (ShelleyLedgerEra era)
+  , L.BabbageEraTxBody (ShelleyLedgerEra era)
+  , L.BabbageEraTxOut (ShelleyLedgerEra era)
+  , L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
+  , L.Era (ShelleyLedgerEra era)
+  , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
+  , L.EraPlutusContext 'L.PlutusV1 (ShelleyLedgerEra era)
+  , L.EraPParams (ShelleyLedgerEra era)
+  , L.EraTx (ShelleyLedgerEra era)
+  , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.ExtendedUTxO (ShelleyLedgerEra era)
+  , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.MaryEraTxBody (ShelleyLedgerEra era)
+  , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
+  , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
+  , L.ShelleyEraTxBody (ShelleyLedgerEra era)
+  , L.ShelleyEraTxCert (ShelleyLedgerEra era)
+  , L.Value (ShelleyLedgerEra era) ~ L.MaryValue L.StandardCrypto
+
+  , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
+  , FromCBOR (DebugLedgerState era)
+  , IsCardanoEra era
+  , IsShelleyBasedEra era
+  , ToJSON (DebugLedgerState era)
   , Typeable era
   )
 

cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs

@@ -71,6 +71,7 @@ type BabbageEraOnwardsConstraints era =
   , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
   , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era)
   , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.AlonzoEraTxOut (ShelleyLedgerEra era)
   , L.BabbageEraPParams (ShelleyLedgerEra era)
   , L.BabbageEraTxBody (ShelleyLedgerEra era)
   , L.BabbageEraTxOut (ShelleyLedgerEra era)
@@ -84,6 +85,7 @@ type BabbageEraOnwardsConstraints era =
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.MaryEraTxBody (ShelleyLedgerEra era)
   , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
   , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs

@@ -72,6 +72,7 @@ type ConwayEraOnwardsConstraints era =
   , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
   , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era)
   , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.AlonzoEraTxOut (ShelleyLedgerEra era)
   , L.BabbageEraTxBody (ShelleyLedgerEra era)
   , L.ConwayEraGov (ShelleyLedgerEra era)
   , L.ConwayEraPParams (ShelleyLedgerEra era)
@@ -88,6 +89,7 @@ type ConwayEraOnwardsConstraints era =
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.MaryEraTxBody (ShelleyLedgerEra era)
   , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
   , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Ledger/Lens.hs

@@ -11,16 +11,19 @@ module Cardano.Api.Ledger.Lens
   , invalidBeforeTxBodyL
   , invalidHereAfterTxBodyL
   , ttlAsInvalidHereAfterTxBodyL
+  , apiUpdateTxBodyL
   ) where
 
 import           Cardano.Api.Eon.AllegraEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eon.ShelleyEraOnly
+import           Cardano.Api.Eon.ShelleyToBabbageEra
 import           Cardano.Api.Eras.Case
 
 import qualified Cardano.Ledger.Allegra.Core as L
 import qualified Cardano.Ledger.Api as L
 import           Cardano.Ledger.BaseTypes (SlotNo, StrictMaybe (..))
+import qualified Cardano.Ledger.Shelley.PParams as L
 
 import           Lens.Micro
 
@@ -95,3 +98,6 @@ invalidHereAfterStrictL = lens g s
 
     s :: L.ValidityInterval -> StrictMaybe SlotNo -> L.ValidityInterval
     s (L.ValidityInterval a _) b = L.ValidityInterval a b
+
+apiUpdateTxBodyL :: ShelleyToBabbageEra era -> Lens' (L.TxBody (ShelleyLedgerEra era)) (StrictMaybe (L.Update (ShelleyLedgerEra era)))
+apiUpdateTxBodyL w = shelleyToBabbageEraConstraints w L.updateTxBodyL