Skip to content

Commit 675c614

Browse files
iohk-bors[bot]newhoggyJimbo4350
authored
Merge #4135
4135: Transaction build in any alonzo era when on babbage testnet r=newhoggy a=newhoggy Resolves #3909 for building Alonzo transactions from Babbage era Co-authored-by: John Ky <[email protected]> Co-authored-by: Jordan Millar <[email protected]>
2 parents 803881b + af2e359 commit 675c614

File tree

10 files changed

+180
-47
lines changed

10 files changed

+180
-47
lines changed

‎cardano-api/cardano-api.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ library
4040
Cardano.Api.ChainSync.Client
4141
Cardano.Api.ChainSync.ClientPipelined
4242
Cardano.Api.Crypto.Ed25519Bip32
43+
Cardano.Api.EraCast
4344
Cardano.Api.Protocol.Types
4445
Cardano.Api.Shelley
4546
-- TODO: Eliminate in the future when

‎cardano-api/src/Cardano/Api.hs

+6-2
Original file line numberDiff line numberDiff line change
@@ -664,19 +664,23 @@ module Cardano.Api (
664664
chainPointToHeaderHash,
665665
makeChainTip,
666666
parseFilePath,
667-
writeSecrets
667+
writeSecrets,
668668

669+
-- ** Cast functions
670+
EraCast (..),
671+
EraCastError (..),
669672
) where
670673

671674
import Cardano.Api.Address
672675
import Cardano.Api.Block
673676
import Cardano.Api.Certificate
677+
import Cardano.Api.EraCast
674678
import Cardano.Api.Eras
675679
import Cardano.Api.Error
676680
import Cardano.Api.Fees
677681
import Cardano.Api.GenesisParameters
678-
import Cardano.Api.HasTypeProxy
679682
import Cardano.Api.Hash
683+
import Cardano.Api.HasTypeProxy
680684
import Cardano.Api.IPC
681685
import Cardano.Api.IPC.Monad
682686
import Cardano.Api.Key

‎cardano-api/src/Cardano/Api/Address.hs

