{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Api.Experimental.Tx
(
UnsignedTx (..)
, UnsignedTxError (..)
, SignedTx (..)
, makeUnsignedTx
, makeKeyWitness
, signTx
, convertTxBodyToUnsignedTx
, hashTxBody
, AnyWitness (..)
, getAnyWitnessScript
, getAnyWitnessPlutusLanguage
, getAnyWitnessScriptData
, TxScriptWitnessRequirements (..)
, extractAllIndexedPlutusScriptWitnesses
, getTxScriptWitnessesRequirements
, obtainMonoidConstraint
, extractExecutionUnits
, getTxScriptWitnessRequirements
)
where
import Cardano.Api.Era.Internal.Core (ToCardanoEra (toCardanoEra), forEraInEon)
import Cardano.Api.Era.Internal.Eon.Convert
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Era.Internal.Feature
import Cardano.Api.Experimental.Era
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
import Cardano.Api.Experimental.Tx.Internal.Body
import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
import Cardano.Api.Ledger.Internal.Reexport (StrictMaybe (..), maybeToStrictMaybe)
import Cardano.Api.Ledger.Internal.Reexport qualified as L
import Cardano.Api.Pretty (docToString, pretty)
import Cardano.Api.Serialise.Raw
( SerialiseAsRawBytes (..)
, SerialiseAsRawBytesError (SerialiseAsRawBytesError)
)
import Cardano.Api.Tx.Internal.Body
import Cardano.Api.Tx.Internal.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.Binary qualified as Ledger
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Hashes qualified as L hiding (Hash)
import Control.Exception (displayException)
import Data.Bifunctor (bimap)
import Data.ByteString.Lazy (fromStrict)
import Data.Set qualified as Set
import GHC.Exts (IsList (..))
import GHC.Stack
import Lens.Micro
data UnsignedTx era
= L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era))
instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where
data AsType (UnsignedTx era) = AsUnsignedTx (AsType era)
proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
proxyToAsType Proxy (UnsignedTx era)
_ = AsType era -> AsType (UnsignedTx era)
forall era. AsType era -> AsType (UnsignedTx era)
AsUnsignedTx (forall t. HasTypeProxy t => AsType t
asType @era)
instance
( HasTypeProxy era
, L.EraTx (LedgerEra era)
)
=> SerialiseAsRawBytes (UnsignedTx era)
where
serialiseToRawBytes :: UnsignedTx era -> ByteString
serialiseToRawBytes (UnsignedTx Tx (LedgerEra era)
tx) =
Version -> Tx (LedgerEra era) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
Ledger.serialize' (forall era. Era era => Version
Ledger.eraProtVerHigh @(LedgerEra era)) Tx (LedgerEra era)
tx
deserialiseFromRawBytes :: AsType (UnsignedTx era)
-> ByteString -> Either SerialiseAsRawBytesError (UnsignedTx era)
deserialiseFromRawBytes AsType (UnsignedTx era)
_ =
(DecoderError -> SerialiseAsRawBytesError)
-> (Tx (LedgerEra era) -> UnsignedTx era)
-> Either DecoderError (Tx (LedgerEra era))
-> Either SerialiseAsRawBytesError (UnsignedTx era)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DecoderError -> SerialiseAsRawBytesError
wrapError Tx (LedgerEra era) -> UnsignedTx era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> UnsignedTx era
UnsignedTx
(Either DecoderError (Tx (LedgerEra era))
-> Either SerialiseAsRawBytesError (UnsignedTx era))
-> (ByteString -> Either DecoderError (Tx (LedgerEra era)))
-> ByteString
-> Either SerialiseAsRawBytesError (UnsignedTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version
-> Text
-> (forall s. Decoder s (Annotator (Tx (LedgerEra era))))
-> ByteString
-> Either DecoderError (Tx (LedgerEra era))
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
Ledger.decodeFullAnnotator
(forall era. Era era => Version
Ledger.eraProtVerHigh @(LedgerEra era))
Text
"UnsignedTx"
Decoder s (Annotator (Tx (LedgerEra era)))
forall s. Decoder s (Annotator (Tx (LedgerEra era)))
forall a s. DecCBOR a => Decoder s a
Ledger.decCBOR
(ByteString -> Either DecoderError (Tx (LedgerEra era)))
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError (Tx (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
where
wrapError
:: Ledger.DecoderError -> SerialiseAsRawBytesError
wrapError :: DecoderError -> SerialiseAsRawBytesError
wrapError = String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> (DecoderError -> String)
-> DecoderError
-> SerialiseAsRawBytesError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall e. Exception e => e -> String
displayException
deriving instance Eq (UnsignedTx era)
deriving instance Show (UnsignedTx era)
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
DijkstraEra TxBodyContent BuildTx era
_ = String -> Either TxBodyError (UnsignedTx era)
forall a. HasCallStack => String -> a
error String
"makeUnsignedTx: Dijkstra era not supported yet"
makeUnsignedTx era :: Era era
era@Era era
ConwayEra 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 languages scripts datums redeemers <-
ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
Either TxBodyError (TxScriptWitnessRequirements ConwayEra))
-> Either TxBodyError (TxScriptWitnessRequirements ConwayEra)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
Either TxBodyError (TxScriptWitnessRequirements ConwayEra))
-> Either TxBodyError (TxScriptWitnessRequirements ConwayEra))
-> (ShelleyBasedEraConstraints era =>
Either TxBodyError (TxScriptWitnessRequirements ConwayEra))
-> Either TxBodyError (TxScriptWitnessRequirements ConwayEra)
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
let apiTxOuts = TxBodyContent BuildTx era -> [TxOut CtxTx era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent BuildTx era
bc
apiScriptValidity = TxBodyContent BuildTx era -> TxScriptValidity era
forall build era. TxBodyContent build era -> TxScriptValidity era
txScriptValidity TxBodyContent BuildTx era
bc
apiMintValue = TxBodyContent BuildTx era -> TxMintValue BuildTx era
forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue TxBodyContent BuildTx era
bc
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 = TxBodyContent BuildTx era -> TxInsCollateral era
forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral TxBodyContent BuildTx era
bc
apiReferenceInputs = TxBodyContent BuildTx era -> TxInsReference BuildTx era
forall build era.
TxBodyContent build era -> TxInsReference build era
txInsReference TxBodyContent BuildTx era
bc
apiExtraKeyWitnesses = TxBodyContent BuildTx era -> TxExtraKeyWitnesses era
forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits TxBodyContent BuildTx era
bc
apiReturnCollateral = TxBodyContent BuildTx era -> TxReturnCollateral CtxTx era
forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txReturnCollateral TxBodyContent BuildTx era
bc
apiTotalCollateral = TxBodyContent BuildTx era -> TxTotalCollateral era
forall build era. TxBodyContent build era -> TxTotalCollateral era
txTotalCollateral TxBodyContent BuildTx era
bc
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 = TxInsCollateral era -> Set TxIn
forall era. TxInsCollateral era -> Set TxIn
convCollateralTxIns TxInsCollateral era
apiCollateralTxIns
refTxIns = TxInsReference BuildTx era -> Set TxIn
forall build era. TxInsReference build era -> Set TxIn
convReferenceInputs TxInsReference BuildTx era
apiReferenceInputs
outs = ShelleyBasedEra era
-> [TxOut CtxTx era] -> StrictSeq (TxOut ConwayEra)
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 = 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 = 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 = 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 = TxTotalCollateral era -> StrictMaybe Coin
forall era. TxTotalCollateral era -> StrictMaybe Coin
convTotalCollateral TxTotalCollateral era
apiTotalCollateral
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 = 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 =
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 ConwayEra
Redeemers (ShelleyLedgerEra era)
redeemers
TxDats ConwayEra
TxDats (ShelleyLedgerEra era)
datums
Set Language
languages
let setMint = TxMintValue BuildTx era -> MultiAsset
forall build era. TxMintValue build era -> MultiAsset
convMintValue TxMintValue BuildTx era
apiMintValue
setReqSignerHashes = TxExtraKeyWitnesses era -> Set (KeyHash 'Witness)
forall era. TxExtraKeyWitnesses era -> Set (KeyHash 'Witness)
convExtraKeyWitnesses TxExtraKeyWitnesses era
apiExtraKeyWitnesses
ledgerTxBody =
TxBody ConwayEra
forall era. EraTxBody era => TxBody era
L.mkBasicTxBody
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
L.inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Set TxIn -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
txins
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
L.collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Set TxIn -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
collTxIns
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
L.referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Set TxIn -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
refTxIns
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ConwayEra)
-> Identity (StrictSeq (TxOut ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
L.outputsTxBodyL ((StrictSeq (TxOut ConwayEra)
-> Identity (StrictSeq (TxOut ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> StrictSeq (TxOut ConwayEra)
-> TxBody ConwayEra
-> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut ConwayEra)
outs
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody ConwayEra) (StrictMaybe Coin)
L.totalCollateralTxBodyL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> StrictMaybe Coin -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
totalCollateral
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxOut ConwayEra)
-> Identity (StrictMaybe (TxOut ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
(StrictMaybe (BabbageTxOut ConwayEra)
-> Identity (StrictMaybe (BabbageTxOut ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody ConwayEra) (StrictMaybe (TxOut ConwayEra))
L.collateralReturnTxBodyL ((StrictMaybe (BabbageTxOut ConwayEra)
-> Identity (StrictMaybe (BabbageTxOut ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> StrictMaybe (BabbageTxOut ConwayEra)
-> TxBody ConwayEra
-> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (TxOut (ShelleyLedgerEra era))
StrictMaybe (BabbageTxOut ConwayEra)
returnCollateral
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody ConwayEra) Coin
L.feeTxBodyL ((Coin -> Identity Coin)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Coin -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody ConwayEra) ValidityInterval
L.vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> ((Maybe SlotNo -> Identity (Maybe SlotNo))
-> ValidityInterval -> Identity ValidityInterval)
-> (Maybe SlotNo -> Identity (Maybe SlotNo))
-> TxBody ConwayEra
-> Identity (TxBody ConwayEra)
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 ConwayEra -> Identity (TxBody ConwayEra))
-> Maybe SlotNo -> TxBody ConwayEra -> TxBody ConwayEra
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 ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody ConwayEra) ValidityInterval
L.vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> ((Maybe SlotNo -> Identity (Maybe SlotNo))
-> ValidityInterval -> Identity ValidityInterval)
-> (Maybe SlotNo -> Identity (Maybe SlotNo))
-> TxBody ConwayEra
-> Identity (TxBody ConwayEra)
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 ConwayEra -> Identity (TxBody ConwayEra))
-> Maybe SlotNo -> TxBody ConwayEra -> TxBody ConwayEra
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 ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
(AlonzoEraTxBody era, AtMostEra "Conway" era) =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
Lens' (TxBody ConwayEra) (Set (KeyHash 'Witness))
L.reqSignerHashesTxBodyL ((Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Set (KeyHash 'Witness) -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness)
setReqSignerHashes
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
-> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody ConwayEra) (StrictMaybe ScriptIntegrityHash)
L.scriptIntegrityHashTxBodyL ((StrictMaybe ScriptIntegrityHash
-> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> StrictMaybe ScriptIntegrityHash
-> TxBody ConwayEra
-> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
scriptIntegrityHash
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody ConwayEra) Withdrawals
L.withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Withdrawals -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
withdrawals
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert ConwayEra)
-> Identity (StrictSeq (TxCert ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
(StrictSeq (ConwayTxCert ConwayEra)
-> Identity (StrictSeq (ConwayTxCert ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody ConwayEra) (StrictSeq (TxCert ConwayEra))
L.certsTxBodyL ((StrictSeq (ConwayTxCert ConwayEra)
-> Identity (StrictSeq (ConwayTxCert ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> StrictSeq (ConwayTxCert ConwayEra)
-> TxBody ConwayEra
-> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert (ShelleyLedgerEra era))
StrictSeq (ConwayTxCert ConwayEra)
certs
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (MultiAsset -> Identity MultiAsset)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody ConwayEra) MultiAsset
L.mintTxBodyL ((MultiAsset -> Identity MultiAsset)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> MultiAsset -> TxBody ConwayEra -> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
setMint
TxBody ConwayEra
-> (TxBody ConwayEra -> TxBody ConwayEra) -> TxBody ConwayEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe TxAuxDataHash -> Identity (StrictMaybe TxAuxDataHash))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
Lens' (TxBody ConwayEra) (StrictMaybe TxAuxDataHash)
L.auxDataHashTxBodyL ((StrictMaybe TxAuxDataHash
-> Identity (StrictMaybe TxAuxDataHash))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> StrictMaybe TxAuxDataHash
-> TxBody ConwayEra
-> TxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
-> (TxAuxData ConwayEra -> StrictMaybe TxAuxDataHash)
-> Maybe (TxAuxData ConwayEra)
-> 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 ConwayEra -> TxAuxDataHash)
-> TxAuxData ConwayEra
-> StrictMaybe TxAuxDataHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxAuxData ConwayEra -> TxAuxDataHash
forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
Ledger.hashTxAuxData) Maybe (TxAuxData ConwayEra)
Maybe (TxAuxData (ShelleyLedgerEra era))
txAuxData
scriptWitnesses =
TxWits ConwayEra
forall era. EraTxWits era => TxWits era
L.mkBasicTxWits
TxWits ConwayEra
-> (TxWits ConwayEra -> TxWits ConwayEra) -> TxWits ConwayEra
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script ConwayEra)
-> Identity (Map ScriptHash (Script ConwayEra)))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits ConwayEra) (Map ScriptHash (Script ConwayEra))
L.scriptTxWitsL
((Map ScriptHash (Script ConwayEra)
-> Identity (Map ScriptHash (Script ConwayEra)))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> Map ScriptHash (Script ConwayEra)
-> TxWits ConwayEra
-> TxWits ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Map ScriptHash (Script ConwayEra))]
-> Map ScriptHash (Script ConwayEra)
forall l. IsList l => [Item l] -> l
fromList
[ (Script ConwayEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript Script ConwayEra
AlonzoScript ConwayEra
sw, AlonzoScript ConwayEra
sw)
| AlonzoScript ConwayEra
sw <- [Script ConwayEra]
[AlonzoScript ConwayEra]
scripts
]
TxWits ConwayEra
-> (TxWits ConwayEra -> AlonzoTxWits ConwayEra)
-> AlonzoTxWits ConwayEra
forall a b. a -> (a -> b) -> b
& (TxDats ConwayEra -> Identity (TxDats ConwayEra))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
(TxDats ConwayEra -> Identity (TxDats ConwayEra))
-> TxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits ConwayEra) (TxDats ConwayEra)
L.datsTxWitsL ((TxDats ConwayEra -> Identity (TxDats ConwayEra))
-> TxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> TxDats ConwayEra -> TxWits ConwayEra -> AlonzoTxWits ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxDats ConwayEra
datums
AlonzoTxWits ConwayEra
-> (AlonzoTxWits ConwayEra -> AlonzoTxWits ConwayEra)
-> AlonzoTxWits ConwayEra
forall a b. a -> (a -> b) -> b
& (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
(Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits ConwayEra) (Redeemers ConwayEra)
L.rdmrsTxWitsL ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> Redeemers ConwayEra
-> AlonzoTxWits ConwayEra
-> AlonzoTxWits ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers ConwayEra
redeemers
let eraSpecificTxBody = Era era
-> TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> TxBody (LedgerEra era)
forall era.
Era era
-> TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> TxBody (LedgerEra era)
eraSpecificLedgerTxBody Era era
era TxBody ConwayEra
TxBody (LedgerEra era)
ledgerTxBody TxBodyContent BuildTx era
bc
return . UnsignedTx $
L.mkBasicTx eraSpecificTxBody
& L.witsTxL .~ scriptWitnesses
& L.auxDataTxL .~ maybeToStrictMaybe (toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc))
& L.isValidTxL .~ txScriptValidityToIsValid apiScriptValidity
eraSpecificLedgerTxBody
:: Era era
-> Ledger.TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> Ledger.TxBody (LedgerEra era)
eraSpecificLedgerTxBody :: forall era.
Era era
-> TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> TxBody (LedgerEra era)
eraSpecificLedgerTxBody Era era
era TxBody (LedgerEra era)
ledgerbody TxBodyContent BuildTx era
bc =
Era era -> TxBody (LedgerEra era)
body Era era
era
where
body :: Era era -> TxBody (LedgerEra era)
body Era era
e =
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 Era era
-> (EraCommonConstraints era => TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
e ((EraCommonConstraints era => TxBody (LedgerEra era))
-> TxBody (LedgerEra era))
-> (EraCommonConstraints era => TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
TxBody (LedgerEra era)
ledgerbody
TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (OSet (ProposalProcedure (LedgerEra era))
-> Identity (OSet (ProposalProcedure (LedgerEra era))))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens'
(TxBody (LedgerEra era)) (OSet (ProposalProcedure (LedgerEra era)))
L.proposalProceduresTxBodyL
((OSet (ProposalProcedure (LedgerEra era))
-> Identity (OSet (ProposalProcedure (LedgerEra era))))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> OSet (ProposalProcedure (LedgerEra era))
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
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)
TxBody (LedgerEra era)
-> (TxBody (LedgerEra era) -> TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (VotingProcedures (LedgerEra era)
-> Identity (VotingProcedures (LedgerEra era)))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody (LedgerEra era)) (VotingProcedures (LedgerEra era))
L.votingProceduresTxBodyL
((VotingProcedures (LedgerEra era)
-> Identity (VotingProcedures (LedgerEra era)))
-> TxBody (LedgerEra era) -> Identity (TxBody (LedgerEra era)))
-> VotingProcedures (LedgerEra era)
-> TxBody (LedgerEra era)
-> TxBody (LedgerEra era)
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)
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. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (LedgerEra era)) Coin
L.treasuryDonationTxBodyL
((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
-> (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
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.
ConwayEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody (LedgerEra era)) (StrictMaybe Coin)
L.currentTreasuryValueTxBodyL
((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
.~ 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).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
L.WitVKey VKey 'Witness
vk SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature
data SignedTx era
= L.EraTx (LedgerEra era) => SignedTx (Ledger.Tx (LedgerEra era))
deriving instance Eq (SignedTx era)
deriving instance Show (SignedTx era)
instance HasTypeProxy era => HasTypeProxy (SignedTx era) where
data AsType (SignedTx era) = AsSignedTx (AsType era)
proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era)
proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era)
proxyToAsType Proxy (SignedTx era)
_ = AsType era -> AsType (SignedTx era)
forall era. AsType era -> AsType (SignedTx era)
AsSignedTx (forall t. HasTypeProxy t => AsType t
asType @era)
instance
( HasTypeProxy era
, L.EraTx (LedgerEra era)
)
=> SerialiseAsRawBytes (SignedTx era)
where
serialiseToRawBytes :: SignedTx era -> ByteString
serialiseToRawBytes (SignedTx Tx (LedgerEra era)
tx) =
Version -> Tx (LedgerEra era) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
Ledger.serialize' (forall era. Era era => Version
Ledger.eraProtVerHigh @(LedgerEra era)) Tx (LedgerEra era)
tx
deserialiseFromRawBytes :: AsType (SignedTx era)
-> ByteString -> Either SerialiseAsRawBytesError (SignedTx era)
deserialiseFromRawBytes AsType (SignedTx era)
_ =
(DecoderError -> SerialiseAsRawBytesError)
-> (Tx (LedgerEra era) -> SignedTx era)
-> Either DecoderError (Tx (LedgerEra era))
-> Either SerialiseAsRawBytesError (SignedTx era)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DecoderError -> SerialiseAsRawBytesError
wrapError Tx (LedgerEra era) -> SignedTx era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> SignedTx era
SignedTx
(Either DecoderError (Tx (LedgerEra era))
-> Either SerialiseAsRawBytesError (SignedTx era))
-> (ByteString -> Either DecoderError (Tx (LedgerEra era)))
-> ByteString
-> Either SerialiseAsRawBytesError (SignedTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version
-> Text
-> (forall s. Decoder s (Annotator (Tx (LedgerEra era))))
-> ByteString
-> Either DecoderError (Tx (LedgerEra era))
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
Ledger.decodeFullAnnotator
(forall era. Era era => Version
Ledger.eraProtVerHigh @(LedgerEra era))
Text
"SignedTx"
Decoder s (Annotator (Tx (LedgerEra era)))
forall s. Decoder s (Annotator (Tx (LedgerEra era)))
forall a s. DecCBOR a => Decoder s a
Ledger.decCBOR
(ByteString -> Either DecoderError (Tx (LedgerEra era)))
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError (Tx (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
where
wrapError
:: Ledger.DecoderError -> SerialiseAsRawBytesError
wrapError :: DecoderError -> SerialiseAsRawBytesError
wrapError = String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> (DecoderError -> String)
-> DecoderError
-> SerialiseAsRawBytesError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall e. Exception e => e -> String
displayException
signTx
:: Era era
-> [L.BootstrapWitness]
-> [L.WitVKey L.Witness]
-> UnsignedTx era
-> SignedTx era
signTx :: forall era.
Era era
-> [BootstrapWitness]
-> [WitVKey 'Witness]
-> UnsignedTx era
-> SignedTx era
signTx Era era
era [BootstrapWitness]
bootstrapWits [WitVKey 'Witness]
shelleyKeyWits (UnsignedTx Tx (LedgerEra era)
unsigned) =
Era era
-> (EraCommonConstraints era => SignedTx era) -> SignedTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => SignedTx era) -> SignedTx era)
-> (EraCommonConstraints era => SignedTx era) -> SignedTx 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 era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> SignedTx era
SignedTx Tx (LedgerEra era)
signedTx
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
Era era
-> (EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
w ((EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era)
-> (EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era
forall a b. (a -> b) -> a -> b
$ Tx (LedgerEra era) -> UnsignedTx era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> UnsignedTx era
UnsignedTx Tx (ShelleyLedgerEra era)
Tx (LedgerEra era)
unsignedLedgerTx
)