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..1a772bc3b9 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -21,20 +21,15 @@ import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Governance.Actions.ProposalProcedure import Cardano.Api.HasTypeProxy -import Cardano.Api.Keys.Shelley import qualified Cardano.Api.ReexposeLedger as Ledger -import Cardano.Api.Script import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseTextEnvelope import qualified Cardano.Binary as CBOR 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 Data.ByteString.Lazy (ByteString) import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text.Encoding as Text @@ -55,41 +50,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,83 +68,12 @@ 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 Yes -> Ledger.VoteYes Abstain -> Ledger.Abstain -toVotingCredential :: () - => ConwayEraOnwards era - -> StakeCredential - -> Either Plain.DecoderError (VotingCredential era) -toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do - let cbor = Plain.serialize $ Ledger.KeyHashObj kh - eraDecodeVotingCredential sbe cbor - -toVotingCredential _sbe (StakeCredentialByScript (ScriptHash _sh)) = - error "toVotingCredential: script stake credentials not implemented yet" - -- TODO: Conway era - -- let cbor = Plain.serialize $ Ledger.ScriptHashObj sh - -- eraDecodeVotingCredential sbe cbor - --- TODO: Conway era --- This is a hack. data StakeCredential in cardano-api is not parameterized by era, it defaults to StandardCrypto. --- However VotingProcedure is parameterized on era. We need to also parameterize StakeCredential on era. -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 - createVotingProcedure :: () => ConwayEraOnwards era -> Vote 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..bac398e4b2 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs @@ -1735,7 +1735,3 @@ instance CastVerificationKeyRole DRepExtendedKey DRepKey where impossible = error "castVerificationKey (DRep): byron and shelley key sizes do not match!" --- --- Committee keys --- - 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..006888c495 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 @@ -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)) 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..3931def968 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -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..ec7a299413 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -261,12 +261,10 @@ module Cardano.Api.Shelley GovernancePollAnswer(..), GovernancePollError(..), Vote(..), - VotingCredential(..), Voter(..), createProposalProcedure, createVotingProcedure, renderGovernancePollError, - toVotingCredential, fromProposalProcedure, hashGovernancePoll, verifyPollAnswer,