From af7749ea0133375ba3b95d17333cd15361aea372 Mon Sep 17 00:00:00 2001 From: John Ky Date: Mon, 24 Jul 2023 23:04:35 +1000 Subject: [PATCH] Further tighten bounds to ConwayEraOnwards --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 2 +- cardano-api/internal/Cardano/Api/Feature.hs | 1 + .../Api/Governance/Actions/VotingProcedure.hs | 42 +------------------ cardano-api/internal/Cardano/Api/TxBody.hs | 38 ++++++++--------- cardano-api/src/Cardano/Api.hs | 4 -- cardano-api/src/Cardano/Api/Shelley.hs | 1 - 6 files changed, 22 insertions(+), 66 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index a0dd7978ba..531e47d59e 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -669,7 +669,7 @@ genTxBodyContent era = do txMintValue <- genTxMintValue era txScriptValidity <- genTxScriptValidity era txGovernanceActions <- return TxGovernanceActionsNone -- TODO: Conway era - txVotes <- return TxVotesNone -- TODO: Conway era + txVotes <- return Nothing -- TODO: Conway era pure $ TxBodyContent { Api.txIns , Api.txInsCollateral diff --git a/cardano-api/internal/Cardano/Api/Feature.hs b/cardano-api/internal/Cardano/Api/Feature.hs index 0271f0e08d..38efaa795a 100644 --- a/cardano-api/internal/Cardano/Api/Feature.hs +++ b/cardano-api/internal/Cardano/Api/Feature.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs index 9acc86e7b3..71a26acf3e 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -13,10 +13,7 @@ {-# LANGUAGE UndecidableInstances #-} module Cardano.Api.Governance.Actions.VotingProcedure - ( TxVotes(..) - , TxVotesSupportedInEra(..) - , votesSupportedInEra - , GovernanceActionId(..) + ( GovernanceActionId(..) , makeGoveranceActionId , Voter(..) , Vote(..) @@ -55,43 +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 - :: TxVotesSupportedInEra 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. --- -data TxVotesSupportedInEra era where - - VotesSupportedInConwayEra :: TxVotesSupportedInEra ConwayEra - -deriving instance Show (TxVotesSupportedInEra era) -deriving instance Eq (TxVotesSupportedInEra era) - - -votesSupportedInEra :: ShelleyBasedEra era -> Maybe (TxVotesSupportedInEra era) -votesSupportedInEra = \case - ShelleyBasedEraShelley -> Nothing - ShelleyBasedEraAllegra -> Nothing - ShelleyBasedEraMary -> Nothing - ShelleyBasedEraAlonzo -> Nothing - ShelleyBasedEraBabbage -> Nothing - ShelleyBasedEraConway -> Just VotesSupportedInConwayEra - newtype GovernanceActionId ledgerera = GovernanceActionId { unGovernanceActionId :: Ledger.GovernanceActionId (EraCrypto ledgerera) } diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index ffb481dd04..6eb39ac6fa 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -190,6 +190,8 @@ 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 import Cardano.Api.Hash @@ -1757,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) @@ -1781,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 @@ -2730,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 @@ -2751,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 votesSupportedInEra sbe of - Nothing -> TxVotesNone - Just vsice -> TxVotes vsice (getVotes vsice body) - where - getVotes :: TxVotesSupportedInEra era - -> Ledger.TxBody (ShelleyLedgerEra era) - -> [VotingProcedure era] - getVotes VotesSupportedInConwayEra 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. @@ -3430,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) @@ -3611,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 @@ -3984,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(..),