Add constraints to Proposal and Vote types, Add test generators for them

cardano-api/cardano-api.cabal

@@ -243,12 +243,14 @@ library gen
                       , cardano-ledger-alonzo >= 1.3.1.1
                       , cardano-ledger-alonzo-test
                       , cardano-ledger-byron-test >= 1.5
-                      , cardano-ledger-core >= 1.4
+                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4
                       , cardano-ledger-shelley >= 1.4.1.0
+                      , cardano-ledger-conway:testlib >= 1.5
                       , containers
                       , filepath
                       , hedgehog >= 1.1
                       , hedgehog-extras
+                      , hedgehog-quickcheck
                       , tasty
                       , tasty-hedgehog
                       , text

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

@@ -1,7 +1,9 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
@@ -126,13 +128,7 @@ import qualified Cardano.Api as Api
 import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
                    WitnessNetworkIdOrByronAddress (..))
 import           Cardano.Api.Script (scriptInEraToRefScript)
-import           Cardano.Api.Shelley (GovernancePoll (..), GovernancePollAnswer (..), Hash (..),
-                   KESPeriod (KESPeriod),
-                   OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
-                   PlutusScript (PlutusScriptSerialised), ProtocolParameters (..),
-                   ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
-                   StakeCredential (StakeCredentialByKey), StakePoolKey,
-                   refInsScriptsAndInlineDatsSupportedInEra)
+import           Cardano.Api.Shelley
 
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash as Crypto
@@ -144,12 +140,14 @@ import           Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
 import qualified Cardano.Ledger.Shelley.TxBody as Ledger (EraIndependentTxBody)
 
 import           Control.Applicative (Alternative (..), optional)
+import           Control.Monad
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
 import           Data.Coerce
 import           Data.Int (Int64)
 import           Data.Map.Strict (Map)
+import           Data.Maybe
 import           Data.Ratio (Ratio, (%))
 import           Data.String
 import           Data.Word (Word64)
@@ -160,9 +158,12 @@ import           Test.Gen.Cardano.Api.Metadata (genTxMetadata)
 import           Test.Cardano.Chain.UTxO.Gen (genVKWitness)
 import           Test.Cardano.Crypto.Gen (genProtocolMagicId)
 import qualified Test.Cardano.Ledger.Alonzo.PlutusScripts as Plutus
+import           Test.Cardano.Ledger.Conway.Arbitrary ()
+import           Test.Cardano.Ledger.Core.Arbitrary ()
 
 import           Hedgehog (Gen, Range)
 import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Gen.QuickCheck as Q
 import qualified Hedgehog.Range as Range
 
 {- HLINT ignore "Reduce duplication" -}
@@ -668,8 +669,8 @@ genTxBodyContent era = do
   txUpdateProposal <- genTxUpdateProposal era
   txMintValue <- genTxMintValue era
   txScriptValidity <- genTxScriptValidity era
