Skip to content

Commit dc6bbd4

Browse files
geo2ageo2a
committed
WIP use KeyRole types instead of promoted constructors
1 parent d285705 commit dc6bbd4

File tree

16 files changed

+72
-73
lines changed

16 files changed

+72
-73
lines changed

‎cabal.project‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -53,8 +53,8 @@ if impl (ghc >= 9.10)
5353
source-repository-package
5454
type: git
5555
location: https://github.com/IntersectMBO/cardano-ledger
56-
tag: c9cd2e7e9eed58320b252b92edbe6afe276a10a5
57-
--sha256: sha256-0HM06cQfij8OFAjlcqIXkvKQYpT/is383BPzGJAJgqc=
56+
tag: 1258f444774a2360ab2d0cad1b9b1a7152b12bfa
57+
--sha256: sha256-fqT8zlcreIZzGCZU9IX+7JqJM/Sjrd68ub96klEfw/w=
5858
subdir:
5959
eras/allegra/impl
6060
eras/alonzo/impl

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Config.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -52,8 +52,8 @@ data instance BlockConfig (ShelleyBlock proto era) = ShelleyConfig
5252
, shelleyNetworkMagic :: !NetworkMagic
5353
, shelleyBlockIssuerVKeys ::
5454
!( Map
55-
(SL.KeyHash 'SL.BlockIssuer)
56-
(SL.VKey 'SL.BlockIssuer)
55+
(SL.KeyHash SL.BlockIssuer)
56+
(SL.VKey SL.BlockIssuer)
5757
)
5858
-- ^ For nodes that can produce blocks, this should be set to the
5959
-- verification key(s) corresponding to the node's signing key(s). For non
@@ -70,7 +70,7 @@ mkShelleyBlockConfig ::
7070
ShelleyBasedEra era =>
7171
SL.ProtVer ->
7272
SL.ShelleyGenesis ->
73-
[SL.VKey 'SL.BlockIssuer] ->
73+
[SL.VKey SL.BlockIssuer] ->
7474
BlockConfig (ShelleyBlock proto era)
7575
mkShelleyBlockConfig protVer genesis blockIssuerVKeys =
7676
ShelleyConfig

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/PeerSelection.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ instance SL.EraCertState era => LedgerSupportsPeerSelection (ShelleyBlock proto
3939

4040
futurePoolParams
4141
, poolParams ::
42-
Map (SL.KeyHash 'SL.StakePool) SL.StakePoolParams
42+
Map (SL.KeyHash SL.StakePool) SL.StakePoolParams
4343
(futurePoolParams, poolParams) =
4444
( SL.psFutureStakePoolParams pstate
4545
, Map.mapWithKey SL.stakePoolStateToStakePoolParams (SL.psStakePools pstate)
@@ -48,7 +48,7 @@ instance SL.EraCertState era => LedgerSupportsPeerSelection (ShelleyBlock proto
4848
-- Sort stake pools by descending stake
4949
orderByStake ::
5050
SL.PoolDistr ->
51-
[(SL.KeyHash 'SL.StakePool, PoolStake)]
51+
[(SL.KeyHash SL.StakePool, PoolStake)]
5252
orderByStake =
5353
sortOn (Down . snd)
5454
. map (second (PoolStake . SL.individualPoolStake))
@@ -92,7 +92,7 @@ instance SL.EraCertState era => LedgerSupportsPeerSelection (ShelleyBlock proto
9292
-- Combine the stake pools registered in the future and the current pool
9393
-- parameters, and remove duplicates.
9494
poolLedgerRelayAccessPoints ::
95-
Map (SL.KeyHash 'SL.StakePool) (NonEmpty StakePoolRelay)
95+
Map (SL.KeyHash SL.StakePool) (NonEmpty StakePoolRelay)
9696
poolLedgerRelayAccessPoints =
9797
Map.unionWith
9898
(\futureRelays currentRelays -> NE.nub (futureRelays <> currentRelays))

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ instance ShelleyCompatible proto era => BlockSupportsProtocol (ShelleyBlock prot
3838
, ptvTieBreakVRF = pTieBreakVRFValue shdr
3939
}
4040
where
41-
hdrIssuer :: SL.VKey 'SL.BlockIssuer
41+
hdrIssuer :: SL.VKey SL.BlockIssuer
4242
hdrIssuer = pHeaderIssuer shdr
4343

4444
projectChainOrderConfig = shelleyVRFTiebreakerFlavor

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs‎

Lines changed: 32 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ import qualified Cardano.Ledger.Conway.Governance as CG
5555
import qualified Cardano.Ledger.Conway.State as CG
5656
import qualified Cardano.Ledger.Core as SL
5757
import Cardano.Ledger.Credential (StakeCredential)
58-
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
58+
import Cardano.Ledger.Keys (KeyHash)
5959
import qualified Cardano.Ledger.Shelley.API as SL
6060
import qualified Cardano.Ledger.Shelley.Core as LC
6161
import qualified Cardano.Ledger.Shelley.RewardProvenance as SL
@@ -127,15 +127,15 @@ import Ouroboros.Network.PeerSelection.LedgerPeers.Utils
127127
newtype NonMyopicMemberRewards = NonMyopicMemberRewards
128128
{ unNonMyopicMemberRewards ::
129129
Map
130-
(Either SL.Coin (SL.Credential 'SL.Staking))
131-
(Map (SL.KeyHash 'SL.StakePool) SL.Coin)
130+
(Either SL.Coin (SL.Credential SL.Staking))
131+
(Map (SL.KeyHash SL.StakePool) SL.Coin)
132132
}
133133
deriving stock Show
134134
deriving newtype (Eq, ToCBOR, FromCBOR)
135135

136-
type Delegations = Map (SL.Credential 'SL.Staking) (SL.KeyHash 'SL.StakePool)
136+
type Delegations = Map (SL.Credential SL.Staking) (SL.KeyHash SL.StakePool)
137137

138-
type VoteDelegatees = Map (SL.Credential 'SL.Staking) SL.DRep
138+
type VoteDelegatees = Map (SL.Credential SL.Staking) SL.DRep
139139

140140
{-# DEPRECATED GetProposedPParamsUpdates "Deprecated in ShelleyNodeToClientVersion12" #-}
141141
{-# DEPRECATED
@@ -153,7 +153,7 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
153153
-- | Calculate the Non-Myopic Pool Member Rewards for a set of
154154
-- credentials. See 'SL.getNonMyopicMemberRewards'
155155
GetNonMyopicMemberRewards ::
156-
Set (Either SL.Coin (SL.Credential 'SL.Staking)) ->
156+
Set (Either SL.Coin (SL.Credential SL.Staking)) ->
157157
BlockQuery (ShelleyBlock proto era) QFNoTables NonMyopicMemberRewards
158158
GetCurrentPParams ::
159159
BlockQuery (ShelleyBlock proto era) QFNoTables (LC.PParams era)
@@ -200,11 +200,11 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
200200
BlockQuery (ShelleyBlock proto era) fp result ->
201201
BlockQuery (ShelleyBlock proto era) fp (Serialised result)
202202
GetFilteredDelegationsAndRewardAccounts ::
203-
Set (SL.Credential 'SL.Staking) ->
203+
Set (SL.Credential SL.Staking) ->
204204
BlockQuery
205205
(ShelleyBlock proto era)
206206
QFNoTables
207-
(Delegations, Map (SL.Credential 'Staking) Coin)
207+
(Delegations, Map (SL.Credential SL.Staking) Coin)
208208
GetGenesisConfig ::
209209
BlockQuery (ShelleyBlock proto era) QFNoTables CompactGenesis
210210
-- | Only for debugging purposes, we make no effort to ensure binary
@@ -226,36 +226,36 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
226226
BlockQuery
227227
(ShelleyBlock proto era)
228228
QFNoTables
229-
(Set (SL.KeyHash 'SL.StakePool))
229+
(Set (SL.KeyHash SL.StakePool))
230230
GetStakePoolParams ::
231-
Set (SL.KeyHash 'SL.StakePool) ->
231+
Set (SL.KeyHash SL.StakePool) ->
232232
BlockQuery
233233
(ShelleyBlock proto era)
234234
QFNoTables
235-
(Map (SL.KeyHash 'SL.StakePool) SL.StakePoolParams)
235+
(Map (SL.KeyHash SL.StakePool) SL.StakePoolParams)
236236
GetRewardInfoPools ::
237237
BlockQuery
238238
(ShelleyBlock proto era)
239239
QFNoTables
240240
( SL.RewardParams
241241
, Map
242-
(SL.KeyHash 'SL.StakePool)
242+
(SL.KeyHash SL.StakePool)
243243
(SL.RewardInfoPool)
244244
)
245245
GetPoolState ::
246-
Maybe (Set (SL.KeyHash 'SL.StakePool)) ->
246+
Maybe (Set (SL.KeyHash SL.StakePool)) ->
247247
BlockQuery
248248
(ShelleyBlock proto era)
249249
QFNoTables
250250
SL.QueryPoolStateResult
251251
GetStakeSnapshots ::
252-
Maybe (Set (SL.KeyHash 'SL.StakePool)) ->
252+
Maybe (Set (SL.KeyHash SL.StakePool)) ->
253253
BlockQuery
254254
(ShelleyBlock proto era)
255255
QFNoTables
256256
StakeSnapshots
257257
GetPoolDistr ::
258-
Maybe (Set (SL.KeyHash 'SL.StakePool)) ->
258+
Maybe (Set (SL.KeyHash SL.StakePool)) ->
259259
BlockQuery
260260
(ShelleyBlock proto era)
261261
QFNoTables
@@ -280,12 +280,12 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
280280
-- Not supported in eras before Conway.
281281
GetDRepState ::
282282
(CG.ConwayEraGov era, CG.ConwayEraCertState era) =>
283-
Set (SL.Credential 'DRepRole) ->
283+
Set (SL.Credential SL.DRepRole) ->
284284
BlockQuery
285285
(ShelleyBlock proto era)
286286
QFNoTables
287287
( Map
288-
(SL.Credential 'DRepRole)
288+
(SL.Credential SL.DRepRole)
289289
SL.DRepState
290290
)
291291
-- | Query the 'DRep' stake distribution. Note that this can be an expensive
@@ -305,8 +305,8 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
305305
-- Not supported in eras before Conway.
306306
GetCommitteeMembersState ::
307307
(CG.ConwayEraGov era, CG.ConwayEraCertState era) =>
308-
Set (SL.Credential 'ColdCommitteeRole) ->
309-
Set (SL.Credential 'HotCommitteeRole) ->
308+
Set (SL.Credential SL.ColdCommitteeRole) ->
309+
Set (SL.Credential SL.HotCommitteeRole) ->
310310
Set SL.MemberStatus ->
311311
BlockQuery (ShelleyBlock proto era) QFNoTables SL.CommitteeMembersState
312312
-- | The argument specifies the credential of each account whose delegatee
@@ -316,7 +316,7 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
316316
-- Not supported in eras before Conway.
317317
GetFilteredVoteDelegatees ::
318318
CG.ConwayEraGov era =>
319-
Set (SL.Credential 'SL.Staking) ->
319+
Set (SL.Credential SL.Staking) ->
320320
BlockQuery (ShelleyBlock proto era) QFNoTables VoteDelegatees
321321
GetAccountState ::
322322
BlockQuery (ShelleyBlock proto era) QFNoTables SL.ChainAccountState
@@ -328,8 +328,8 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
328328
-- Not supported in eras before Conway.
329329
GetSPOStakeDistr ::
330330
CG.ConwayEraGov era =>
331-
Set (KeyHash 'StakePool) ->
332-
BlockQuery (ShelleyBlock proto era) QFNoTables (Map (KeyHash 'StakePool) Coin)
331+
Set (KeyHash SL.StakePool) ->
332+
BlockQuery (ShelleyBlock proto era) QFNoTables (Map (KeyHash SL.StakePool) Coin)
333333
GetProposals ::
334334
CG.ConwayEraGov era =>
335335
Set CG.GovActionId ->
@@ -347,10 +347,10 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
347347
BlockQuery (ShelleyBlock proto era) QFNoTables LedgerPeerSnapshot
348348
QueryStakePoolDefaultVote ::
349349
CG.ConwayEraGov era =>
350-
KeyHash 'StakePool ->
350+
KeyHash SL.StakePool ->
351351
BlockQuery (ShelleyBlock proto era) QFNoTables CG.DefaultVote
352352
GetPoolDistr2 ::
353-
Maybe (Set (SL.KeyHash 'SL.StakePool)) ->
353+
Maybe (Set (SL.KeyHash SL.StakePool)) ->
354354
BlockQuery
355355
(ShelleyBlock proto era)
356356
QFNoTables
@@ -441,16 +441,16 @@ instance
441441
, SL.ssStakeGo
442442
} = SL.esSnapshots . SL.nesEs $ st
443443

444-
totalMarkByPoolId :: Map (KeyHash 'StakePool) Coin
444+
totalMarkByPoolId :: Map (KeyHash SL.StakePool) Coin
445445
totalMarkByPoolId = SL.sumStakePerPool (SL.ssDelegations ssStakeMark) (SL.ssStake ssStakeMark)
446446

447-
totalSetByPoolId :: Map (KeyHash 'StakePool) Coin
447+
totalSetByPoolId :: Map (KeyHash SL.StakePool) Coin
448448
totalSetByPoolId = SL.sumStakePerPool (SL.ssDelegations ssStakeSet) (SL.ssStake ssStakeSet)
449449

450-
totalGoByPoolId :: Map (KeyHash 'StakePool) Coin
450+
totalGoByPoolId :: Map (KeyHash SL.StakePool) Coin
451451
totalGoByPoolId = SL.sumStakePerPool (SL.ssDelegations ssStakeGo) (SL.ssStake ssStakeGo)
452452

453-
getPoolStakes :: Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) StakeSnapshot
453+
getPoolStakes :: Set (KeyHash SL.StakePool) -> Map (KeyHash SL.StakePool) StakeSnapshot
454454
getPoolStakes poolIds = Map.fromSet mkStakeSnapshot poolIds
455455
where
456456
mkStakeSnapshot poolId =
@@ -821,14 +821,14 @@ getDState = view SL.certDStateL . SL.lsCertState . SL.esLState . SL.nesEs
821821
getFilteredDelegationsAndRewardAccounts ::
822822
SL.EraCertState era =>
823823
SL.NewEpochState era ->
824-
Set (SL.Credential 'SL.Staking) ->
825-
(Delegations, Map (SL.Credential 'Staking) Coin)
824+
Set (SL.Credential SL.Staking) ->
825+
(Delegations, Map (SL.Credential SL.Staking) Coin)
826826
getFilteredDelegationsAndRewardAccounts = SL.queryStakePoolDelegsAndRewards
827827

828828
getFilteredVoteDelegatees ::
829829
(SL.EraCertState era, CG.ConwayEraAccounts era) =>
830830
SL.NewEpochState era ->
831-
Set (SL.Credential 'SL.Staking) ->
831+
Set (SL.Credential SL.Staking) ->
832832
VoteDelegatees
833833
getFilteredVoteDelegatees ss creds
834834
| Set.null creds =
@@ -1163,7 +1163,7 @@ instance FromCBOR StakeSnapshot where
11631163
<*> fromCBOR
11641164

11651165
data StakeSnapshots = StakeSnapshots
1166-
{ ssStakeSnapshots :: !(Map (SL.KeyHash 'SL.StakePool) StakeSnapshot)
1166+
{ ssStakeSnapshots :: !(Map (SL.KeyHash SL.StakePool) StakeSnapshot)
11671167
, ssMarkTotal :: !SL.Coin
11681168
, ssSetTotal :: !SL.Coin
11691169
, ssGoTotal :: !SL.Coin

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -107,8 +107,8 @@ instance ShelleyCompatible proto era => BlockSupportsMetrics (ShelleyBlock proto
107107
where
108108
issuerVKeys ::
109109
Map
110-
(SL.KeyHash 'SL.BlockIssuer)
111-
(SL.VKey 'SL.BlockIssuer)
110+
(SL.KeyHash SL.BlockIssuer)
111+
(SL.VKey SL.BlockIssuer)
112112
issuerVKeys = shelleyBlockIssuerVKeys cfg
113113

114114
instance ConsensusProtocol proto => BlockSupportsSanityCheck (ShelleyBlock proto era) where

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ data ShelleyLeaderCredentials c = ShelleyLeaderCredentials
6565
}
6666

6767
shelleyBlockIssuerVKey ::
68-
ShelleyLeaderCredentials c -> SL.VKey 'SL.BlockIssuer
68+
ShelleyLeaderCredentials c -> SL.VKey SL.BlockIssuer
6969
shelleyBlockIssuerVKey =
7070
praosCanBeLeaderColdVerKey . shelleyLeaderCredentialsCanBeLeader
7171

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/Abstract.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -174,7 +174,7 @@ class ProtocolHeaderSupportsProtocol proto where
174174
ShelleyProtocolHeader proto -> ValidateView proto
175175

176176
pHeaderIssuer ::
177-
ShelleyProtocolHeader proto -> VKey 'BlockIssuer
177+
ShelleyProtocolHeader proto -> VKey BlockIssuer
178178
pHeaderIssueNo ::
179179
ShelleyProtocolHeader proto -> Word64
180180

‎ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Cardano.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -203,14 +203,14 @@ migrateUTxO migrationInfo curSlot lcfg lst
203203
Byron.addrAttributes byronAddr
204204

205205
-- Witness the stake delegation.
206-
delegWit :: SL.WitVKey 'SL.Witness
206+
delegWit :: SL.WitVKey SL.Witness
207207
delegWit =
208208
TL.mkWitnessVKey
209209
bodyHash
210210
(Shelley.mkKeyPair stakingSK)
211211

212212
-- Witness the pool registration.
213-
poolWit :: SL.WitVKey 'SL.Witness
213+
poolWit :: SL.WitVKey SL.Witness
214214
poolWit =
215215
TL.mkWitnessVKey
216216
bodyHash

‎ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysShelley.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -568,7 +568,7 @@ instance HasTypeProxy GenesisKey where
568568

569569
instance Key GenesisKey where
570570
newtype VerificationKey GenesisKey
571-
= GenesisVerificationKey (Shelley.VKey Shelley.Genesis)
571+
= GenesisVerificationKey (Shelley.VKey Shelley.GenesisRole)
572572
deriving stock Eq
573573
deriving (Show, IsString) via UsingRawBytesHex (VerificationKey GenesisKey)
574574
deriving newtype (ToCBOR, FromCBOR)
@@ -615,7 +615,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisKey) where
615615
GenesisSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs
616616

617617
newtype instance Hash GenesisKey
618-
= GenesisKeyHash (Shelley.KeyHash Shelley.Genesis)
618+
= GenesisKeyHash (Shelley.KeyHash Shelley.GenesisRole)
619619
deriving stock (Eq, Ord)
620620
deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisKey)
621621
deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisKey)

0 commit comments

Comments
 (0)