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 36070074d3..3dc15ee526 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 -- @@ -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 @@ -437,14 +436,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 @@ -476,19 +475,18 @@ selectStakeCredential = fmap fromShelleyStakeCredential . \case Ledger.RegTxCert sCred -> Just sCred Ledger.UnRegTxCert sCred -> Just sCred Ledger.DelegStakeTxCert sCred _ -> Just sCred - Ledger.RegPoolTxCert poolParams -> - Just . Ledger.coerceKeyRole . Ledger.KeyHashObj $ Ledger.ppId poolParams - Ledger.RetirePoolTxCert poolId _ -> - Just . Ledger.coerceKeyRole $ Ledger.KeyHashObj poolId + -- StakePool is always controlled by key, i.e. it is never a script. In other words, + -- @Credential StakePool@ cannot exist, because @ScriptHashObj@ constructor can't be used for that type. + Ledger.RegPoolTxCert _ -> Nothing -- contains StakePool key which cannot be a credential + Ledger.RetirePoolTxCert _ _ -> Nothing -- contains StakePool key which cannot be a credential + 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 - Ledger.RetirePoolTxCert kh _ -> - Just . Ledger.coerceKeyRole $ Ledger.KeyHashObj kh + Ledger.RegPoolTxCert _ -> Nothing -- contains StakePool key which cannot be a credential + Ledger.RetirePoolTxCert _ _ -> Nothing -- contains StakePool key which cannot 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 2c86b30ced..dfd55f5e8d 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -32,7 +32,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 @@ -55,41 +55,17 @@ 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 - | VoterSpo (Hash StakePoolKey) -- ^ Stake pool operator +newtype Voter era = Voter (Ledger.Voter (L.EraCrypto (ShelleyLedgerEra era))) deriving (Show, Eq, Ord) instance IsShelleyBasedEra era => ToCBOR (Voter era) where - toCBOR = \case - VoterCommittee v -> - CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> toCBOR v - VoterDRep v -> - CBOR.encodeListLen 2 <> CBOR.encodeWord 1 <> toCBOR v - VoterSpo v -> - CBOR.encodeListLen 2 <> CBOR.encodeWord 2 <> toCBOR v + toCBOR (Voter v) = shelleyBasedEraConstraints (shelleyBasedEra @era) $ Ledger.toEraCBOR @(ShelleyLedgerEra era) v instance IsShelleyBasedEra era => FromCBOR (Voter era) where fromCBOR = do - CBOR.decodeListLenOf 2 - t <- CBOR.decodeWord - case t of - 0 -> do - !x <- fromCBOR - return $ VoterCommittee x - 1 -> do - !x <- fromCBOR - return $ VoterDRep x - 2 -> do - !x <- fromCBOR - return $ VoterSpo x - _ -> - CBOR.cborError $ CBOR.DecoderErrorUnknownTag "Voter era" (fromIntegral t) + !v <- shelleyBasedEraConstraints (shelleyBasedEra @era) $ Ledger.fromEraCBOR @(ShelleyLedgerEra era) + pure $ Voter v + data Vote = No @@ -97,32 +73,6 @@ data Vote | Abstain deriving (Show, Eq) -toVoterRole :: () - => ConwayEraOnwards era - -> Voter era - -> Ledger.Voter (L.EraCrypto (ShelleyLedgerEra era)) -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. - VoterDRep (VotingCredential cred) -> - Ledger.DRepVoter cred - VoterSpo (StakePoolKeyHash kh) -> - Ledger.StakePoolVoter kh - -fromVoterRole :: () - => ConwayEraOnwards era - -> Ledger.Voter (L.EraCrypto (ShelleyLedgerEra era)) - -> Voter era -fromVoterRole eon = - conwayEraOnwardsConstraints eon $ \case - Ledger.CommitteeVoter cred -> - VoterCommittee (VotingCredential (coerceKeyRole cred)) -- TODO: Conway era - We shouldn't be using coerceKeyRole. - Ledger.DRepVoter cred -> - VoterDRep (VotingCredential cred) - Ledger.StakePoolVoter kh -> - VoterSpo (StakePoolKeyHash kh) - toVote :: Vote -> Ledger.Vote toVote = \case No -> Ledger.VoteNo @@ -132,7 +82,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 @@ -149,30 +99,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/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/Keys/Shelley.hs b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs index 01c748d18c..c9d9f34176 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs @@ -37,6 +37,9 @@ module Cardano.Api.Keys.Shelley ( VerificationKey(..), SigningKey(..), Hash(..), + + -- * Utilities + fromWitness ) where import Cardano.Api.Error @@ -1735,7 +1738,9 @@ instance CastVerificationKeyRole DRepExtendedKey DRepKey where impossible = error "castVerificationKey (DRep): byron and shelley key sizes do not match!" --- --- Committee keys --- +-- | Coerce a key from a witness key into an arbitrary key. Dual to @Shelley.asWitness@. +fromWitness :: Shelley.HasKeyRole a + => a Shelley.Witness c + -> a r c +fromWitness = Shelley.coerceKeyRole diff --git a/cardano-api/internal/Cardano/Api/Orphans.hs b/cardano-api/internal/Cardano/Api/Orphans.hs index 351ba6b3e3..1f3da28f26 100644 --- a/cardano-api/internal/Cardano/Api/Orphans.hs +++ b/cardano-api/internal/Cardano/Api/Orphans.hs @@ -333,3 +333,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 c1f040dcb3..ec5caf831f 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 (EraCrypto, PParams (..), PoolCert (..), fr import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Crypto (Crypto, StandardCrypto) import Cardano.Ledger.DRep (DRep (..), 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..27d035888b 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -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 (Shelley.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 (Shelley.coerceKeyRole kh)) + (PaymentKeyHash (fromWitness 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 (Shelley.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 (Shelley.coerceKeyRole kh)) + (PaymentKeyHash (fromWitness 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..c5a941da31 100644 --- a/cardano-api/internal/Cardano/Api/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Tx.hs @@ -793,16 +793,16 @@ getShelleyKeyWitnessVerificationKey :: ShelleySigningKey -> Shelley.VKey Shelley.Witness StandardCrypto getShelleyKeyWitnessVerificationKey (ShelleyNormalSigningKey sk) = - (Shelley.coerceKeyRole :: 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) . getVerificationKey . PaymentSigningKey $ sk getShelleyKeyWitnessVerificationKey (ShelleyExtendedSigningKey sk) = - (Shelley.coerceKeyRole :: 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 5a47ab872f..99ddc2302f 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -2459,7 +2459,7 @@ fromLedgerTxExtraKeyWitnesses sbe body = then TxExtraKeyWitnessesNone else TxExtraKeyWitnesses w - [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) + [ PaymentKeyHash (fromWitness keyhash) | keyhash <- Set.toList $ body ^. L.reqSignerHashesTxBodyL ] ) @@ -2668,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 + [ 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,