Skip to content

Commit

Permalink
Fix Eq, Show for Proposal type
Browse files Browse the repository at this point in the history
  • Loading branch information
carbolymer committed Jul 11, 2023
1 parent ef0a3be commit dc20f0a
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 28 deletions.
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 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 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
Expand Down
14 changes: 11 additions & 3 deletions cardano-api/internal/Cardano/Api/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit dc20f0a

Please sign in to comment.