Skip to content
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

Jump to bottom

Fix Eq, Show for Proposal type #115

Merged
merged 2 commits into from
Jul 12, 2023
Merged

Fix Eq, Show for Proposal type #115

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
696193a
Fix Eq, Show for Proposal type
carbolymer Jul 11, 2023
e2fef97
Add setting of votes and proposals in TxBody
carbolymer Jul 12, 2023
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
45 changes: 19 additions & 26 deletions cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
Expand Down Expand Up @@ -37,16 +38,11 @@ data TxGovernanceActions era where

TxGovernanceActions
:: TxGovernanceActionSupportedInEra era
-- (deposit, return address, governance action)
-- TODO: Conway era - This should be [Proposal era]
-- however when defining Eq and Show instances for Proposal era
-- There is a ledger class constraint that needs to be propagated
-- across several types which is unacceptable.
-> [(Lovelace, Hash StakeKey, GovernanceAction)]
-> [Proposal era]
-> TxGovernanceActions era

deriving instance Show (TxGovernanceActions era)
deriving instance Eq (TxGovernanceActions era)
deriving instance IsShelleyBasedEra era => Show (TxGovernanceActions era)
deriving instance IsShelleyBasedEra era => Eq (TxGovernanceActions era)


-- | A representation of whether the era supports transactions with governance
Expand All @@ -61,7 +57,7 @@ data TxGovernanceActionSupportedInEra era where
deriving instance Show (TxGovernanceActionSupportedInEra era)
deriving instance Eq (TxGovernanceActionSupportedInEra era)

governanceActionsSupportedInEra :: ShelleyBasedEra era -> Maybe (TxGovernanceActionSupportedInEra era)
governanceActionsSupportedInEra :: ShelleyBasedEra era -> Maybe (TxGovernanceActionSupportedInEra era)
governanceActionsSupportedInEra ShelleyBasedEraShelley = Nothing
governanceActionsSupportedInEra ShelleyBasedEraAllegra = Nothing
governanceActionsSupportedInEra ShelleyBasedEraMary = Nothing
Expand Down Expand Up @@ -100,28 +96,25 @@ fromGovernanceAction _ _ = error "fromGovernanceAction Conway: not implemented y

newtype Proposal era = Proposal { unProposal :: Gov.ProposalProcedure (ShelleyLedgerEra era) }

deriving instance (Shelley.EraPParams (ShelleyLedgerEra era)) => Show (Proposal era)
deriving instance (Shelley.EraPParams (ShelleyLedgerEra era)) => Eq (Proposal era)
instance IsShelleyBasedEra era => Show (Proposal era) where
show (Proposal pp) = do
let ppStr = withShelleyBasedEraConstraintsForLedger (shelleyBasedEra @era) $ show pp
Copy link
Contributor

Choose a reason for hiding this comment

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

Good work however what we really should be doing is asking the ledger team to provide a show instance for us. Can you propagate these changes to cardano-cli to see how what the changes will look like?

Copy link
Contributor Author

@carbolymer carbolymer Jul 12, 2023 •
edited
Loading

Choose a reason for hiding this comment

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

https://github.com/input-output-hk/cardano-cli/pull/72/files
CI checks are running in: https://github.com/input-output-hk/fusion-flamingo/pull/13/checks

"Proposal {unProposal = " <> ppStr <> "}"

instance (IsShelleyBasedEra era, Shelley.EraPParams (ShelleyLedgerEra era)) => ToCBOR (Proposal era) where
toCBOR (Proposal vp) = Shelley.toEraCBOR @Conway.Conway vp
instance IsShelleyBasedEra era => Eq (Proposal era) where
(Proposal pp1) == (Proposal pp2) = withShelleyBasedEraConstraintsForLedger (shelleyBasedEra @era) $ pp1 == pp2

