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

@@ -10,10 +10,23 @@
 {-# 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
@@ -92,38 +105,42 @@ 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 sbe = \case
+fromGovernanceAction w = \case
   Gov.NoConfidence ->
     MotionOfNoConfidence
   Gov.NewConstitution h ->
-    ProposeNewConstitution $ shelleyBasedEraConstraints sbe $ originalBytes h
+    ProposeNewConstitution $ conwayEraOnwardsConstraints w $ originalBytes h
   Gov.ParameterChange pparams ->
-    UpdatePParams $ fromLedgerPParamsUpdate sbe pparams
+    UpdatePParams $ fromLedgerPParamsUpdate (conwayEraOnwardsToShelleyBasedEra w) pparams
   Gov.HardForkInitiation pVer ->
     InitiateHardfork pVer
   Gov.TreasuryWithdrawals withdrawlMap ->
@@ -166,27 +183,26 @@ 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 =
-  shelleyBasedEraConstraints sbe $ shelleyBasedEraConstraints sbe $
+createProposalProcedure w dep (StakeKeyHash retAddrh) govAct =
+  conwayEraOnwardsConstraints w $
     Proposal 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 (shelleyBasedEraConstraints sbe (Gov.pProcReturnAddr pp))
-  , shelleyBasedEraConstraints 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
@@ -40,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.
@@ -67,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 shelleyBasedEraConstraints sbe
+  in conwayEraOnwardsConstraints w
       $ GovernanceActionId
       $ Ledger.GovernanceActionId
           { Ledger.gaidTxId = txid
@@ -112,7 +99,7 @@ data Vote
 
 toVoterRole
   :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-  => ShelleyBasedEra era
+  => ConwayEraOnwards era
   -> Voter era
   -> Ledger.Voter (Shelley.EraCrypto (ShelleyLedgerEra era))
 toVoterRole _ = \case
@@ -130,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
@@ -147,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 =
-  shelleyBasedEraConstraints sbe $
+eraDecodeVotingCredential w bs =
+  conwayEraOnwardsConstraints w $
     case Plain.decodeFull bs of
       Left e -> Left e
       Right x -> Right $ VotingCredential x
@@ -164,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) =
-  shelleyBasedEraConstraints sbe $ shelleyBasedEraConstraints 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
       }

cardano-api/internal/Cardano/Api/TxBody.hs

@@ -190,6 +190,7 @@ import           Cardano.Api.Convenience.Constraints
 import           Cardano.Api.EraCast
 import           Cardano.Api.Eras
 import           Cardano.Api.Error
+import           Cardano.Api.Feature
 import           Cardano.Api.Feature.ConwayEraOnwards
 import           Cardano.Api.Governance.Actions.ProposalProcedure
 import           Cardano.Api.Governance.Actions.VotingProcedure
@@ -1758,7 +1759,7 @@ data TxBodyContent build era =
        txMintValue         :: TxMintValue    build era,
        txScriptValidity    :: TxScriptValidity era,
        txGovernanceActions :: TxGovernanceActions era,
-       txVotes             :: TxVotes era
+       txVotes             :: Maybe (Featured ConwayEraOnwards era [VotingProcedure era])
      }
      deriving (Eq, Show)
 
@@ -1782,7 +1783,7 @@ defaultTxBodyContent = TxBodyContent
     , txMintValue = TxMintNone
     , txScriptValidity = TxScriptValidityNone
     , txGovernanceActions = TxGovernanceActionsNone
-    , txVotes = TxVotesNone
+    , txVotes = Nothing
     }
 
 setTxIns :: TxIns build era -> TxBodyContent build era -> TxBodyContent build era
@@ -2731,7 +2732,7 @@ fromLedgerTxBody sbe scriptValidity body scriptdata mAux =
       , txAuxScripts
       , txScriptValidity    = scriptValidity
       , txGovernanceActions = fromLedgerProposalProcedure sbe body
-      , txVotes             = fromLedgerTxVotes sbe body
+      , txVotes             = featureInShelleyBasedEra Nothing (\w -> Just (fromLedgerTxVotes w body)) sbe
       }
   where
     (txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData sbe mAux
@@ -2752,16 +2753,14 @@ fromLedgerProposalProcedure sbe body =
     getProposals GovernanceActionsSupportedInConwayEra body_ = fmap Proposal . toList $ body_ ^. L.proposalProceduresTxBodyL
 
 
-fromLedgerTxVotes :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxVotes era
-fromLedgerTxVotes sbe body =
-  case featureInShelleyBasedEra Nothing Just sbe of
-    Nothing -> TxVotesNone
-    Just w  -> TxVotes w (getVotes w body)
-  where
-    getVotes :: ConwayEraOnwards era
-             -> Ledger.TxBody (ShelleyLedgerEra era)
-             -> [VotingProcedure era]
-    getVotes ConwayEraOnwardsConway body_ = fmap VotingProcedure . toList $ body_ ^. L.votingProceduresTxBodyL
+fromLedgerTxVotes :: ()
+  => ConwayEraOnwards era
+  -> Ledger.TxBody (ShelleyLedgerEra era)
+  -> Featured ConwayEraOnwards era [VotingProcedure era]
+fromLedgerTxVotes w body =
+  conwayEraOnwardsConstraints w
+    $ Featured w
+    $ fmap VotingProcedure $ toList $ body ^. L.votingProceduresTxBodyL
 
 fromLedgerTxIns
   :: forall era.
@@ -3431,7 +3430,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) =
   , txMintValue         = TxMintNone
   , txScriptValidity    = TxScriptValidityNone
   , txGovernanceActions = TxGovernanceActionsNone
-  , txVotes             = TxVotesNone
+  , txVotes             = Nothing
   }
 
 convTxIns :: TxIns BuildTx era -> Set (L.TxIn StandardCrypto)
@@ -3612,10 +3611,10 @@ convGovActions :: TxGovernanceActions era -> Seq.StrictSeq (Gov.ProposalProcedur
 convGovActions TxGovernanceActionsNone = Seq.empty
 convGovActions (TxGovernanceActions _ govActions) = Seq.fromList $ fmap unProposal govActions
 
-convVotes :: ShelleyBasedEra era -> TxVotes era -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era))
-convVotes _ = \case
-  TxVotesNone -> Seq.empty
-  TxVotes _ votes -> Seq.fromList $ map unVotingProcedure votes
+convVotes :: ()
+  => Featured ConwayEraOnwards era [VotingProcedure era]
+  -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era))
+convVotes (Featured _ v) = Seq.fromList $ map unVotingProcedure v
 
 guardShelleyTxInsOverflow :: [TxIn] -> Either TxBodyError ()
 guardShelleyTxInsOverflow txIns = do
@@ -3985,7 +3984,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway
            & L.reqSignerHashesTxBodyL     .~ convExtraKeyWitnesses txExtraKeyWits
            & L.mintTxBodyL                .~ convMintValue txMintValue
            & L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash
-           & L.votingProceduresTxBodyL    .~ convVotes sbe txVotes
+           & L.votingProceduresTxBodyL    .~ maybe mempty convVotes txVotes
            & L.proposalProceduresTxBodyL  .~ convGovActions txGovernanceActions
            -- TODO Conway: support optional network id in TxBodyContent
            -- & L.networkIdTxBodyL .~ SNothing