-
Notifications
You must be signed in to change notification settings - Fork 721
/
Eras.hs
373 lines (296 loc) · 12.2 KB
/
Eras.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
-- | Cardano eras, sometimes we have to distinguish them.
--
module Cardano.Api.Eras
( -- * Eras
ByronEra
, ShelleyEra
, AllegraEra
, MaryEra
, AlonzoEra
, CardanoEra(..)
, IsCardanoEra(..)
, AnyCardanoEra(..)
, anyCardanoEra
, InAnyCardanoEra(..)
-- * Deprecated aliases
, Byron
, Shelley
, Allegra
, Mary
-- * Shelley-based eras
, ShelleyBasedEra(..)
, IsShelleyBasedEra(..)
, InAnyShelleyBasedEra(..)
, shelleyBasedToCardanoEra
-- ** Mapping to era types from the Shelley ledger library
, ShelleyLedgerEra
-- * Cardano eras, as Byron vs Shelley-based
, CardanoEraStyle(..)
, cardanoEraStyle
-- * Data family instances
, AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra,
AsByron, AsShelley, AsAllegra, AsMary)
) where
import Prelude
import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
import qualified Data.Text as Text
import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
import Ouroboros.Consensus.Shelley.Eras as Ledger (StandardAllegra, StandardAlonzo,
StandardMary, StandardShelley)
import Cardano.Api.HasTypeProxy
-- | A type used as a tag to distinguish the Byron era.
data ByronEra
-- | A type used as a tag to distinguish the Shelley era.
data ShelleyEra
-- | A type used as a tag to distinguish the Allegra era.
data AllegraEra
-- | A type used as a tag to distinguish the Mary era.
data MaryEra
-- | A type used as a tag to distinguish the Alonzo era.
data AlonzoEra
instance HasTypeProxy ByronEra where
data AsType ByronEra = AsByronEra
proxyToAsType _ = AsByronEra
instance HasTypeProxy ShelleyEra where
data AsType ShelleyEra = AsShelleyEra
proxyToAsType _ = AsShelleyEra
instance HasTypeProxy AllegraEra where
data AsType AllegraEra = AsAllegraEra
proxyToAsType _ = AsAllegraEra
instance HasTypeProxy MaryEra where
data AsType MaryEra = AsMaryEra
proxyToAsType _ = AsMaryEra
instance HasTypeProxy AlonzoEra where
data AsType AlonzoEra = AsAlonzoEra
proxyToAsType _ = AsAlonzoEra
-- ----------------------------------------------------------------------------
-- Deprecated aliases
--
type Byron = ByronEra
type Shelley = ShelleyEra
type Allegra = AllegraEra
type Mary = MaryEra
{-# DEPRECATED Byron "Use 'ByronEra' or 'ByronAddr' as appropriate" #-}
{-# DEPRECATED Shelley "Use 'ShelleyEra' or 'ShelleyAddr' as appropriate" #-}
{-# DEPRECATED Allegra "Use 'AllegraEra' instead" #-}
{-# DEPRECATED Mary "Use 'MaryEra' instead" #-}
pattern AsByron :: AsType ByronEra
pattern AsByron = AsByronEra
pattern AsShelley :: AsType ShelleyEra
pattern AsShelley = AsShelleyEra
pattern AsAllegra :: AsType AllegraEra
pattern AsAllegra = AsAllegraEra
pattern AsMary :: AsType MaryEra
pattern AsMary = AsMaryEra
{-# DEPRECATED AsByron "Use 'AsByronEra' instead" #-}
{-# DEPRECATED AsShelley "Use 'AsShelleyEra' instead" #-}
{-# DEPRECATED AsAllegra "Use 'AsAllegraEra' instead" #-}
{-# DEPRECATED AsMary "Use 'AsMaryEra' instead" #-}
-- ----------------------------------------------------------------------------
-- Value level representation for Cardano eras
--
-- | This GADT provides a value-level representation of all the Cardano eras.
-- This enables pattern matching on the era to allow them to be treated in a
-- non-uniform way.
--
-- This can be used in combination with the 'IsCardanoEra' class to get access
-- to this value.
--
-- In combination this can often enable code that handles all eras, and does
-- so uniformly where possible, and non-uniformly where necessary.
--
data CardanoEra era where
ByronEra :: CardanoEra ByronEra
ShelleyEra :: CardanoEra ShelleyEra
AllegraEra :: CardanoEra AllegraEra
MaryEra :: CardanoEra MaryEra
AlonzoEra :: CardanoEra AlonzoEra
-- when you add era here, change `instance Bounded AnyCardanoEra`
deriving instance Eq (CardanoEra era)
deriving instance Ord (CardanoEra era)
deriving instance Show (CardanoEra era)
instance ToJSON (CardanoEra era) where
toJSON ByronEra = "Byron"
toJSON ShelleyEra = "Shelley"
toJSON AllegraEra = "Allegra"
toJSON MaryEra = "Mary"
toJSON AlonzoEra = "Alonzo"
instance TestEquality CardanoEra where
testEquality ByronEra ByronEra = Just Refl
testEquality ShelleyEra ShelleyEra = Just Refl
testEquality AllegraEra AllegraEra = Just Refl
testEquality MaryEra MaryEra = Just Refl
testEquality AlonzoEra AlonzoEra = Just Refl
testEquality _ _ = Nothing
-- | The class of Cardano eras. This allows uniform handling of all Cardano
-- eras, but also non-uniform by making case distinctions on the 'CardanoEra'
-- constructors, or the 'CardanoEraStyle' constructors via `cardanoEraStyle`.
--
class HasTypeProxy era => IsCardanoEra era where
cardanoEra :: CardanoEra era
instance IsCardanoEra ByronEra where
cardanoEra = ByronEra
instance IsCardanoEra ShelleyEra where
cardanoEra = ShelleyEra
instance IsCardanoEra AllegraEra where
cardanoEra = AllegraEra
instance IsCardanoEra MaryEra where
cardanoEra = MaryEra
instance IsCardanoEra AlonzoEra where
cardanoEra = AlonzoEra
data AnyCardanoEra where
AnyCardanoEra :: IsCardanoEra era -- Provide class constraint
=> CardanoEra era -- and explicit value.
-> AnyCardanoEra
deriving instance Show AnyCardanoEra
instance Eq AnyCardanoEra where
AnyCardanoEra era == AnyCardanoEra era' =
case testEquality era era' of
Nothing -> False
Just Refl -> True -- since no constructors share types
instance Bounded AnyCardanoEra where
minBound = AnyCardanoEra ByronEra
maxBound = AnyCardanoEra AlonzoEra
instance Enum AnyCardanoEra where
-- [e..] = [e..maxBound]
enumFrom e = enumFromTo e maxBound
fromEnum = \case
AnyCardanoEra ByronEra -> 0
AnyCardanoEra ShelleyEra -> 1
AnyCardanoEra AllegraEra -> 2
AnyCardanoEra MaryEra -> 3
AnyCardanoEra AlonzoEra -> 4
toEnum = \case
0 -> AnyCardanoEra ByronEra
1 -> AnyCardanoEra ShelleyEra
2 -> AnyCardanoEra AllegraEra
3 -> AnyCardanoEra MaryEra
4 -> AnyCardanoEra AlonzoEra
n ->
error $
"AnyCardanoEra.toEnum: " <> show n
<> " does not correspond to any known enumerated era."
instance ToJSON AnyCardanoEra where
toJSON (AnyCardanoEra era) = toJSON era
instance FromJSON AnyCardanoEra where
parseJSON = withText "AnyCardanoEra"
$ \case
"Byron" -> pure $ AnyCardanoEra ByronEra
"Shelley" -> pure $ AnyCardanoEra ShelleyEra
"Allegra" -> pure $ AnyCardanoEra AllegraEra
"Mary" -> pure $ AnyCardanoEra MaryEra
"Alonzo" -> pure $ AnyCardanoEra AlonzoEra
wrong -> fail $ "Failed to parse unknown era: " <> Text.unpack wrong
-- | Like the 'AnyCardanoEra' constructor but does not demand a 'IsCardanoEra'
-- class constraint.
--
anyCardanoEra :: CardanoEra era -> AnyCardanoEra
anyCardanoEra ByronEra = AnyCardanoEra ByronEra
anyCardanoEra ShelleyEra = AnyCardanoEra ShelleyEra
anyCardanoEra AllegraEra = AnyCardanoEra AllegraEra
anyCardanoEra MaryEra = AnyCardanoEra MaryEra
anyCardanoEra AlonzoEra = AnyCardanoEra AlonzoEra
-- | This pairs up some era-dependent type with a 'CardanoEra' value that tells
-- us what era it is, but hides the era type. This is useful when the era is
-- not statically known, for example when deserialising from a file.
--
data InAnyCardanoEra thing where
InAnyCardanoEra :: IsCardanoEra era -- Provide class constraint
=> CardanoEra era -- and explicit value.
-> thing era
-> InAnyCardanoEra thing
-- ----------------------------------------------------------------------------
-- Shelley-based eras
--
-- | While the Byron and Shelley eras are quite different, there are several
-- eras that are based on Shelley with only minor differences. It is useful
-- to be able to treat the Shelley-based eras in a mostly-uniform way.
--
-- Values of this type witness the fact that the era is Shelley-based. This
-- can be used to constrain the era to being a Shelley-based on. It allows
-- non-uniform handling making case distinctions on the constructor.
--
data ShelleyBasedEra era where
ShelleyBasedEraShelley :: ShelleyBasedEra ShelleyEra
ShelleyBasedEraAllegra :: ShelleyBasedEra AllegraEra
ShelleyBasedEraMary :: ShelleyBasedEra MaryEra
ShelleyBasedEraAlonzo :: ShelleyBasedEra AlonzoEra
deriving instance Eq (ShelleyBasedEra era)
deriving instance Ord (ShelleyBasedEra era)
deriving instance Show (ShelleyBasedEra era)
-- | The class of eras that are based on Shelley. This allows uniform handling
-- of Shelley-based eras, but also non-uniform by making case distinctions on
-- the 'ShelleyBasedEra' constructors.
--
class IsCardanoEra era => IsShelleyBasedEra era where
shelleyBasedEra :: ShelleyBasedEra era
instance IsShelleyBasedEra ShelleyEra where
shelleyBasedEra = ShelleyBasedEraShelley
instance IsShelleyBasedEra AllegraEra where
shelleyBasedEra = ShelleyBasedEraAllegra
instance IsShelleyBasedEra MaryEra where
shelleyBasedEra = ShelleyBasedEraMary
instance IsShelleyBasedEra AlonzoEra where
shelleyBasedEra = ShelleyBasedEraAlonzo
-- | This pairs up some era-dependent type with a 'ShelleyBasedEra' value that
-- tells us what era it is, but hides the era type. This is useful when the era
-- is not statically known, for example when deserialising from a file.
--
data InAnyShelleyBasedEra thing where
InAnyShelleyBasedEra :: IsShelleyBasedEra era -- Provide class constraint
=> ShelleyBasedEra era -- and explicit value.
-> thing era
-> InAnyShelleyBasedEra thing
-- | Converts a 'ShelleyBasedEra' to the broader 'CardanoEra'.
shelleyBasedToCardanoEra :: ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEraShelley = ShelleyEra
shelleyBasedToCardanoEra ShelleyBasedEraAllegra = AllegraEra
shelleyBasedToCardanoEra ShelleyBasedEraMary = MaryEra
shelleyBasedToCardanoEra ShelleyBasedEraAlonzo = AlonzoEra
-- ----------------------------------------------------------------------------
-- Cardano eras factored as Byron vs Shelley-based
--
-- | This is the same essential information as 'CardanoEra' but instead of a
-- flat set of alternative eras, it is factored into the legcy Byron era and
-- the current Shelley-based eras.
--
-- This way of factoring the eras is useful because in many cases the
-- major differences are between the Byron and Shelley-based eras, and
-- the Shelley-based eras can often be treated uniformly.
--
data CardanoEraStyle era where
LegacyByronEra :: CardanoEraStyle ByronEra
ShelleyBasedEra :: IsShelleyBasedEra era -- Also provide class constraint
=> ShelleyBasedEra era
-> CardanoEraStyle era
deriving instance Eq (CardanoEraStyle era)
deriving instance Ord (CardanoEraStyle era)
deriving instance Show (CardanoEraStyle era)
-- | The 'CardanoEraStyle' for a 'CardanoEra'.
--
cardanoEraStyle :: CardanoEra era -> CardanoEraStyle era
cardanoEraStyle ByronEra = LegacyByronEra
cardanoEraStyle ShelleyEra = ShelleyBasedEra ShelleyBasedEraShelley
cardanoEraStyle AllegraEra = ShelleyBasedEra ShelleyBasedEraAllegra
cardanoEraStyle MaryEra = ShelleyBasedEra ShelleyBasedEraMary
cardanoEraStyle AlonzoEra = ShelleyBasedEra ShelleyBasedEraAlonzo
-- ----------------------------------------------------------------------------
-- Conversion to Shelley ledger library types
--
-- | A type family that connects our era type tags to equivalent type tags used
-- in the Shelley ledger library.
--
-- This type mapping connect types from this API with types in the Shelley
-- ledger library which allows writing conversion functions in a more generic
-- way.
--
type family ShelleyLedgerEra era where
ShelleyLedgerEra ShelleyEra = Ledger.StandardShelley
ShelleyLedgerEra AllegraEra = Ledger.StandardAllegra
ShelleyLedgerEra MaryEra = Ledger.StandardMary
ShelleyLedgerEra AlonzoEra = Ledger.StandardAlonzo