1
{-# LANGUAGE DeriveGeneric #-}
2
{-# LANGUAGE DerivingStrategies #-}
3
{-# LANGUAGE EmptyCase #-}
4
{-# LANGUAGE FlexibleContexts #-}
5
{-# LANGUAGE FlexibleInstances #-}
7
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8
{-# LANGUAGE NamedFieldPuns #-}
9
{-# LANGUAGE PatternSynonyms #-}
10
{-# LANGUAGE ScopedTypeVariables #-}
11
{-# LANGUAGE StandaloneDeriving #-}
12
{-# LANGUAGE TypeApplications #-}
13
{-# LANGUAGE TypeFamilies #-}
16
-- | Transaction bodies
18
module Cardano.Api.TxBody (
20
-- * Transaction bodies
26
-- ** Transitional utils
33
-- * Transaction inputs
36
genesisUTxOPseudoTxIn,
38
-- * Transaction outputs
41
serialiseAddressForTxOut,
43
-- * Other transaction body types
45
TxValidityLowerBound(..),
46
TxValidityUpperBound(..),
54
-- ** Building vs viewing transactions
59
-- * Era-dependent transaction body features
60
MultiAssetSupportedInEra(..),
61
OnlyAdaSupportedInEra(..),
62
TxFeesExplicitInEra(..),
63
TxFeesImplicitInEra(..),
64
ValidityUpperBoundSupportedInEra(..),
65
ValidityNoUpperBoundSupportedInEra(..),
66
ValidityLowerBoundSupportedInEra(..),
67
TxMetadataSupportedInEra(..),
68
AuxScriptsSupportedInEra(..),
69
WithdrawalsSupportedInEra(..),
70
CertificatesSupportedInEra(..),
71
UpdateProposalSupportedInEra(..),
73
-- ** Feature availability functions
74
multiAssetSupportedInEra,
76
validityUpperBoundSupportedInEra,
77
validityNoUpperBoundSupportedInEra,
78
validityLowerBoundSupportedInEra,
79
txMetadataSupportedInEra,
80
auxScriptsSupportedInEra,
81
withdrawalsSupportedInEra,
82
certificatesSupportedInEra,
83
updateProposalSupportedInEra,
85
-- * Internal conversion functions & types
94
-- * Data family instances
95
AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody, AsMaryTxBody),
97
-- * Conversion functions
103
import Data.Aeson (ToJSON (..), object, (.=))
104
import qualified Data.Aeson as Aeson
105
import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
106
import Data.Bifunctor (first)
107
import Data.ByteString (ByteString)
108
import qualified Data.ByteString.Lazy as LBS
109
import Data.List (intercalate)
110
import qualified Data.List.NonEmpty as NonEmpty
111
import Data.Map.Strict (Map)
112
import qualified Data.Map.Strict as Map
113
import Data.Maybe (fromMaybe)
114
import qualified Data.Sequence.Strict as Seq
115
import qualified Data.Set as Set
116
import Data.String (IsString)
117
import Data.Text (Text)
118
import qualified Data.Text as Text
119
import Data.Word (Word64)
122
import Control.Monad (guard)
124
import Cardano.Binary (Annotated (..), reAnnotate, recoverBytes)
125
import qualified Cardano.Binary as CBOR
126
import qualified Shelley.Spec.Ledger.Serialization as CBOR (decodeNullMaybe, encodeNullMaybe)
128
import qualified Cardano.Crypto.Hash.Class as Crypto
129
import Cardano.Slotting.Slot (SlotNo (..))
131
import qualified Cardano.Chain.Common as Byron
132
import qualified Cardano.Chain.UTxO as Byron
133
import qualified Cardano.Crypto.Hashing as Byron
135
import qualified Cardano.Ledger.AuxiliaryData as Ledger (hashAuxiliaryData)
136
import qualified Cardano.Ledger.Core as Core
137
import qualified Cardano.Ledger.Core as Ledger
138
import qualified Cardano.Ledger.Era as Ledger
139
import qualified Cardano.Ledger.SafeHash as SafeHash
140
import qualified Cardano.Ledger.Shelley.Constraints as Ledger
141
import qualified Cardano.Ledger.ShelleyMA.AuxiliaryData as Allegra
142
import qualified Cardano.Ledger.ShelleyMA.TxBody as Allegra
143
import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary, StandardShelley)
144
import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
146
import qualified Shelley.Spec.Ledger.Address as Shelley
147
import Shelley.Spec.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe)
148
import qualified Shelley.Spec.Ledger.Credential as Shelley
149
import qualified Shelley.Spec.Ledger.Genesis as Shelley
150
import qualified Shelley.Spec.Ledger.Keys as Shelley
151
import qualified Shelley.Spec.Ledger.Metadata as Shelley
152
import qualified Shelley.Spec.Ledger.Tx as Shelley
153
import qualified Shelley.Spec.Ledger.TxBody as Shelley
154
import qualified Shelley.Spec.Ledger.UTxO as Shelley
156
import Cardano.Api.Address
157
import Cardano.Api.Certificate
158
import Cardano.Api.Eras
159
import Cardano.Api.Error
160
import Cardano.Api.HasTypeProxy
161
import Cardano.Api.Hash
162
import Cardano.Api.KeysByron
163
import Cardano.Api.KeysShelley
164
import Cardano.Api.NetworkId
165
import Cardano.Api.ProtocolParameters
166
import Cardano.Api.Script
167
import Cardano.Api.SerialiseBech32
168
import Cardano.Api.SerialiseCBOR
169
import Cardano.Api.SerialiseRaw
170
import Cardano.Api.SerialiseTextEnvelope
171
import Cardano.Api.TxMetadata
172
import Cardano.Api.Utils
173
import Cardano.Api.Value
176
-- ----------------------------------------------------------------------------
180
newtype TxId = TxId (Shelley.Hash StandardCrypto Shelley.EraIndependentTxBody)
181
deriving stock (Eq, Ord, Show)
182
deriving newtype (IsString)
183
-- We use the Shelley representation and convert the Byron one
185
instance ToJSON TxId where
186
toJSON = Aeson.String . serialiseToRawBytesHexText
188
instance HasTypeProxy TxId where
189
data AsType TxId = AsTxId
190
proxyToAsType _ = AsTxId
192
instance SerialiseAsRawBytes TxId where
193
serialiseToRawBytes (TxId h) = Crypto.hashToBytes h
194
deserialiseFromRawBytes AsTxId bs = TxId <$> Crypto.hashFromBytes bs
196
toByronTxId :: TxId -> Byron.TxId
197
toByronTxId (TxId h) =
198
Byron.unsafeHashFromBytes (Crypto.hashToBytes h)
200
toShelleyTxId :: TxId -> Shelley.TxId StandardCrypto
201
toShelleyTxId (TxId h) =
202
Shelley.TxId (SafeHash.unsafeMakeSafeHash (Crypto.castHash h))
204
fromShelleyTxId :: Shelley.TxId StandardCrypto -> TxId
205
fromShelleyTxId (Shelley.TxId h) =
206
TxId (Crypto.castHash (SafeHash.extractHash h))
208
-- | Calculate the transaction identifier for a 'TxBody'.
210
getTxId :: forall era. TxBody era -> TxId
211
getTxId (ByronTxBody tx) =
213
. fromMaybe impossible
214
. Crypto.hashFromBytesShort
215
. Byron.abstractHashToShort
220
error "getTxId: byron and shelley hash sizes do not match"
222
getTxId (ShelleyTxBody era tx _ _) =
224
ShelleyBasedEraShelley -> getTxIdShelley tx
225
ShelleyBasedEraAllegra -> getTxIdShelley tx
226
ShelleyBasedEraMary -> getTxIdShelley tx
228
getTxIdShelley :: Ledger.Crypto (ShelleyLedgerEra era) ~ StandardCrypto
229
=> Ledger.UsesTxBody (ShelleyLedgerEra era)
230
=> Ledger.TxBody (ShelleyLedgerEra era) -> TxId
234
. (\(Shelley.TxId txhash) -> SafeHash.extractHash txhash)
235
. (Shelley.txid @(ShelleyLedgerEra era))
238
-- ----------------------------------------------------------------------------
239
-- Transaction inputs
242
data TxIn = TxIn TxId TxIx
243
deriving (Eq, Ord, Show)
245
instance ToJSON TxIn where
246
toJSON txIn = Aeson.String $ renderTxIn txIn
248
instance ToJSONKey TxIn where
249
toJSONKey = toJSONKeyText renderTxIn
251
renderTxIn :: TxIn -> Text
252
renderTxIn (TxIn txId (TxIx ix)) =
253
serialiseToRawBytesHexText txId <> "#" <> Text.pack (show ix)
256
newtype TxIx = TxIx Word
257
deriving stock (Eq, Ord, Show)
258
deriving newtype (Enum)
259
deriving newtype ToJSON
261
fromByronTxIn :: Byron.TxIn -> TxIn
262
fromByronTxIn (Byron.TxInUtxo txId index) =
263
let shortBs = Byron.abstractHashToShort txId
264
mApiHash = Crypto.hashFromBytesShort shortBs
266
Just apiHash -> TxIn (TxId apiHash) (TxIx . fromIntegral $ toInteger index)
267
Nothing -> error $ "Error converting Byron era TxId: " <> show txId
269
toByronTxIn :: TxIn -> Byron.TxIn
270
toByronTxIn (TxIn txid (TxIx txix)) =
271
Byron.TxInUtxo (toByronTxId txid) (fromIntegral txix)
273
toShelleyTxIn :: TxIn -> Shelley.TxIn StandardCrypto
274
toShelleyTxIn (TxIn txid (TxIx txix)) =
275
Shelley.TxIn (toShelleyTxId txid) (fromIntegral txix)
277
fromShelleyTxIn :: Shelley.TxIn StandardCrypto -> TxIn
278
fromShelleyTxIn (Shelley.TxIn txid txix) =
279
TxIn (fromShelleyTxId txid) (TxIx (fromIntegral txix))
282
-- ----------------------------------------------------------------------------
283
-- Transaction outputs
287
= TxOut (AddressInEra era) (TxOutValue era)
290
instance IsCardanoEra era => ToJSON (TxOut era) where
291
toJSON (TxOut addr val) =
292
object ["address" .= serialiseAddressForTxOut addr, "value" .= toJSON val]
294
serialiseAddressForTxOut :: AddressInEra era -> Text
295
serialiseAddressForTxOut (AddressInEra addrType addr) =
297
ByronAddressInAnyEra -> serialiseToRawBytesHexText addr
298
ShelleyAddressInEra _ -> serialiseToBech32 addr
301
deriving instance Eq (TxOut era)
302
deriving instance Show (TxOut era)
305
toByronTxOut :: TxOut ByronEra -> Maybe Byron.TxOut
306
toByronTxOut (TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress addr))
307
(TxOutAdaOnly AdaOnlyInByronEra value)) =
308
Byron.TxOut addr <$> toByronLovelace value
310
toByronTxOut (TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress _))
311
(TxOutValue era _)) = case era of {}
313
toByronTxOut (TxOut (AddressInEra (ShelleyAddressInEra era) ShelleyAddress{})
317
toShelleyTxOut :: forall era ledgerera.
318
(ShelleyLedgerEra era ~ ledgerera,
319
IsShelleyBasedEra era, Ledger.ShelleyBased ledgerera)
320
=> TxOut era -> Shelley.TxOut ledgerera
321
toShelleyTxOut (TxOut _ (TxOutAdaOnly AdaOnlyInByronEra _)) =
322
case shelleyBasedEra :: ShelleyBasedEra era of {}
324
toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value)) =
325
Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value)
327
toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value)) =
328
Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value)
330
toShelleyTxOut (TxOut addr (TxOutValue MultiAssetInMaryEra value)) =
331
Shelley.TxOut (toShelleyAddr addr) (toMaryValue value)
333
fromShelleyTxOut :: Shelley.TxOut StandardShelley -> TxOut ShelleyEra
334
fromShelleyTxOut = fromTxOut ShelleyBasedEraShelley
337
:: ShelleyLedgerEra era ~ ledgerera
338
=> ShelleyBasedEra era
339
-> Core.TxOut ledgerera
341
fromTxOut shelleyBasedEra' ledgerTxOut =
342
case shelleyBasedEra' of
343
ShelleyBasedEraShelley -> let (Shelley.TxOut addr value) = ledgerTxOut
344
in TxOut (fromShelleyAddr addr)
345
(TxOutAdaOnly AdaOnlyInShelleyEra
346
(fromShelleyLovelace value))
347
ShelleyBasedEraAllegra -> let (Shelley.TxOut addr value) = ledgerTxOut
348
in TxOut (fromShelleyAddr addr)
349
(TxOutAdaOnly AdaOnlyInAllegraEra
350
(fromShelleyLovelace value))
351
ShelleyBasedEraMary -> let (Shelley.TxOut addr value) = ledgerTxOut
352
in TxOut (fromShelleyAddr addr)
353
(TxOutValue MultiAssetInMaryEra
354
(fromMaryValue value))
356
-- ----------------------------------------------------------------------------
357
-- Era-dependent transaction body features
360
-- | A representation of whether the era supports multi-asset transactions.
362
-- The Mary and subsequent eras support multi-asset transactions.
364
-- The negation of this is 'OnlyAdaSupportedInEra'.
366
data MultiAssetSupportedInEra era where
368
-- | Multi-asset transactions are supported in the 'Mary' era.
369
MultiAssetInMaryEra :: MultiAssetSupportedInEra MaryEra
371
deriving instance Eq (MultiAssetSupportedInEra era)
372
deriving instance Show (MultiAssetSupportedInEra era)
374
instance ToJSON (MultiAssetSupportedInEra era) where
375
toJSON = Aeson.String . Text.pack . show
377
-- | A representation of whether the era supports only ada transactions.
379
-- Prior to the Mary era only ada transactions are supported. Multi-assets are
380
-- supported from the Mary era onwards.
382
-- This is the negation of 'MultiAssetSupportedInEra'. It exists since we need
383
-- evidence to be positive.
385
data OnlyAdaSupportedInEra era where
387
AdaOnlyInByronEra :: OnlyAdaSupportedInEra ByronEra
388
AdaOnlyInShelleyEra :: OnlyAdaSupportedInEra ShelleyEra
389
AdaOnlyInAllegraEra :: OnlyAdaSupportedInEra AllegraEra
391
deriving instance Eq (OnlyAdaSupportedInEra era)
392
deriving instance Show (OnlyAdaSupportedInEra era)
394
multiAssetSupportedInEra :: CardanoEra era
395
-> Either (OnlyAdaSupportedInEra era)
396
(MultiAssetSupportedInEra era)
397
multiAssetSupportedInEra ByronEra = Left AdaOnlyInByronEra
398
multiAssetSupportedInEra ShelleyEra = Left AdaOnlyInShelleyEra
399
multiAssetSupportedInEra AllegraEra = Left AdaOnlyInAllegraEra
400
multiAssetSupportedInEra MaryEra = Right MultiAssetInMaryEra
403
-- | A representation of whether the era requires explicitly specified fees in
406
-- The Byron era tx fees are implicit (as the difference bettween the sum of
407
-- outputs and sum of inputs), but all later eras the fees are specified in the
408
-- transaction explicitly.
410
data TxFeesExplicitInEra era where
412
TxFeesExplicitInShelleyEra :: TxFeesExplicitInEra ShelleyEra
413
TxFeesExplicitInAllegraEra :: TxFeesExplicitInEra AllegraEra
414
TxFeesExplicitInMaryEra :: TxFeesExplicitInEra MaryEra
416
deriving instance Eq (TxFeesExplicitInEra era)
417
deriving instance Show (TxFeesExplicitInEra era)
419
-- | A representation of whether the era requires implicitly specified fees in
422
-- This is the negation of 'TxFeesExplicitInEra'.
424
data TxFeesImplicitInEra era where
425
TxFeesImplicitInByronEra :: TxFeesImplicitInEra ByronEra
427
deriving instance Eq (TxFeesImplicitInEra era)
428
deriving instance Show (TxFeesImplicitInEra era)
430
txFeesExplicitInEra :: CardanoEra era
431
-> Either (TxFeesImplicitInEra era)
432
(TxFeesExplicitInEra era)
433
txFeesExplicitInEra ByronEra = Left TxFeesImplicitInByronEra
434
txFeesExplicitInEra ShelleyEra = Right TxFeesExplicitInShelleyEra
435
txFeesExplicitInEra AllegraEra = Right TxFeesExplicitInAllegraEra
436
txFeesExplicitInEra MaryEra = Right TxFeesExplicitInMaryEra
439
-- | A representation of whether the era supports transactions with an upper
440
-- bound on the range of slots in which they are valid.
442
-- The Shelley and subsequent eras support an upper bound on the validity
443
-- range. In the Shelley era specifically it is actually required. It is
444
-- optional in later eras.
446
data ValidityUpperBoundSupportedInEra era where
448
ValidityUpperBoundInShelleyEra :: ValidityUpperBoundSupportedInEra ShelleyEra
449
ValidityUpperBoundInAllegraEra :: ValidityUpperBoundSupportedInEra AllegraEra
450
ValidityUpperBoundInMaryEra :: ValidityUpperBoundSupportedInEra MaryEra
452
deriving instance Eq (ValidityUpperBoundSupportedInEra era)
453
deriving instance Show (ValidityUpperBoundSupportedInEra era)
455
validityUpperBoundSupportedInEra :: CardanoEra era
456
-> Maybe (ValidityUpperBoundSupportedInEra era)
457
validityUpperBoundSupportedInEra ByronEra = Nothing
458
validityUpperBoundSupportedInEra ShelleyEra = Just ValidityUpperBoundInShelleyEra
459
validityUpperBoundSupportedInEra AllegraEra = Just ValidityUpperBoundInAllegraEra
460
validityUpperBoundSupportedInEra MaryEra = Just ValidityUpperBoundInMaryEra
463
-- | A representation of whether the era supports transactions having /no/
464
-- upper bound on the range of slots in which they are valid.
466
-- Note that the 'ShelleyEra' /does not support/ omitting a validity upper
467
-- bound. It was introduced as a /required/ field in Shelley and then made
468
-- optional in Allegra and subsequent eras.
470
-- The Byron era supports this by virtue of the fact that it does not support
471
-- validity ranges at all.
473
data ValidityNoUpperBoundSupportedInEra era where
475
ValidityNoUpperBoundInByronEra :: ValidityNoUpperBoundSupportedInEra ByronEra
476
ValidityNoUpperBoundInAllegraEra :: ValidityNoUpperBoundSupportedInEra AllegraEra
477
ValidityNoUpperBoundInMaryEra :: ValidityNoUpperBoundSupportedInEra MaryEra
479
deriving instance Eq (ValidityNoUpperBoundSupportedInEra era)
480
deriving instance Show (ValidityNoUpperBoundSupportedInEra era)
482
validityNoUpperBoundSupportedInEra :: CardanoEra era
483
-> Maybe (ValidityNoUpperBoundSupportedInEra era)
484
validityNoUpperBoundSupportedInEra ByronEra = Just ValidityNoUpperBoundInByronEra
485
validityNoUpperBoundSupportedInEra ShelleyEra = Nothing
486
validityNoUpperBoundSupportedInEra AllegraEra = Just ValidityNoUpperBoundInAllegraEra
487
validityNoUpperBoundSupportedInEra MaryEra = Just ValidityNoUpperBoundInMaryEra
490
-- | A representation of whether the era supports transactions with a lower
491
-- bound on the range of slots in which they are valid.
493
-- The Allegra and subsequent eras support an optional lower bound on the
494
-- validity range. No equivalent of 'ValidityNoUpperBoundSupportedInEra' is
495
-- needed since all eras support having no lower bound.
497
data ValidityLowerBoundSupportedInEra era where
499
ValidityLowerBoundInAllegraEra :: ValidityLowerBoundSupportedInEra AllegraEra
500
ValidityLowerBoundInMaryEra :: ValidityLowerBoundSupportedInEra MaryEra
502
deriving instance Eq (ValidityLowerBoundSupportedInEra era)
503
deriving instance Show (ValidityLowerBoundSupportedInEra era)
505
validityLowerBoundSupportedInEra :: CardanoEra era
506
-> Maybe (ValidityLowerBoundSupportedInEra era)
507
validityLowerBoundSupportedInEra ByronEra = Nothing
508
validityLowerBoundSupportedInEra ShelleyEra = Nothing
509
validityLowerBoundSupportedInEra AllegraEra = Just ValidityLowerBoundInAllegraEra
510
validityLowerBoundSupportedInEra MaryEra = Just ValidityLowerBoundInMaryEra
513
-- | A representation of whether the era supports transaction metadata.
515
-- Transaction metadata is supported from the Shelley era onwards.
517
data TxMetadataSupportedInEra era where
519
TxMetadataInShelleyEra :: TxMetadataSupportedInEra ShelleyEra
520
TxMetadataInAllegraEra :: TxMetadataSupportedInEra AllegraEra
521
TxMetadataInMaryEra :: TxMetadataSupportedInEra MaryEra
523
deriving instance Eq (TxMetadataSupportedInEra era)
524
deriving instance Show (TxMetadataSupportedInEra era)
526
txMetadataSupportedInEra :: CardanoEra era
527
-> Maybe (TxMetadataSupportedInEra era)
528
txMetadataSupportedInEra ByronEra = Nothing
529
txMetadataSupportedInEra ShelleyEra = Just TxMetadataInShelleyEra
530
txMetadataSupportedInEra AllegraEra = Just TxMetadataInAllegraEra
531
txMetadataSupportedInEra MaryEra = Just TxMetadataInMaryEra
534
-- | A representation of whether the era supports auxiliary scripts in
537
-- Auxiliary scripts are supported from the Allegra era onwards.
539
data AuxScriptsSupportedInEra era where
541
AuxScriptsInAllegraEra :: AuxScriptsSupportedInEra AllegraEra
542
AuxScriptsInMaryEra :: AuxScriptsSupportedInEra MaryEra
544
deriving instance Eq (AuxScriptsSupportedInEra era)
545
deriving instance Show (AuxScriptsSupportedInEra era)
547
auxScriptsSupportedInEra :: CardanoEra era
548
-> Maybe (AuxScriptsSupportedInEra era)
549
auxScriptsSupportedInEra ByronEra = Nothing
550
auxScriptsSupportedInEra ShelleyEra = Nothing
551
auxScriptsSupportedInEra AllegraEra = Just AuxScriptsInAllegraEra
552
auxScriptsSupportedInEra MaryEra = Just AuxScriptsInMaryEra
555
-- | A representation of whether the era supports withdrawals from reward
558
-- The Shelley and subsequent eras support stake addresses, their associated
559
-- reward accounts and support for withdrawals from them.
561
data WithdrawalsSupportedInEra era where
563
WithdrawalsInShelleyEra :: WithdrawalsSupportedInEra ShelleyEra
564
WithdrawalsInAllegraEra :: WithdrawalsSupportedInEra AllegraEra
565
WithdrawalsInMaryEra :: WithdrawalsSupportedInEra MaryEra
567
deriving instance Eq (WithdrawalsSupportedInEra era)
568
deriving instance Show (WithdrawalsSupportedInEra era)
570
withdrawalsSupportedInEra :: CardanoEra era
571
-> Maybe (WithdrawalsSupportedInEra era)
572
withdrawalsSupportedInEra ByronEra = Nothing
573
withdrawalsSupportedInEra ShelleyEra = Just WithdrawalsInShelleyEra
574
withdrawalsSupportedInEra AllegraEra = Just WithdrawalsInAllegraEra
575
withdrawalsSupportedInEra MaryEra = Just WithdrawalsInMaryEra
578
-- | A representation of whether the era supports 'Certificate's embedded in
581
-- The Shelley and subsequent eras support such certificates.
583
data CertificatesSupportedInEra era where
585
CertificatesInShelleyEra :: CertificatesSupportedInEra ShelleyEra
586
CertificatesInAllegraEra :: CertificatesSupportedInEra AllegraEra
587
CertificatesInMaryEra :: CertificatesSupportedInEra MaryEra
589
deriving instance Eq (CertificatesSupportedInEra era)
590
deriving instance Show (CertificatesSupportedInEra era)
592
certificatesSupportedInEra :: CardanoEra era
593
-> Maybe (CertificatesSupportedInEra era)
594
certificatesSupportedInEra ByronEra = Nothing
595
certificatesSupportedInEra ShelleyEra = Just CertificatesInShelleyEra
596
certificatesSupportedInEra AllegraEra = Just CertificatesInAllegraEra
597
certificatesSupportedInEra MaryEra = Just CertificatesInMaryEra
600
-- | A representation of whether the era supports 'UpdateProposal's embedded in
603
-- The Shelley and subsequent eras support such update proposals. They Byron
604
-- era has a notion of an update proposal, but it is a standalone chain object
605
-- and not embedded in a transaction.
607
data UpdateProposalSupportedInEra era where
609
UpdateProposalInShelleyEra :: UpdateProposalSupportedInEra ShelleyEra
610
UpdateProposalInAllegraEra :: UpdateProposalSupportedInEra AllegraEra
611
UpdateProposalInMaryEra :: UpdateProposalSupportedInEra MaryEra
613
deriving instance Eq (UpdateProposalSupportedInEra era)
614
deriving instance Show (UpdateProposalSupportedInEra era)
616
updateProposalSupportedInEra :: CardanoEra era
617
-> Maybe (UpdateProposalSupportedInEra era)
618
updateProposalSupportedInEra ByronEra = Nothing
619
updateProposalSupportedInEra ShelleyEra = Just UpdateProposalInShelleyEra
620
updateProposalSupportedInEra AllegraEra = Just UpdateProposalInAllegraEra
621
updateProposalSupportedInEra MaryEra = Just UpdateProposalInMaryEra
624
-- ----------------------------------------------------------------------------
625
-- Building vs viewing transactions
631
data BuildTxWith build a where
633
ViewTx :: BuildTxWith ViewTx a
634
BuildTxWith :: a -> BuildTxWith BuildTx a
636
deriving instance Eq a => Eq (BuildTxWith build a)
637
deriving instance Show a => Show (BuildTxWith build a)
640
-- ----------------------------------------------------------------------------
641
-- Transaction output values (era-dependent)
644
data TxOutValue era where
646
TxOutAdaOnly :: OnlyAdaSupportedInEra era -> Lovelace -> TxOutValue era
648
TxOutValue :: MultiAssetSupportedInEra era -> Value -> TxOutValue era
650
deriving instance Eq (TxOutValue era)
651
deriving instance Show (TxOutValue era)
652
deriving instance Generic (TxOutValue era)
654
instance ToJSON (TxOutValue era) where
655
toJSON (TxOutAdaOnly _ ll) = toJSON ll
656
toJSON (TxOutValue _ val) = toJSON val
658
-- ----------------------------------------------------------------------------
664
TxFeeImplicit :: TxFeesImplicitInEra era -> TxFee era
666
TxFeeExplicit :: TxFeesExplicitInEra era -> Lovelace -> TxFee era
668
deriving instance Eq (TxFee era)
669
deriving instance Show (TxFee era)
672
-- ----------------------------------------------------------------------------
673
-- Transaction validity range
676
-- | This was formerly known as the TTL.
678
data TxValidityUpperBound era where
680
TxValidityNoUpperBound :: ValidityNoUpperBoundSupportedInEra era
681
-> TxValidityUpperBound era
683
TxValidityUpperBound :: ValidityUpperBoundSupportedInEra era
685
-> TxValidityUpperBound era
687
deriving instance Eq (TxValidityUpperBound era)
688
deriving instance Show (TxValidityUpperBound era)
691
data TxValidityLowerBound era where
693
TxValidityNoLowerBound :: TxValidityLowerBound era
695
TxValidityLowerBound :: ValidityLowerBoundSupportedInEra era
697
-> TxValidityLowerBound era
699
deriving instance Eq (TxValidityLowerBound era)
700
deriving instance Show (TxValidityLowerBound era)
703
-- ----------------------------------------------------------------------------
704
-- Transaction metadata (era-dependent)
707
data TxMetadataInEra era where
709
TxMetadataNone :: TxMetadataInEra era
711
TxMetadataInEra :: TxMetadataSupportedInEra era
713
-> TxMetadataInEra era
715
deriving instance Eq (TxMetadataInEra era)
716
deriving instance Show (TxMetadataInEra era)
719
-- ----------------------------------------------------------------------------
720
-- Auxiliary scripts (era-dependent)
723
data TxAuxScripts era where
725
TxAuxScriptsNone :: TxAuxScripts era
727
TxAuxScripts :: AuxScriptsSupportedInEra era
731
deriving instance Eq (TxAuxScripts era)
732
deriving instance Show (TxAuxScripts era)
735
-- ----------------------------------------------------------------------------
736
-- Withdrawals within transactions (era-dependent)
739
data TxWithdrawals build era where
741
TxWithdrawalsNone :: TxWithdrawals build era
743
TxWithdrawals :: WithdrawalsSupportedInEra era
744
-> [(StakeAddress, Lovelace,
745
BuildTxWith build (Witness WitCtxStake era))]
746
-> TxWithdrawals build era
748
deriving instance Eq (TxWithdrawals build era)
749
deriving instance Show (TxWithdrawals build era)
752
-- ----------------------------------------------------------------------------
753
-- Certificates within transactions (era-dependent)
756
data TxCertificates build era where
758
TxCertificatesNone :: TxCertificates build era
760
TxCertificates :: CertificatesSupportedInEra era
763
(Map StakeCredential (Witness WitCtxStake era))
764
-> TxCertificates build era
766
deriving instance Eq (TxCertificates build era)
767
deriving instance Show (TxCertificates build era)
770
-- ----------------------------------------------------------------------------
771
-- Transaction metadata (era-dependent)
774
data TxUpdateProposal era where
776
TxUpdateProposalNone :: TxUpdateProposal era
778
TxUpdateProposal :: UpdateProposalSupportedInEra era
780
-> TxUpdateProposal era
782
deriving instance Eq (TxUpdateProposal era)
783
deriving instance Show (TxUpdateProposal era)
786
-- ----------------------------------------------------------------------------
787
-- Value minting within transactions (era-dependent)
790
data TxMintValue build era where
792
TxMintNone :: TxMintValue build era
794
TxMintValue :: MultiAssetSupportedInEra era
796
-> BuildTxWith build (Map PolicyId (Witness WitCtxMint era))
797
-> TxMintValue build era
799
deriving instance Eq (TxMintValue build era)
800
deriving instance Show (TxMintValue build era)
803
-- ----------------------------------------------------------------------------
804
-- Transaction body content
807
data TxBodyContent build era =
809
txIns :: [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))],
810
txOuts :: [TxOut era],
812
txValidityRange :: (TxValidityLowerBound era,
813
TxValidityUpperBound era),
814
txMetadata :: TxMetadataInEra era,
815
txAuxScripts :: TxAuxScripts era,
816
txWithdrawals :: TxWithdrawals build era,
817
txCertificates :: TxCertificates build era,
818
txUpdateProposal :: TxUpdateProposal era,
819
txMintValue :: TxMintValue build era
823
-- ----------------------------------------------------------------------------
824
-- Transaction bodies
827
data TxBody era where
830
:: Annotated Byron.Tx ByteString
834
:: ShelleyBasedEra era
835
-> Ledger.TxBody (ShelleyLedgerEra era)
837
-- We include the scripts along with the tx body, rather than the
838
-- witnesses set, since they need to be known when building the body.
839
-> [Ledger.Script (ShelleyLedgerEra era)]
841
-- The 'Ledger.AuxiliaryData' consists of one or several things,
843
-- + transaction metadata (in Shelley and later)
844
-- + auxiliary scripts (in Allegra and later)
845
-- + auxiliary script data (in Allonzo and later)
846
-> Maybe (Ledger.AuxiliaryData (ShelleyLedgerEra era))
849
-- The 'ShelleyBasedEra' GADT tells us what era we are in.
850
-- The 'ShelleyLedgerEra' type family maps that to the era type from the
851
-- ledger lib. The 'Ledger.TxBody' type family maps that to a specific
852
-- tx body type, which is different for each Shelley-based era.
855
-- The GADT in the ShelleyTxBody case requires a custom instance
856
instance Eq (TxBody era) where
857
(==) (ByronTxBody txbodyA)
858
(ByronTxBody txbodyB) = txbodyA == txbodyB
860
(==) (ShelleyTxBody era txbodyA txscriptsA txmetadataA)
861
(ShelleyTxBody _ txbodyB txscriptsB txmetadataB) =
863
ShelleyBasedEraShelley -> txbodyA == txbodyB
864
&& txscriptsA == txscriptsB
865
&& txmetadataA == txmetadataB
867
ShelleyBasedEraAllegra -> txbodyA == txbodyB
868
&& txscriptsA == txscriptsB
869
&& txmetadataA == txmetadataB
871
ShelleyBasedEraMary -> txbodyA == txbodyB
872
&& txscriptsA == txscriptsB
873
&& txmetadataA == txmetadataB
875
(==) ByronTxBody{} (ShelleyTxBody era _ _ _) = case era of {}
878
-- The GADT in the ShelleyTxBody case requires a custom instance
879
instance Show (TxBody era) where
880
showsPrec p (ByronTxBody txbody) =
882
( showString "ByronTxBody "
883
. showsPrec 11 txbody
886
showsPrec p (ShelleyTxBody ShelleyBasedEraShelley
887
txbody txscripts txmetadata) =
889
( showString "ShelleyTxBody ShelleyBasedEraShelley "
890
. showsPrec 11 txbody
892
. showsPrec 11 txscripts
894
. showsPrec 11 txmetadata
897
showsPrec p (ShelleyTxBody ShelleyBasedEraAllegra
898
txbody txscripts txmetadata) =
900
( showString "ShelleyTxBody ShelleyBasedEraAllegra "
901
. showsPrec 11 txbody
903
. showsPrec 11 txscripts
905
. showsPrec 11 txmetadata
908
showsPrec p (ShelleyTxBody ShelleyBasedEraMary
909
txbody txscripts txmetadata) =
911
( showString "ShelleyTxBody ShelleyBasedEraMary "
912
. showsPrec 11 txbody
914
. showsPrec 11 txscripts
916
. showsPrec 11 txmetadata
919
instance HasTypeProxy era => HasTypeProxy (TxBody era) where
920
data AsType (TxBody era) = AsTxBody (AsType era)
921
proxyToAsType _ = AsTxBody (proxyToAsType (Proxy :: Proxy era))
923
pattern AsByronTxBody :: AsType (TxBody ByronEra)
924
pattern AsByronTxBody = AsTxBody AsByronEra
925
{-# COMPLETE AsByronTxBody #-}
927
pattern AsShelleyTxBody :: AsType (TxBody ShelleyEra)
928
pattern AsShelleyTxBody = AsTxBody AsShelleyEra
929
{-# COMPLETE AsShelleyTxBody #-}
931
pattern AsMaryTxBody :: AsType (TxBody MaryEra)
932
pattern AsMaryTxBody = AsTxBody AsMaryEra
933
{-# COMPLETE AsMaryTxBody #-}
935
instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where
937
serialiseToCBOR (ByronTxBody txbody) =
940
serialiseToCBOR (ShelleyTxBody era txbody txscripts txmetadata) =
942
-- Use the same serialisation impl, but at different types:
943
ShelleyBasedEraShelley -> serialiseShelleyBasedTxBody txbody txscripts txmetadata
944
ShelleyBasedEraAllegra -> serialiseShelleyBasedTxBody txbody txscripts txmetadata
945
ShelleyBasedEraMary -> serialiseShelleyBasedTxBody txbody txscripts txmetadata
947
deserialiseFromCBOR _ bs =
948
case cardanoEra :: CardanoEra era of
951
CBOR.decodeFullAnnotatedBytes
953
CBOR.fromCBORAnnotated
956
-- Use the same derialisation impl, but at different types:
957
ShelleyEra -> deserialiseShelleyBasedTxBody
958
(ShelleyTxBody ShelleyBasedEraShelley) bs
959
AllegraEra -> deserialiseShelleyBasedTxBody
960
(ShelleyTxBody ShelleyBasedEraAllegra) bs
961
MaryEra -> deserialiseShelleyBasedTxBody
962
(ShelleyTxBody ShelleyBasedEraMary) bs
964
-- | The serialisation format for the different Shelley-based eras are not the
965
-- same, but they can be handled generally with one overloaded implementation.
967
serialiseShelleyBasedTxBody :: forall txbody script metadata.
968
(ToCBOR txbody, ToCBOR script, ToCBOR metadata)
973
serialiseShelleyBasedTxBody txbody txscripts txmetadata =
974
CBOR.serializeEncoding' $
976
<> CBOR.toCBOR txbody
977
<> CBOR.toCBOR txscripts
978
<> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata
980
deserialiseShelleyBasedTxBody :: forall txbody script metadata pair.
981
(FromCBOR (CBOR.Annotator txbody),
982
FromCBOR (CBOR.Annotator script),
983
FromCBOR (CBOR.Annotator metadata))
984
=> (txbody -> [script] -> Maybe metadata -> pair)
986
-> Either CBOR.DecoderError pair
987
deserialiseShelleyBasedTxBody mkTxBody bs =
993
decodeAnnotatedTuple :: CBOR.Decoder s (CBOR.Annotator pair)
994
decodeAnnotatedTuple = do
995
CBOR.decodeListLenOf 3
997
txscripts <- fromCBOR
998
txmetadata <- CBOR.decodeNullMaybe fromCBOR
999
return $ CBOR.Annotator $ \fbs ->
1001
(CBOR.runAnnotator txbody fbs)
1002
(map (`CBOR.runAnnotator` fbs) txscripts)
1003
(CBOR.runAnnotator <$> txmetadata <*> pure fbs)
1005
instance IsCardanoEra era => HasTextEnvelope (TxBody era) where
1006
textEnvelopeType _ =
1007
case cardanoEra :: CardanoEra era of
1008
ByronEra -> "TxUnsignedByron"
1009
ShelleyEra -> "TxUnsignedShelley"
1010
AllegraEra -> "TxBodyAllegra"
1011
MaryEra -> "TxBodyMary"
1014
-- ----------------------------------------------------------------------------
1015
-- Constructing transaction bodies
1018
data TxBodyError era =
1021
| TxBodyOutputNegative Quantity (TxOut era)
1022
| TxBodyOutputOverflow Quantity (TxOut era)
1023
| TxBodyMetadataError [(Word64, TxMetadataRangeError)]
1024
| TxBodyMintAdaError
1027
instance Error (TxBodyError era) where
1028
displayError TxBodyEmptyTxIns = "Transaction body has no inputs"
1029
displayError TxBodyEmptyTxOuts = "Transaction body has no outputs"
1030
displayError (TxBodyOutputNegative (Quantity q) txout) =
1031
"Negative quantity (" ++ show q ++ ") in transaction output: " ++
1033
displayError (TxBodyOutputOverflow (Quantity q) txout) =
1034
"Quantity too large (" ++ show q ++ " >= 2^64) in transaction output: " ++
1036
displayError (TxBodyMetadataError [(k, err)]) =
1037
"Error in metadata entry " ++ show k ++ ": " ++ displayError err
1038
displayError (TxBodyMetadataError errs) =
1039
"Error in metadata entries: " ++
1041
[ show k ++ ": " ++ displayError err
1042
| (k, err) <- errs ]
1043
displayError TxBodyMintAdaError =
1044
"Transaction cannot mint ada, only non-ada assets"
1047
makeTransactionBody :: forall era.
1049
=> TxBodyContent BuildTx era
1050
-> Either (TxBodyError era) (TxBody era)
1051
makeTransactionBody =
1052
case cardanoEraStyle (cardanoEra :: CardanoEra era) of
1053
LegacyByronEra -> makeByronTransactionBody
1054
ShelleyBasedEra era -> makeShelleyTransactionBody era
1057
makeByronTransactionBody :: TxBodyContent BuildTx ByronEra
1058
-> Either (TxBodyError ByronEra) (TxBody ByronEra)
1059
makeByronTransactionBody TxBodyContent { txIns, txOuts } = do
1060
ins' <- NonEmpty.nonEmpty txIns ?! TxBodyEmptyTxIns
1061
let ins'' = NonEmpty.map (toByronTxIn . fst) ins'
1063
outs' <- NonEmpty.nonEmpty txOuts ?! TxBodyEmptyTxOuts
1065
(\out -> toByronTxOut out ?! classifyRangeError out)
1071
(Byron.UnsafeTx ins'' outs'' (Byron.mkAttributes ()))
1074
classifyRangeError :: TxOut ByronEra -> TxBodyError ByronEra
1076
txout@(TxOut (AddressInEra ByronAddressInAnyEra ByronAddress{})
1077
(TxOutAdaOnly AdaOnlyInByronEra value))
1078
| value < 0 = TxBodyOutputNegative (lovelaceToQuantity value) txout
1079
| otherwise = TxBodyOutputOverflow (lovelaceToQuantity value) txout
1082
(TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress _))
1083
(TxOutValue era _)) = case era of {}
1086
(TxOut (AddressInEra (ShelleyAddressInEra era) ShelleyAddress{})
1089
makeShelleyTransactionBody :: ShelleyBasedEra era
1090
-> TxBodyContent BuildTx era
1091
-> Either (TxBodyError era) (TxBody era)
1092
makeShelleyTransactionBody era@ShelleyBasedEraShelley
1093
txbodycontent@TxBodyContent {
1097
txValidityRange = (_, upperBound),
1104
guard (not (null txIns)) ?! TxBodyEmptyTxIns
1106
[ do guard (v >= 0) ?! TxBodyOutputNegative (lovelaceToQuantity v) txout
1107
guard (v <= maxTxOut) ?! TxBodyOutputOverflow (lovelaceToQuantity v) txout
1108
| let maxTxOut = fromIntegral (maxBound :: Word64) :: Lovelace
1109
, txout@(TxOut _ (TxOutAdaOnly AdaOnlyInShelleyEra v)) <- txOuts ]
1111
TxMetadataNone -> return ()
1112
TxMetadataInEra _ m -> first TxBodyMetadataError (validateTxMetadata m)
1117
(Set.fromList (map (toShelleyTxIn . fst) txIns))
1118
(Seq.fromList (map toShelleyTxOut txOuts))
1119
(case txCertificates of
1120
TxCertificatesNone -> Seq.empty
1121
TxCertificates _ cs _ -> Seq.fromList (map toShelleyCertificate cs))
1122
(case txWithdrawals of
1123
TxWithdrawalsNone -> Shelley.Wdrl Map.empty
1124
TxWithdrawals _ ws -> toShelleyWithdrawal ws)
1126
TxFeeImplicit era' -> case era' of {}
1127
TxFeeExplicit _ fee -> toShelleyLovelace fee)
1129
TxValidityNoUpperBound era' -> case era' of {}
1130
TxValidityUpperBound _ ttl -> ttl)
1131
(case txUpdateProposal of
1132
TxUpdateProposalNone -> SNothing
1133
TxUpdateProposal _ p -> SJust (toShelleyUpdate p))
1135
(Ledger.hashAuxiliaryData @StandardShelley <$> txAuxData)))
1136
(map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent))
1139
txAuxData :: Maybe (Ledger.AuxiliaryData StandardShelley)
1141
| Map.null ms = Nothing
1142
| otherwise = Just (toShelleyAuxiliaryData ms)
1144
ms = case txMetadata of
1145
TxMetadataNone -> Map.empty
1146
TxMetadataInEra _ (TxMetadata ms') -> ms'
1148
makeShelleyTransactionBody era@ShelleyBasedEraAllegra
1149
txbodycontent@TxBodyContent {
1153
txValidityRange = (lowerBound, upperBound),
1161
guard (not (null txIns)) ?! TxBodyEmptyTxIns
1163
[ do guard (v >= 0) ?! TxBodyOutputNegative (lovelaceToQuantity v) txout
1164
guard (v <= maxTxOut) ?! TxBodyOutputOverflow (lovelaceToQuantity v) txout
1165
| let maxTxOut = fromIntegral (maxBound :: Word64) :: Lovelace
1166
, txout@(TxOut _ (TxOutAdaOnly AdaOnlyInAllegraEra v)) <- txOuts
1169
TxMetadataNone -> return ()
1170
TxMetadataInEra _ m -> validateTxMetadata m ?!. TxBodyMetadataError
1175
(Set.fromList (map (toShelleyTxIn . fst) txIns))
1176
(Seq.fromList (map toShelleyTxOut txOuts))
1177
(case txCertificates of
1178
TxCertificatesNone -> Seq.empty
1179
TxCertificates _ cs _ -> Seq.fromList (map toShelleyCertificate cs))
1180
(case txWithdrawals of
1181
TxWithdrawalsNone -> Shelley.Wdrl Map.empty
1182
TxWithdrawals _ ws -> toShelleyWithdrawal ws)
1184
TxFeeImplicit era' -> case era' of {}
1185
TxFeeExplicit _ fee -> toShelleyLovelace fee)
1186
(Allegra.ValidityInterval {
1187
Allegra.invalidBefore = case lowerBound of
1188
TxValidityNoLowerBound -> SNothing
1189
TxValidityLowerBound _ s -> SJust s,
1190
Allegra.invalidHereafter = case upperBound of
1191
TxValidityNoUpperBound _ -> SNothing
1192
TxValidityUpperBound _ s -> SJust s
1194
(case txUpdateProposal of
1195
TxUpdateProposalNone -> SNothing
1196
TxUpdateProposal _ p -> SJust (toShelleyUpdate p))
1198
(Ledger.hashAuxiliaryData @StandardAllegra <$> txAuxData))
1199
mempty) -- No minting in Allegra, only Mary
1200
(map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent))
1203
txAuxData :: Maybe (Ledger.AuxiliaryData StandardAllegra)
1207
| otherwise = Just (toAllegraAuxiliaryData ms ss)
1209
ms = case txMetadata of
1210
TxMetadataNone -> Map.empty
1211
TxMetadataInEra _ (TxMetadata ms') -> ms'
1212
ss = case txAuxScripts of
1213
TxAuxScriptsNone -> []
1214
TxAuxScripts _ ss' -> ss'
1216
makeShelleyTransactionBody era@ShelleyBasedEraMary
1217
txbodycontent@TxBodyContent {
1221
txValidityRange = (lowerBound, upperBound),
1230
guard (not (null txIns)) ?! TxBodyEmptyTxIns
1234
| let maxTxOut = fromIntegral (maxBound :: Word64) :: Quantity
1235
, txout@(TxOut _ (TxOutValue MultiAssetInMaryEra v)) <- txOuts
1236
, let allPositive = case [ q | (_,q) <- valueToList v, q < 0 ] of
1238
q:_ -> Left (TxBodyOutputNegative q txout)
1239
allWithinMaxBound = case [ q | (_,q) <- valueToList v, q > maxTxOut ] of
1241
q:_ -> Left (TxBodyOutputOverflow q txout)
1244
TxMetadataNone -> return ()
1245
TxMetadataInEra _ m -> validateTxMetadata m ?!. TxBodyMetadataError
1247
TxMintNone -> return ()
1248
TxMintValue _ v _ -> guard (selectLovelace v == 0) ?! TxBodyMintAdaError
1253
(Set.fromList (map (toShelleyTxIn . fst) txIns))
1254
(Seq.fromList (map toShelleyTxOut txOuts))
1255
(case txCertificates of
1256
TxCertificatesNone -> Seq.empty
1257
TxCertificates _ cs _ -> Seq.fromList (map toShelleyCertificate cs))
1258
(case txWithdrawals of
1259
TxWithdrawalsNone -> Shelley.Wdrl Map.empty
1260
TxWithdrawals _ ws -> toShelleyWithdrawal ws)
1262
TxFeeImplicit era' -> case era' of {}
1263
TxFeeExplicit _ fee -> toShelleyLovelace fee)
1264
(Allegra.ValidityInterval {
1265
Allegra.invalidBefore = case lowerBound of
1266
TxValidityNoLowerBound -> SNothing
1267
TxValidityLowerBound _ s -> SJust s,
1268
Allegra.invalidHereafter = case upperBound of
1269
TxValidityNoUpperBound _ -> SNothing
1270
TxValidityUpperBound _ s -> SJust s
1272
(case txUpdateProposal of
1273
TxUpdateProposalNone -> SNothing
1274
TxUpdateProposal _ p -> SJust (toShelleyUpdate p))
1276
(Ledger.hashAuxiliaryData @StandardMary <$> txAuxData))
1277
(case txMintValue of
1278
TxMintNone -> mempty
1279
TxMintValue _ v _ -> toMaryValue v))
1280
(map toShelleySimpleScript (collectTxBodySimpleScripts txbodycontent))
1283
txAuxData :: Maybe (Ledger.AuxiliaryData StandardMary)
1287
| otherwise = Just (toAllegraAuxiliaryData ms ss)
1289
ms = case txMetadata of
1290
TxMetadataNone -> Map.empty
1291
TxMetadataInEra _ (TxMetadata ms') -> ms'
1292
ss = case txAuxScripts of
1293
TxAuxScriptsNone -> []
1294
TxAuxScripts _ ss' -> ss'
1296
data SimpleScriptInEra era where
1297
SimpleScriptInEra :: ScriptLanguageInEra lang era
1298
-> SimpleScriptVersion lang
1299
-> SimpleScript lang
1300
-> SimpleScriptInEra era
1302
{-# ANN collectTxBodySimpleScripts ("HLint: ignore Reduce duplication" :: Text) #-}
1304
collectTxBodySimpleScripts :: TxBodyContent BuildTx era
1305
-> [SimpleScriptInEra era]
1306
collectTxBodySimpleScripts TxBodyContent {
1313
| (_, BuildTxWith witness) <- txIns
1314
, script <- simpleScriptInEra witness ]
1317
| TxWithdrawals _ withdrawals <- [txWithdrawals]
1318
, (_, _, BuildTxWith witness) <- withdrawals
1319
, script <- simpleScriptInEra witness ]
1322
| TxCertificates _ _ (BuildTxWith witnesses) <- [txCertificates]
1323
, witness <- Map.elems witnesses
1324
, script <- simpleScriptInEra witness ]
1327
| TxMintValue _ _ (BuildTxWith witnesses) <- [txMintValue]
1328
, witness <- Map.elems witnesses
1329
, script <- simpleScriptInEra witness ]
1332
simpleScriptInEra :: Witness witctx era -> [SimpleScriptInEra era]
1333
simpleScriptInEra (ScriptWitness
1334
_ (SimpleScriptWitness langInEra version script)) =
1335
[SimpleScriptInEra langInEra version script]
1337
simpleScriptInEra _ = []
1339
toShelleySimpleScript :: SimpleScriptInEra era
1340
-> Ledger.Script (ShelleyLedgerEra era)
1341
toShelleySimpleScript (SimpleScriptInEra langInEra version script) =
1342
toShelleyScript (ScriptInEra langInEra (SimpleScript version script))
1344
toShelleyWithdrawal :: [(StakeAddress, Lovelace, a)] -> Shelley.Wdrl StandardCrypto
1345
toShelleyWithdrawal withdrawals =
1348
[ (toShelleyStakeAddr stakeAddr, toShelleyLovelace value)
1349
| (stakeAddr, value, _) <- withdrawals ]
1351
-- | In the Shelley era the auxiliary data consists only of the tx metadata
1352
toShelleyAuxiliaryData :: Map Word64 TxMetadataValue
1353
-> Ledger.AuxiliaryData StandardShelley
1354
toShelleyAuxiliaryData m =
1356
(toShelleyMetadata m)
1358
-- | In the Allegra and Mary eras the auxiliary data consists of the tx metadata
1359
-- and the axiliary scripts.
1361
toAllegraAuxiliaryData :: forall era ledgeera.
1362
ShelleyLedgerEra era ~ ledgeera
1363
=> Ledger.AuxiliaryData ledgeera ~ Allegra.AuxiliaryData ledgeera
1364
=> Ledger.AnnotatedData (Ledger.Script ledgeera)
1365
=> Ord (Ledger.Script ledgeera)
1366
=> Map Word64 TxMetadataValue
1367
-> [ScriptInEra era]
1368
-> Ledger.AuxiliaryData ledgeera
1369
toAllegraAuxiliaryData m ss =
1370
Allegra.AuxiliaryData
1371
(toShelleyMetadata m)
1372
(Seq.fromList (map toShelleyScript ss))
1374
-- ----------------------------------------------------------------------------
1375
-- Transitional utility functions for making transaction bodies
1378
-- | Transitional function to help the CLI move to the updated TxBody API.
1380
makeByronTransaction :: [TxIn]
1382
-> Either (TxBodyError ByronEra) (TxBody ByronEra)
1383
makeByronTransaction txIns txOuts =
1384
makeTransactionBody $
1386
txIns = [ (txin, BuildTxWith (KeyWitness KeyWitnessForSpending))
1389
txFee = TxFeeImplicit TxFeesImplicitInByronEra,
1390
txValidityRange = (TxValidityNoLowerBound,
1391
TxValidityNoUpperBound
1392
ValidityNoUpperBoundInByronEra),
1393
txMetadata = TxMetadataNone,
1394
txAuxScripts = TxAuxScriptsNone,
1395
txWithdrawals = TxWithdrawalsNone,
1396
txCertificates = TxCertificatesNone,
1397
txUpdateProposal = TxUpdateProposalNone,
1398
txMintValue = TxMintNone
1400
{-# DEPRECATED makeByronTransaction "Use makeTransactionBody" #-}
1402
-- ----------------------------------------------------------------------------
1403
-- Other utilities helpful with making transaction bodies
1406
-- | Compute the 'TxIn' of the initial UTxO pseudo-transaction corresponding
1407
-- to the given address in the genesis initial funds.
1409
-- The Shelley initial UTxO is constructed from the 'sgInitialFunds' which
1410
-- is not a full UTxO but just a map from addresses to coin values.
1412
-- This gets turned into a UTxO by making a pseudo-transaction for each address,
1413
-- with the 0th output being the coin value. So to spend from the initial UTxO
1414
-- we need this same 'TxIn' to use as an input to the spending transaction.
1416
genesisUTxOPseudoTxIn :: NetworkId -> Hash GenesisUTxOKey -> TxIn
1417
genesisUTxOPseudoTxIn nw (GenesisUTxOKeyHash kh) =
1418
--TODO: should handle Byron UTxO case too.
1419
fromShelleyTxIn (Shelley.initialFundsPseudoTxIn addr)
1421
addr :: Shelley.Addr StandardCrypto
1423
(toShelleyNetwork nw)
1424
(Shelley.KeyHashObj kh)
1425
Shelley.StakeRefNull
added
removed
cardano-api/src/Cardano/Api/TxBody.hs
