{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Api.Internal.Experimental.Tx
  ( -- * Creating transactions using the new API

    -- |
    -- Both the old and new APIs can be used to create transactions, and
    -- it is possible to transform a transaction from one format to the other
    -- as they share the same representation. However, the focus will shift
    -- towards using the new API, while the old API will be deprecated to ensure
    -- simplicity, closer alignment with the ledger, and easier maintenance.
    --
    -- In both the new and old APIs, constructing a transaction requires creating
    -- a 'TxBodyContent', along with at least one witness (for example, a
    -- 'ShelleyWitnessSigningKey') to sign the transaction.
    -- This process remains unchanged.
    --
    -- To learn how to create a transaction using the old API, see the
    -- "Cardano.Api.Internal.Tx.Body" documentation.
    --
    -- In the examples below, the following qualified modules are used:
    --
    -- @
    -- import qualified Cardano.Api as Api                -- the general `cardano-api` exports (including the old API)
    -- import qualified Cardano.Api.Script as Script      -- types related to scripts (Plutus and native)
    -- import qualified Cardano.Api.Ledger as Ledger      -- cardano-ledger re-exports
    -- import qualified Cardano.Api.Experimental as Exp   -- the experimental API
    -- @
    --
    -- For instructions on how to do this, refer to the @Test.Cardano.Api.Experimental@ documentation.

    -- ** Creating a 'TxBodyContent'

    -- |
    -- Regardless of whether the experimental or the traditional API is used, creating a 'TxBodyContent'
    -- is necessary.
    --
    -- You can see how to do this in the documentation of the "Cardano.Api.Internal.Tx.Body" module.

    -- ** Balancing a transaction

    -- |
    -- If a UTXO has exactly 12 ada, the transaction could be constructed as described in
    -- "Cardano.Api.Internal.Tx.Body", and it would be valid. However:
    --
    --   * Ada may be wasted
    --   * The UTXO that we intend to spend may not contain exactly 12 ada
    --   * The transaction may not be this simple.
    --
    -- For these reasons, it is recommended to balance the transaction before proceeding with
    -- signing and submitting.
    --
    -- For instructions on how to balance a transaction, refer to the "Cardano.Api.Internal.Fees" documentation.

    -- ** Creating a 'ShelleyWitnessSigningKey'

    -- |
    -- Signing a transaction requires a witness, such as a 'ShelleyWitnessSigningKey'.
    --
    -- For instructions on creating a 'ShelleyWitnessSigningKey' refer to the "Cardano.Api.Internal.Tx.Sign" documentation.

    -- ** Creating a transaction using the new API

    -- |
    -- This section outlines how to create a transaction using the new API. First,
    -- create an 'UnsignedTx' using the 'makeUnsignedTx' function and the 'Era' and
    -- 'TxBodyContent' that we defined earlier:
    --
    -- @
    -- let (Right unsignedTx) = Exp.makeUnsignedTx era txBodyContent
    -- @
    --
    -- Next, use the key witness to sign the unsigned transaction with the 'makeKeyWitness' function:
    --
    -- @
    -- let transactionWitness = Exp.makeKeyWitness era unsignedTx (Api.WitnessPaymentKey signingKey)
    -- @
    --
    -- Finally, sign the transaction using the 'signTx' function:
    --
    -- @
    -- let newApiSignedTx :: Ledger.Tx (Exp.LedgerEra Exp.ConwayEra) = Exp.signTx era [] [transactionWitness] unsignedTx
    -- @
    --
    -- The empty list represents the bootstrap witnesses, which are not needed in this case.
    --
    -- The transaction is now signed.

    -- ** Converting a transaction from the new API to the old API

    -- |
    -- A transaction created with the new API can be easily converted to the old API by
    -- wrapping it with the 'ShelleyTx' constructor:
    --
    -- @
    -- let oldStyleTx :: Api.Tx Api.ConwayEra = ShelleyTx sbe newApiSignedTx
    -- @

    -- ** Inspecting transactions

    -- |
    -- When using a 'Tx' created with the experimental API, the 'TxBody' and
    -- 'TxWits' can be extracted using the 'txBody' and 'txWits' lenses from
    -- "Cardano.Api.Ledger" respectively.

    -- * Contents
    UnsignedTx (..)
  , UnsignedTxError (..)
  , makeUnsignedTx
  , makeKeyWitness
  , signTx
  , convertTxBodyToUnsignedTx
  , hashTxBody
  )
where

import Cardano.Api.Internal.Eon.Convert
import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Eras.Core (ToCardanoEra (toCardanoEra), forEraInEon)
import Cardano.Api.Internal.Experimental.Eras
import Cardano.Api.Internal.Experimental.Witness.TxScriptWitnessRequirements
import Cardano.Api.Internal.Feature
import Cardano.Api.Internal.Pretty (docToString, pretty)
import Cardano.Api.Internal.ReexposeLedger (StrictMaybe (..), maybeToStrictMaybe)
import Cardano.Api.Internal.ReexposeLedger qualified as L
import Cardano.Api.Internal.Tx.Body
import Cardano.Api.Internal.Tx.Sign

import Cardano.Crypto.Hash qualified as Hash
import Cardano.Ledger.Alonzo.TxBody qualified as L
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Babbage qualified as Ledger
import Cardano.Ledger.Conway qualified as Ledger
import Cardano.Ledger.Conway.TxBody qualified as L
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Hashes qualified as L hiding (Hash)

import Data.Set qualified as Set
import GHC.Exts (IsList (..))
import GHC.Stack
import Lens.Micro

-- | A transaction that can contain everything
-- except key witnesses.
newtype UnsignedTx era
  = UnsignedTx (Ledger.Tx (LedgerEra era))

instance IsEra era => Show (UnsignedTx era) where
  showsPrec :: Int -> UnsignedTx era -> ShowS
showsPrec Int
p (UnsignedTx Tx (LedgerEra era)
tx) = case forall era. IsEra era => Era era
useEra @era of
    Era era
BabbageEra -> Int -> AlonzoTx BabbageEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Tx BabbageEra
Tx (LedgerEra era)
tx :: Ledger.Tx Ledger.BabbageEra)
    Era era