+16-1
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@
66
{-# LANGUAGE StandaloneDeriving #-}
77
{-# LANGUAGE TypeFamilies #-}
88

9+
{- HLINT ignore "Avoid lambda using `infix`" -}
10+
911
-- | Cardano addresses: payment and stake addresses.
1012
--
1113
module Cardano.Api.Address (
@@ -95,9 +97,10 @@ import qualified Cardano.Ledger.Credential as Shelley
9597
import Cardano.Ledger.Crypto (StandardCrypto)
9698
import qualified Plutus.V1.Ledger.Api as Plutus
9799

100+
import Cardano.Api.EraCast
98101
import Cardano.Api.Eras
99-
import Cardano.Api.HasTypeProxy
100102
import Cardano.Api.Hash
103+
import Cardano.Api.HasTypeProxy
101104
import Cardano.Api.Key
102105
import Cardano.Api.KeysByron
103106
import Cardano.Api.KeysShelley
@@ -353,6 +356,11 @@ instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where
353356
addressAny <- runParsecParser parseAddressAny txt
354357
pure $ anyAddressInShelleyBasedEra addressAny
355358

359+
instance EraCast AddressInEra where
360+
eraCast toEra' (AddressInEra addressTypeInEra address) = AddressInEra
361+
<$> eraCast toEra' addressTypeInEra
362+
<*> pure address
363+
356364
parseAddressAny :: Parsec.Parser AddressAny
357365
parseAddressAny = do
358366
str <- lexPlausibleAddressString
@@ -425,6 +433,13 @@ instance IsCardanoEra era => SerialiseAddress (AddressInEra era) where
425433
deserialiseAddress _ t =
426434
anyAddressInEra cardanoEra =<< deserialiseAddress AsAddressAny t
427435

436+
instance EraCast (AddressTypeInEra addrtype) where
437+
eraCast toEra' v = case v of
438+
ByronAddressInAnyEra -> pure ByronAddressInAnyEra
439+
ShelleyAddressInEra previousEra ->
440+
case cardanoEraStyle toEra' of
441+
LegacyByronEra -> Left $ EraCastError v (shelleyBasedToCardanoEra previousEra) toEra'
442+
ShelleyBasedEra newSbe -> Right $ ShelleyAddressInEra newSbe
428443

429444
byronAddressInEra :: Address ByronAddr -> AddressInEra era
430445
byronAddressInEra = AddressInEra ByronAddressInAnyEra

‎cardano-api/src/Cardano/Api/EraCast.hs

+29
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
{-# LANGUAGE GADTs #-}
2+
{-# LANGUAGE KindSignatures #-}
3+
4+
module Cardano.Api.EraCast
5+
( EraCast(..)
6+
, EraCastError(..)
7+
) where
8+
9+
import Cardano.Api.Eras (CardanoEra (..), IsCardanoEra)
10+
import Data.Either (Either)
11+
import Data.Kind (Type)
12+
import Text.Show (Show (..))
13+
14+
data EraCastError = forall fromEra toEra value.
15+
( IsCardanoEra fromEra
16+
, IsCardanoEra toEra
17+
, Show value
18+
) =>
19+
EraCastError
20+
{ originalValue :: value
21+
, fromEra :: CardanoEra fromEra
22+
, toEra :: CardanoEra toEra
23+
}
24+
25+
class EraCast (f :: Type -> Type) where
26+
eraCast :: (IsCardanoEra fromEra, IsCardanoEra toEra)
27+
=> CardanoEra toEra
28+
-> f fromEra
29+
-> Either EraCastError (f toEra)

‎cardano-api/src/Cardano/Api/Eras.hs

+5-3
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE GADTs #-}
22
{-# LANGUAGE LambdaCase #-}
33
{-# LANGUAGE PatternSynonyms #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
45
{-# LANGUAGE StandaloneDeriving #-}
56
{-# LANGUAGE TypeFamilies #-}
67

@@ -47,16 +48,16 @@ module Cardano.Api.Eras
4748

4849
import Prelude
4950

51+
import Cardano.Api.HasTypeProxy
52+
53+
import Control.DeepSeq
5054
import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
5155
import qualified Data.Text as Text
5256
import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
5357

5458
import Ouroboros.Consensus.Shelley.Eras as Consensus (StandardAllegra, StandardAlonzo,
5559
StandardBabbage, StandardMary, StandardShelley)
5660

57-
import Cardano.Api.HasTypeProxy
58-
import Control.DeepSeq (NFData(..))
59-
6061

6162
-- | A type used as a tag to distinguish the Byron era.
6263
data ByronEra
@@ -319,6 +320,7 @@ deriving instance Eq (ShelleyBasedEra era)
319320
deriving instance Ord (ShelleyBasedEra era)
320321
deriving instance Show (ShelleyBasedEra era)
321322

323+
322324
-- | The class of eras that are based on Shelley. This allows uniform handling
323325
-- of Shelley-based eras, but also non-uniform by making case distinctions on
324326
-- the 'ShelleyBasedEra' constructors.

‎cardano-api/src/Cardano/Api/Query.hs

+6-1
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ module Cardano.Api.Query (
6565

6666
) where
6767

68+
import Control.Monad (forM)
6869
import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.=))
6970
import qualified Data.Aeson as Aeson
7071
import Data.Aeson.Types (Parser)
@@ -115,6 +116,7 @@ import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
115116
import Cardano.Api.Address
116117
import Cardano.Api.Block
117118
import Cardano.Api.Certificate
119+
import Cardano.Api.EraCast
118120
import Cardano.Api.Eras
119121
import Cardano.Api.GenesisParameters
120122
import Cardano.Api.KeysShelley
@@ -124,9 +126,9 @@ import Cardano.Api.Orphans ()
124126
import Cardano.Api.ProtocolParameters
125127
import Cardano.Api.TxBody
126128
import Cardano.Api.Value
129+
import Data.Word (Word64)
127130

128131
import qualified Data.Aeson.KeyMap as KeyMap
129-
import Data.Word (Word64)
130132

131133
-- ----------------------------------------------------------------------------
132134
-- Queries
@@ -275,6 +277,9 @@ newtype ByronUpdateState = ByronUpdateState Byron.Update.State
275277
newtype UTxO era = UTxO { unUTxO :: Map TxIn (TxOut CtxUTxO era) }
276278
deriving (Eq, Show)
277279

280+
instance EraCast UTxO where
281+
eraCast toEra' (UTxO m) = UTxO <$> forM m (eraCast toEra')
282+
278283
data UTxOInAnyEra where
279284
UTxOInAnyEra :: CardanoEra era
280285
-> UTxO era

‎cardano-api/src/Cardano/Api/Script.hs

+15-4
Original file line numberDiff line numberDiff line change
@@ -2,13 +2,17 @@
22
{-# LANGUAGE DerivingVia #-}
33
{-# LANGUAGE FlexibleInstances #-}
44
{-# LANGUAGE GADTs #-}
5+
{-# LANGUAGE LambdaCase #-}
56
{-# LANGUAGE NamedFieldPuns #-}
67
{-# LANGUAGE RankNTypes #-}
78
{-# LANGUAGE ScopedTypeVariables #-}
89
{-# LANGUAGE StandaloneDeriving #-}
910
{-# LANGUAGE TypeApplications #-}
1011
{-# LANGUAGE TypeFamilies #-}
1112

13+
{- HLINT ignore "Avoid lambda using `infix`" -}
14+
{- HLINT ignore "Use section" -}
15+
1216
module Cardano.Api.Script (
1317
-- * Languages
1418
SimpleScriptV1,
@@ -150,10 +154,11 @@ import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
150154

151155
import qualified Plutus.V1.Ledger.Examples as Plutus
152156

157+
import Cardano.Api.EraCast
153158
import Cardano.Api.Eras
154159
import Cardano.Api.Error
155-
import Cardano.Api.HasTypeProxy
156160
import Cardano.Api.Hash
161+
import Cardano.Api.HasTypeProxy
157162
import Cardano.Api.KeysShelley
158163
import Cardano.Api.ScriptData
159164
import Cardano.Api.SerialiseCBOR
@@ -164,9 +169,6 @@ import Cardano.Api.SerialiseUsing
164169
import Cardano.Api.TxIn
165170
import Cardano.Api.Utils (failEitherWith)
166171

167-
{- HLINT ignore "Use section" -}
168-
169-
170172
-- ----------------------------------------------------------------------------
171173
-- Types for script language and version
172174
--
@@ -1420,6 +1422,7 @@ data ReferenceScript era where
14201422

14211423
deriving instance Eq (ReferenceScript era)
14221424
deriving instance Show (ReferenceScript era)
1425+
deriving instance Typeable (ReferenceScript era)
14231426

14241427
instance IsCardanoEra era => ToJSON (ReferenceScript era) where
14251428
toJSON (ReferenceScript _ s) = object ["referenceScript" .= s]
@@ -1432,6 +1435,14 @@ instance IsCardanoEra era => FromJSON (ReferenceScript era) where
14321435
Just refSupInEra ->
14331436
ReferenceScript refSupInEra <$> o .: "referenceScript"
14341437

1438+
instance EraCast ReferenceScript where
1439+
eraCast toEra = \case
1440+
ReferenceScriptNone -> pure ReferenceScriptNone
1441+
v@(ReferenceScript (_ :: ReferenceTxInsScriptsInlineDatumsSupportedInEra fromEra) scriptInAnyLang) ->
1442+
case refInsScriptsAndInlineDatsSupportedInEra toEra of
1443+
Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra
1444+
Just supportedInEra -> Right $ ReferenceScript supportedInEra scriptInAnyLang
1445+
14351446
data ReferenceTxInsScriptsInlineDatumsSupportedInEra era where
14361447
ReferenceTxInsScriptsInlineDatumsInBabbageEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
14371448

‎cardano-api/src/Cardano/Api/TxBody.hs

+44-6
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,9 @@
1515
{-# LANGUAGE TypeFamilies #-}
1616
{-# LANGUAGE ViewPatterns #-}
1717

18+
{- HLINT ignore "Avoid lambda using `infix`" -}
19+
{- HLINT ignore "Redundant flip" -}
20+
{- HLINT ignore "Use section" -}
1821

1922
-- | Transaction bodies
2023
--
@@ -181,8 +184,8 @@ import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
181184
import Data.Word (Word16, Word32, Word64)
182185
import GHC.Generics
183186
import GHC.Records (HasField (..))
184-
import Text.Parsec ((<?>))
185187
import qualified Text.Parsec as Parsec
188+
import Text.Parsec ((<?>))
186189
import qualified Text.Parsec.String as Parsec
187190

188191
import Cardano.Binary (Annotated (..), reAnnotate, recoverBytes)
@@ -239,10 +242,11 @@ import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardAlon
239242

240243
import Cardano.Api.Address
241244
import Cardano.Api.Certificate
245+
import Cardano.Api.EraCast
242246
import Cardano.Api.Eras
243247
import Cardano.Api.Error
244-
import Cardano.Api.HasTypeProxy
245248
import Cardano.Api.Hash
249+
import Cardano.Api.HasTypeProxy
246250
import Cardano.Api.KeysByron
247251
import Cardano.Api.KeysShelley
248252
import Cardano.Api.NetworkId
@@ -259,10 +263,6 @@ import Cardano.Api.Utils
259263
import Cardano.Api.Value
260264
import Cardano.Api.ValueParser
261265

262-
263-
{- HLINT ignore "Redundant flip" -}
264-
{- HLINT ignore "Use section" -}
265-
266266
-- | Indicates whether a script is expected to fail or pass validation.
267267
data ScriptValidity
268268
= ScriptInvalid -- ^ Script is expected to fail validation.
@@ -356,6 +356,14 @@ data TxOut ctx era = TxOut (AddressInEra era)
356356
deriving instance Eq (TxOut ctx era)
357357
deriving instance Show (TxOut ctx era)
358358

359+
instance EraCast (TxOut ctx) where
360+
eraCast toEra (TxOut addressInEra txOutValue txOutDatum referenceScript) =
361+
TxOut
362+
<$> eraCast toEra addressInEra
363+
<*> eraCast toEra txOutValue
364+
<*> eraCast toEra txOutDatum
365+
<*> eraCast toEra referenceScript
366+
359367
data TxOutInAnyEra where
360368
TxOutInAnyEra :: CardanoEra era
361369
-> TxOut CtxTx era
@@ -1188,6 +1196,18 @@ data TxOutValue era where
11881196

11891197
TxOutValue :: MultiAssetSupportedInEra era -> Value -> TxOutValue era
11901198

1199+
instance EraCast TxOutValue where
1200+
eraCast toEra v = case v of
1201+
TxOutAdaOnly _previousEra lovelace ->
1202+
case multiAssetSupportedInEra toEra of
1203+
Left adaOnly -> Right $ TxOutAdaOnly adaOnly lovelace
1204+
Right multiAssetSupp -> Right $ TxOutValue multiAssetSupp $ lovelaceToValue lovelace
1205+
TxOutValue (_ :: MultiAssetSupportedInEra fromEra) value ->
1206+
case multiAssetSupportedInEra toEra of
1207+
Left _adaOnly -> Left $ EraCastError v (cardanoEra @fromEra) toEra
1208+
Right multiAssetSupp -> Right $ TxOutValue multiAssetSupp value
1209+
1210+
11911211
deriving instance Eq (TxOutValue era)
11921212
deriving instance Show (TxOutValue era)
11931213
deriving instance Generic (TxOutValue era)
@@ -1333,6 +1353,24 @@ data TxOutDatum ctx era where
13331353
deriving instance Eq (TxOutDatum ctx era)
13341354
deriving instance Show (TxOutDatum ctx era)
13351355

1356+
instance EraCast (TxOutDatum ctx) where
1357+
eraCast toEra v = case v of
1358+
TxOutDatumNone -> pure TxOutDatumNone
1359+
TxOutDatumHash (_ :: ScriptDataSupportedInEra fromEra) hash ->
1360+
case scriptDataSupportedInEra toEra of
1361+
Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra
1362+
Just sDatumsSupported ->
1363+
Right $ TxOutDatumHash sDatumsSupported hash
1364+
TxOutDatumInTx' (_ :: ScriptDataSupportedInEra fromEra) scriptData hash ->
1365+
case scriptDataSupportedInEra toEra of
1366+
Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra
1367+
Just sDatumsSupported ->
1368+
Right $ TxOutDatumInTx' sDatumsSupported scriptData hash
1369+
TxOutDatumInline (_ :: ReferenceTxInsScriptsInlineDatumsSupportedInEra fromEra) scriptData ->
1370+
case refInsScriptsAndInlineDatsSupportedInEra toEra of
1371+
Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra
1372+
Just refInsAndInlineSupported ->
1373+
Right $ TxOutDatumInline refInsAndInlineSupported scriptData
13361374

13371375
pattern TxOutDatumInTx
13381376
:: ScriptDataSupportedInEra era

‎cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -51,8 +51,8 @@ import qualified Data.Text.IO as T
5151
import qualified Data.Text.IO as Text
5252
import Data.Text.Lazy.Builder (toLazyText)
5353
import Data.Time.Clock
54-
import qualified Data.VMap as VMap
5554
import qualified Data.Vector as Vector
55+
import qualified Data.VMap as VMap
5656
import Formatting.Buildable (build)
5757
import Numeric (showEFloat)
5858
import Text.Printf (printf)

0 commit comments

Comments
 (0)