instance ( IsShelleyBasedEra era
, Shelley.EraPParams (ShelleyLedgerEra era)
) => FromCBOR (Proposal era) where
fromCBOR = Proposal <$> Shelley.fromEraCBOR @Conway.Conway
instance IsShelleyBasedEra era => ToCBOR (Proposal era) where
toCBOR (Proposal vp) = withShelleyBasedEraConstraintsForLedger (shelleyBasedEra @era) $ Shelley.toEraCBOR @Conway.Conway vp

instance ( IsShelleyBasedEra era
, Shelley.EraPParams (ShelleyLedgerEra era)
) => SerialiseAsCBOR (Proposal era) where
instance IsShelleyBasedEra era => FromCBOR (Proposal era) where
fromCBOR = Proposal <$> withShelleyBasedEraConstraintsForLedger (shelleyBasedEra @era) (Shelley.fromEraCBOR @Conway.Conway)

serialiseToCBOR = CBOR.serialize'
deserialiseFromCBOR _proxy = CBOR.decodeFull'
instance IsShelleyBasedEra era => SerialiseAsCBOR (Proposal era) where
serialiseToCBOR = withShelleyBasedEraConstraintsForLedger (shelleyBasedEra @era) CBOR.serialize'
deserialiseFromCBOR _proxy = withShelleyBasedEraConstraintsForLedger (shelleyBasedEra @era) CBOR.decodeFull'


instance ( IsShelleyBasedEra era
, Shelley.EraPParams (ShelleyLedgerEra era)
) => HasTextEnvelope (Proposal era) where
instance IsShelleyBasedEra era => HasTextEnvelope (Proposal era) where
textEnvelopeType _ = "Governance proposal"

