Merge pull request #3588 from input-output-hk/aniketd/key-roles-rename

Rename key roles

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

@@ -93,8 +93,8 @@ import Lens.Micro (Lens', lens, (^.))
 import NoThunks.Class (NoThunks)
 
 data GovernanceActionState era = GovernanceActionState
- { gasCommitteeVotes :: !(Map (Credential 'CommitteeHotKey (EraCrypto era)) Vote)
- , gasDRepVotes :: !(Map (Credential 'Voting (EraCrypto era)) Vote)
+ { gasCommitteeVotes :: !(Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote)
+ , gasDRepVotes :: !(Map (Credential 'DRepRole (EraCrypto era)) Vote)
  , gasStakePoolVotes :: !(Map (KeyHash 'StakePool (EraCrypto era)) Vote)
  , gasDeposit :: !Coin
  , gasReturnAddr :: !(KeyHash 'Staking (EraCrypto era))
@@ -178,7 +178,7 @@ instance EraPParams era => FromCBOR (ConwayGovState era) where
  fromCBOR = fromEraCBOR @era
 
 data EnactState era = EnactState
- { ensCommittee :: !(StrictMaybe (Set (KeyHash 'Voting (EraCrypto era)), Rational))
+ { ensCommittee :: !(StrictMaybe (Set (KeyHash 'DRepRole (EraCrypto era)), Rational))
  -- ^ Constitutional Committee
  , ensConstitution :: !(Constitution era)
  -- ^ Hash of the Constitution

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

@@ -140,8 +140,8 @@ govActionIdToText (GovernanceActionId (TxId txidHash) (GovernanceActionIx ix)) =
  <> Text.pack (show ix)
 
 data Voter c
- = CommitteeVoter !(Credential 'CommitteeHotKey c)
- | DRepVoter !(Credential 'Voting c)
+ = CommitteeVoter !(Credential 'HotCommitteeRole c)
+ | DRepVoter !(Credential 'DRepRole c)
  | StakePoolVoter !(KeyHash 'StakePool c)
  deriving (Generic, Eq, Ord, Show)
 
@@ -348,7 +348,7 @@ data GovernanceAction era
  | HardForkInitiation !ProtVer
  | TreasuryWithdrawals !(Map (Credential 'Staking (EraCrypto era)) Coin)
  | NoConfidence
- | NewCommittee !(Set (KeyHash 'Voting (EraCrypto era))) !Rational
+ | NewCommittee !(Set (KeyHash 'DRepRole (EraCrypto era))) !Rational
  | NewConstitution !(Constitution era)
  | InfoAction
  deriving (Generic)

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs

@@ -30,7 +30,7 @@ import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..))
 import Cardano.Ledger.Core (Era (EraCrypto), EraPParams, EraRule, PParams)
 import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.Crypto (Crypto)
-import Cardano.Ledger.Keys (KeyRole (CommitteeColdKey, Voting))
+import Cardano.Ledger.Keys (KeyRole (ColdCommitteeRole, DRepRole))
 import Control.DeepSeq (NFData)
 import Control.State.Transition.Extended (
  BaseM,
@@ -55,10 +55,10 @@ import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
 
 data ConwayGovCertPredFailure era
- = ConwayDRepAlreadyRegistered !(Credential 'Voting (EraCrypto era))
- | ConwayDRepNotRegistered !(Credential 'Voting (EraCrypto era))
+ = ConwayDRepAlreadyRegistered !(Credential 'DRepRole (EraCrypto era))
+ | ConwayDRepNotRegistered !(Credential 'DRepRole (EraCrypto era))
  | ConwayDRepIncorrectDeposit !Coin
- | ConwayCommitteeHasResigned !(Credential 'CommitteeColdKey (EraCrypto era))
+ | ConwayCommitteeHasResigned !(Credential 'ColdCommitteeRole (EraCrypto era))
  deriving (Show, Eq, Generic)
 
 instance NoThunks (ConwayGovCertPredFailure era)

eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs

@@ -140,18 +140,18 @@ class ShelleyEraTxCert era => ConwayEraTxCert era where
  TxCert era -> Maybe (StakeCredential (EraCrypto era), Delegatee (EraCrypto era), Coin)
 
  mkAuthCommitteeHotKeyTxCert ::
- Credential 'CommitteeColdKey (EraCrypto era) -> Credential 'CommitteeHotKey (EraCrypto era) -> TxCert era
+ Credential 'ColdCommitteeRole (EraCrypto era) -> Credential 'HotCommitteeRole (EraCrypto era) -> TxCert era
  getAuthCommitteeHotKeyTxCert ::
- TxCert era -> Maybe (Credential 'CommitteeColdKey (EraCrypto era), Credential 'CommitteeHotKey (EraCrypto era))
+ TxCert era -> Maybe (Credential 'ColdCommitteeRole (EraCrypto era), Credential 'HotCommitteeRole (EraCrypto era))
 
- mkResignCommitteeColdTxCert :: Credential 'CommitteeColdKey (EraCrypto era) -> TxCert era
- getResignCommitteeColdTxCert :: TxCert era -> Maybe (Credential 'CommitteeColdKey (EraCrypto era))
+ mkResignCommitteeColdTxCert :: Credential 'ColdCommitteeRole (EraCrypto era) -> TxCert era
+ getResignCommitteeColdTxCert :: TxCert era -> Maybe (Credential 'ColdCommitteeRole (EraCrypto era))
 
- mkRegDRepTxCert :: Credential 'Voting (EraCrypto era) -> Coin -> StrictMaybe (Anchor (EraCrypto era)) -> TxCert era
- getRegDRepTxCert :: TxCert era -> Maybe (Credential 'Voting (EraCrypto era), Coin, StrictMaybe (Anchor (EraCrypto era)))
+ mkRegDRepTxCert :: Credential 'DRepRole (EraCrypto era) -> Coin -> StrictMaybe (Anchor (EraCrypto era)) -> TxCert era
+ getRegDRepTxCert :: TxCert era -> Maybe (Credential 'DRepRole (EraCrypto era), Coin, StrictMaybe (Anchor (EraCrypto era)))
 
- mkUnRegDRepTxCert :: Credential 'Voting (EraCrypto era) -> Coin -> TxCert era
- getUnRegDRepTxCert :: TxCert era -> Maybe (Credential 'Voting (EraCrypto era), Coin)
+ mkUnRegDRepTxCert :: Credential 'DRepRole (EraCrypto era) -> Coin -> TxCert era
+ getUnRegDRepTxCert :: TxCert era -> Maybe (Credential 'DRepRole (EraCrypto era), Coin)
 
 instance Crypto c => ConwayEraTxCert (ConwayEra c) where
  mkRegDepositTxCert cred c = ConwayTxCertDeleg $ ConwayRegCert cred $ SJust c
@@ -228,24 +228,24 @@ pattern RegDepositDelegTxCert cred d c <- (getRegDepositDelegTxCert -> Just (cre
 
 pattern AuthCommitteeHotKeyTxCert ::
  ConwayEraTxCert era =>
- Credential 'CommitteeColdKey (EraCrypto era) ->
- Credential 'CommitteeHotKey (EraCrypto era) ->
+ Credential 'ColdCommitteeRole (EraCrypto era) ->
+ Credential 'HotCommitteeRole (EraCrypto era) ->
  TxCert era
 pattern AuthCommitteeHotKeyTxCert ck hk <- (getAuthCommitteeHotKeyTxCert -> Just (ck, hk))
  where
  AuthCommitteeHotKeyTxCert ck hk = mkAuthCommitteeHotKeyTxCert ck hk
 
 pattern ResignCommitteeColdTxCert ::
  ConwayEraTxCert era =>
- Credential 'CommitteeColdKey (EraCrypto era) ->
+ Credential 'ColdCommitteeRole (EraCrypto era) ->
  TxCert era
 pattern ResignCommitteeColdTxCert ck <- (getResignCommitteeColdTxCert -> Just ck)
  where
  ResignCommitteeColdTxCert ck = mkResignCommitteeColdTxCert ck
 
 pattern RegDRepTxCert ::
  ConwayEraTxCert era =>
- Credential 'Voting (EraCrypto era) ->
+ Credential 'DRepRole (EraCrypto era) ->
  Coin ->
  StrictMaybe (Anchor (EraCrypto era)) ->
  TxCert era
@@ -255,7 +255,7 @@ pattern RegDRepTxCert cred deposit mAnchor <- (getRegDRepTxCert -> Just (cred, d
 
 pattern UnRegDRepTxCert ::
  ConwayEraTxCert era =>
- Credential 'Voting (EraCrypto era) ->
+ Credential 'DRepRole (EraCrypto era) ->
  Coin ->
  TxCert era
 pattern UnRegDRepTxCert cred deposit <- (getUnRegDRepTxCert -> Just (cred, deposit))
@@ -319,10 +319,10 @@ instance NFData (ConwayDelegCert c)
 instance NoThunks (ConwayDelegCert c)
 
 data ConwayGovCert c
- = ConwayRegDRep !(Credential 'Voting c) !Coin !(StrictMaybe (Anchor c))
- | ConwayUnRegDRep !(Credential 'Voting c) !Coin
- | ConwayAuthCommitteeHotKey !(Credential 'CommitteeColdKey c) !(Credential 'CommitteeHotKey c)
- | ConwayResignCommitteeColdKey !(Credential 'CommitteeColdKey c)
+ = ConwayRegDRep !(Credential 'DRepRole c) !Coin !(StrictMaybe (Anchor c))
+ | ConwayUnRegDRep !(Credential 'DRepRole c) !Coin
+ | ConwayAuthCommitteeHotKey !(Credential 'ColdCommitteeRole c) !(Credential 'HotCommitteeRole c)
+ | ConwayResignCommitteeColdKey !(Credential 'ColdCommitteeRole c)
  deriving (Show, Generic, Eq)
 
 instance Crypto c => NFData (ConwayGovCert c)

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## 1.5.0.0
 
+* Rename key roles #3588
+ * `Voting` to `DRepRole`
+ * `CommitteeHotKey` to `HotCommitteeRole`
+ * `CommitteeColdKey` to `ColdCommitteeRole`
 * Change `VState` to allow committee cold keys to be script-hashes #3581
  * `vsCommitteeHotKeys :: Map (Credential 'CommitteeColdKey eracrypto) (Maybe (Credential 'CommitteeHotKey eracrypto))`
 * Adopt `Default` instances #3556

libs/cardano-ledger-core/src/Cardano/Ledger/CertState.hs

@@ -276,11 +276,11 @@ toPStatePair PState {..} =
  ]
 
 data VState era = VState
- { vsDReps :: !(Set (Credential 'Voting (EraCrypto era)))
+ { vsDReps :: !(Set (Credential 'DRepRole (EraCrypto era)))
  , vsCommitteeHotKeys ::
  !( Map
- (Credential 'CommitteeColdKey (EraCrypto era))
- (Maybe (Credential 'CommitteeHotKey (EraCrypto era))) -- `Nothing` to indicate "resigned".
+ (Credential 'ColdCommitteeRole (EraCrypto era))
+ (Maybe (Credential 'HotCommitteeRole (EraCrypto era))) -- `Nothing` to indicate "resigned".
  )
  }
  deriving (Show, Eq, Generic)

libs/cardano-ledger-core/src/Cardano/Ledger/Core/TxCert.hs

@@ -132,7 +132,7 @@ poolCWitness (RegPool pool) = KeyHashObj $ ppId pool
 poolCWitness (RetirePool k _) = KeyHashObj k
 
 data DRep c
- = DRepKeyHash !(KeyHash 'Voting c)
+ = DRepKeyHash !(KeyHash 'DRepRole c)
  | DRepScriptHash !(ScriptHash c)
  | DRepAlwaysAbstain
  | DRepAlwaysNoConfidence
@@ -163,12 +163,12 @@ instance Crypto c => DecCBOR (DRep c) where
  3 -> SumD DRepAlwaysNoConfidence
  k -> Invalid k
 
-dRepToCred :: DRep c -> Maybe (Credential 'Voting c)
+dRepToCred :: DRep c -> Maybe (Credential 'DRepRole c)
 dRepToCred (DRepKeyHash kh) = Just $ KeyHashObj kh
 dRepToCred (DRepScriptHash sh) = Just $ ScriptHashObj sh
 dRepToCred _ = Nothing
 
-pattern DRepCredential :: Credential 'Voting c -> DRep c
+pattern DRepCredential :: Credential 'DRepRole c -> DRep c
 pattern DRepCredential c <- (dRepToCred -> Just c)
  where
  DRepCredential c = case c of

libs/cardano-ledger-core/src/Cardano/Ledger/Keys.hs

@@ -124,9 +124,9 @@ data KeyRole
  | StakePool
  | BlockIssuer
  | Witness
- | Voting
- | CommitteeHotKey
- | CommitteeColdKey
+ | DRepRole
+ | HotCommitteeRole
+ | ColdCommitteeRole
  deriving (Show)
 
 class HasKeyRole (a :: KeyRole -> Type -> Type) where

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Lenses.hs

@@ -111,13 +111,13 @@ psDepositsL = lens psDeposits (\ds u -> ds {psDeposits = u})
 -- ===================================
 -- VState
 
-vsDRepsL :: Lens' (VState era) (Set (Credential 'Voting (EraCrypto era)))
+vsDRepsL :: Lens' (VState era) (Set (Credential 'DRepRole (EraCrypto era)))
 vsDRepsL = lens vsDReps (\vs u -> vs {vsDReps = u})
 
 vsCommitteeHotKeysL ::
  Lens'
  (VState era)
- (Map (Credential 'CommitteeColdKey (EraCrypto era)) (Maybe (Credential 'CommitteeHotKey (EraCrypto era))))
+ (Map (Credential 'ColdCommitteeRole (EraCrypto era)) (Maybe (Credential 'HotCommitteeRole (EraCrypto era))))
 vsCommitteeHotKeysL = lens vsCommitteeHotKeys (\vs u -> vs {vsCommitteeHotKeys = u})
 
 -- ========================================

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs

@@ -110,14 +110,14 @@ data Rep era t where
  SetR :: Ord a => Rep era a -> Rep era (Set a)
  ListR :: Rep era a -> Rep era [a]
  CredR :: Rep era (Credential 'Staking (EraCrypto era))
- VCredR :: Rep era (Credential 'Voting (EraCrypto era))
+ VCredR :: Rep era (Credential 'DRepRole (EraCrypto era))
  PoolHashR :: Rep era (KeyHash 'StakePool (EraCrypto era))
  WitHashR :: Rep era (KeyHash 'Witness (EraCrypto era))
  GenHashR :: Rep era (KeyHash 'Genesis (EraCrypto era))
  GenDelegHashR :: Rep era (KeyHash 'GenesisDelegate (EraCrypto era))
- VHashR :: Rep era (KeyHash 'Voting (EraCrypto era))
- CommColdHashR :: Rep era (Credential 'CommitteeColdKey (EraCrypto era))
- CommHotHashR :: Rep era (Credential 'CommitteeHotKey (EraCrypto era))
+ VHashR :: Rep era (KeyHash 'DRepRole (EraCrypto era))
+ CommColdHashR :: Rep era (Credential 'ColdCommitteeRole (EraCrypto era))
+ CommHotHashR :: Rep era (Credential 'HotCommitteeRole (EraCrypto era))
  PoolParamsR :: Rep era (PoolParams (EraCrypto era))
  NewEpochStateR :: Rep era (NewEpochState era)
  IntR :: Rep era Int

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs

@@ -220,16 +220,16 @@ poolDeposits = Var $ V "poolDeposits" (MapR PoolHashR CoinR) (Yes NewEpochStateR
 poolDepositsL :: NELens era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
 poolDepositsL = nesEsL . esLStateL . lsCertStateL . certPStateL . psDepositsL
 
-dreps :: Term era (Set (Credential 'Voting (EraCrypto era)))
+dreps :: Term era (Set (Credential 'DRepRole (EraCrypto era)))
 dreps = Var $ V "dreps" (SetR VCredR) (Yes NewEpochStateR drepsL)
 
-drepsL :: NELens era (Set (Credential 'Voting (EraCrypto era)))
+drepsL :: NELens era (Set (Credential 'DRepRole (EraCrypto era)))
 drepsL = nesEsL . esLStateL . lsCertStateL . certVStateL . vsDRepsL
 
-ccHotKeys :: Term era (Map (Credential 'CommitteeColdKey (EraCrypto era)) (Maybe (Credential 'CommitteeHotKey (EraCrypto era))))
+ccHotKeys :: Term era (Map (Credential 'ColdCommitteeRole (EraCrypto era)) (Maybe (Credential 'HotCommitteeRole (EraCrypto era))))
 ccHotKeys = Var $ V "dreps" (MapR CommColdHashR (MaybeR CommHotHashR)) (Yes NewEpochStateR ccHotKeysL)
 
-ccHotKeysL :: NELens era (Map (Credential 'CommitteeColdKey (EraCrypto era)) (Maybe (Credential 'CommitteeHotKey (EraCrypto era))))
+ccHotKeysL :: NELens era (Map (Credential 'ColdCommitteeRole (EraCrypto era)) (Maybe (Credential 'HotCommitteeRole (EraCrypto era))))
 ccHotKeysL = nesEsL . esLStateL . lsCertStateL . certVStateL . vsCommitteeHotKeysL
 
 -- UTxOState