Tighten era bounds to ConwaryEraOnwards

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -670,7 +670,7 @@ genTxBodyContent era = do
   txMintValue <- genTxMintValue era
   txScriptValidity <- genTxScriptValidity era
   txGovernanceActions <- genTxGovernanceActions era
-  txVotes <- genTxVotes era
+  txVotes <- genMaybeFeaturedInEra genTxVotes era
   pure $ TxBodyContent
     { Api.txIns
     , Api.txInsCollateral
@@ -748,12 +748,12 @@ genFeaturedInEra witness gen =
 genMaybeFeaturedInEra :: ()
   => FeatureInEra feature
   => Alternative f
-  => f a
+  => (feature era -> f a)
   -> CardanoEra era
   -> f (Maybe (Featured feature era a))
 genMaybeFeaturedInEra gen =
   featureInEra (pure Nothing) $ \witness ->
-    pure Nothing <|> fmap Just (genFeaturedInEra witness gen)
+    pure Nothing <|> fmap Just (genFeaturedInEra witness (gen witness))
 
 genTxScriptValidity :: CardanoEra era -> Gen (TxScriptValidity era)
 genTxScriptValidity era = case txScriptValiditySupportedInCardanoEra era of
@@ -1122,12 +1122,14 @@ genTxGovernanceActions era = fromMaybe (pure TxGovernanceActionsNone) $ do
     genProposal sbe = shelleyBasedEraConstraints sbe $ fmap Proposal . \case
       GovernanceActionsSupportedInConwayEra -> Q.arbitrary
 
-genTxVotes :: CardanoEra era -> Gen (TxVotes era)
-genTxVotes era = fromMaybe (pure TxVotesNone) $ do
-  w <- featureInEra Nothing Just era
-  let votes = Gen.list (Range.constant 0 10) $ genVote w
-  pure $ TxVotes w <$> votes
-  where
-    genVote :: ConwayEraOnwards era -> Gen (VotingProcedure era)
-    genVote w = conwayEraOnwardsConstraints w $ VotingProcedure <$> Q.arbitrary
-
+genTxVotingProcedure :: ()
+  => ConwayEraOnwards era
+  -> Gen (VotingProcedure era)
+genTxVotingProcedure w = 
+  conwayEraOnwardsConstraints w $ VotingProcedure <$> Q.arbitrary
+
+genTxVotes :: ()
+  => ConwayEraOnwards era
+  -> Gen [VotingProcedure era]
+genTxVotes w =
+  Gen.list (Range.constant 0 10) $ genTxVotingProcedure w

cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs

@@ -2,23 +2,36 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Cardano.Api.Governance.Actions.ProposalProcedure where
+module Cardano.Api.Governance.Actions.ProposalProcedure
+  ( TxGovernanceActions(..)
+  , TxGovernanceActionSupportedInEra(..)
+  , governanceActionsSupportedInEra
+  , AnyGovernanceAction(..)
+  , GovernanceAction(..)
+  , toSafeHash
+  , toGovernanceAction
+  , fromGovernanceAction
+  , Proposal(..)
+  , createProposalProcedure
+  , fromProposalProcedure
+  ) where
 
 import           Cardano.Api.Address
 import           Cardano.Api.Eras
+import           Cardano.Api.Feature.ConwayEraOnwards
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Shelley
 import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseTextEnvelope
-import           Cardano.Api.Utils
 import           Cardano.Api.Value
 
 import qualified Cardano.Binary as CBOR
@@ -92,47 +105,54 @@ toSafeHash = makeHashWithExplicitProxys (Proxy @StandardCrypto) (Proxy @ByteStri
 toGovernanceAction
   :: EraCrypto ledgerera ~ StandardCrypto
   => ShelleyLedgerEra era ~ ledgerera
-  => ShelleyBasedEra era
+  => ConwayEraOnwards era
   -> GovernanceAction
   -> Gov.GovernanceAction ledgerera
-toGovernanceAction _ MotionOfNoConfidence = Gov.NoConfidence
-toGovernanceAction _ (ProposeNewConstitution bs) =
-  Gov.NewConstitution $ toSafeHash bs
-toGovernanceAction _ (ProposeNewCommittee stakeKeys quor) =
-  Gov.NewCommittee (Set.fromList $ map (\(StakeKeyHash sk) -> coerceKeyRole sk) stakeKeys) quor
-toGovernanceAction _ InfoAct = Gov.InfoAction
-toGovernanceAction _ (TreasuryWithdrawal withdrawals) =
-  let m = Map.fromList [(toShelleyStakeCredential sc, toShelleyLovelace l) | (sc,l) <- withdrawals]
-  in Gov.TreasuryWithdrawals m
-toGovernanceAction _ (InitiateHardfork pVer) = Gov.HardForkInitiation pVer
-toGovernanceAction sbe (UpdatePParams ppup) =
-  case toLedgerPParamsUpdate sbe ppup of
-    Left e -> error $ "toGovernanceAction: " <> show e
-    -- TODO: Conway era - remove use of error. Ideally we will use the ledger's PParams type
-    -- in place of ProtocolParametersUpdate
-    Right ppup' -> Gov.ParameterChange ppup'
+toGovernanceAction w = \case
+  MotionOfNoConfidence ->
+    Gov.NoConfidence
+  ProposeNewConstitution bs ->
+    Gov.NewConstitution $ toSafeHash bs
+  ProposeNewCommittee stakeKeys quor ->
+    Gov.NewCommittee (Set.fromList $ map (\(StakeKeyHash sk) -> coerceKeyRole sk) stakeKeys) quor
+  InfoAct ->
+    Gov.InfoAction
+  TreasuryWithdrawal withdrawals ->
+    let m = Map.fromList [(toShelleyStakeCredential sc, toShelleyLovelace l) | (sc,l) <- withdrawals]
+    in Gov.TreasuryWithdrawals m
+  InitiateHardfork pVer ->
+    Gov.HardForkInitiation pVer
+  UpdatePParams ppup ->
+    case toLedgerPParamsUpdate (conwayEraOnwardsToShelleyBasedEra w) ppup of
+      Left e -> error $ "toGovernanceAction: " <> show e
+      -- TODO: Conway era - remove use of error. Ideally we will use the ledger's PParams type
+      -- in place of ProtocolParametersUpdate
+      Right ppup' -> Gov.ParameterChange ppup'
 
 fromGovernanceAction
   :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-  => ShelleyBasedEra era
+  => ConwayEraOnwards era
   -> Gov.GovernanceAction (ShelleyLedgerEra era)
   -> GovernanceAction
-fromGovernanceAction _ Gov.NoConfidence = MotionOfNoConfidence
-fromGovernanceAction sbe (Gov.NewConstitution h) =
-  ProposeNewConstitution $ obtainSafeToHashConstraint sbe $ originalBytes h
-fromGovernanceAction sbe (Gov.ParameterChange pparams) =
-  UpdatePParams $ fromLedgerPParamsUpdate sbe pparams
-fromGovernanceAction _ (Gov.HardForkInitiation pVer) =
-  InitiateHardfork pVer
-fromGovernanceAction _ (Gov.TreasuryWithdrawals withdrawlMap) =
-  let res = [ (fromShelleyStakeCredential lScred , fromShelleyLovelace coin)
-            | (lScred, coin) <- Map.toList withdrawlMap
-            ]
-  in TreasuryWithdrawal res
-fromGovernanceAction _ (Gov.NewCommittee proposedMembers quor) =
-  let stakeCred = map (StakeKeyHash . coerceKeyRole) $ Set.toList proposedMembers
-  in ProposeNewCommittee stakeCred quor
-fromGovernanceAction _ Gov.InfoAction = InfoAct
+fromGovernanceAction w = \case
+  Gov.NoConfidence ->
+    MotionOfNoConfidence
+  Gov.NewConstitution h ->
+    conwayEraOnwardsConstraints w $ ProposeNewConstitution $ originalBytes h
+  Gov.ParameterChange pparams ->
+    UpdatePParams $ fromLedgerPParamsUpdate (conwayEraOnwardsToShelleyBasedEra w) pparams
+  Gov.HardForkInitiation pVer ->
+    InitiateHardfork pVer
+  Gov.TreasuryWithdrawals withdrawlMap ->
+    let res = [ (fromShelleyStakeCredential lScred , fromShelleyLovelace coin)
+              | (lScred, coin) <- Map.toList withdrawlMap
+              ]
+    in TreasuryWithdrawal res
+  Gov.NewCommittee proposedMembers quor ->
+    let stakeCred = map (StakeKeyHash . coerceKeyRole) $ Set.toList proposedMembers
+    in ProposeNewCommittee stakeCred quor
+  Gov.InfoAction ->
+    InfoAct
 
 newtype Proposal era = Proposal { unProposal :: Gov.ProposalProcedure (ShelleyLedgerEra era) }
 
@@ -163,27 +183,27 @@ instance HasTypeProxy era => HasTypeProxy (Proposal era) where
 
 
 createProposalProcedure
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> Lovelace -- ^ Deposit
   -> Hash StakeKey -- ^ Return address
   -> GovernanceAction
   -> Proposal era
-createProposalProcedure sbe dep (StakeKeyHash retAddrh) govAct =
-  obtainEraConstraints sbe $ obtainEraCryptoConstraints sbe $
-    Proposal Gov.ProposalProcedure
+createProposalProcedure w dep (StakeKeyHash retAddrh) govAct =
+  Proposal $ conwayEraOnwardsConstraints w $
+    Gov.ProposalProcedure
       { Gov.pProcDeposit = toShelleyLovelace dep
       , Gov.pProcReturnAddr = retAddrh
-      , Gov.pProcGovernanceAction = toGovernanceAction sbe govAct
+      , Gov.pProcGovernanceAction = toGovernanceAction w govAct
       , Gov.pProcAnchor = SNothing -- TODO: Conway
       }
 
 fromProposalProcedure
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> Proposal era
   -> (Lovelace, Hash StakeKey, GovernanceAction)
-fromProposalProcedure sbe (Proposal pp) =
+fromProposalProcedure w (Proposal pp) =
   ( fromShelleyLovelace $ Gov.pProcDeposit pp
-  , StakeKeyHash (obtainEraCryptoConstraints sbe (Gov.pProcReturnAddr pp))
-  , obtainEraCryptoConstraints sbe $ fromGovernanceAction sbe (Gov.pProcGovernanceAction pp)
+  , StakeKeyHash (conwayEraOnwardsConstraints w (Gov.pProcReturnAddr pp))
+  , conwayEraOnwardsConstraints w $ fromGovernanceAction w (Gov.pProcGovernanceAction pp)
   )
 

cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs

@@ -13,7 +13,19 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Cardano.Api.Governance.Actions.VotingProcedure where
+module Cardano.Api.Governance.Actions.VotingProcedure
+  ( GovernanceActionId(..)
+  , makeGoveranceActionId
+  , Voter(..)
+  , Vote(..)
+  , toVoterRole
+  , toVote
+  , toVotingCredential
+  , eraDecodeVotingCredential
+  , VotingCredential(..)
+  , createVotingProcedure
+  , VotingProcedure(..)
+  ) where
 
 import           Cardano.Api.Address
 import           Cardano.Api.Eras
@@ -25,7 +37,6 @@ import           Cardano.Api.SerialiseCBOR (FromCBOR (fromCBOR), SerialiseAsCBOR
                    ToCBOR (toCBOR))
 import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.TxIn
-import           Cardano.Api.Utils
 
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Ledger.BaseTypes as Ledger
@@ -41,22 +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
-    :: ConwayEraOnwards 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.
@@ -68,27 +63,18 @@ data TxVotesSupportedInEra era where
 deriving instance Show (TxVotesSupportedInEra era)
 deriving instance Eq (TxVotesSupportedInEra era)
 
-votesSupportedInEra :: ShelleyBasedEra  era -> Maybe (TxVotesSupportedInEra era)
-votesSupportedInEra ShelleyBasedEraShelley = Nothing
-votesSupportedInEra ShelleyBasedEraAllegra = Nothing
-votesSupportedInEra ShelleyBasedEraMary    = Nothing
-votesSupportedInEra ShelleyBasedEraAlonzo  = Nothing
-votesSupportedInEra ShelleyBasedEraBabbage = Nothing
-votesSupportedInEra ShelleyBasedEraConway  = Just VotesSupportedInConwayEra
-{-# DEPRECATED votesSupportedInEra "Use conwayEraOnwardsConstraints instead" #-}
-
 newtype GovernanceActionId ledgerera = GovernanceActionId
   { unGovernanceActionId :: Ledger.GovernanceActionId (EraCrypto ledgerera)
   }
   deriving (Show, Eq)
 
 makeGoveranceActionId
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> TxIn
   -> GovernanceActionId (ShelleyLedgerEra era)
-makeGoveranceActionId sbe txin =
+makeGoveranceActionId w txin =
   let Ledger.TxIn txid (Ledger.TxIx txix) = toShelleyTxIn txin
-  in obtainEraCryptoConstraints sbe
+  in conwayEraOnwardsConstraints w
       $ GovernanceActionId
       $ Ledger.GovernanceActionId
           { Ledger.gaidTxId = txid
@@ -113,7 +99,7 @@ data Vote
 
 toVoterRole
   :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-  => ShelleyBasedEra era
+  => ConwayEraOnwards era
   -> Voter era
   -> Ledger.Voter (Shelley.EraCrypto (ShelleyLedgerEra era))
 toVoterRole _ = \case
@@ -131,7 +117,7 @@ toVote = \case
   Abstain -> Ledger.Abstain
 
 toVotingCredential
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> StakeCredential
   -> Either Plain.DecoderError (VotingCredential era)
 toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do
@@ -148,11 +134,11 @@ toVotingCredential _sbe (StakeCredentialByScript (ScriptHash _sh)) =
 -- This is a hack. data StakeCredential in cardano-api is not parameterized by era, it defaults to StandardCrypto.
 -- However VotingProcedure is parameterized on era. We need to also parameterize StakeCredential on era.
 eraDecodeVotingCredential
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> ByteString
   -> Either Plain.DecoderError (VotingCredential era)
-eraDecodeVotingCredential sbe bs =
-  obtainCryptoConstraints sbe $
+eraDecodeVotingCredential w bs =
+  conwayEraOnwardsConstraints w $
     case Plain.decodeFull bs of
       Left e -> Left e
       Right x -> Right $ VotingCredential x
@@ -165,16 +151,16 @@ deriving instance Show (VotingCredential crypto)
 deriving instance Eq (VotingCredential crypto)
 
 createVotingProcedure
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> Vote
   -> Voter era
   -> GovernanceActionId (ShelleyLedgerEra era)
   -> VotingProcedure era
-createVotingProcedure sbe vChoice vt (GovernanceActionId govActId) =
-  obtainEraConstraints sbe $ obtainEraCryptoConstraints sbe
+createVotingProcedure w vChoice vt (GovernanceActionId govActId) =
+  conwayEraOnwardsConstraints w
     $ VotingProcedure $ Ledger.VotingProcedure
       { Ledger.vProcGovActionId = govActId
-      , Ledger.vProcVoter = toVoterRole sbe vt
+      , Ledger.vProcVoter = toVoterRole w vt
       , Ledger.vProcVote = toVote vChoice
       , Ledger.vProcAnchor = SNothing -- TODO: Conway
       }
@@ -185,15 +171,15 @@ newtype VotingProcedure era = VotingProcedure
   deriving (Show, Eq)
 
 instance IsShelleyBasedEra era => ToCBOR (VotingProcedure era) where
-  toCBOR (VotingProcedure vp) = obtainEraConstraints sbe $ Shelley.toEraCBOR @(ShelleyLedgerEra era) vp
+  toCBOR (VotingProcedure vp) = shelleyBasedEraConstraints sbe $ Shelley.toEraCBOR @(ShelleyLedgerEra era) vp
     where sbe = shelleyBasedEra @era
 
 instance IsShelleyBasedEra era => FromCBOR (VotingProcedure era) where
-  fromCBOR = obtainEraConstraints (shelleyBasedEra @era) $ VotingProcedure <$> Shelley.fromEraCBOR @(ShelleyLedgerEra era)
+  fromCBOR = shelleyBasedEraConstraints (shelleyBasedEra @era) $ VotingProcedure <$> Shelley.fromEraCBOR @(ShelleyLedgerEra era)
 
 instance IsShelleyBasedEra era => SerialiseAsCBOR (VotingProcedure era) where
-  serialiseToCBOR = obtainEraConstraints (shelleyBasedEra @era) CBOR.serialize'
-  deserialiseFromCBOR _proxy = obtainEraConstraints (shelleyBasedEra @era) CBOR.decodeFull'
+  serialiseToCBOR = shelleyBasedEraConstraints (shelleyBasedEra @era) CBOR.serialize'
+  deserialiseFromCBOR _proxy = shelleyBasedEraConstraints (shelleyBasedEra @era) CBOR.decodeFull'
 
 instance IsShelleyBasedEra era => HasTextEnvelope (VotingProcedure era) where
   textEnvelopeType _ = "Governance vote"