ConwayEra -> Int -> AlonzoTx ConwayEra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Tx ConwayEra
Tx (LedgerEra era)
tx :: Ledger.Tx Ledger.ConwayEra)

newtype UnsignedTxError
  = UnsignedTxError TxBodyError

makeUnsignedTx
  :: Era era
  -> TxBodyContent BuildTx era
  -> Either TxBodyError (UnsignedTx era)
makeUnsignedTx :: forall era.
Era era
-> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era)
makeUnsignedTx Era era
era TxBodyContent BuildTx era
bc = Era era
-> (EraCommonConstraints era =>
    Either TxBodyError (UnsignedTx era))
-> Either TxBodyError (UnsignedTx era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => Either TxBodyError (UnsignedTx era))
 -> Either TxBodyError (UnsignedTx era))
-> (EraCommonConstraints era =>
    Either TxBodyError (UnsignedTx era))
-> Either TxBodyError (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$ do
  let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
      aeon :: AlonzoEraOnwards era
aeon = Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
  TxScriptWitnessRequirements Set Language
languages [Script (LedgerEra era)]
scripts TxDats (LedgerEra era)
datums Redeemers (LedgerEra era)
redeemers <-
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either TxBodyError (TxScriptWitnessRequirements (LedgerEra era)))
-> Either TxBodyError (TxScriptWitnessRequirements (LedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either TxBodyError (TxScriptWitnessRequirements (LedgerEra era)))
 -> Either
      TxBodyError (TxScriptWitnessRequirements (LedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    Either TxBodyError (TxScriptWitnessRequirements (LedgerEra era)))
-> Either TxBodyError (TxScriptWitnessRequirements (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
      AlonzoEraOnwards era
-> TxBodyContent BuildTx era
-> Either
     TxBodyError (TxScriptWitnessRequirements (ShelleyLedgerEra era))
forall era.
IsShelleyBasedEra era =>
AlonzoEraOnwards era
-> TxBodyContent BuildTx era
-> Either
     TxBodyError (TxScriptWitnessRequirements (ShelleyLedgerEra era))
collectTxBodyScriptWitnessRequirements (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) TxBodyContent BuildTx era
bc

  -- cardano-api types
  let apiTxOuts :: [TxOut CtxTx era]
apiTxOuts = TxBodyContent BuildTx era -> [TxOut CtxTx era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent BuildTx era
bc
      apiScriptValidity :: TxScriptValidity era
apiScriptValidity = TxBodyContent BuildTx era -> TxScriptValidity era
forall build era. TxBodyContent build era -> TxScriptValidity era
txScriptValidity TxBodyContent BuildTx era
bc
      apiMintValue :: TxMintValue BuildTx era
apiMintValue = TxBodyContent BuildTx era -> TxMintValue BuildTx era
forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue TxBodyContent BuildTx era
bc
      apiProtocolParameters :: BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
apiProtocolParameters = TxBodyContent BuildTx era
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
forall build era.
TxBodyContent build era
-> BuildTxWith build (Maybe (LedgerProtocolParameters era))
txProtocolParams TxBodyContent BuildTx era
bc
      apiCollateralTxIns :: TxInsCollateral era
apiCollateralTxIns = TxBodyContent BuildTx era -> TxInsCollateral era
forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral TxBodyContent BuildTx era
bc
      apiReferenceInputs :: TxInsReference era
apiReferenceInputs = TxBodyContent BuildTx era -> TxInsReference era
forall build era. TxBodyContent build era -> TxInsReference era
txInsReference TxBodyContent BuildTx era
bc
      apiExtraKeyWitnesses :: TxExtraKeyWitnesses era
apiExtraKeyWitnesses = TxBodyContent BuildTx era -> TxExtraKeyWitnesses era
forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits TxBodyContent BuildTx era
bc
      apiReturnCollateral :: TxReturnCollateral CtxTx era
apiReturnCollateral = TxBodyContent BuildTx era -> TxReturnCollateral CtxTx era
forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txReturnCollateral TxBodyContent BuildTx era
bc
      apiTotalCollateral :: TxTotalCollateral era
apiTotalCollateral = TxBodyContent BuildTx era -> TxTotalCollateral era
forall build era. TxBodyContent build era -> TxTotalCollateral era
txTotalCollateral TxBodyContent BuildTx era
bc

      -- Ledger types
      txins :: Set TxIn
txins = TxIns BuildTx era -> Set TxIn
forall era. TxIns BuildTx era -> Set TxIn
convTxIns (TxIns BuildTx era -> Set TxIn) -> TxIns BuildTx era -> Set TxIn
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxIns BuildTx era
forall build era. TxBodyContent build era -> TxIns build era
txIns TxBodyContent BuildTx era
bc
      collTxIns :: Set TxIn
collTxIns = TxInsCollateral era -> Set TxIn
forall era. TxInsCollateral era -> Set TxIn
convCollateralTxIns TxInsCollateral era
apiCollateralTxIns
      refTxIns :: Set TxIn
refTxIns = TxInsReference era -> Set TxIn
forall era. TxInsReference era -> Set TxIn
convReferenceInputs TxInsReference era
apiReferenceInputs
      outs :: StrictSeq (TxOut (LedgerEra era))
outs = ShelleyBasedEra era
-> [TxOut CtxTx era] -> StrictSeq (TxOut (LedgerEra era))
forall ctx era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> [TxOut ctx era] -> StrictSeq (TxOut ledgerera)
convTxOuts ShelleyBasedEra era
sbe [TxOut CtxTx era]
apiTxOuts
      fee :: Coin
fee = ShelleyBasedEra era -> TxFee era -> Coin
forall era. ShelleyBasedEra era -> TxFee era -> Coin
convTransactionFee ShelleyBasedEra era
sbe (TxFee era -> Coin) -> TxFee era -> Coin
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxFee era
forall build era. TxBodyContent build era -> TxFee era
txFee TxBodyContent BuildTx era
bc
      withdrawals :: Withdrawals
withdrawals = TxWithdrawals BuildTx era -> Withdrawals
forall build era. TxWithdrawals build era -> Withdrawals
convWithdrawals (TxWithdrawals BuildTx era -> Withdrawals)
-> TxWithdrawals BuildTx era -> Withdrawals
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxWithdrawals BuildTx era
forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals TxBodyContent BuildTx era
bc
      returnCollateral :: StrictMaybe (TxOut (ShelleyLedgerEra era))
returnCollateral = ShelleyBasedEra era
-> TxReturnCollateral CtxTx era
-> StrictMaybe (TxOut (ShelleyLedgerEra era))
forall era ctx.
ShelleyBasedEra era
-> TxReturnCollateral ctx era
-> StrictMaybe (TxOut (ShelleyLedgerEra era))
convReturnCollateral ShelleyBasedEra era
sbe TxReturnCollateral CtxTx era
apiReturnCollateral
      totalCollateral :: StrictMaybe Coin
totalCollateral = TxTotalCollateral era -> StrictMaybe Coin
forall era. TxTotalCollateral era -> StrictMaybe Coin
convTotalCollateral TxTotalCollateral era
apiTotalCollateral
      certs :: StrictSeq (TxCert (ShelleyLedgerEra era))
certs = ShelleyBasedEra era
-> TxCertificates BuildTx era
-> StrictSeq (TxCert (ShelleyLedgerEra era))
forall era build.
ShelleyBasedEra era
-> TxCertificates build era
-> StrictSeq (TxCert (ShelleyLedgerEra era))
convCertificates ShelleyBasedEra era
sbe (TxCertificates BuildTx era
 -> StrictSeq (TxCert (ShelleyLedgerEra era)))
-> TxCertificates BuildTx era
-> StrictSeq (TxCert (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxCertificates BuildTx era
forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates TxBodyContent BuildTx era
bc
      txAuxData :: Maybe (TxAuxData (ShelleyLedgerEra era))
txAuxData = ShelleyBasedEra era
-> TxMetadataInEra era
-> TxAuxScripts era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> TxMetadataInEra era
-> TxAuxScripts era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
toAuxiliaryData ShelleyBasedEra era
sbe (TxBodyContent BuildTx era -> TxMetadataInEra era
forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata TxBodyContent BuildTx era
bc) (TxBodyContent BuildTx era -> TxAuxScripts era
forall build era. TxBodyContent build era -> TxAuxScripts era
txAuxScripts TxBodyContent BuildTx era
bc)
      scriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
scriptIntegrityHash =
        AlonzoEraOnwards era
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
-> Redeemers (ShelleyLedgerEra era)
-> TxDats (ShelleyLedgerEra era)
-> Set Language
-> StrictMaybe ScriptIntegrityHash
forall era.
AlonzoEraOnwards era
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
-> Redeemers (ShelleyLedgerEra era)
-> TxDats (ShelleyLedgerEra era)
-> Set Language
-> StrictMaybe ScriptIntegrityHash
convPParamsToScriptIntegrityHash
          AlonzoEraOnwards era
aeon
          BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))
apiProtocolParameters
          Redeemers (ShelleyLedgerEra era)
Redeemers (LedgerEra era)
redeemers
          TxDats (ShelleyLedgerEra era)
TxDats (LedgerEra era)
datums
          Set Language
languages

  let setMint :: MultiAsset
setMint = TxMintValue BuildTx era -> MultiAsset
forall build era. TxMintValue build era -> MultiAsset
convMintValue TxMintValue BuildTx era
apiMintValue
      setReqSignerHashes :: Set (KeyHash 'Witness)
setReqSignerHashes = TxExtraKeyWitnesses era -> Set (KeyHash 'Witness)
forall era. TxExtraKeyWitnesses era -> Set (KeyHash 'Witness)
convExtraKeyWitnesses TxExtraKeyWitnesses era
apiExtraKeyWitnesses
      ledgerTxBody :: TxBody (LedgerEra era)
ledgerTxBody =
        TxBody (LedgerEra era)
forall era. EraTxBody era => TxBody era
L.mkBasicTxBody
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody (LedgerEra era)) (Set TxIn)
L.inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Set TxIn -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
txins
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody (LedgerEra era)) (Set TxIn)
L.collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Set TxIn -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
collTxIns
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody (LedgerEra era)) (Set TxIn)
L.referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Set TxIn -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
refTxIns
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut (LedgerEra era))
 -> Identity (StrictSeq (TxOut (LedgerEra era))))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody (LedgerEra era)) (StrictSeq (TxOut (LedgerEra era)))
L.outputsTxBodyL ((StrictSeq (TxOut (LedgerEra era))
  -> Identity (StrictSeq (TxOut (LedgerEra era))))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> StrictSeq (TxOut (LedgerEra era))
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut (LedgerEra era))
outs
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody (LedgerEra era)) (StrictMaybe Coin)
L.totalCollateralTxBodyL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> StrictMaybe Coin
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
totalCollateral
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxOut (LedgerEra era))
 -> Identity (StrictMaybe (TxOut (LedgerEra era))))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens'
  (TxBody (LedgerEra era)) (StrictMaybe (TxOut (LedgerEra era)))
