diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs index 64920ea57f..c3932fd749 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -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 @@ -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 gp) = do + let ppStr = withShelleyBasedEraConstraintsForLedger (shelleyBasedEra @era) $ show gp + "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 diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index e028ce90ea..beaf6d4b9f 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -3598,13 +3598,21 @@ convReferenceInputs txInsReference = TxInsReferenceNone -> mempty TxInsReference _ refTxins -> Set.fromList $ map toShelleyTxIn refTxins -convGovActions :: ShelleyBasedEra era -> TxGovernanceActions era -> Seq.StrictSeq (Gov.ProposalProcedure (ShelleyLedgerEra era)) +convGovActions :: forall era. 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 + [ unProposal $ createProposalProcedure + sbe + (fromShelleyLovelace pProcDeposit) + (convert_ pProcReturnAddr) + (fromGovernanceAction sbe pProcGovernanceAction) + | Proposal Gov.ProposalProcedure{pProcDeposit, pProcReturnAddr, pProcGovernanceAction} <- govActions + -- (deposit, stakeCred, action) <- govActions ] + where + convert_ = undefined :: Ledger.KeyHash 'Ledger.Staking (Ledger.EraCrypto (ShelleyLedgerEra era)) + -> Hash StakeKey convVotes :: ShelleyBasedEra era -> TxVotes era -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era)) convVotes _ TxVotesNone = Seq.empty