From 28f54ebea6959dc47bc67450672d18632a311031 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 29 Jul 2023 13:01:59 +1000 Subject: [PATCH] Tighten era bounds to ConwaryEraOnwards --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 26 ++++--- .../Governance/Actions/ProposalProcedure.hs | 78 +++++++++++-------- .../Api/Governance/Actions/VotingProcedure.hs | 63 ++++++--------- cardano-api/internal/Cardano/Api/TxBody.hs | 37 +++++---- cardano-api/src/Cardano/Api.hs | 4 - cardano-api/src/Cardano/Api/Shelley.hs | 1 - 6 files changed, 104 insertions(+), 105 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 546315331e..a150dd394d 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -670,7 +670,7 @@ genTxBodyContent era = do txMintValue <- genTxMintValue era txScriptValidity <- genTxScriptValidity era txGovernanceActions <- genTxGovernanceActions era - txVotes <- genTxVotes era + txVotes <- genMaybeFeaturedInEra genTxVotes era pure $ TxBodyContent { Api.txIns , Api.txInsCollateral @@ -748,12 +748,12 @@ genFeaturedInEra witness gen = genMaybeFeaturedInEra :: () => FeatureInEra feature => Alternative f - => f a + => (feature era -> f a) -> CardanoEra era -> f (Maybe (Featured feature era a)) genMaybeFeaturedInEra gen = featureInEra (pure Nothing) $ \witness -> - pure Nothing <|> fmap Just (genFeaturedInEra witness gen) + pure Nothing <|> fmap Just (genFeaturedInEra witness (gen witness)) genTxScriptValidity :: CardanoEra era -> Gen (TxScriptValidity era) genTxScriptValidity era = case txScriptValiditySupportedInCardanoEra era of @@ -1122,12 +1122,14 @@ genTxGovernanceActions era = fromMaybe (pure TxGovernanceActionsNone) $ do genProposal sbe = shelleyBasedEraConstraints sbe $ fmap Proposal . \case GovernanceActionsSupportedInConwayEra -> Q.arbitrary -genTxVotes :: CardanoEra era -> Gen (TxVotes era) -genTxVotes era = fromMaybe (pure TxVotesNone) $ do - w <- featureInEra Nothing Just era - let votes = Gen.list (Range.constant 0 10) $ genVote w - pure $ TxVotes w <$> votes - where - genVote :: ConwayEraOnwards era -> Gen (VotingProcedure era) - genVote w = conwayEraOnwardsConstraints w $ VotingProcedure <$> Q.arbitrary - +genTxVotingProcedure :: () + => ConwayEraOnwards era + -> Gen (VotingProcedure era) +genTxVotingProcedure w = + conwayEraOnwardsConstraints w $ VotingProcedure <$> Q.arbitrary + +genTxVotes :: () + => ConwayEraOnwards era + -> Gen [VotingProcedure era] +genTxVotes w = + Gen.list (Range.constant 0 10) $ genTxVotingProcedure w diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs index 75c7d0dd00..7ec65b5c43 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -10,10 +10,23 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module Cardano.Api.Governance.Actions.ProposalProcedure where +module Cardano.Api.Governance.Actions.ProposalProcedure + ( TxGovernanceActions(..) + , TxGovernanceActionSupportedInEra(..) + , governanceActionsSupportedInEra + , AnyGovernanceAction(..) + , GovernanceAction(..) + , toSafeHash + , toGovernanceAction + , fromGovernanceAction + , Proposal(..) + , createProposalProcedure + , fromProposalProcedure + ) where import Cardano.Api.Address import Cardano.Api.Eras +import Cardano.Api.Feature.ConwayEraOnwards import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Shelley import Cardano.Api.ProtocolParameters @@ -92,38 +105,42 @@ toSafeHash = makeHashWithExplicitProxys (Proxy @StandardCrypto) (Proxy @ByteStri toGovernanceAction :: EraCrypto ledgerera ~ StandardCrypto => ShelleyLedgerEra era ~ ledgerera - => ShelleyBasedEra era + => ConwayEraOnwards era -> GovernanceAction -> Gov.GovernanceAction ledgerera -toGovernanceAction _ MotionOfNoConfidence = Gov.NoConfidence -toGovernanceAction _ (ProposeNewConstitution bs) = - Gov.NewConstitution $ toSafeHash bs -toGovernanceAction _ (ProposeNewCommittee stakeKeys quor) = - Gov.NewCommittee (Set.fromList $ map (\(StakeKeyHash sk) -> coerceKeyRole sk) stakeKeys) quor -toGovernanceAction _ InfoAct = Gov.InfoAction -toGovernanceAction _ (TreasuryWithdrawal withdrawals) = - let m = Map.fromList [(toShelleyStakeCredential sc, toShelleyLovelace l) | (sc,l) <- withdrawals] - in Gov.TreasuryWithdrawals m -toGovernanceAction _ (InitiateHardfork pVer) = Gov.HardForkInitiation pVer -toGovernanceAction sbe (UpdatePParams ppup) = - case toLedgerPParamsUpdate sbe ppup of - Left e -> error $ "toGovernanceAction: " <> show e - -- TODO: Conway era - remove use of error. Ideally we will use the ledger's PParams type - -- in place of ProtocolParametersUpdate - Right ppup' -> Gov.ParameterChange ppup' +toGovernanceAction w = \case + MotionOfNoConfidence -> + Gov.NoConfidence + ProposeNewConstitution bs -> + Gov.NewConstitution $ toSafeHash bs + ProposeNewCommittee stakeKeys quor -> + Gov.NewCommittee (Set.fromList $ map (\(StakeKeyHash sk) -> coerceKeyRole sk) stakeKeys) quor + InfoAct -> + Gov.InfoAction + TreasuryWithdrawal withdrawals -> + let m = Map.fromList [(toShelleyStakeCredential sc, toShelleyLovelace l) | (sc,l) <- withdrawals] + in Gov.TreasuryWithdrawals m + InitiateHardfork pVer -> + Gov.HardForkInitiation pVer + UpdatePParams ppup -> + case toLedgerPParamsUpdate (conwayEraOnwardsToShelleyBasedEra w) ppup of + Left e -> error $ "toGovernanceAction: " <> show e + -- TODO: Conway era - remove use of error. Ideally we will use the ledger's PParams type + -- in place of ProtocolParametersUpdate + Right ppup' -> Gov.ParameterChange ppup' fromGovernanceAction :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto - => ShelleyBasedEra era + => ConwayEraOnwards era -> Gov.GovernanceAction (ShelleyLedgerEra era) -> GovernanceAction -fromGovernanceAction sbe = \case +fromGovernanceAction w = \case Gov.NoConfidence -> MotionOfNoConfidence Gov.NewConstitution h -> - ProposeNewConstitution $ shelleyBasedEraConstraints sbe $ originalBytes h + ProposeNewConstitution $ conwayEraOnwardsConstraints w $ originalBytes h Gov.ParameterChange pparams -> - UpdatePParams $ fromLedgerPParamsUpdate sbe pparams + UpdatePParams $ fromLedgerPParamsUpdate (conwayEraOnwardsToShelleyBasedEra w) pparams Gov.HardForkInitiation pVer -> InitiateHardfork pVer Gov.TreasuryWithdrawals withdrawlMap -> @@ -166,27 +183,26 @@ instance HasTypeProxy era => HasTypeProxy (Proposal era) where createProposalProcedure - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> Lovelace -- ^ Deposit -> Hash StakeKey -- ^ Return address -> GovernanceAction -> Proposal era -createProposalProcedure sbe dep (StakeKeyHash retAddrh) govAct = - shelleyBasedEraConstraints sbe $ shelleyBasedEraConstraints sbe $ +createProposalProcedure w dep (StakeKeyHash retAddrh) govAct = + conwayEraOnwardsConstraints w $ Proposal Gov.ProposalProcedure { Gov.pProcDeposit = toShelleyLovelace dep , Gov.pProcReturnAddr = retAddrh - , Gov.pProcGovernanceAction = toGovernanceAction sbe govAct + , Gov.pProcGovernanceAction = toGovernanceAction w govAct , Gov.pProcAnchor = SNothing -- TODO: Conway } fromProposalProcedure - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> Proposal era -> (Lovelace, Hash StakeKey, GovernanceAction) -fromProposalProcedure sbe (Proposal pp) = +fromProposalProcedure w (Proposal pp) = ( fromShelleyLovelace $ Gov.pProcDeposit pp - , StakeKeyHash (shelleyBasedEraConstraints sbe (Gov.pProcReturnAddr pp)) - , shelleyBasedEraConstraints sbe $ fromGovernanceAction sbe (Gov.pProcGovernanceAction pp) + , StakeKeyHash (conwayEraOnwardsConstraints w (Gov.pProcReturnAddr pp)) + , conwayEraOnwardsConstraints w $ fromGovernanceAction w (Gov.pProcGovernanceAction pp) ) - diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs index 423041d077..d5421f092c 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -13,7 +13,19 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module Cardano.Api.Governance.Actions.VotingProcedure where +module Cardano.Api.Governance.Actions.VotingProcedure + ( GovernanceActionId(..) + , makeGoveranceActionId + , Voter(..) + , Vote(..) + , toVoterRole + , toVote + , toVotingCredential + , eraDecodeVotingCredential + , VotingCredential(..) + , createVotingProcedure + , VotingProcedure(..) + ) where import Cardano.Api.Address import Cardano.Api.Eras @@ -40,22 +52,6 @@ import qualified Cardano.Ledger.TxIn as Ledger import Data.ByteString.Lazy (ByteString) import Data.Maybe.Strict --- | A representation of whether the era supports tx voting on governance actions. --- --- The Conway and subsequent eras support tx voting on governance actions. --- -data TxVotes era where - TxVotesNone :: TxVotes era - - TxVotes - :: ConwayEraOnwards era - -> [VotingProcedure era] - -> TxVotes era - -deriving instance Show (TxVotes era) -deriving instance Eq (TxVotes era) - - -- | A representation of whether the era supports transactions with votes. -- -- The Conway and subsequent eras support governance actions. @@ -67,27 +63,18 @@ data TxVotesSupportedInEra era where deriving instance Show (TxVotesSupportedInEra era) deriving instance Eq (TxVotesSupportedInEra era) -votesSupportedInEra :: ShelleyBasedEra era -> Maybe (TxVotesSupportedInEra era) -votesSupportedInEra ShelleyBasedEraShelley = Nothing -votesSupportedInEra ShelleyBasedEraAllegra = Nothing -votesSupportedInEra ShelleyBasedEraMary = Nothing -votesSupportedInEra ShelleyBasedEraAlonzo = Nothing -votesSupportedInEra ShelleyBasedEraBabbage = Nothing -votesSupportedInEra ShelleyBasedEraConway = Just VotesSupportedInConwayEra -{-# DEPRECATED votesSupportedInEra "Use conwayEraOnwardsConstraints instead" #-} - newtype GovernanceActionId ledgerera = GovernanceActionId { unGovernanceActionId :: Ledger.GovernanceActionId (EraCrypto ledgerera) } deriving (Show, Eq) makeGoveranceActionId - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> TxIn -> GovernanceActionId (ShelleyLedgerEra era) -makeGoveranceActionId sbe txin = +makeGoveranceActionId w txin = let Ledger.TxIn txid (Ledger.TxIx txix) = toShelleyTxIn txin - in shelleyBasedEraConstraints sbe + in conwayEraOnwardsConstraints w $ GovernanceActionId $ Ledger.GovernanceActionId { Ledger.gaidTxId = txid @@ -112,7 +99,7 @@ data Vote toVoterRole :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto - => ShelleyBasedEra era + => ConwayEraOnwards era -> Voter era -> Ledger.Voter (Shelley.EraCrypto (ShelleyLedgerEra era)) toVoterRole _ = \case @@ -130,7 +117,7 @@ toVote = \case Abstain -> Ledger.Abstain toVotingCredential - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> StakeCredential -> Either Plain.DecoderError (VotingCredential era) toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do @@ -147,11 +134,11 @@ toVotingCredential _sbe (StakeCredentialByScript (ScriptHash _sh)) = -- 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 - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> ByteString -> Either Plain.DecoderError (VotingCredential era) -eraDecodeVotingCredential sbe bs = - shelleyBasedEraConstraints sbe $ +eraDecodeVotingCredential w bs = + conwayEraOnwardsConstraints w $ case Plain.decodeFull bs of Left e -> Left e Right x -> Right $ VotingCredential x @@ -164,16 +151,16 @@ deriving instance Show (VotingCredential crypto) deriving instance Eq (VotingCredential crypto) createVotingProcedure - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> Vote -> Voter era -> GovernanceActionId (ShelleyLedgerEra era) -> VotingProcedure era -createVotingProcedure sbe vChoice vt (GovernanceActionId govActId) = - shelleyBasedEraConstraints sbe $ shelleyBasedEraConstraints sbe +createVotingProcedure w vChoice vt (GovernanceActionId govActId) = + conwayEraOnwardsConstraints w $ VotingProcedure $ Ledger.VotingProcedure { Ledger.vProcGovActionId = govActId - , Ledger.vProcVoter = toVoterRole sbe vt + , Ledger.vProcVoter = toVoterRole w vt , Ledger.vProcVote = toVote vChoice , Ledger.vProcAnchor = SNothing -- TODO: Conway } diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index c2b5867d45..feaa91712c 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -190,6 +190,7 @@ import Cardano.Api.Convenience.Constraints import Cardano.Api.EraCast import Cardano.Api.Eras import Cardano.Api.Error +import Cardano.Api.Feature import Cardano.Api.Feature.ConwayEraOnwards import Cardano.Api.Governance.Actions.ProposalProcedure import Cardano.Api.Governance.Actions.VotingProcedure @@ -1758,7 +1759,7 @@ data TxBodyContent build era = txMintValue :: TxMintValue build era, txScriptValidity :: TxScriptValidity era, txGovernanceActions :: TxGovernanceActions era, - txVotes :: TxVotes era + txVotes :: Maybe (Featured ConwayEraOnwards era [VotingProcedure era]) } deriving (Eq, Show) @@ -1782,7 +1783,7 @@ defaultTxBodyContent = TxBodyContent , txMintValue = TxMintNone , txScriptValidity = TxScriptValidityNone , txGovernanceActions = TxGovernanceActionsNone - , txVotes = TxVotesNone + , txVotes = Nothing } setTxIns :: TxIns build era -> TxBodyContent build era -> TxBodyContent build era @@ -2731,7 +2732,7 @@ fromLedgerTxBody sbe scriptValidity body scriptdata mAux = , txAuxScripts , txScriptValidity = scriptValidity , txGovernanceActions = fromLedgerProposalProcedure sbe body - , txVotes = fromLedgerTxVotes sbe body + , txVotes = featureInShelleyBasedEra Nothing (\w -> Just (fromLedgerTxVotes w body)) sbe } where (txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData sbe mAux @@ -2752,16 +2753,14 @@ fromLedgerProposalProcedure sbe body = getProposals GovernanceActionsSupportedInConwayEra body_ = fmap Proposal . toList $ body_ ^. L.proposalProceduresTxBodyL -fromLedgerTxVotes :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxVotes era -fromLedgerTxVotes sbe body = - case featureInShelleyBasedEra Nothing Just sbe of - Nothing -> TxVotesNone - Just w -> TxVotes w (getVotes w body) - where - getVotes :: ConwayEraOnwards era - -> Ledger.TxBody (ShelleyLedgerEra era) - -> [VotingProcedure era] - getVotes ConwayEraOnwardsConway body_ = fmap VotingProcedure . toList $ body_ ^. L.votingProceduresTxBodyL +fromLedgerTxVotes :: () + => ConwayEraOnwards era + -> Ledger.TxBody (ShelleyLedgerEra era) + -> Featured ConwayEraOnwards era [VotingProcedure era] +fromLedgerTxVotes w body = + conwayEraOnwardsConstraints w + $ Featured w + $ fmap VotingProcedure $ toList $ body ^. L.votingProceduresTxBodyL fromLedgerTxIns :: forall era. @@ -3431,7 +3430,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = , txMintValue = TxMintNone , txScriptValidity = TxScriptValidityNone , txGovernanceActions = TxGovernanceActionsNone - , txVotes = TxVotesNone + , txVotes = Nothing } convTxIns :: TxIns BuildTx era -> Set (L.TxIn StandardCrypto) @@ -3612,10 +3611,10 @@ convGovActions :: TxGovernanceActions era -> Seq.StrictSeq (Gov.ProposalProcedur convGovActions TxGovernanceActionsNone = Seq.empty convGovActions (TxGovernanceActions _ govActions) = Seq.fromList $ fmap unProposal govActions -convVotes :: ShelleyBasedEra era -> TxVotes era -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era)) -convVotes _ = \case - TxVotesNone -> Seq.empty - TxVotes _ votes -> Seq.fromList $ map unVotingProcedure votes +convVotes :: () + => Featured ConwayEraOnwards era [VotingProcedure era] + -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era)) +convVotes (Featured _ v) = Seq.fromList $ map unVotingProcedure v guardShelleyTxInsOverflow :: [TxIn] -> Either TxBodyError () guardShelleyTxInsOverflow txIns = do @@ -3985,7 +3984,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway & L.reqSignerHashesTxBodyL .~ convExtraKeyWitnesses txExtraKeyWits & L.mintTxBodyL .~ convMintValue txMintValue & L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash - & L.votingProceduresTxBodyL .~ convVotes sbe txVotes + & L.votingProceduresTxBodyL .~ maybe mempty convVotes txVotes & L.proposalProceduresTxBodyL .~ convGovActions txGovernanceActions -- TODO Conway: support optional network id in TxBodyContent -- & L.networkIdTxBodyL .~ SNothing diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index d8b85696a4..81e119bcaa 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -280,7 +280,6 @@ module Cardano.Api ( TxCertificates(..), TxUpdateProposal(..), TxMintValue(..), - TxVotes(..), TxGovernanceActions(..), -- ** Building vs viewing transactions @@ -305,7 +304,6 @@ module Cardano.Api ( CertificatesSupportedInEra(..), UpdateProposalSupportedInEra(..), TxTotalAndReturnCollateralSupportedInEra(..), - TxVotesSupportedInEra(..), TxGovernanceActionSupportedInEra(..), -- ** Feature availability functions @@ -323,7 +321,6 @@ module Cardano.Api ( updateProposalSupportedInEra, scriptDataSupportedInEra, totalAndReturnCollateralSupportedInEra, - votesSupportedInEra, governanceActionsSupportedInEra, -- ** Era-dependent protocol features @@ -960,7 +957,6 @@ import Cardano.Api.Fees import Cardano.Api.Genesis import Cardano.Api.GenesisParameters import Cardano.Api.Governance.Actions.ProposalProcedure -import Cardano.Api.Governance.Actions.VotingProcedure import Cardano.Api.Hash import Cardano.Api.HasTypeProxy import Cardano.Api.InMode diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 664a5857c9..4649ea9206 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -242,7 +242,6 @@ module Cardano.Api.Shelley GovernanceActionId(..), Proposal(..), TxGovernanceActions(..), - TxVotes(..), VotingProcedure(..), GovernancePoll(..), GovernancePollAnswer(..),