L.collateralReturnTxBodyL ((StrictMaybe (TxOut (LedgerEra era))
  -> Identity (StrictMaybe (TxOut (LedgerEra era))))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> StrictMaybe (TxOut (LedgerEra era))
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (TxOut (ShelleyLedgerEra era))
StrictMaybe (TxOut (LedgerEra era))
returnCollateral
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (LedgerEra era)) Coin
L.feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Coin -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody (LedgerEra era)) ValidityInterval
L.vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> ((Maybe SlotNo -> Identity (Maybe SlotNo))
    -> ValidityInterval -> Identity ValidityInterval)
-> (Maybe SlotNo -> Identity (Maybe SlotNo))
-> TxBody (LedgerEra era)
-> Identity (TxBody (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SlotNo -> Identity (Maybe SlotNo))
-> ValidityInterval -> Identity ValidityInterval
Lens' ValidityInterval (Maybe SlotNo)
L.invalidBeforeL ((Maybe SlotNo -> Identity (Maybe SlotNo))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Maybe SlotNo -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxValidityLowerBound era -> Maybe SlotNo
forall era. TxValidityLowerBound era -> Maybe SlotNo
convValidityLowerBound (TxBodyContent BuildTx era -> TxValidityLowerBound era
forall build era.
TxBodyContent build era -> TxValidityLowerBound era
txValidityLowerBound TxBodyContent BuildTx era
bc)
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody (LedgerEra era)) ValidityInterval
L.vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> ((Maybe SlotNo -> Identity (Maybe SlotNo))
    -> ValidityInterval -> Identity ValidityInterval)
-> (Maybe SlotNo -> Identity (Maybe SlotNo))
-> TxBody (LedgerEra era)
-> Identity (TxBody (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SlotNo -> Identity (Maybe SlotNo))
-> ValidityInterval -> Identity ValidityInterval
Lens' ValidityInterval (Maybe SlotNo)
L.invalidHereAfterL ((Maybe SlotNo -> Identity (Maybe SlotNo))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Maybe SlotNo -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era -> TxValidityUpperBound era -> Maybe SlotNo
forall era.
ShelleyBasedEra era -> TxValidityUpperBound era -> Maybe SlotNo
convValidityUpperBound ShelleyBasedEra era
sbe (TxBodyContent BuildTx era -> TxValidityUpperBound era
forall build era.
TxBodyContent build era -> TxValidityUpperBound era
txValidityUpperBound TxBodyContent BuildTx era
bc)
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
Lens' (TxBody (LedgerEra era)) (Set (KeyHash 'Witness))
L.reqSignerHashesTxBodyL ((Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Set (KeyHash 'Witness)
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness)
setReqSignerHashes
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody (LedgerEra era)) (StrictMaybe ScriptIntegrityHash)
L.scriptIntegrityHashTxBodyL ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> StrictMaybe ScriptIntegrityHash
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
scriptIntegrityHash
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody (LedgerEra era)) Withdrawals
L.withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> Withdrawals -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
withdrawals
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert (LedgerEra era))
 -> Identity (StrictSeq (TxCert (LedgerEra era))))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody (LedgerEra era)) (StrictSeq (TxCert (LedgerEra era)))
