From 0ab6808e6285831152910dfe08b5c5abda303e14 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 26 Oct 2023 11:57:18 +0200 Subject: [PATCH] Remove keys casting --- cardano-api/cardano-api.cabal | 1 - cardano-api/internal/Cardano/Api/Address.hs | 1 - .../internal/Cardano/Api/Certificate.hs | 21 +++----- .../Api/Governance/Actions/VotingProcedure.hs | 54 +++++-------------- .../internal/Cardano/Api/Ledger/Keys.hs | 31 ----------- cardano-api/internal/Cardano/Api/Script.hs | 10 ++-- cardano-api/internal/Cardano/Api/Tx.hs | 7 ++- cardano-api/internal/Cardano/Api/TxBody.hs | 5 +- cardano-api/src/Cardano/Api/Shelley.hs | 1 - 9 files changed, 30 insertions(+), 101 deletions(-) delete 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 d74f947d7d..0f2ca0f360 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -102,7 +102,6 @@ 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/Address.hs b/cardano-api/internal/Cardano/Api/Address.hs index 9182d20008..63458cb1dc 100644 --- a/cardano-api/internal/Cardano/Api/Address.hs +++ b/cardano-api/internal/Cardano/Api/Address.hs @@ -523,7 +523,6 @@ makeShelleyAddressInEra sbe nw pc scr = -- data StakeAddress where - StakeAddress :: Shelley.Network -> Shelley.StakeCredential StandardCrypto diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index bdfe0d537f..662e150f78 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -81,7 +81,6 @@ 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 @@ -383,7 +382,7 @@ makeMIRCertificate (MirCertificateRequirements atMostEra mirPot mirTarget) = data DRepRegistrationRequirements era where DRepRegistrationRequirements :: ConwayEraOnwards era - -> VotingCredential era + -> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era))) -> Lovelace -> DRepRegistrationRequirements era @@ -392,7 +391,7 @@ makeDrepRegistrationCertificate :: () => DRepRegistrationRequirements era -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era))) -> Certificate era -makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards (VotingCredential vcred) deposit) anchor = +makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards vcred deposit) anchor = ConwayCertificate conwayOnwards . Ledger.ConwayTxCertGov $ Ledger.ConwayRegDRep @@ -435,14 +434,14 @@ makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequireme data DRepUnregistrationRequirements era where DRepUnregistrationRequirements :: ConwayEraOnwards era - -> VotingCredential era + -> (Ledger.Credential Ledger.DRepRole (EraCrypto (ShelleyLedgerEra era))) -> Lovelace -> DRepUnregistrationRequirements era makeDrepUnregistrationCertificate :: () => DRepUnregistrationRequirements era -> Certificate era -makeDrepUnregistrationCertificate (DRepUnregistrationRequirements conwayOnwards (VotingCredential vcred) deposit) = +makeDrepUnregistrationCertificate (DRepUnregistrationRequirements conwayOnwards vcred deposit) = ConwayCertificate conwayOnwards . Ledger.ConwayTxCertGov . Ledger.ConwayUnRegDRep vcred @@ -474,19 +473,15 @@ selectStakeCredential = fmap fromShelleyStakeCredential . \case Ledger.RegTxCert sCred -> Just sCred Ledger.UnRegTxCert sCred -> Just sCred Ledger.DelegStakeTxCert sCred _ -> Just sCred - Ledger.RegPoolTxCert poolParams -> - Just . castLedgerKey . Ledger.KeyHashObj $ Ledger.ppId poolParams - Ledger.RetirePoolTxCert poolId _ -> - Just . castLedgerKey $ Ledger.KeyHashObj poolId + Ledger.RegPoolTxCert _ -> Nothing -- StakePool should never be a credential + Ledger.RetirePoolTxCert _ _ -> Nothing -- StakePool should never be a credential Ledger.MirTxCert _ -> Nothing Ledger.GenesisDelegTxCert{} -> Nothing ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $ case conwayCert of - Ledger.RegPoolTxCert poolParams -> - Just . castLedgerKey . Ledger.KeyHashObj $ Ledger.ppId poolParams - Ledger.RetirePoolTxCert kh _ -> - Just . castLedgerKey $ Ledger.KeyHashObj kh + Ledger.RegPoolTxCert _ -> Nothing -- StakePool should never be a credential + Ledger.RetirePoolTxCert _ _ -> Nothing -- StakePool should never be a credential 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 9cef15ada0..7c7128dfef 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -22,7 +22,6 @@ 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 @@ -56,18 +55,14 @@ instance IsShelleyBasedEra era => FromCBOR (GovernanceActionId era) where !v <- shelleyBasedEraConstraints (shelleyBasedEra @era) $ Ledger.fromEraCBOR @(ShelleyLedgerEra era) return $ GovernanceActionId v - --- TODO: Conway era - --- These should be the different keys corresponding to the Constitutional Committee and DReps. --- We can then derive the StakeCredentials from them. data Voter era - = VoterCommittee (VotingCredential era) -- ^ Constitutional committee - | VoterDRep (VotingCredential era) -- ^ Delegated representative + = VoterCommittee (Ledger.Credential Ledger.HotCommitteeRole (EraCrypto (ShelleyLedgerEra era))) -- ^ Constitutional committee + | VoterDRep (Ledger.Credential DRepRole (EraCrypto (ShelleyLedgerEra era))) -- ^ Delegated representative | VoterSpo (Hash StakePoolKey) -- ^ Stake pool operator deriving (Show, Eq, Ord) instance IsShelleyBasedEra era => ToCBOR (Voter era) where - toCBOR = \case + toCBOR = shelleyBasedEraConstraints (shelleyBasedEra @era) $ \case VoterCommittee v -> CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> toCBOR v VoterDRep v -> @@ -76,7 +71,7 @@ instance IsShelleyBasedEra era => ToCBOR (Voter era) where CBOR.encodeListLen 2 <> CBOR.encodeWord 2 <> toCBOR v instance IsShelleyBasedEra era => FromCBOR (Voter era) where - fromCBOR = do + fromCBOR = shelleyBasedEraConstraints (shelleyBasedEra @era) $ do CBOR.decodeListLenOf 2 t <- CBOR.decodeWord case t of @@ -104,12 +99,9 @@ toVoterRole :: () -> Ledger.Voter (L.EraCrypto (ShelleyLedgerEra era)) toVoterRole eon = conwayEraOnwardsConstraints eon $ \case - VoterCommittee (VotingCredential cred) -> - Ledger.CommitteeVoter $ castLedgerKey cred - VoterDRep (VotingCredential cred) -> - Ledger.DRepVoter cred - VoterSpo (StakePoolKeyHash kh) -> - Ledger.StakePoolVoter kh + VoterCommittee cred -> Ledger.CommitteeVoter cred + VoterDRep cred -> Ledger.DRepVoter cred + VoterSpo (StakePoolKeyHash kh) -> Ledger.StakePoolVoter kh fromVoterRole :: () => ConwayEraOnwards era @@ -118,9 +110,9 @@ fromVoterRole :: () fromVoterRole eon = conwayEraOnwardsConstraints eon $ \case Ledger.CommitteeVoter cred -> - VoterCommittee (VotingCredential (castLedgerKey cred)) + VoterCommittee cred Ledger.DRepVoter cred -> - VoterDRep (VotingCredential cred) + VoterDRep cred Ledger.StakePoolVoter kh -> VoterSpo (StakePoolKeyHash kh) @@ -133,7 +125,7 @@ toVote = \case toVotingCredential :: () => ConwayEraOnwards era -> StakeCredential - -> Either Plain.DecoderError (VotingCredential era) + -> Either Plain.DecoderError (Ledger.Credential DRepRole (EraCrypto (ShelleyLedgerEra era))) toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do let cbor = Plain.serialize $ Ledger.KeyHashObj kh eraDecodeVotingCredential sbe cbor @@ -150,30 +142,8 @@ toVotingCredential _sbe (StakeCredentialByScript (ScriptHash _sh)) = eraDecodeVotingCredential :: () => ConwayEraOnwards era -> ByteString - -> Either Plain.DecoderError (VotingCredential era) -eraDecodeVotingCredential eon bs = - conwayEraOnwardsConstraints eon $ - case Plain.decodeFull bs of - Left e -> Left e - Right x -> Right $ VotingCredential x - -newtype VotingCredential era = VotingCredential - { unVotingCredential :: Ledger.Credential 'DRepRole (EraCrypto (ShelleyLedgerEra era)) - } - -deriving instance Show (VotingCredential crypto) -deriving instance Eq (VotingCredential crypto) -deriving instance Ord (VotingCredential crypto) - -instance IsShelleyBasedEra era => ToCBOR (VotingCredential era) where - toCBOR = \case - VotingCredential v -> - shelleyBasedEraConstraints (shelleyBasedEra @era) $ CBOR.toCBOR v - -instance IsShelleyBasedEra era => FromCBOR (VotingCredential era) where - fromCBOR = do - v <- shelleyBasedEraConstraints (shelleyBasedEra @era) CBOR.fromCBOR - return $ VotingCredential v + -> Either Plain.DecoderError (Ledger.Credential DRepRole (EraCrypto (ShelleyLedgerEra era))) +eraDecodeVotingCredential eon bs = conwayEraOnwardsConstraints eon $ Plain.decodeFull bs createVotingProcedure :: () => ConwayEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Ledger/Keys.hs b/cardano-api/internal/Cardano/Api/Ledger/Keys.hs deleted file mode 100644 index 5ed7be31b2..0000000000 --- a/cardano-api/internal/Cardano/Api/Ledger/Keys.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# 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/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index b0732bb3b5..8dcedb7517 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -117,7 +117,6 @@ 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 @@ -136,6 +135,7 @@ 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 L 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 (castLedgerKey kh) + return $ Shelley.RequireSignature (L.asWitness 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 (castLedgerKey kh)) + (PaymentKeyHash (L.coerceKeyRole 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 (castLedgerKey kh) + = Timelock.RequireSignature (L.asWitness 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 (castLedgerKey kh)) + (PaymentKeyHash (L.coerceKeyRole 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 69b89fa7a3..c5a941da31 100644 --- a/cardano-api/internal/Cardano/Api/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Tx.hs @@ -59,7 +59,6 @@ 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 @@ -794,7 +793,7 @@ getShelleyKeyWitnessVerificationKey :: ShelleySigningKey -> Shelley.VKey Shelley.Witness StandardCrypto getShelleyKeyWitnessVerificationKey (ShelleyNormalSigningKey sk) = - (castLedgerKey :: Shelley.VKey Shelley.Payment StandardCrypto + (Shelley.asWitness :: Shelley.VKey Shelley.Payment StandardCrypto -> Shelley.VKey Shelley.Witness StandardCrypto) . (\(PaymentVerificationKey vk) -> vk) . getVerificationKey @@ -802,8 +801,8 @@ getShelleyKeyWitnessVerificationKey (ShelleyNormalSigningKey sk) = $ sk getShelleyKeyWitnessVerificationKey (ShelleyExtendedSigningKey sk) = - (castLedgerKey :: Shelley.VKey Shelley.Payment StandardCrypto - -> Shelley.VKey Shelley.Witness StandardCrypto) + (Shelley.asWitness :: 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 732a2d3762..77551bf20a 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -169,7 +169,6 @@ 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 @@ -2459,7 +2458,7 @@ fromLedgerTxExtraKeyWitnesses sbe body = then TxExtraKeyWitnessesNone else TxExtraKeyWitnesses w - [ PaymentKeyHash (castLedgerKey keyhash) + [ PaymentKeyHash (Ledger.coerceKeyRole keyhash) | keyhash <- Set.toList $ body ^. L.reqSignerHashesTxBodyL ] ) @@ -2673,7 +2672,7 @@ convExtraKeyWitnesses txExtraKeyWits = case txExtraKeyWits of TxExtraKeyWitnessesNone -> Set.empty TxExtraKeyWitnesses _ khs -> Set.fromList - [ castLedgerKey kh + [ Shelley.asWitness kh | PaymentKeyHash kh <- khs ] convScripts diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index e2ffc024aa..84ed6d82f8 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -261,7 +261,6 @@ module Cardano.Api.Shelley GovernancePollAnswer(..), GovernancePollError(..), Vote(..), - VotingCredential(..), Voter(..), createProposalProcedure, createVotingProcedure,