Skip to content

Commit ca870e4

Browse files
SoupstrawSoupstraw
committed
Added missing translations
1 parent d8cd874 commit ca870e4

File tree

4 files changed

+130
-15
lines changed

4 files changed

+130
-15
lines changed

‎eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -164,6 +164,7 @@ module Cardano.Ledger.Conway.Governance (
164164
reCommitteeStateL,
165165
DefaultVote (..),
166166
defaultStakePoolVote,
167+
translateProposals,
167168

168169
-- * Exported for testing
169170
pparamsUpdateThreshold,

‎eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,8 @@ module Cardano.Ledger.Conway.TxBody (
4747
ConwayTxBodyRaw (..),
4848
conwayTotalDepositsTxBody,
4949
conwayProposalsDeposits,
50+
conwayRedeemerPointer,
51+
conwayRedeemerPointerInverse,
5052
) where
5153

5254
import Cardano.Ledger.Alonzo.TxBody (Indexable (..))

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/Translation.hs‎

Lines changed: 71 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE MultiParamTypeClasses #-}
33
{-# LANGUAGE RecordWildCards #-}
44
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
56
{-# LANGUAGE TypeFamilies #-}
67
{-# OPTIONS_GHC -Wno-orphans #-}
78

@@ -16,10 +17,21 @@ import Cardano.Ledger.Binary (DecoderError)
1617
import Cardano.Ledger.Conway (ConwayEra)
1718
import Cardano.Ledger.Conway.Governance (
1819
ConwayGovState (..),
20+
DRepPulsingState (..),
21+
EnactState (..),
22+
GovAction (..),
23+
GovActionState (..),
24+
ProposalProcedure (..),
25+
Proposals,
26+
PulsingSnapshot,
27+
RatifyState (..),
28+
finishDRepPulser,
1929
mkEnactState,
2030
rsEnactStateL,
21-
setCompleteDRepPulsingState, Proposals, DRepPulsingState,
31+
setCompleteDRepPulsingState,
32+
translateProposals,
2233
)
34+
import Cardano.Ledger.Conway.Governance.DRepPulser (PulsingSnapshot (..))
2335
import Cardano.Ledger.Conway.State (ConwayInstantStake (..), EraCertState (..))
2436
import Cardano.Ledger.Core (
2537
EraTx (auxDataTxL, bodyTxL, witsTxL),
@@ -37,7 +49,7 @@ import Cardano.Ledger.Dijkstra.Governance ()
3749
import Cardano.Ledger.Dijkstra.State.CertState ()
3850
import Cardano.Ledger.Dijkstra.Tx ()
3951
import Cardano.Ledger.Dijkstra.TxAuxData ()
40-
import Cardano.Ledger.Dijkstra.TxBody ()
52+
import Cardano.Ledger.Dijkstra.TxBody (upgradeProposals, upgradeGovAction)
4153
import Cardano.Ledger.Dijkstra.TxWits ()
4254
import qualified Cardano.Ledger.Shelley.API as API
4355
import Cardano.Ledger.Shelley.LedgerState (
@@ -51,10 +63,10 @@ import Cardano.Ledger.Shelley.LedgerState (
5163
lsUTxOStateL,
5264
)
5365
import qualified Cardano.Ledger.UMap as UM
66+
import Data.Coerce (coerce)
5467
import Data.Default (Default (..))
5568
import qualified Data.Map.Strict as Map
5669
import Lens.Micro ((&), (.~), (^.))
57-
import Data.Coerce (coerce)
5870

5971
type instance TranslationContext DijkstraEra = ()
6072

@@ -150,11 +162,65 @@ translateCertState ctx scert =
150162
& certDStateL .~ translateEra' ctx (scert ^. certDStateL)
151163
& certPStateL .~ translateEra' ctx (scert ^. certPStateL)
152164

165+
instance TranslateEra DijkstraEra GovAction where
166+
translateEra _ = pure . upgradeGovAction
167+
168+
instance TranslateEra DijkstraEra ProposalProcedure where
169+
translateEra _ = pure . upgradeProposals
170+
171+
instance TranslateEra DijkstraEra GovActionState where
172+
translateEra ctxt GovActionState {..} =
173+
pure $
174+
GovActionState
175+
{ gasId = gasId
176+
, gasCommitteeVotes = gasCommitteeVotes
177+
, gasDRepVotes = gasDRepVotes
178+
, gasStakePoolVotes = gasStakePoolVotes
179+
, gasProposalProcedure = translateEra' ctxt gasProposalProcedure
180+
, gasProposedIn = gasProposedIn
181+
, gasExpiresAfter = gasExpiresAfter
182+
}
183+
153184
instance TranslateEra DijkstraEra Proposals where
154-
translateEra _ _ = undefined
185+
translateEra ctxt = pure . translateProposals @DijkstraEra ctxt
186+
187+
instance TranslateEra DijkstraEra PulsingSnapshot where
188+
translateEra ctxt PulsingSnapshot {..} =
189+
pure $
190+
PulsingSnapshot
191+
{ psProposals = translateEra' ctxt <$> psProposals
192+
, psDRepDistr = psDRepDistr
193+
, psDRepState = psDRepState
194+
, psPoolDistr = psPoolDistr
195+
}
196+
197+
instance TranslateEra DijkstraEra EnactState where
198+
translateEra _ EnactState {..} =
199+
pure $
200+
EnactState
201+
{ ensCommittee = coerce ensCommittee
202+
, ensConstitution = coerce ensConstitution
203+
, ensCurPParams = coerce ensCurPParams
204+
, ensPrevPParams = coerce ensPrevPParams
205+
, ensTreasury = ensTreasury
206+
, ensWithdrawals = ensWithdrawals
207+
, ensPrevGovActionIds = ensPrevGovActionIds
208+
}
209+
210+
instance TranslateEra DijkstraEra RatifyState where
211+
translateEra ctxt RatifyState {..} =
212+
pure $
213+
RatifyState
214+
{ rsEnactState = translateEra' ctxt rsEnactState
215+
, rsEnacted = translateEra' ctxt <$> rsEnacted
216+
, rsExpired = rsExpired
217+
, rsDelayed = rsDelayed
218+
}
155219

156220
instance TranslateEra DijkstraEra DRepPulsingState where
157-
translateEra _ _ = undefined
221+
translateEra ctxt dps = pure $ DRComplete (translateEra' ctxt x) (translateEra' ctxt y)
222+
where
223+
(x, y) = finishDRepPulser dps
158224

159225
instance TranslateEra DijkstraEra ConwayGovState where
160226
translateEra ctxt ConwayGovState {..} =

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/TxBody.hs‎

Lines changed: 56 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE DerivingStrategies #-}
4+
{-# LANGUAGE FlexibleContexts #-}
45
{-# LANGUAGE FlexibleInstances #-}
56
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
67
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -36,6 +37,8 @@ module Cardano.Ledger.Dijkstra.TxBody (
3637
dtbCurrentTreasuryValue,
3738
dtbTreasuryDonation
3839
),
40+
upgradeProposals,
41+
upgradeGovAction,
3942
DijkstraTxBodyRaw (..),
4043
) where
4144

@@ -44,7 +47,7 @@ import Cardano.Ledger.Babbage.TxBody (
4447
babbageAllInputsTxBodyF,
4548
babbageSpendableInputsTxBodyF,
4649
)
47-
import Cardano.Ledger.BaseTypes (Network, StrictMaybe, fromSMaybe)
50+
import Cardano.Ledger.BaseTypes (Network, StrictMaybe (..), fromSMaybe)
4851
import Cardano.Ledger.Binary (
4952
DecCBOR (..),
5053
EncCBOR (..),
@@ -71,8 +74,12 @@ import Cardano.Ledger.Binary.Coders (
7174
import Cardano.Ledger.Coin (Coin, decodePositiveCoin)
7275
import Cardano.Ledger.Conway (ConwayEra)
7376
import Cardano.Ledger.Conway.Core
74-
import Cardano.Ledger.Conway.Governance (ProposalProcedure, VotingProcedures (..))
75-
import Cardano.Ledger.Conway.TxBody (TxBody (..))
77+
import Cardano.Ledger.Conway.Governance (
78+
GovAction (..),
79+
ProposalProcedure (..),
80+
VotingProcedures (..),
81+
)
82+
import Cardano.Ledger.Conway.TxBody (TxBody (..), conwayProposalsDeposits, conwayRedeemerPointer, conwayRedeemerPointerInverse)
7683
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
7784
import Cardano.Ledger.Dijkstra.PParams ()
7885
import Cardano.Ledger.Dijkstra.Scripts ()
@@ -91,7 +98,7 @@ import Cardano.Ledger.MemoBytes (
9198
import Cardano.Ledger.TxIn (TxIn)
9299
import Cardano.Ledger.Val (Val (..))
93100
import Control.DeepSeq (NFData)
94-
import Data.Coerce (coerce)
101+
import Data.Coerce (Coercible, coerce)
95102
import qualified Data.OSet.Strict as OSet
96103
import Data.Sequence.Strict (StrictSeq)
97104
import Data.Set (Set)
@@ -133,7 +140,27 @@ instance NFData DijkstraTxBodyRaw
133140
deriving instance Show DijkstraTxBodyRaw
134141

135142
basicDijkstraTxBodyRaw :: DijkstraTxBodyRaw
136-
basicDijkstraTxBodyRaw = undefined
143+
basicDijkstraTxBodyRaw =
144+
DijkstraTxBodyRaw
145+
mempty
146+
mempty
147+
mempty
148+
mempty
149+
SNothing
150+
SNothing
151+
OSet.empty
152+
(Withdrawals mempty)
153+
mempty
154+
(ValidityInterval SNothing SNothing)
155+
mempty
156+
mempty
157+
SNothing
158+
SNothing
159+
SNothing
160+
(VotingProcedures mempty)
161+
OSet.empty
162+
SNothing
163+
mempty
137164

138165
instance DecCBOR DijkstraTxBodyRaw where
139166
decCBOR =
@@ -433,7 +460,7 @@ instance EraTxBody DijkstraEra where
433460
pure $
434461
DijkstraTxBody
435462
{ dtbSpendInputs = ctbSpendInputs
436-
, dtbOutputs = undefined <$> ctbOutputs
463+
, dtbOutputs = unsafeMapSized upgradeTxOut <$> ctbOutputs
437464
, dtbCerts = OSet.mapL coerce ctbCerts
438465
, dtbWithdrawals = ctbWithdrawals
439466
, dtbTxfee = ctbTxfee
@@ -453,12 +480,31 @@ instance EraTxBody DijkstraEra where
453480
, dtbTreasuryDonation = ctbTreasuryDonation
454481
}
455482

483+
upgradeGovAction ::
484+
Coercible (PParamsHKD StrictMaybe (PreviousEra era)) (PParamsHKD StrictMaybe era) =>
485+
GovAction (PreviousEra era) -> GovAction era
486+
upgradeGovAction (ParameterChange x y z) = ParameterChange (coerce x) (coerce y) z
487+
upgradeGovAction (HardForkInitiation x y) = HardForkInitiation (coerce x) y
488+
upgradeGovAction (TreasuryWithdrawals x y) = TreasuryWithdrawals x y
489+
upgradeGovAction (NoConfidence x) = NoConfidence x
490+
upgradeGovAction (UpdateCommittee x y z w) = UpdateCommittee x y z w
491+
upgradeGovAction (NewConstitution x y) = NewConstitution x (coerce y)
492+
upgradeGovAction InfoAction = InfoAction
493+
456494
upgradeProposals :: ProposalProcedure ConwayEra -> ProposalProcedure DijkstraEra
457-
upgradeProposals = undefined
495+
upgradeProposals ProposalProcedure {..} =
496+
ProposalProcedure
497+
{ pProcDeposit = pProcDeposit
498+
, pProcReturnAddr = pProcReturnAddr
499+
, pProcGovAction = upgradeGovAction pProcGovAction
500+
, pProcAnchor = pProcAnchor
501+
}
458502

459503
dijkstraTotalDepositsTxBody ::
460504
PParams DijkstraEra -> (KeyHash StakePool -> Bool) -> TxBody DijkstraEra -> Coin
461-
dijkstraTotalDepositsTxBody = undefined
505+
dijkstraTotalDepositsTxBody pp isPoolRegisted txBody =
506+
getTotalDepositsTxCerts pp isPoolRegisted (txBody ^. certsTxBodyL)
507+
<+> conwayProposalsDeposits pp txBody
462508

463509
instance AllegraEraTxBody DijkstraEra where
464510
vldtTxBodyL = lensMemoRawType @DijkstraEra dtbrVldt $
@@ -493,9 +539,9 @@ instance AlonzoEraTxBody DijkstraEra where
493539
\txb x -> txb {dtbrNetworkId = x}
494540
{-# INLINE networkIdTxBodyL #-}
495541

496-
redeemerPointer = undefined -- conwayRedeemerPointer
542+
redeemerPointer = conwayRedeemerPointer
497543

498-
redeemerPointerInverse = undefined -- conwayRedeemerPointerInverse
544+
redeemerPointerInverse = conwayRedeemerPointerInverse
499545

500546
instance BabbageEraTxBody DijkstraEra where
501547
sizedOutputsTxBodyL = lensMemoRawType @DijkstraEra dtbrOutputs $

0 commit comments

Comments
 (0)