-  txGovernanceActions <- return TxGovernanceActionsNone -- TODO: Conway era
-  txVotes <- return TxVotesNone -- TODO: Conway era
+  txGovernanceActions <- genTxGovernanceActions era
+  txVotes <- genTxVotes era
   pure $ TxBodyContent
     { Api.txIns
     , Api.txInsCollateral
@@ -1107,3 +1108,27 @@ genGovernancePollAnswer =
  where
    genGovernancePollHash =
      GovernancePollHash . mkDummyHash <$> Gen.int (Range.linear 0 10)
+
+genTxGovernanceActions :: CardanoEra era -> Gen (TxGovernanceActions era)
+genTxGovernanceActions era = fromMaybe (pure TxGovernanceActionsNone) $ do
+  sbe <- join $ requireShelleyBasedEra era
+  supported <- governanceActionsSupportedInEra sbe
+  let proposals = Gen.list (Range.constant 0 10) $ genProposal sbe supported
+  pure $ TxGovernanceActions supported <$> proposals
+  where
+    genProposal :: ShelleyBasedEra era
+                -> TxGovernanceActionSupportedInEra era
+                -> Gen (Proposal era)
+    genProposal sbe = shelleyBasedEraConstraints sbe $ fmap Proposal . \case
+      GovernanceActionsSupportedInConwayEra -> Q.arbitrary
+
+genTxVotes :: CardanoEra era -> Gen (TxVotes era)
+genTxVotes era = fromMaybe (pure TxVotesNone) $ do
+  sbe <- join $ requireShelleyBasedEra era
+  supported <- votesSupportedInEra sbe
+  let votes = Gen.list (Range.constant 0 10) $ genVote sbe
+  pure $ TxVotes supported <$> votes
+  where
+    genVote :: ShelleyBasedEra era -> Gen (VotingProcedure era)
+    genVote sbe = obtainEraConstraints sbe $ VotingProcedure <$> Q.arbitrary
+

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

@@ -295,8 +295,6 @@ estimateTransactionKeyWitnessCount TxBodyContent {
 
 type PlutusScriptBytes = ShortByteString
 
--- TODO: Conway era - We don't really want to parameterise error
--- types on the error for now. As a stop gap we should implement a rendering function
 data ResolvablePointers where
   ResolvablePointers ::
       ( Ledger.Era (ShelleyLedgerEra era)

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

@@ -87,7 +87,7 @@ data GovernanceAction
 
 
 toSafeHash :: ByteString -> SafeHash StandardCrypto ByteString
-toSafeHash = makeHashWithExplicitProxys (Proxy :: Proxy  StandardCrypto) (Proxy :: Proxy ByteString)
+toSafeHash = makeHashWithExplicitProxys (Proxy @StandardCrypto) (Proxy @ByteString)
 
 toGovernanceAction
   :: EraCrypto ledgerera ~ StandardCrypto
@@ -169,8 +169,8 @@ createProposalProcedure
   -> GovernanceAction
   -> Proposal era
 createProposalProcedure sbe dep (StakeKeyHash retAddrh) govAct =
-  Proposal $ obtainEraCryptoConstraints sbe $
-    Gov.ProposalProcedure
+  obtainEraConstraints sbe $ obtainEraCryptoConstraints sbe $
+    Proposal Gov.ProposalProcedure
       { Gov.pProcDeposit = toShelleyLovelace dep
       , Gov.pProcReturnAddr = retAddrh
       , Gov.pProcGovernanceAction = toGovernanceAction sbe govAct
@@ -186,3 +186,4 @@ fromProposalProcedure sbe (Proposal pp) =
   , StakeKeyHash (obtainEraCryptoConstraints sbe (Gov.pProcReturnAddr pp))
   , obtainEraCryptoConstraints sbe $ fromGovernanceAction sbe (Gov.pProcGovernanceAction pp)
   )
+

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

@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -28,7 +29,6 @@ import           Cardano.Api.Utils
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import qualified Cardano.Ledger.Binary.Plain as Plain
-import qualified Cardano.Ledger.Conway as Conway
 import qualified Cardano.Ledger.Conway.Governance as Ledger
 import           Cardano.Ledger.Core (EraCrypto)
 import qualified Cardano.Ledger.Core as Shelley
@@ -61,7 +61,6 @@ deriving instance Eq (TxVotes era)
 -- The Conway and subsequent eras support governance actions.
 --
 data TxVotesSupportedInEra era where
-
      VotesSupportedInConwayEra  :: TxVotesSupportedInEra ConwayEra
 
 deriving instance Show (TxVotesSupportedInEra era)
@@ -171,7 +170,7 @@ createVotingProcedure
   -> GovernanceActionId (ShelleyLedgerEra era)
   -> VotingProcedure era
 createVotingProcedure sbe vChoice vt (GovernanceActionId govActId) =
-  obtainEraCryptoConstraints sbe
+  obtainEraConstraints sbe $ obtainEraCryptoConstraints sbe
     $ VotingProcedure $ Ledger.VotingProcedure
       { Ledger.vProcGovActionId = govActId
       , Ledger.vProcVoter = toVoterRole sbe vt
@@ -184,33 +183,21 @@ newtype VotingProcedure era = VotingProcedure
   }
   deriving (Show, Eq)
 
--- TODO: Conway - convert newtype VotingProcedure to a GADT with a ShelleyBasedEra era value
-instance
-  (Shelley.Era (ShelleyLedgerEra era)
-  , IsShelleyBasedEra era
-  ) => ToCBOR (VotingProcedure era) where
-  toCBOR (VotingProcedure vp) = Shelley.toEraCBOR @Conway.Conway vp
-
-instance
-  ( IsShelleyBasedEra era
-  , Shelley.Era (ShelleyLedgerEra era)
-  ) => FromCBOR (VotingProcedure era) where
-  fromCBOR = VotingProcedure <$> Shelley.fromEraCBOR @Conway.Conway
-
-instance
-  ( IsShelleyBasedEra era
-  , Shelley.Era (ShelleyLedgerEra era)
-  ) => SerialiseAsCBOR (VotingProcedure era) where
-  serialiseToCBOR = CBOR.serialize'
-  deserialiseFromCBOR _proxy = CBOR.decodeFull'
-
-
-instance
-  ( IsShelleyBasedEra era
-  , Shelley.Era (ShelleyLedgerEra era)
-  ) => HasTextEnvelope (VotingProcedure era) where
+instance IsShelleyBasedEra era => ToCBOR (VotingProcedure era) where
+  toCBOR (VotingProcedure vp) = obtainEraConstraints 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)
+
+instance IsShelleyBasedEra era => SerialiseAsCBOR (VotingProcedure era) where
+  serialiseToCBOR = obtainEraConstraints (shelleyBasedEra @era) CBOR.serialize'
+  deserialiseFromCBOR _proxy = obtainEraConstraints (shelleyBasedEra @era) CBOR.decodeFull'
+
+instance IsShelleyBasedEra era => HasTextEnvelope (VotingProcedure era) where
   textEnvelopeType _ = "Governance vote"
 
 instance HasTypeProxy era => HasTypeProxy (VotingProcedure era) where
   data AsType (VotingProcedure era) = AsVote
   proxyToAsType _ = AsVote
+