L.certsTxBodyL ((StrictSeq (TxCert (LedgerEra era))
  -> Identity (StrictSeq (TxCert (LedgerEra era))))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> StrictSeq (TxCert (LedgerEra era))
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert (ShelleyLedgerEra era))
StrictSeq (TxCert (LedgerEra era))
certs
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (MultiAsset -> Identity MultiAsset)
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody (LedgerEra era)) MultiAsset
L.mintTxBodyL ((MultiAsset -> Identity MultiAsset)
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> MultiAsset -> TxBody (LedgerEra era) -> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
setMint
          TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe TxAuxDataHash -> Identity (StrictMaybe TxAuxDataHash))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
Lens' (TxBody (LedgerEra era)) (StrictMaybe TxAuxDataHash)
L.auxDataHashTxBodyL ((StrictMaybe TxAuxDataHash
  -> Identity (StrictMaybe TxAuxDataHash))
 -> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> StrictMaybe TxAuxDataHash
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
-> (TxAuxData (LedgerEra era) -> StrictMaybe TxAuxDataHash)
-> Maybe (TxAuxData (LedgerEra era))
-> StrictMaybe TxAuxDataHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing (TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a. a -> StrictMaybe a
SJust (TxAuxDataHash -> StrictMaybe TxAuxDataHash)
-> (TxAuxData (LedgerEra era) -> TxAuxDataHash)
-> TxAuxData (LedgerEra era)
-> StrictMaybe TxAuxDataHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxAuxData (LedgerEra era) -> TxAuxDataHash
forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
Ledger.hashTxAuxData) Maybe (TxAuxData (ShelleyLedgerEra era))
Maybe (TxAuxData (LedgerEra era))
txAuxData

      scriptWitnesses :: TxWits (LedgerEra era)
scriptWitnesses =
        TxWits (LedgerEra era)
forall era. EraTxWits era => TxWits era
L.mkBasicTxWits
          TxWits (LedgerEra era)
-> (TxWits (LedgerEra era) -> TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script (LedgerEra era))
 -> Identity (Map ScriptHash (Script (LedgerEra era))))
-> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens'
  (TxWits (LedgerEra era)) (Map ScriptHash (Script (LedgerEra era)))
L.scriptTxWitsL
            ((Map ScriptHash (Script (LedgerEra era))
  -> Identity (Map ScriptHash (Script (LedgerEra era))))
 -> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Map ScriptHash (Script (LedgerEra era))
-> TxWits (LedgerEra era)
-> TxWits (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Map ScriptHash (Script (LedgerEra era)))]
-> Map ScriptHash (Script (LedgerEra era))
forall l. IsList l => [Item l] -> l
fromList
              [ (Script (LedgerEra era) -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript Script (LedgerEra era)
sw, Script (LedgerEra era)
sw)
              | Script (LedgerEra era)
sw <- [Script (LedgerEra era)]
scripts
              ]
          TxWits (LedgerEra era)
-> (TxWits (LedgerEra era) -> TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxDats (LedgerEra era) -> Identity (TxDats (LedgerEra era)))
-> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era))
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits (LedgerEra era)) (TxDats (LedgerEra era))
L.datsTxWitsL ((TxDats (LedgerEra era) -> Identity (TxDats (LedgerEra era)))
 -> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> TxDats (LedgerEra era)
-> TxWits (LedgerEra era)
-> TxWits (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxDats (LedgerEra era)
datums
          TxWits (LedgerEra era)
-> (TxWits (LedgerEra era) -> TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Redeemers (LedgerEra era) -> Identity (Redeemers (LedgerEra era)))
-> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits (LedgerEra era)) (Redeemers (LedgerEra era))
L.rdmrsTxWitsL ((Redeemers (LedgerEra era)
  -> Identity (Redeemers (LedgerEra era)))
 -> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Redeemers (LedgerEra era)
-> TxWits (LedgerEra era)
-> TxWits (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers (LedgerEra era)
redeemers

  TxBody (LedgerEra era)
eraSpecificTxBody <- Era era
-> TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> Either TxBodyError (TxBody (LedgerEra era))
forall era.
Era era
-> TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> Either TxBodyError (TxBody (LedgerEra era))
eraSpecificLedgerTxBody Era era
era TxBody (LedgerEra era)
ledgerTxBody TxBodyContent BuildTx era
bc

  UnsignedTx era -> Either TxBodyError (UnsignedTx era)
forall a. a -> Either TxBodyError a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnsignedTx era -> Either TxBodyError (UnsignedTx era))
-> (Tx (LedgerEra era) -> UnsignedTx era)
-> Tx (LedgerEra era)
-> Either TxBodyError (UnsignedTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (LedgerEra era) -> UnsignedTx era
forall era. Tx (LedgerEra era) -> UnsignedTx era
UnsignedTx (Tx (LedgerEra era) -> Either TxBodyError (UnsignedTx era))
-> Tx (LedgerEra era) -> Either TxBodyError (UnsignedTx era)
forall a b. (a -> b) -> a -> b
$
    TxBody (LedgerEra era) -> Tx (LedgerEra era)
forall era. EraTx era => TxBody era -> Tx era
L.mkBasicTx TxBody (LedgerEra era)
eraSpecificTxBody
      Tx (LedgerEra era)
-> (Tx (LedgerEra era) -> Tx (LedgerEra era)) -> Tx (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (LedgerEra era)) (TxWits (LedgerEra era))
L.witsTxL ((TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
 -> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era)))
-> TxWits (LedgerEra era)
-> Tx (LedgerEra era)
-> Tx (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits (LedgerEra era)
scriptWitnesses
      Tx (LedgerEra era)
-> (Tx (LedgerEra era) -> Tx (LedgerEra era)) -> Tx (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData (LedgerEra era))
 -> Identity (StrictMaybe (TxAuxData (LedgerEra era))))
-> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
Lens'
  (Tx (LedgerEra era)) (StrictMaybe (TxAuxData (LedgerEra era)))
L.auxDataTxL ((StrictMaybe (TxAuxData (LedgerEra era))
  -> Identity (StrictMaybe (TxAuxData (LedgerEra era))))
 -> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era)))
-> StrictMaybe (TxAuxData (LedgerEra era))
-> Tx (LedgerEra era)
-> Tx (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (TxAuxData (LedgerEra era))
-> StrictMaybe (TxAuxData (LedgerEra era))
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (ShelleyBasedEra era
-> TxMetadataInEra era
-> TxAuxScripts era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> TxMetadataInEra era
-> TxAuxScripts era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
toAuxiliaryData ShelleyBasedEra era
sbe (TxBodyContent BuildTx era -> TxMetadataInEra era
forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata TxBodyContent BuildTx era
bc) (TxBodyContent BuildTx era -> TxAuxScripts era
forall build era. TxBodyContent build era -> TxAuxScripts era
txAuxScripts TxBodyContent BuildTx era
bc))
      Tx (LedgerEra era)
-> (Tx (LedgerEra era) -> Tx (LedgerEra era)) -> Tx (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid)
-> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era))
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx (LedgerEra era)) IsValid
L.isValidTxL ((IsValid -> Identity IsValid)
 -> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era)))