instance HasTypeProxy era => HasTypeProxy (Proposal era) where
Expand Down
80 changes: 42 additions & 38 deletions cardano-api/internal/Cardano/Api/TxBody.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -224,7 +224,6 @@ import Cardano.Ledger.Binary (Annotated (..), reAnnotate, recoverBytes
import qualified Cardano.Ledger.Binary as CBOR
import qualified Cardano.Ledger.Block as Ledger
import qualified Cardano.Ledger.Conway.Core as L
import qualified Cardano.Ledger.Conway.Governance as Conway
import qualified Cardano.Ledger.Conway.Governance as Gov
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Core as Ledger
Expand Down Expand Up @@ -2712,46 +2711,55 @@ fromLedgerTxBody
-> TxBodyContent ViewTx era
fromLedgerTxBody sbe scriptValidity body scriptdata mAux =
TxBodyContent
{ txIns = fromLedgerTxIns sbe body
, txInsCollateral = fromLedgerTxInsCollateral sbe body
, txInsReference = fromLedgerTxInsReference sbe body
, txOuts = fromLedgerTxOuts sbe body scriptdata
, txTotalCollateral = fromLedgerTxTotalCollateral sbe body
, txReturnCollateral = fromLedgerTxReturnCollateral sbe body
, txFee = fromLedgerTxFee sbe body
, txValidityRange = fromLedgerTxValidityRange sbe body
, txWithdrawals = fromLedgerTxWithdrawals sbe body
, txCertificates = fromLedgerTxCertificates sbe body
, txUpdateProposal = fromLedgerTxUpdateProposal sbe body
, txMintValue = fromLedgerTxMintValue sbe body
, txExtraKeyWits = fromLedgerTxExtraKeyWitnesses sbe body
, txProtocolParams = ViewTx
{ txIns = fromLedgerTxIns sbe body
, txInsCollateral = fromLedgerTxInsCollateral sbe body
, txInsReference = fromLedgerTxInsReference sbe body
, txOuts = fromLedgerTxOuts sbe body scriptdata
, txTotalCollateral = fromLedgerTxTotalCollateral sbe body
, txReturnCollateral = fromLedgerTxReturnCollateral sbe body
, txFee = fromLedgerTxFee sbe body
, txValidityRange = fromLedgerTxValidityRange sbe body
, txWithdrawals = fromLedgerTxWithdrawals sbe body
, txCertificates = fromLedgerTxCertificates sbe body
, txUpdateProposal = fromLedgerTxUpdateProposal sbe body
, txMintValue = fromLedgerTxMintValue sbe body
, txExtraKeyWits = fromLedgerTxExtraKeyWitnesses sbe body
, txProtocolParams = ViewTx
, txMetadata
, txAuxScripts
, txScriptValidity = scriptValidity
, txScriptValidity = scriptValidity
, txGovernanceActions = fromLedgerProposalProcedure sbe body
, txVotes = error "fromLedgerTxBody.txVotes: TODO: Conway"
, txVotes = fromLedgerTxVotes sbe body
}
where
(txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData sbe mAux

-- TODO: Conway

fromLedgerProposalProcedure
:: ShelleyBasedEra era
-> Ledger.TxBody (ShelleyLedgerEra era)
-> TxGovernanceActions era
fromLedgerProposalProcedure _ _bdy = TxGovernanceActionsNone
where
_proposalProcedures
:: ShelleyBasedEra era
-> Ledger.TxBody (ShelleyLedgerEra era)
-> Seq.StrictSeq (Conway.ProposalProcedure era)
_proposalProcedures ShelleyBasedEraShelley _bdy = mempty
_proposalProcedures ShelleyBasedEraAllegra _bdy = mempty
_proposalProcedures ShelleyBasedEraMary _bdy = mempty
_proposalProcedures ShelleyBasedEraAlonzo _bdy = mempty
_proposalProcedures ShelleyBasedEraBabbage _bdy = mempty
_proposalProcedures ShelleyBasedEraConway _bdy = mempty
fromLedgerProposalProcedure sbe body =
case governanceActionsSupportedInEra sbe of
Nothing -> TxGovernanceActionsNone
Just gasice -> TxGovernanceActions gasice (getProposals gasice body)
where
getProposals :: TxGovernanceActionSupportedInEra era
-> Ledger.TxBody (ShelleyLedgerEra era)
-> [Proposal era]
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)
-> [Vote era]
getVotes VotesSupportedInConwayEra body_ = fmap Vote . toList $ body_ ^. L.votingProceduresTxBodyL

fromLedgerTxIns
:: forall era.
Expand Down Expand Up @@ -3598,13 +3606,9 @@ convReferenceInputs txInsReference =
TxInsReferenceNone -> mempty
TxInsReference _ refTxins -> Set.fromList $ map toShelleyTxIn refTxins

convGovActions :: ShelleyBasedEra era -> TxGovernanceActions era -> Seq.StrictSeq (Gov.ProposalProcedure (ShelleyLedgerEra era))
convGovActions _ TxGovernanceActionsNone = Seq.empty
convGovActions sbe (TxGovernanceActions _ govActions) =
Seq.fromList
[ unProposal $ createProposalProcedure sbe deposit stakeCred action
| (deposit, stakeCred, action) <- govActions
]
convGovActions :: TxGovernanceActions era -> Seq.StrictSeq (Gov.ProposalProcedure (ShelleyLedgerEra era))
convGovActions TxGovernanceActionsNone = Seq.empty
convGovActions (TxGovernanceActions _ govActions) = Seq.fromList $ fmap unProposal govActions

convVotes :: ShelleyBasedEra era -> TxVotes era -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era))
convVotes _ TxVotesNone = Seq.empty
Expand Down Expand Up @@ -3979,7 +3983,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway
& L.mintTxBodyL .~ convMintValue txMintValue
& L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash
& L.votingProceduresTxBodyL .~ convVotes sbe txVotes
& L.proposalProceduresTxBodyL .~ convGovActions sbe txGovernanceActions
& L.proposalProceduresTxBodyL .~ convGovActions txGovernanceActions
-- TODO Conway: support optional network id in TxBodyContent
-- & L.networkIdTxBodyL .~ SNothing
)
Expand Down