From 2626ccee558a6b4074c12f24e1a366cf852c2441 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 25 Oct 2023 11:49:54 +0200 Subject: [PATCH] Use ledger keys' roles casting with explicit whitelist, instead of coerceKeyRole --- cardano-api/cardano-api.cabal | 1 + .../internal/Cardano/Api/Certificate.hs | 10 +++--- .../Api/Governance/Actions/VotingProcedure.hs | 7 +++-- .../internal/Cardano/Api/Keys/Class.hs | 1 - .../internal/Cardano/Api/Ledger/Keys.hs | 31 +++++++++++++++++++ cardano-api/internal/Cardano/Api/Orphans.hs | 1 + .../internal/Cardano/Api/ReexposeLedger.hs | 4 +-- cardano-api/internal/Cardano/Api/Script.hs | 10 +++--- cardano-api/internal/Cardano/Api/Tx.hs | 9 +++--- cardano-api/internal/Cardano/Api/TxBody.hs | 7 +++-- 10 files changed, 58 insertions(+), 23 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/Ledger/Keys.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 0f2ca0f360..d74f947d7d 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -102,6 +102,7 @@ library internal Cardano.Api.Keys.Read Cardano.Api.Keys.Shelley Cardano.Api.Ledger.Lens + Cardano.Api.Ledger.Keys Cardano.Api.LedgerEvent Cardano.Api.LedgerState Cardano.Api.Modes diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index d86e0fda79..bdfe0d537f 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -10,7 +10,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -- | Certificates embedded in transactions -- @@ -82,6 +81,7 @@ import Cardano.Api.Governance.Actions.VotingProcedure import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Praos import Cardano.Api.Keys.Shelley +import Cardano.Api.Ledger.Keys (castLedgerKey) import Cardano.Api.ReexposeLedger (EraCrypto, StandardCrypto) import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.SerialiseCBOR @@ -475,18 +475,18 @@ selectStakeCredential = fmap fromShelleyStakeCredential . \case Ledger.UnRegTxCert sCred -> Just sCred Ledger.DelegStakeTxCert sCred _ -> Just sCred Ledger.RegPoolTxCert poolParams -> - Just . Ledger.coerceKeyRole . Ledger.KeyHashObj $ Ledger.ppId poolParams + Just . castLedgerKey . Ledger.KeyHashObj $ Ledger.ppId poolParams Ledger.RetirePoolTxCert poolId _ -> - Just . Ledger.coerceKeyRole $ Ledger.KeyHashObj poolId + Just . castLedgerKey $ Ledger.KeyHashObj poolId Ledger.MirTxCert _ -> Nothing Ledger.GenesisDelegTxCert{} -> Nothing ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $ case conwayCert of Ledger.RegPoolTxCert poolParams -> - Just . Ledger.coerceKeyRole . Ledger.KeyHashObj $ Ledger.ppId poolParams + Just . castLedgerKey . Ledger.KeyHashObj $ Ledger.ppId poolParams Ledger.RetirePoolTxCert kh _ -> - Just . Ledger.coerceKeyRole $ Ledger.KeyHashObj kh + Just . castLedgerKey $ Ledger.KeyHashObj kh Ledger.RegTxCert sCred -> Just sCred Ledger.UnRegTxCert sCred -> Just sCred Ledger.RegDepositTxCert sCred _ -> Just sCred diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs index 2c86b30ced..9cef15ada0 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -22,6 +22,7 @@ import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Governance.Actions.ProposalProcedure import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Shelley +import Cardano.Api.Ledger.Keys import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.Script import Cardano.Api.SerialiseCBOR @@ -32,7 +33,7 @@ import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.Binary.Plain as Plain import Cardano.Ledger.Core (EraCrypto) import qualified Cardano.Ledger.Core as L -import Cardano.Ledger.Keys (HasKeyRole (..), KeyRole (DRepRole)) +import Cardano.Ledger.Keys (KeyRole (DRepRole)) import Data.ByteString.Lazy (ByteString) import qualified Data.Map as Map @@ -104,7 +105,7 @@ toVoterRole :: () toVoterRole eon = conwayEraOnwardsConstraints eon $ \case VoterCommittee (VotingCredential cred) -> - Ledger.CommitteeVoter $ coerceKeyRole cred -- TODO: Conway era - Alexey realllllyyy doesn't like this. We need to fix it. + Ledger.CommitteeVoter $ castLedgerKey cred VoterDRep (VotingCredential cred) -> Ledger.DRepVoter cred VoterSpo (StakePoolKeyHash kh) -> @@ -117,7 +118,7 @@ fromVoterRole :: () fromVoterRole eon = conwayEraOnwardsConstraints eon $ \case Ledger.CommitteeVoter cred -> - VoterCommittee (VotingCredential (coerceKeyRole cred)) -- TODO: Conway era - We shouldn't be using coerceKeyRole. + VoterCommittee (VotingCredential (castLedgerKey cred)) Ledger.DRepVoter cred -> VoterDRep (VotingCredential cred) Ledger.StakePoolVoter kh -> diff --git a/cardano-api/internal/Cardano/Api/Keys/Class.hs b/cardano-api/internal/Cardano/Api/Keys/Class.hs index 6b04e6f605..1d7c00729a 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Class.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Class.hs @@ -98,7 +98,6 @@ instance HasTypeProxy a => HasTypeProxy (SigningKey a) where -- | Some key roles share the same representation and it is sometimes -- legitimate to change the role of a key. --- class CastVerificationKeyRole keyroleA keyroleB where -- | Change the role of a 'VerificationKey', if the representation permits. diff --git a/cardano-api/internal/Cardano/Api/Ledger/Keys.hs b/cardano-api/internal/Cardano/Api/Ledger/Keys.hs new file mode 100644 index 0000000000..5ed7be31b2 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Ledger/Keys.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Cardano.Api.Ledger.Keys where + +import qualified Cardano.Api.ReexposeLedger as L + +import Cardano.Ledger.Keys (HasKeyRole (..)) +import qualified Cardano.Ledger.Keys as Shelley + +-- | Allows casting of the ledger keys between different roles. In comparison to the 'coerceKeyRole', this +-- class requires explicit listing of the key types we allow casting of. This prevents from accidental +-- casting of a new key role when ledger interface changes. +class CastLedgerKey keyType keyRoleA keyRoleB where + castLedgerKey :: keyType keyRoleA c -> keyType keyRoleB c + default castLedgerKey :: HasKeyRole keyType => keyType keyRoleA c -> keyType keyRoleB c + castLedgerKey = coerceKeyRole + +instance CastLedgerKey L.Credential L.StakePool L.Staking +instance CastLedgerKey L.Credential L.Staking L.StakePool + +instance CastLedgerKey L.Credential L.DRepRole L.HotCommitteeRole +instance CastLedgerKey L.Credential L.HotCommitteeRole L.DRepRole + +instance CastLedgerKey Shelley.VKey L.Payment L.Witness +instance CastLedgerKey Shelley.VKey L.Witness L.Payment + +instance CastLedgerKey Shelley.KeyHash L.Payment L.Witness +instance CastLedgerKey Shelley.KeyHash L.Witness L.Payment diff --git a/cardano-api/internal/Cardano/Api/Orphans.hs b/cardano-api/internal/Cardano/Api/Orphans.hs index 5fff888259..436cc95dc0 100644 --- a/cardano-api/internal/Cardano/Api/Orphans.hs +++ b/cardano-api/internal/Cardano/Api/Orphans.hs @@ -332,3 +332,4 @@ instance Semigroup (Ledger.ConwayPParams StrictMaybe era) where , Ledger.cppDRepDeposit = lastMappendWith Ledger.cppDRepDeposit p1 p2 , Ledger.cppDRepActivity = lastMappendWith Ledger.cppDRepActivity p1 p2 } + diff --git a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs index a2dea782d8..e0ae81cae7 100644 --- a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs +++ b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs @@ -9,7 +9,7 @@ module Cardano.Api.ReexposeLedger , ShelleyEraTxCert(..) , GenesisDelegCert(..) , PoolParams (..) - , HasKeyRole(..) + , HasKeyRole , MIRPot(..) , MIRTarget(..) , MIRCert(..) @@ -129,7 +129,7 @@ import Cardano.Ledger.Core (DRep (..), EraCrypto, PParams (..), PoolCe import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Crypto (Crypto, StandardCrypto) import Cardano.Ledger.DRepDistr (DRepState, drepAnchorL, drepDepositL, drepExpiryL) -import Cardano.Ledger.Keys (HasKeyRole (..), KeyHash (..), KeyRole (..)) +import Cardano.Ledger.Keys (HasKeyRole, KeyHash (..), KeyRole (..)) import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) import Cardano.Ledger.Shelley.TxCert (EraTxCert (..), GenesisDelegCert (..), MIRCert (..), MIRPot (..), MIRTarget (..), ShelleyDelegCert (..), ShelleyEraTxCert (..), diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index 0fc49b1a01..b0732bb3b5 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -117,6 +117,7 @@ import Cardano.Api.Error import Cardano.Api.Hash import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Shelley +import Cardano.Api.Ledger.Keys import Cardano.Api.ScriptData import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseJSON @@ -135,7 +136,6 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import qualified Cardano.Ledger.Binary as Binary (decCBOR, decodeFullAnnotator) import Cardano.Ledger.Core (Era (EraCrypto)) import qualified Cardano.Ledger.Core as Ledger -import qualified Cardano.Ledger.Keys as Shelley import qualified Cardano.Ledger.Shelley.Scripts as Shelley import Cardano.Slotting.Slot (SlotNo) import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) @@ -1197,7 +1197,7 @@ toShelleyMultiSig = go where go :: SimpleScript -> Either MultiSigError (Shelley.MultiSig era) go (RequireSignature (PaymentKeyHash kh)) = - return $ Shelley.RequireSignature (Shelley.coerceKeyRole kh) + return $ Shelley.RequireSignature (castLedgerKey kh) go (RequireAllOf s) = mapM go s <&> Shelley.RequireAllOf go (RequireAnyOf s) = mapM go s <&> Shelley.RequireAnyOf go (RequireMOf m s) = mapM go s <&> Shelley.RequireMOf m @@ -1211,7 +1211,7 @@ fromShelleyMultiSig = go where go (Shelley.RequireSignature kh) = RequireSignature - (PaymentKeyHash (Shelley.coerceKeyRole kh)) + (PaymentKeyHash (castLedgerKey kh)) go (Shelley.RequireAllOf s) = RequireAllOf (map go s) go (Shelley.RequireAnyOf s) = RequireAnyOf (map go s) go (Shelley.RequireMOf m s) = RequireMOf m (map go s) @@ -1226,7 +1226,7 @@ toAllegraTimelock = go where go :: SimpleScript -> Timelock.Timelock era go (RequireSignature (PaymentKeyHash kh)) - = Timelock.RequireSignature (Shelley.coerceKeyRole kh) + = Timelock.RequireSignature (castLedgerKey kh) go (RequireAllOf s) = Timelock.RequireAllOf (Seq.fromList (map go s)) go (RequireAnyOf s) = Timelock.RequireAnyOf (Seq.fromList (map go s)) go (RequireMOf m s) = Timelock.RequireMOf m (Seq.fromList (map go s)) @@ -1241,7 +1241,7 @@ fromAllegraTimelock :: (Era era, EraCrypto era ~ StandardCrypto) fromAllegraTimelock = go where go (Timelock.RequireSignature kh) = RequireSignature - (PaymentKeyHash (Shelley.coerceKeyRole kh)) + (PaymentKeyHash (castLedgerKey kh)) go (Timelock.RequireTimeExpire t) = RequireTimeBefore t go (Timelock.RequireTimeStart t) = RequireTimeAfter t go (Timelock.RequireAllOf s) = RequireAllOf (map go (toList s)) diff --git a/cardano-api/internal/Cardano/Api/Tx.hs b/cardano-api/internal/Cardano/Api/Tx.hs index 66f0694183..69b89fa7a3 100644 --- a/cardano-api/internal/Cardano/Api/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Tx.hs @@ -59,6 +59,7 @@ import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Byron import Cardano.Api.Keys.Class import Cardano.Api.Keys.Shelley +import Cardano.Api.Ledger.Keys import Cardano.Api.NetworkId import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseTextEnvelope @@ -793,16 +794,16 @@ getShelleyKeyWitnessVerificationKey :: ShelleySigningKey -> Shelley.VKey Shelley.Witness StandardCrypto getShelleyKeyWitnessVerificationKey (ShelleyNormalSigningKey sk) = - (Shelley.coerceKeyRole :: Shelley.VKey Shelley.Payment StandardCrypto - -> Shelley.VKey Shelley.Witness StandardCrypto) + (castLedgerKey :: Shelley.VKey Shelley.Payment StandardCrypto + -> Shelley.VKey Shelley.Witness StandardCrypto) . (\(PaymentVerificationKey vk) -> vk) . getVerificationKey . PaymentSigningKey $ sk getShelleyKeyWitnessVerificationKey (ShelleyExtendedSigningKey sk) = - (Shelley.coerceKeyRole :: Shelley.VKey Shelley.Payment StandardCrypto - -> Shelley.VKey Shelley.Witness StandardCrypto) + (castLedgerKey :: Shelley.VKey Shelley.Payment StandardCrypto + -> Shelley.VKey Shelley.Witness StandardCrypto) . (\(PaymentVerificationKey vk) -> vk) . (castVerificationKey :: VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index a638afef49..732a2d3762 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -169,6 +169,7 @@ import Cardano.Api.Hash import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Byron import Cardano.Api.Keys.Shelley +import Cardano.Api.Ledger.Keys import qualified Cardano.Api.Ledger.Lens as L import Cardano.Api.NetworkId import Cardano.Api.ProtocolParameters @@ -2458,7 +2459,7 @@ fromLedgerTxExtraKeyWitnesses sbe body = then TxExtraKeyWitnessesNone else TxExtraKeyWitnesses w - [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) + [ PaymentKeyHash (castLedgerKey keyhash) | keyhash <- Set.toList $ body ^. L.reqSignerHashesTxBodyL ] ) @@ -2667,12 +2668,12 @@ convMintValue txMintValue = case toMaryValue v of MaryValue _ ma -> ma -convExtraKeyWitnesses :: TxExtraKeyWitnesses era -> Set (Shelley.KeyHash r' StandardCrypto) +convExtraKeyWitnesses :: TxExtraKeyWitnesses era -> Set (Shelley.KeyHash Shelley.Witness StandardCrypto) convExtraKeyWitnesses txExtraKeyWits = case txExtraKeyWits of TxExtraKeyWitnessesNone -> Set.empty TxExtraKeyWitnesses _ khs -> Set.fromList - [ Shelley.coerceKeyRole kh + [ castLedgerKey kh | PaymentKeyHash kh <- khs ] convScripts