Skip to content

Remove eon from AnyVote #997

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Remove eon from AnyVote #997

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 22 additions & 15 deletions cardano-api/src/Cardano/Api/Compatible/Tx.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,8 +50,8 @@ data AnyProtocolUpdate era where

data AnyVote era where
VotingProcedures
:: ConwayEraOnwards era
-> TxVotingProcedures BuildTx era
:: L.ConwayEraTxBody era
=> L.VotingProcedures era
-> AnyVote era
NoVotes :: AnyVote era

Expand All @@ -64,7 +64,7 @@ createCompatibleTx
-> Lovelace
-- ^ Fee
-> AnyProtocolUpdate era
-> AnyVote era
-> AnyVote (ShelleyLedgerEra era)
-> TxCertificates BuildTx era
-> Either ProtocolParametersConversionError (Tx era)
createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates' =
Expand Down Expand Up @@ -108,8 +108,8 @@ createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates'
updateVotingProcedures =
case anyVote of
NoVotes -> id
VotingProcedures conwayOnwards procedures ->
overwriteVotingProcedures conwayOnwards (convVotingProcedures procedures)
VotingProcedures procedures ->
overwriteVotingProcedures sbe procedures

apiScriptWitnesses =
[ (ix, AnyScriptWitness witness)
Expand Down Expand Up @@ -144,16 +144,6 @@ createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates'
babbageEraOnwardsConstraints beo $
Endo $
L.referenceInputsTxBodyL .~ fromList refInputs

overwriteVotingProcedures
:: ConwayEraOnwards era
-> L.VotingProcedures (ShelleyLedgerEra era)
-> L.Tx (ShelleyLedgerEra era)
-> L.Tx (ShelleyLedgerEra era)
overwriteVotingProcedures conwayOnwards votingProcedures =
conwayEraOnwardsConstraints conwayOnwards $
(L.bodyTxL . L.votingProceduresTxBodyL) .~ votingProcedures

indexedTxCerts
:: [ ( ScriptWitnessIndex
, Exp.Certificate (ShelleyLedgerEra era)
Expand Down Expand Up @@ -190,6 +180,23 @@ createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates'
)
]

overwriteVotingProcedures
:: ShelleyBasedEra era
-> L.VotingProcedures (ShelleyLedgerEra era)
-> L.Tx (ShelleyLedgerEra era)
-> L.Tx (ShelleyLedgerEra era)
overwriteVotingProcedures sbe votingProcedures =
case sbe of
ShelleyBasedEraShelley -> id
ShelleyBasedEraAllegra -> id
ShelleyBasedEraMary -> id
ShelleyBasedEraAlonzo -> id
ShelleyBasedEraBabbage -> id
ShelleyBasedEraConway -> overwrite votingProcedures
ShelleyBasedEraDijkstra -> overwrite votingProcedures
Copy link
Contributor

@carbolymer carbolymer Nov 5, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could we avoid matching on every era? This just adds a boilerplate to maintain. Why not

let era = either (const Nothing) pure $ sbeToEra sbe
maybe id (\era' -> obtainEraCommonConstraints era' $ overwrite votingProcedures) era

where
overwrite vp = (L.bodyTxL . L.votingProceduresTxBodyL) .~ vp

createCommonTxBody
:: HasCallStack
=> ShelleyBasedEra era
Expand Down
Loading