-> IsValid -> Tx (LedgerEra era) -> Tx (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxScriptValidity era -> IsValid
forall era. TxScriptValidity era -> IsValid
txScriptValidityToIsValid TxScriptValidity era
apiScriptValidity

eraSpecificLedgerTxBody
  :: Era era
  -> Ledger.TxBody (LedgerEra era)
  -> TxBodyContent BuildTx era
  -> Either TxBodyError (Ledger.TxBody (LedgerEra era))
eraSpecificLedgerTxBody :: forall era.
Era era
-> TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> Either TxBodyError (TxBody (LedgerEra era))
eraSpecificLedgerTxBody Era era
BabbageEra TxBody (LedgerEra era)
ledgerbody TxBodyContent BuildTx era
bc = do
  let sbe :: ShelleyBasedEra BabbageEra
sbe = Era BabbageEra -> ShelleyBasedEra BabbageEra
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era BabbageEra
BabbageEra

  StrictMaybe (Update BabbageEra)
setUpdateProposal <- ShelleyBasedEra BabbageEra
-> TxUpdateProposal BabbageEra
-> Either
     TxBodyError (StrictMaybe (Update (ShelleyLedgerEra BabbageEra)))
forall era.
ShelleyBasedEra era
-> TxUpdateProposal era
-> Either TxBodyError (StrictMaybe (Update (ShelleyLedgerEra era)))
convTxUpdateProposal ShelleyBasedEra BabbageEra
sbe (TxBodyContent BuildTx BabbageEra -> TxUpdateProposal BabbageEra
forall build era. TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal TxBodyContent BuildTx era
TxBodyContent BuildTx BabbageEra
bc)

  BabbageTxBody BabbageEra
-> Either TxBodyError (BabbageTxBody BabbageEra)
forall a. a -> Either TxBodyError a
forall (m :: * -> *) a. Monad m => a -> m a
return (BabbageTxBody BabbageEra
 -> Either TxBodyError (BabbageTxBody BabbageEra))
-> BabbageTxBody BabbageEra
-> Either TxBodyError (BabbageTxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$ TxBody (LedgerEra era)
BabbageTxBody BabbageEra
ledgerbody BabbageTxBody BabbageEra
-> (BabbageTxBody BabbageEra -> BabbageTxBody BabbageEra)
-> BabbageTxBody BabbageEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Update BabbageEra)
 -> Identity (StrictMaybe (Update BabbageEra)))
-> TxBody BabbageEra -> Identity (TxBody BabbageEra)
(StrictMaybe (Update BabbageEra)
 -> Identity (StrictMaybe (Update BabbageEra)))
-> BabbageTxBody BabbageEra -> Identity (BabbageTxBody BabbageEra)
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody BabbageEra) (StrictMaybe (Update BabbageEra))
L.updateTxBodyL ((StrictMaybe (Update BabbageEra)
  -> Identity (StrictMaybe (Update BabbageEra)))
 -> BabbageTxBody BabbageEra -> Identity (BabbageTxBody BabbageEra))
-> StrictMaybe (Update BabbageEra)
-> BabbageTxBody BabbageEra
-> BabbageTxBody BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Update BabbageEra)
setUpdateProposal
eraSpecificLedgerTxBody Era era
ConwayEra TxBody (LedgerEra era)
ledgerbody TxBodyContent BuildTx era
bc =
  let propProcedures :: Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
propProcedures = TxBodyContent BuildTx era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
forall build era.
TxBodyContent build era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures build era))
txProposalProcedures TxBodyContent BuildTx era
bc
      voteProcedures :: Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
voteProcedures = TxBodyContent BuildTx era
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
forall build era.
TxBodyContent build era
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures build era))
txVotingProcedures TxBodyContent BuildTx era
bc
      treasuryDonation :: Maybe (Featured ConwayEraOnwards era Coin)
treasuryDonation = TxBodyContent BuildTx era
-> Maybe (Featured ConwayEraOnwards era Coin)
forall build era.
TxBodyContent build era
-> Maybe (Featured ConwayEraOnwards era Coin)
txTreasuryDonation TxBodyContent BuildTx era
bc
      currentTresuryValue :: Maybe (Featured ConwayEraOnwards era (Maybe Coin))
currentTresuryValue = TxBodyContent BuildTx era
-> Maybe (Featured ConwayEraOnwards era (Maybe Coin))
forall build era.
TxBodyContent build era
-> Maybe (Featured ConwayEraOnwards era (Maybe Coin))
txCurrentTreasuryValue TxBodyContent BuildTx era
bc
   in TxBody (LedgerEra era)
-> Either TxBodyError (TxBody (LedgerEra era))
forall a. a -> Either TxBodyError a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBody (LedgerEra era)
 -> Either TxBodyError (TxBody (LedgerEra era)))
-> TxBody (LedgerEra era)
-> Either TxBodyError (TxBody (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        TxBody (LedgerEra era)
ConwayTxBody ConwayEra
ledgerbody
          ConwayTxBody ConwayEra
-> (ConwayTxBody ConwayEra -> ConwayTxBody ConwayEra)
-> ConwayTxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (OSet (ProposalProcedure ConwayEra)
 -> Identity (OSet (ProposalProcedure ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
(OSet (ProposalProcedure ConwayEra)
 -> Identity (OSet (ProposalProcedure ConwayEra)))
-> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody ConwayEra) (OSet (ProposalProcedure ConwayEra))
L.proposalProceduresTxBodyL
            ((OSet (ProposalProcedure ConwayEra)
  -> Identity (OSet (ProposalProcedure ConwayEra)))
 -> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra))
-> OSet (ProposalProcedure ConwayEra)
-> ConwayTxBody ConwayEra
-> ConwayTxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxProposalProcedures BuildTx era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall build era.
TxProposalProcedures build era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
convProposalProcedures (TxProposalProcedures BuildTx era
-> (Featured
      ConwayEraOnwards era (TxProposalProcedures BuildTx era)
    -> TxProposalProcedures BuildTx era)
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
-> TxProposalProcedures BuildTx era
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxProposalProcedures BuildTx era
forall build era. TxProposalProcedures build era
TxProposalProceduresNone Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era)
-> TxProposalProcedures BuildTx era
forall (eon :: * -> *) era a. Featured eon era a -> a
unFeatured Maybe
  (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
propProcedures)
          ConwayTxBody ConwayEra
-> (ConwayTxBody ConwayEra -> ConwayTxBody ConwayEra)
-> ConwayTxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (VotingProcedures ConwayEra
 -> Identity (VotingProcedures ConwayEra))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
(VotingProcedures ConwayEra
 -> Identity (VotingProcedures ConwayEra))
-> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody ConwayEra) (VotingProcedures ConwayEra)
L.votingProceduresTxBodyL
            ((VotingProcedures ConwayEra
  -> Identity (VotingProcedures ConwayEra))
 -> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra))
-> VotingProcedures ConwayEra
-> ConwayTxBody ConwayEra
-> ConwayTxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxVotingProcedures BuildTx era
-> VotingProcedures (ShelleyLedgerEra era)
forall build era.
TxVotingProcedures build era
-> VotingProcedures (ShelleyLedgerEra era)
convVotingProcedures (TxVotingProcedures BuildTx era
-> (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era)
    -> TxVotingProcedures BuildTx era)
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
-> TxVotingProcedures BuildTx era
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxVotingProcedures BuildTx era
forall build era. TxVotingProcedures build era
TxVotingProceduresNone Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era)
-> TxVotingProcedures BuildTx era
forall (eon :: * -> *) era a. Featured eon era a -> a
unFeatured Maybe
  (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
voteProcedures)
          ConwayTxBody ConwayEra
