Skip to content

Commit 12acadc

Browse files
lehinslehins
authored
Merge pull request #5056 from IntersectMBO/td/reinstate-annotator-instances
Reinstate `Annotator` instances to main libs
2 parents ecb9fc8 + adc1d1c commit 12acadc

File tree

85 files changed

+1025
-969
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

85 files changed

+1025
-969
lines changed

‎eras/allegra/impl/CHANGELOG.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,9 @@
22

33
## 1.8.0.0
44

5+
* Move to `testlib` `DecCBOR` instances for: `TxBody AllegraEra`, `AllegraTxAuxDataRaw`, `AllegraTxAuxData`, `TimelockRaw`, `Timelock`
56
* Remove `AllegraTxBody`
67
* Removed `era` parameter from `AllegraTxBodyRaw`
7-
* Move `Annotator` instances to `testlib`
88
* Expose access to `AllegraTxBodyRaw`, `AllegraTxAuxData` and `TimelockRaw`
99
* Expose constructor `MkAllegraTxBody`, `MkTxAuxData` and `MkTimelock`
1010
* Deprecate `TimelockConstr`

‎eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs‎

Lines changed: 17 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ module Cardano.Ledger.Allegra.Scripts (
5151
import Cardano.Ledger.Allegra.Era (AllegraEra)
5252
import Cardano.Ledger.BaseTypes (StrictMaybe (SJust, SNothing))
5353
import Cardano.Ledger.Binary (
54+
Annotator,
5455
DecCBOR (decCBOR),
5556
EncCBOR (encCBOR),
5657
ToCBOR (..),
@@ -64,14 +65,14 @@ import Cardano.Ledger.Binary.Coders (
6465
encode,
6566
(!>),
6667
(<!),
68+
(<*!),
6769
)
6870
import Cardano.Ledger.Core
6971
import Cardano.Ledger.MemoBytes (
7072
EqRaw (..),
7173
MemoBytes (Memo),
7274
Memoized (..),
7375
byteCountMemoBytes,
74-
decodeMemoized,
7576
getMemoRawType,
7677
mkMemoizedEra,
7778
packMemoBytesM,
@@ -186,15 +187,19 @@ instance Era era => EncCBOR (TimelockRaw era) where
186187
TimelockTimeStart m -> Sum TimelockTimeStart 4 !> To m
187188
TimelockTimeExpire m -> Sum TimelockTimeExpire 5 !> To m
188189

189-
instance Era era => DecCBOR (TimelockRaw era) where
190-
decCBOR = decode $ Summands "TimelockRaw" $ \case
191-
0 -> SumD TimelockSignature <! From
192-
1 -> SumD TimelockAllOf <! From
193-
2 -> SumD TimelockAnyOf <! From
194-
3 -> SumD TimelockMOf <! From <! From
195-
4 -> SumD TimelockTimeStart <! From
196-
5 -> SumD TimelockTimeExpire <! From
197-
n -> Invalid n
190+
-- This instance allows us to derive instance DecCBOR (Annotator (Timelock era)).
191+
-- Since Timelock is a newtype around (Memo (Timelock era)).
192+
instance Era era => DecCBOR (Annotator (TimelockRaw era)) where
193+
decCBOR = decode (Summands "TimelockRaw" decRaw)
194+
where
195+
decRaw :: Word -> Decode 'Open (Annotator (TimelockRaw era))
196+
decRaw 0 = Ann (SumD TimelockSignature <! From)
197+
decRaw 1 = Ann (SumD TimelockAllOf) <*! D (sequence <$> decCBOR)
198+
decRaw 2 = Ann (SumD TimelockAnyOf) <*! D (sequence <$> decCBOR)
199+
decRaw 3 = Ann (SumD TimelockMOf) <*! Ann From <*! D (sequence <$> decCBOR)
200+
decRaw 4 = Ann (SumD TimelockTimeStart <! From)
201+
decRaw 5 = Ann (SumD TimelockTimeExpire <! From)
202+
decRaw n = Invalid n
198203

199204
-- =================================================================
200205
-- Native Scripts are Memoized TimelockRaw.
@@ -222,8 +227,8 @@ instance Era era => NoThunks (Timelock era)
222227

223228
instance Era era => EncCBOR (Timelock era)
224229

225-
instance Era era => DecCBOR (Timelock era) where
226-
decCBOR = MkTimelock <$> decodeMemoized decCBOR
230+
instance Era era => DecCBOR (Annotator (Timelock era)) where
231+
decCBOR = fmap MkTimelock <$> decCBOR
227232

228233
instance Memoized (Timelock era) where
229234
type RawType (Timelock era) = TimelockRaw era

‎eras/allegra/impl/src/Cardano/Ledger/Allegra/Translation.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ instance TranslateEra AllegraEra NewEpochState where
7474

7575
instance TranslateEra AllegraEra ShelleyTx where
7676
type TranslationError AllegraEra ShelleyTx = DecoderError
77-
translateEra _ctx = translateEraThroughCBOR
77+
translateEra _ctx = translateEraThroughCBOR "ShelleyTx"
7878

7979
--------------------------------------------------------------------------------
8080
-- Auxiliary instances and functions
@@ -164,7 +164,7 @@ instance TranslateEra AllegraEra EpochState where
164164

165165
instance TranslateEra AllegraEra ShelleyTxWits where
166166
type TranslationError AllegraEra ShelleyTxWits = DecoderError
167-
translateEra _ctx = translateEraThroughCBOR
167+
translateEra _ctx = translateEraThroughCBOR "ShelleyTxWits"
168168

169169
instance TranslateEra AllegraEra Update where
170170
translateEra _ (Update pp en) = pure $ Update (coerce pp) en

‎eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ module Cardano.Ledger.Allegra.TxAuxData (
2929
import Cardano.Ledger.Allegra.Era (AllegraEra)
3030
import Cardano.Ledger.Allegra.Scripts (Timelock)
3131
import Cardano.Ledger.Binary (
32+
Annotator,
3233
DecCBOR (..),
3334
EncCBOR (..),
3435
ToCBOR,
@@ -37,6 +38,7 @@ import Cardano.Ledger.Binary (
3738
import Cardano.Ledger.Binary.Coders
3839
import Cardano.Ledger.MemoBytes (
3940
EqRaw,
41+
Mem,
4042
MemoBytes,
4143
MemoHashIndex,
4244
Memoized (RawType),
@@ -119,11 +121,16 @@ instance NFData (AllegraTxAuxDataRaw era)
119121

120122
newtype AllegraTxAuxData era = MkAlegraTxAuxData (MemoBytes (AllegraTxAuxDataRaw era))
121123
deriving (Generic)
122-
deriving newtype (Eq, ToCBOR, SafeToHash, DecCBOR)
124+
deriving newtype (Eq, ToCBOR, SafeToHash)
123125

124126
instance Memoized (AllegraTxAuxData era) where
125127
type RawType (AllegraTxAuxData era) = AllegraTxAuxDataRaw era
126128

129+
deriving via
130+
(Mem (AllegraTxAuxDataRaw era))
131+
instance
132+
Era era => DecCBOR (Annotator (AllegraTxAuxData era))
133+
127134
type instance MemoHashIndex (AllegraTxAuxDataRaw era) = EraIndependentTxAuxData
128135

129136
instance HashAnnotated (AllegraTxAuxData era) EraIndependentTxAuxData where
@@ -160,7 +167,7 @@ instance Era era => EncCBOR (AllegraTxAuxDataRaw era) where
160167
-- | Encodes memoized bytes created upon construction.
161168
instance Era era => EncCBOR (AllegraTxAuxData era)
162169

163-
instance Era era => DecCBOR (AllegraTxAuxDataRaw era) where
170+
instance Era era => DecCBOR (Annotator (AllegraTxAuxDataRaw era)) where
164171
decCBOR =
165172
peekTokenType >>= \case
166173
TypeMapLen -> decodeFromMap
@@ -173,13 +180,13 @@ instance Era era => DecCBOR (AllegraTxAuxDataRaw era) where
173180
where
174181
decodeFromMap =
175182
decode
176-
( Emit AllegraTxAuxDataRaw
177-
<! From
178-
<! Emit StrictSeq.empty
183+
( Ann (Emit AllegraTxAuxDataRaw)
184+
<*! Ann From
185+
<*! Ann (Emit StrictSeq.empty)
179186
)
180187
decodeFromList =
181188
decode
182-
( RecD AllegraTxAuxDataRaw
183-
<! From
184-
<! From
189+
( Ann (RecD AllegraTxAuxDataRaw)
190+
<*! Ann From
191+
<*! D (sequence <$> decCBOR)
185192
)

‎eras/allegra/impl/src/Cardano/Ledger/Allegra/TxBody.hs‎

Lines changed: 14 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
4242
import Cardano.Ledger.Allegra.TxCert ()
4343
import Cardano.Ledger.Allegra.TxOut ()
4444
import Cardano.Ledger.BaseTypes (SlotNo, StrictMaybe (SJust, SNothing))
45-
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), ToCBOR)
45+
import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR (..), ToCBOR)
4646
import Cardano.Ledger.Binary.Coders (
4747
Decode (..),
4848
Encode (..),
@@ -59,6 +59,7 @@ import Cardano.Ledger.Coin (Coin (..))
5959
import Cardano.Ledger.Core
6060
import Cardano.Ledger.MemoBytes (
6161
EqRaw,
62+
Mem,
6263
MemoBytes,
6364
MemoHashIndex,
6465
Memoized (RawType),
@@ -124,6 +125,12 @@ instance (DecCBOR ma, Monoid ma, AllegraEraTxBody era) => DecCBOR (AllegraTxBody
124125
[(0, "atbrInputs"), (1, "atbrOutputs"), (2, "atbrFee")]
125126
)
126127

128+
instance
129+
(DecCBOR m, Monoid m, AllegraEraTxBody era) =>
130+
DecCBOR (Annotator (AllegraTxBodyRaw m era))
131+
where
132+
decCBOR = pure <$> decCBOR
133+
127134
-- Sparse encodings of AllegraTxBodyRaw, the key values are fixed by backward compatibility
128135
-- concerns as we want the ShelleyTxBody to deserialise as AllegraTxBody.
129136
-- txXparse and bodyFields should be Duals, visual inspection helps ensure this.
@@ -196,6 +203,11 @@ emptyAllegraTxBodyRaw =
196203
instance Memoized (TxBody AllegraEra) where
197204
type RawType (TxBody AllegraEra) = AllegraTxBodyRaw () AllegraEra
198205

206+
deriving via
207+
Mem (AllegraTxBodyRaw () AllegraEra)
208+
instance
209+
DecCBOR (Annotator (TxBody AllegraEra))
210+
199211
deriving instance Eq (TxBody AllegraEra)
200212

201213
deriving instance Show (TxBody AllegraEra)
@@ -275,7 +287,7 @@ pattern AllegraTxBody
275287

276288
instance EraTxBody AllegraEra where
277289
newtype TxBody AllegraEra = MkAllegraTxBody (MemoBytes (AllegraTxBodyRaw () AllegraEra))
278-
deriving newtype (SafeToHash, ToCBOR, DecCBOR)
290+
deriving newtype (SafeToHash, ToCBOR)
279291

280292
mkBasicTxBody = mkMemoizedEra @AllegraEra emptyAllegraTxBodyRaw
281293

‎eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Annotator.hs‎

Lines changed: 23 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE DerivingVia #-}
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE FlexibleInstances #-}
5+
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
56
{-# LANGUAGE LambdaCase #-}
67
{-# LANGUAGE OverloadedStrings #-}
78
{-# LANGUAGE ScopedTypeVariables #-}
@@ -21,12 +22,14 @@ import Cardano.Ledger.Allegra.TxBody
2122
import Cardano.Ledger.Binary
2223
import Cardano.Ledger.Binary.Coders
2324
import Cardano.Ledger.Core
25+
import Cardano.Ledger.MemoBytes (decodeMemoized)
2426
import qualified Data.Sequence.Strict as StrictSeq
2527
import Test.Cardano.Ledger.Allegra.Arbitrary ()
26-
import Test.Cardano.Ledger.Core.Binary.Annotator
2728
import Test.Cardano.Ledger.Shelley.Binary.Annotator
2829

29-
instance Era era => DecCBOR (Annotator (AllegraTxAuxDataRaw era)) where
30+
deriving newtype instance DecCBOR (TxBody AllegraEra)
31+
32+
instance Era era => DecCBOR (AllegraTxAuxDataRaw era) where
3033
decCBOR =
3134
peekTokenType >>= \case
3235
TypeMapLen -> decodeFromMap
@@ -39,44 +42,28 @@ instance Era era => DecCBOR (Annotator (AllegraTxAuxDataRaw era)) where
3942
where
4043
decodeFromMap =
4144
decode
42-
( Ann (Emit AllegraTxAuxDataRaw)
43-
<*! Ann From
44-
<*! Ann (Emit StrictSeq.empty)
45+
( Emit AllegraTxAuxDataRaw
46+
<! From
47+
<! Emit StrictSeq.empty
4548
)
4649
decodeFromList =
4750
decode
48-
( Ann (RecD AllegraTxAuxDataRaw)
49-
<*! Ann From
50-
<*! D (sequence <$> decCBOR)
51+
( RecD AllegraTxAuxDataRaw
52+
<! From
53+
<! From
5154
)
5255

53-
deriving via
54-
(Mem (AllegraTxAuxDataRaw era))
55-
instance
56-
Era era => DecCBOR (Annotator (AllegraTxAuxData era))
57-
58-
instance Era era => DecCBOR (Annotator (TimelockRaw era)) where
59-
decCBOR = decode (Summands "TimelockRaw" decRaw)
60-
where
61-
decRaw :: Word -> Decode 'Open (Annotator (TimelockRaw era))
62-
decRaw 0 = Ann (SumD TimelockSignature <! From)
63-
decRaw 1 = Ann (SumD TimelockAllOf) <*! D (sequence <$> decCBOR)
64-
decRaw 2 = Ann (SumD TimelockAnyOf) <*! D (sequence <$> decCBOR)
65-
decRaw 3 = Ann (SumD TimelockMOf) <*! Ann From <*! D (sequence <$> decCBOR)
66-
decRaw 4 = Ann (SumD TimelockTimeStart <! From)
67-
decRaw 5 = Ann (SumD TimelockTimeExpire <! From)
68-
decRaw n = Invalid n
69-
70-
instance Era era => DecCBOR (Annotator (Timelock era)) where
71-
decCBOR = fmap MkTimelock <$> decCBOR
56+
deriving newtype instance Era era => DecCBOR (AllegraTxAuxData era)
7257

73-
instance
74-
(DecCBOR m, Monoid m, AllegraEraTxBody era) =>
75-
DecCBOR (Annotator (AllegraTxBodyRaw m era))
76-
where
77-
decCBOR = pure <$> decCBOR
58+
instance Era era => DecCBOR (TimelockRaw era) where
59+
decCBOR = decode $ Summands "TimelockRaw" $ \case
60+
0 -> SumD TimelockSignature <! From
61+
1 -> SumD TimelockAllOf <! From
62+
2 -> SumD TimelockAnyOf <! From
63+
3 -> SumD TimelockMOf <! From <! From
64+
4 -> SumD TimelockTimeStart <! From
65+
5 -> SumD TimelockTimeExpire <! From
66+
n -> Invalid n
7867

79-
deriving via
80-
Mem (AllegraTxBodyRaw () AllegraEra)
81-
instance
82-
DecCBOR (Annotator (TxBody AllegraEra))
68+
instance Era era => DecCBOR (Timelock era) where
69+
decCBOR = MkTimelock <$> decodeMemoized decCBOR

‎eras/alonzo/impl/CHANGELOG.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
## 1.14.0.0
44

5+
* Move to `testlib` `DecCBOR` instances for: `AlonzoTxSeq`, `AlonzoTx`, `TxBody AlonzoEra`, `AlonzoTxAuxDataRaw`, `AlonzoTxAuxData`, `AlonzoScript`, `AlonzoTxWitsRaw`, `AlonzoTxWits`, `RedeemersRaw`, `Redeemers`, `TxDatsRaw`, `TxDats`
56
* Added to `PParams`: `ppCollateralPercentage`,`ppCostModels`,`ppMaxBlockExUnits`,`ppMaxCollateralInputs`,`ppMaxTxExUnits`,`ppMaxValSize`,`ppPrices`
67
* Removed `alonzoCommonPParamsHKDPairs` from `PParams`
78
* Added error-throwing `ToPlutusData` instance for `CoinPerWord`
@@ -10,7 +11,6 @@
1011
* Deprecate `inputs'`, `collateral'`, `outputs'`, `certs'`, `withdrawals'`, `txfee'`,
1112
`vldt'`, `update'`, `reqSignerHashes'`, `adHash'`, `mint'`, `scriptIntegrityHash'`,
1213
and `txnetworkid'`
13-
* Move `Annotator` instances and `alonzoSegwitTx` to `testlib`
1414
* Expose `addScriptsTxWitsRaw`, `decodeAlonzoPlutusScript` and `asHashedScriptPair`
1515
* Expose `emptyAlonzoTxAuxDataRaw`, `decodeTxAuxDataByTokenType` and `addPlutusScripts`
1616
* Expose `alonzoEqTxWitsRaw` and `emptyTxWitsRaw`

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ import Cardano.Ledger.Alonzo.Era (AlonzoEra)
6565
import Cardano.Ledger.Alonzo.TxCert ()
6666
import Cardano.Ledger.BaseTypes (ProtVer (..), kindObject)
6767
import Cardano.Ledger.Binary (
68+
Annotator,
6869
DecCBOR (decCBOR),
6970
DecCBORGroup (..),
7071
Decoder,
@@ -76,13 +77,14 @@ import Cardano.Ledger.Binary (
7677
encodeWord8,
7778
)
7879
import Cardano.Ledger.Binary.Coders (
79-
Decode (D, From, Invalid, SumD, Summands),
80+
Decode (Ann, D, From, Invalid, SumD, Summands),
8081
Encode (Sum, To),
8182
Wrapped (..),
8283
decode,
8384
encode,
8485
(!>),
8586
(<!),
87+
(<*!),
8688
)
8789
import Cardano.Ledger.Binary.Plain (serializeAsHexText)
8890
import Cardano.Ledger.Core
@@ -598,17 +600,21 @@ encodeScript = \case
598600
SPlutusV2 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV2) 2 !> To pb
599601
SPlutusV3 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV3) 3 !> To pb
600602

601-
instance AlonzoEraScript era => DecCBOR (AlonzoScript era) where
603+
instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
602604
decCBOR = decode (Summands "AlonzoScript" decodeScript)
603605
where
606+
decodeAnnPlutus slang =
607+
Ann (SumD PlutusScript) <*! Ann (D (decodePlutusScript slang))
608+
{-# INLINE decodeAnnPlutus #-}
609+
decodeScript :: Word -> Decode 'Open (Annotator (AlonzoScript era))
604610
decodeScript = \case
605-
0 -> SumD TimelockScript <! From
606-
1 -> decodePlutus SPlutusV1
607-
2 -> decodePlutus SPlutusV2
608-
3 -> decodePlutus SPlutusV3
611+
0 -> Ann (SumD TimelockScript) <*! From
612+
1 -> decodeAnnPlutus SPlutusV1
613+
2 -> decodeAnnPlutus SPlutusV2
614+
3 -> decodeAnnPlutus SPlutusV3
609615
n -> Invalid n
610-
decodePlutus slang =
611-
SumD PlutusScript <! D (decodePlutusScript slang)
616+
{-# INLINE decodeScript #-}
617+
{-# INLINE decCBOR #-}
612618

613619
-- | Verify that every `Script` represents a valid script. Force native scripts to Normal
614620
-- Form, to ensure that there are no bottoms and deserialize `Plutus` scripts into a

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -79,9 +79,9 @@ instance TranslateEra AlonzoEra Tx where
7979
-- Note that this does not preserve the hidden bytes field of the transaction.
8080
-- This is under the premise that this is irrelevant for TxInBlocks, which are
8181
-- not transmitted as contiguous chunks.
82-
txBody <- translateEraThroughCBOR $ tx ^. bodyTxL
83-
txWits <- translateEraThroughCBOR $ tx ^. witsTxL
84-
txAuxData <- mapM translateEraThroughCBOR (tx ^. auxDataTxL)
82+
txBody <- translateEraThroughCBOR "TxBody" $ tx ^. bodyTxL
83+
txWits <- translateEraThroughCBOR "TxWits" $ tx ^. witsTxL
84+
txAuxData <- mapM (translateEraThroughCBOR "TxAuxData") (tx ^. auxDataTxL)
8585
-- transactions from Mary era always pass script ("phase 2") validation
8686
let validating = IsValid True
8787
pure $ Tx $ AlonzoTx txBody txWits validating txAuxData

0 commit comments

Comments
 (0)