/
Translation.hs
176 lines (156 loc) · 6.38 KB
/
Translation.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
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Babbage.Translation where
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis)
import Cardano.Ledger.Alonzo.PParams (AlonzoPParamsHKD (..))
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..))
import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.PParams (BabbagePParamsHKD (..))
import Cardano.Ledger.Babbage.Tx (AlonzoTx (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..), Datum (..))
import Cardano.Ledger.Binary (DecoderError)
import Cardano.Ledger.Coin (Coin (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Era
( PreviousEra,
TranslateEra (..),
TranslationContext,
translateEra',
)
import Cardano.Ledger.HKD (HKDFunctor (..))
import Cardano.Ledger.Shelley.API
( EpochState (..),
NewEpochState (..),
StrictMaybe (..),
)
import qualified Cardano.Ledger.Shelley.API as API
import Cardano.Ledger.Shelley.PParams (ShelleyPParamsHKD)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
--------------------------------------------------------------------------------
-- Translation from Alonzo to Babbage
--
-- The instances below are needed by the consensus layer. Do not remove any of
-- them without coordinating with consensus.
--
-- Please add auxiliary instances and other declarations at the bottom of this
-- module, not in the list below so that it remains clear which instances the
-- consensus layer needs.
--
-- WARNING: when a translation instance currently uses the default
-- 'TranslationError', i.e., 'Void', it means the consensus layer relies on it
-- being total. Do not change it!
--------------------------------------------------------------------------------
type instance PreviousEra (BabbageEra c) = AlonzoEra c
type instance TranslationContext (BabbageEra c) = AlonzoGenesis
instance
(Crypto c) =>
TranslateEra (BabbageEra c) NewEpochState
where
translateEra ctxt nes =
pure $
NewEpochState
{ nesEL = nesEL nes,
nesBprev = nesBprev nes,
nesBcur = nesBcur nes,
nesEs = translateEra' ctxt $ nesEs nes,
nesRu = nesRu nes,
nesPd = nesPd nes,
stashedAVVMAddresses = ()
}
newtype Tx era = Tx {unTx :: Core.Tx era}
instance
( Crypto c,
Core.Tx (BabbageEra c) ~ AlonzoTx (BabbageEra c)
) =>
TranslateEra (BabbageEra c) Tx
where
type TranslationError (BabbageEra c) Tx = DecoderError
translateEra _ctxt (Tx tx) = do
-- Note that this does not preserve the hidden bytes field of the transaction.
-- This is under the premise that this is irrelevant for TxInBlocks, which are
-- not transmitted as contiguous chunks.
txBody <- Core.translateEraThroughCBOR "TxBody" $ Alonzo.body tx
txWits <- Core.translateEraThroughCBOR "TxWitness" $ Alonzo.wits tx
auxData <- case Alonzo.auxiliaryData tx of
SNothing -> pure SNothing
SJust auxData -> SJust <$> Core.translateEraThroughCBOR "AuxData" auxData
let validating = Alonzo.isValid tx
pure $ Tx $ AlonzoTx txBody txWits validating auxData
--------------------------------------------------------------------------------
-- Auxiliary instances and functions
--------------------------------------------------------------------------------
instance (Crypto c, Functor f) => TranslateEra (BabbageEra c) (ShelleyPParamsHKD f)
instance Crypto c => TranslateEra (BabbageEra c) EpochState where
translateEra ctxt es =
pure
EpochState
{ esAccountState = esAccountState es,
esSnapshots = esSnapshots es,
esLState = translateEra' ctxt $ esLState es,
esPrevPp = translatePParams $ esPrevPp es,
esPp = translatePParams $ esPp es,
esNonMyopic = esNonMyopic es
}
instance Crypto c => TranslateEra (BabbageEra c) API.LedgerState where
translateEra ctxt ls =
pure
API.LedgerState
{ API.lsUTxOState = translateEra' ctxt $ API.lsUTxOState ls,
API.lsDPState = API.lsDPState ls
}
instance Crypto c => TranslateEra (BabbageEra c) API.UTxOState where
translateEra ctxt us =
pure
API.UTxOState
{ API.utxosUtxo = translateEra' ctxt $ API.utxosUtxo us,
API.utxosDeposited = API.utxosDeposited us,
API.utxosFees = API.utxosFees us,
API.utxosPpups = translateEra' ctxt $ API.utxosPpups us,
API.utxosStakeDistr = API.utxosStakeDistr us
}
instance Crypto c => TranslateEra (BabbageEra c) API.UTxO where
translateEra _ctxt utxo =
pure $ API.UTxO $ translateTxOut `Map.map` API.unUTxO utxo
instance Crypto c => TranslateEra (BabbageEra c) API.PPUPState where
translateEra ctxt ps =
pure
API.PPUPState
{ API.proposals = translateEra' ctxt $ API.proposals ps,
API.futureProposals = translateEra' ctxt $ API.futureProposals ps
}
instance Crypto c => TranslateEra (BabbageEra c) API.ProposedPPUpdates where
translateEra _ctxt (API.ProposedPPUpdates ppup) =
pure $ API.ProposedPPUpdates $ fmap translatePParams ppup
translateTxOut ::
Crypto c =>
Core.TxOut (AlonzoEra c) ->
Core.TxOut (BabbageEra c)
translateTxOut (AlonzoTxOut addr value dh) = BabbageTxOut addr value d SNothing
where
d = case dh of
SNothing -> NoDatum
SJust d' -> DatumHash d'
-- | A word is 8 bytes, so to convert from coinsPerUTxOWord to coinsPerUTxOByte, rounding down.
coinsPerUTxOWordToCoinsPerUTxOByte :: Coin -> Coin
coinsPerUTxOWordToCoinsPerUTxOByte (Coin c) = Coin $ c `div` 8
-- | A word is 8 bytes, so to convert from coinsPerUTxOByte to coinsPerUTxOWord.
coinsPerUTxOByteToCoinsPerUTxOWord :: Coin -> Coin
coinsPerUTxOByteToCoinsPerUTxOWord (Coin c) = Coin $ c * 8
translatePParams ::
forall f c. HKDFunctor f => AlonzoPParamsHKD f (AlonzoEra c) -> BabbagePParamsHKD f (BabbageEra c)
translatePParams AlonzoPParams {_coinsPerUTxOWord = cpuw, ..} =
BabbagePParams {_coinsPerUTxOByte = cpub, ..}
where
cpub = hkdMap (Proxy :: Proxy f) coinsPerUTxOWordToCoinsPerUTxOByte cpuw