-> (ConwayTxBody ConwayEra -> ConwayTxBody ConwayEra)
-> ConwayTxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
(Coin -> Identity Coin)
-> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra)
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody ConwayEra) Coin
L.treasuryDonationTxBodyL ((Coin -> Identity Coin)
 -> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra))
-> Coin -> ConwayTxBody ConwayEra -> ConwayTxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
-> (Featured ConwayEraOnwards era Coin -> Coin)
-> Maybe (Featured ConwayEraOnwards era Coin)
-> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer -> Coin
L.Coin Integer
0) Featured ConwayEraOnwards era Coin -> Coin
forall (eon :: * -> *) era a. Featured eon era a -> a
unFeatured Maybe (Featured ConwayEraOnwards era Coin)
treasuryDonation
          ConwayTxBody ConwayEra
-> (ConwayTxBody ConwayEra -> ConwayTxBody ConwayEra)
-> ConwayTxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
(StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody ConwayEra) (StrictMaybe Coin)
L.currentTreasuryValueTxBodyL
            ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra))
-> StrictMaybe Coin
-> ConwayTxBody ConwayEra
-> ConwayTxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Featured ConwayEraOnwards era (Maybe Coin) -> Maybe Coin
forall (eon :: * -> *) era a. Featured eon era a -> a
unFeatured (Featured ConwayEraOnwards era (Maybe Coin) -> Maybe Coin)
-> Maybe (Featured ConwayEraOnwards era (Maybe Coin)) -> Maybe Coin
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Featured ConwayEraOnwards era (Maybe Coin))
currentTresuryValue)

hashTxBody
  :: L.HashAnnotated (Ledger.TxBody era) L.EraIndependentTxBody
  => L.TxBody era -> Hash.Hash L.HASH L.EraIndependentTxBody
hashTxBody :: forall era.
HashAnnotated (TxBody era) EraIndependentTxBody =>
TxBody era -> Hash HASH EraIndependentTxBody
hashTxBody = SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
L.extractHash (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody)
-> (TxBody era -> SafeHash EraIndependentTxBody)
-> TxBody era
-> Hash HASH EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
L.hashAnnotated

makeKeyWitness
  :: Era era
  -> UnsignedTx era
  -> ShelleyWitnessSigningKey
  -> L.WitVKey L.Witness
makeKeyWitness :: forall era.
Era era
-> UnsignedTx era -> ShelleyWitnessSigningKey -> WitVKey 'Witness
makeKeyWitness Era era
era (UnsignedTx Tx (LedgerEra era)
unsignedTx) ShelleyWitnessSigningKey
wsk =
  Era era
-> (EraCommonConstraints era => WitVKey 'Witness)
-> WitVKey 'Witness
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => WitVKey 'Witness)
 -> WitVKey 'Witness)
-> (EraCommonConstraints era => WitVKey 'Witness)
-> WitVKey 'Witness
forall a b. (a -> b) -> a -> b
$
    let txbody :: TxBody (LedgerEra era)
txbody = Tx (LedgerEra era)
unsignedTx Tx (LedgerEra era)
-> Getting
     (TxBody (LedgerEra era))
     (Tx (LedgerEra era))
     (TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (LedgerEra era))
  (Tx (LedgerEra era))
  (TxBody (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (LedgerEra era)) (TxBody (LedgerEra era))
L.bodyTxL
        txhash :: Hash.Hash L.HASH L.EraIndependentTxBody
        txhash :: Hash HASH EraIndependentTxBody
txhash = Era era
-> (EraCommonConstraints era => Hash HASH EraIndependentTxBody)
-> Hash HASH EraIndependentTxBody
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => Hash HASH EraIndependentTxBody)
 -> Hash HASH EraIndependentTxBody)
-> (EraCommonConstraints era => Hash HASH EraIndependentTxBody)
-> Hash HASH EraIndependentTxBody
forall a b. (a -> b) -> a -> b
$ TxBody (LedgerEra era) -> Hash HASH EraIndependentTxBody
forall era.
HashAnnotated (TxBody era) EraIndependentTxBody =>
TxBody era -> Hash HASH EraIndependentTxBody
hashTxBody TxBody (LedgerEra era)
txbody
        sk :: ShelleySigningKey
sk = ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey ShelleyWitnessSigningKey
wsk
        vk :: VKey 'Witness
vk = ShelleySigningKey -> VKey 'Witness
getShelleyKeyWitnessVerificationKey ShelleySigningKey
sk
        signature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature = Hash HASH EraIndependentTxBody
-> ShelleySigningKey
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
forall tosign.
SignableRepresentation tosign =>
tosign -> ShelleySigningKey -> SignedDSIGN DSIGN tosign
makeShelleySignature Hash HASH EraIndependentTxBody
txhash ShelleySigningKey
sk
     in VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> WitVKey 'Witness
forall (kr :: KeyRole).
Typeable kr =>
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
L.WitVKey VKey 'Witness
vk SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature

signTx
  :: Era era
  -> [L.BootstrapWitness]
  -> [L.WitVKey L.Witness]
  -> UnsignedTx era
  -> Ledger.Tx (LedgerEra era)
signTx :: forall era.
Era era
-> [BootstrapWitness]
-> [WitVKey 'Witness]
-> UnsignedTx era
-> Tx (LedgerEra era)
signTx Era era
era [BootstrapWitness]
bootstrapWits [WitVKey 'Witness]
shelleyKeyWits (UnsignedTx Tx (LedgerEra era)
unsigned) =
  Era era
-> (EraCommonConstraints era => Tx (LedgerEra era))
-> Tx (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => Tx (LedgerEra era))
 -> Tx (LedgerEra era))
-> (EraCommonConstraints era => Tx (LedgerEra era))
-> Tx (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    let currentScriptWitnesses :: TxWits (LedgerEra era)
currentScriptWitnesses = Tx (LedgerEra era)
unsigned Tx (LedgerEra era)
-> Getting
     (TxWits (LedgerEra era))
     (Tx (LedgerEra era))
     (TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxWits (LedgerEra era))
  (Tx (LedgerEra era))
  (TxWits (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (LedgerEra era)) (TxWits (LedgerEra era))
L.witsTxL
        keyWits :: TxWits (LedgerEra era)
keyWits =
          Era era
-> (EraCommonConstraints era => TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => TxWits (LedgerEra era))
 -> TxWits (LedgerEra era))
-> (EraCommonConstraints era => TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
            TxWits (LedgerEra era)
forall era. EraTxWits era => TxWits era
L.mkBasicTxWits
              TxWits (LedgerEra era)
-> (TxWits (LedgerEra era) -> TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits (LedgerEra era)) (Set (WitVKey 'Witness))
L.addrTxWitsL
                ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Set (WitVKey 'Witness)
-> TxWits (LedgerEra era)
-> TxWits (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WitVKey 'Witness] -> Set (WitVKey 'Witness)
forall a. Ord a => [a] -> Set a
Set.fromList [WitVKey 'Witness]
shelleyKeyWits
              TxWits (LedgerEra era)
-> (TxWits (LedgerEra era) -> TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits (LedgerEra era)) (Set BootstrapWitness)
L.bootAddrTxWitsL
                ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
 -> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Set BootstrapWitness
-> TxWits (LedgerEra era)
-> TxWits (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [BootstrapWitness] -> Set BootstrapWitness
forall a. Ord a => [a] -> Set a
Set.fromList [BootstrapWitness]
bootstrapWits
        signedTx :: Tx (LedgerEra era)
signedTx = Tx (LedgerEra era)
unsigned Tx (LedgerEra era)
-> (Tx (LedgerEra era) -> Tx (LedgerEra era)) -> Tx (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (LedgerEra era)) (TxWits (LedgerEra era))
L.witsTxL ((TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
 -> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era)))
-> TxWits (LedgerEra era)
-> Tx (LedgerEra era)
-> Tx (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits (LedgerEra era)
keyWits TxWits (LedgerEra era)
-> TxWits (LedgerEra era) -> TxWits (LedgerEra era)
forall a. Semigroup a => a -> a -> a
<> TxWits (LedgerEra era)
currentScriptWitnesses)
     in Tx (LedgerEra era)
signedTx

-- Compatibility related. Will be removed once the old api has been deprecated and deleted.

convertTxBodyToUnsignedTx
  :: HasCallStack => ShelleyBasedEra era -> TxBody era -> UnsignedTx era
convertTxBodyToUnsignedTx :: forall era.
HasCallStack =>
ShelleyBasedEra era -> TxBody era -> UnsignedTx era
convertTxBodyToUnsignedTx ShelleyBasedEra era
sbe TxBody era
txbody =
  CardanoEra era
-> UnsignedTx era -> (Era era -> UnsignedTx era) -> UnsignedTx era
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
forEraInEon
    (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe)
    (String -> UnsignedTx era
forall a. HasCallStack => String -> a
error (String -> UnsignedTx era) -> String -> UnsignedTx era
forall a b. (a -> b) -> a -> b
$ String
"convertTxBodyToUnsignedTx: Error - unsupported era " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> String
docToString (ShelleyBasedEra era -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. ShelleyBasedEra era -> Doc ann
pretty ShelleyBasedEra era
sbe))
    ( \Era era
w -> do
        let ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
unsignedLedgerTx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
txbody
        Tx (LedgerEra era) -> UnsignedTx era
forall era. Tx (LedgerEra era) -> UnsignedTx era
UnsignedTx (Tx (LedgerEra era) -> UnsignedTx era)
-> Tx (LedgerEra era) -> UnsignedTx era
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era => Tx (LedgerEra era))
-> Tx (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
w Tx (ShelleyLedgerEra era)
Tx (LedgerEra era)
EraCommonConstraints era => Tx (LedgerEra era)
unsignedLedgerTx
    )