Propagate changes throughout the rest of cardano-api

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

@@ -590,22 +590,43 @@ genTxCertificates :: CardanoEra era -> Gen (TxCertificates BuildTx era)
 genTxCertificates era =
   case certificatesSupportedInEra era of
     Nothing -> pure TxCertificatesNone
-    Just supported -> do
-      certs <- Gen.list (Range.constant 0 3) genCertificate
-      Gen.choice
-        [ pure TxCertificatesNone
-        , pure (TxCertificates supported certs $ BuildTxWith mempty)
-          -- TODO: Generate certificates
-        ]
+    Just supported ->
+      case cardanoEraStyle era of
+        LegacyByronEra -> pure TxCertificatesNone
+        ShelleyBasedEra sbe -> do
+          certs <- Gen.list (Range.constant 0 3) $ genCertificate sbe
+          Gen.choice
+            [ pure TxCertificatesNone
+            , pure (TxCertificates supported certs $ BuildTxWith mempty)
+              -- TODO: Generate certificates
+            ]
 
 -- TODO: Add remaining certificates
-genCertificate :: Gen (Certificate era)
-genCertificate =
+-- TODO: This should be parameterised on ShelleyBasedEra
+genCertificate :: ShelleyBasedEra era -> Gen (Certificate era)
+genCertificate sbe =
   Gen.choice
-    [ StakeAddressRegistrationCertificate <$> genStakeCredential
-    , StakeAddressDeregistrationCertificate <$> genStakeCredential
+    [ makeStakeAddressRegistrationCertificate <$> genStakeAddressRequirements sbe
+    , makeStakeAddressUnregistrationCertificate <$> genStakeAddressRequirements sbe
     ]
 
+genStakeAddressRequirements :: ShelleyBasedEra era -> Gen (StakeAddressRequirements era)
+genStakeAddressRequirements sbe =
+  case sbe of
+    ShelleyBasedEraShelley ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraShelley <$> genStakeCredential
+    ShelleyBasedEraAllegra ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraAllegra <$> genStakeCredential
+    ShelleyBasedEraMary ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraMary <$> genStakeCredential
+    ShelleyBasedEraAlonzo ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraAlonzo <$> genStakeCredential
+    ShelleyBasedEraBabbage ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraBabbage <$> genStakeCredential
+    ShelleyBasedEraConway ->
+      StakeAddrRegistrationConway ConwayEraOnwardsConway <$> genLovelace <*> genStakeCredential
+
+
 genTxUpdateProposal :: CardanoEra era -> Gen (TxUpdateProposal era)
 genTxUpdateProposal era =
   case updateProposalSupportedInEra era of

cardano-api/internal/Cardano/Api/Convenience/Query.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -88,9 +87,7 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
   qeInMode <- pure (toEraInMode era CardanoMode)
     & onNothing (left (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (getIsCardanoEraConstraint era $ AnyCardanoEra era)))
 
-  let stakeCreds = Set.fromList $ flip mapMaybe certs $ \case
-        StakeAddressDeregistrationCertificate cred -> Just cred
-        _ -> Nothing
+  let stakeCreds = Set.fromList $ mapMaybe (filterUnRegCreds sbe) certs
 
   -- Query execution
   utxo <- lift (queryUtxo qeInMode sbe (QueryUTxOByTxIn (Set.fromList allTxIns)))

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

@@ -950,7 +950,7 @@ makeTransactionBodyAutoBalance systemstart history pparams poolids stakeDelegDep
             failures
             exUnitsMap'
 
-    txbodycontent1 <- substituteExecutionUnits exUnitsMap' txbodycontent
+    txbodycontent1 <- substituteExecutionUnits sbe exUnitsMap' txbodycontent
 
     explicitTxFees <- first (const TxBodyErrorByronEraNotSupported) $
                         txFeesExplicitInEra era'
@@ -1174,11 +1174,12 @@ makeTransactionBodyAutoBalance systemstart history pparams poolids stakeDelegDep
                    (txOutInAnyEra txout)
                    minUTxO
 
-substituteExecutionUnits :: Map ScriptWitnessIndex ExecutionUnits
+substituteExecutionUnits :: ShelleyBasedEra era
+                         -> Map ScriptWitnessIndex ExecutionUnits
                          -> TxBodyContent BuildTx era
                          -> Either TxBodyErrorAutoBalance (TxBodyContent BuildTx era)
-substituteExecutionUnits exUnitsMap =
-    mapTxScriptWitnesses f
+substituteExecutionUnits sbe exUnitsMap =
+    mapTxScriptWitnesses f sbe
   where
     f :: ScriptWitnessIndex
       -> ScriptWitness witctx era
@@ -1195,9 +1196,10 @@ mapTxScriptWitnesses
       (forall witctx. ScriptWitnessIndex
                    -> ScriptWitness witctx era
                    -> Either TxBodyErrorAutoBalance (ScriptWitness witctx era))
+  -> ShelleyBasedEra era
   -> TxBodyContent BuildTx era
   -> Either TxBodyErrorAutoBalance (TxBodyContent BuildTx era)
-mapTxScriptWitnesses f txbodycontent@TxBodyContent {
+mapTxScriptWitnesses f sbe txbodycontent@TxBodyContent {
                          txIns,
                          txWithdrawals,
                          txCertificates,
@@ -1206,7 +1208,7 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent {
     mappedTxIns <- mapScriptWitnessesTxIns txIns
     mappedWithdrawals <- mapScriptWitnessesWithdrawals txWithdrawals
     mappedMintedVals <- mapScriptWitnessesMinting txMintValue
-    mappedTxCertificates <- mapScriptWitnessesCertificates txCertificates
+    mappedTxCertificates <- mapScriptWitnessesCertificates sbe txCertificates
 
     Right $ txbodycontent
       & setTxIns mappedTxIns
@@ -1271,18 +1273,19 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent {
         adjustWitness g (ScriptWitness ctx witness') = ScriptWitness ctx <$> g witness'
 
     mapScriptWitnessesCertificates
-      :: TxCertificates BuildTx era
+      :: ShelleyBasedEra era
+      -> TxCertificates BuildTx era
       -> Either TxBodyErrorAutoBalance (TxCertificates BuildTx era)
-    mapScriptWitnessesCertificates  TxCertificatesNone = Right TxCertificatesNone
-    mapScriptWitnessesCertificates (TxCertificates supported certs
+    mapScriptWitnessesCertificates _ TxCertificatesNone = Right TxCertificatesNone
+    mapScriptWitnessesCertificates sbe' (TxCertificates supported certs
                                                    (BuildTxWith witnesses)) =
       let mappedScriptWitnesses
            :: [(StakeCredential, Either TxBodyErrorAutoBalance (Witness WitCtxStake era))]
           mappedScriptWitnesses =
               [ (stakecred, ScriptWitness ctx <$> witness')
                 -- The certs are indexed in list order
               | (ix, cert) <- zip [0..] certs
-              , stakecred  <- maybeToList (selectStakeCredential cert)
+              , stakecred  <- maybeToList (selectStakeCredential sbe' cert)
               , ScriptWitness ctx witness
                            <- maybeToList (Map.lookup stakecred witnesses)
               , let witness' = f (ScriptWitnessIndexCertificate ix) witness
@@ -1294,12 +1297,6 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent {
                           Right wit -> Right (sCred, wit)
                     ) mappedScriptWitnesses
 
-    selectStakeCredential cert =
-      case cert of
-        StakeAddressDeregistrationCertificate stakecred   -> Just stakecred
-        StakeAddressPoolDelegationCertificate stakecred _ -> Just stakecred
-        _                                                 -> Nothing
-
     mapScriptWitnessesMinting
       :: TxMintValue BuildTx era
       -> Either TxBodyErrorAutoBalance (TxMintValue BuildTx era)

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

@@ -2359,7 +2359,7 @@ createTransactionBody
   -> Either TxBodyError (TxBody era)
 createTransactionBody sbe txBodyContent =
   let apiTxOuts = txOuts txBodyContent
-      apiScriptWitnesses = collectTxBodyScriptWitnesses txBodyContent
+      apiScriptWitnesses = collectTxBodyScriptWitnesses sbe txBodyContent
       apiScriptValidity = txScriptValidity txBodyContent
       apiMintValue = txMintValue txBodyContent
       apiProtocolParameters = txProtocolParams txBodyContent
@@ -2553,7 +2553,7 @@ validateTxBodyContent sbe txBodContent@TxBodyContent {
                              txProtocolParams,
                              txMintValue,
                              txMetadata} =
-  let witnesses = collectTxBodyScriptWitnesses txBodContent
+  let witnesses = collectTxBodyScriptWitnesses sbe txBodContent
       languages = Set.fromList
                     [ toAlonzoLanguage (AnyPlutusScriptVersion v)
                     | (_, AnyScriptWitness (PlutusScriptWitness _ v _ _ _ _)) <- witnesses
@@ -3679,7 +3679,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraShelley
     scripts_ = catMaybes
       [ toShelleyScript <$> scriptWitnessScript scriptwitness
       | (_, AnyScriptWitness scriptwitness)
-          <- collectTxBodyScriptWitnesses txbodycontent
+          <- collectTxBodyScriptWitnesses sbe txbodycontent
       ]
 
     txAuxData :: Maybe (L.TxAuxData StandardShelley)
@@ -3716,7 +3716,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraAllegra
     scripts_ = catMaybes
       [ toShelleyScript <$> scriptWitnessScript scriptwitness
       | (_, AnyScriptWitness scriptwitness)
-          <- collectTxBodyScriptWitnesses txbodycontent
+          <- collectTxBodyScriptWitnesses sbe txbodycontent
       ]
 
     txAuxData :: Maybe (L.TxAuxData StandardAllegra)
@@ -3755,7 +3755,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraMary
     scripts = List.nub $ catMaybes
       [ toShelleyScript <$> scriptWitnessScript scriptwitness
       | (_, AnyScriptWitness scriptwitness)
-          <- collectTxBodyScriptWitnesses txbodycontent
+          <- collectTxBodyScriptWitnesses sbe txbodycontent
       ]
 
     txAuxData :: Maybe (L.TxAuxData StandardMary)
@@ -3801,7 +3801,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraAlonzo
         txScriptValidity
   where
     witnesses :: [(ScriptWitnessIndex, AnyScriptWitness AlonzoEra)]
-    witnesses = collectTxBodyScriptWitnesses txbodycontent
+    witnesses = collectTxBodyScriptWitnesses sbe txbodycontent
 
     scripts :: [Ledger.Script StandardAlonzo]
     scripts = List.nub $ catMaybes
@@ -3894,7 +3894,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraBabbage
         txScriptValidity
   where
     witnesses :: [(ScriptWitnessIndex, AnyScriptWitness BabbageEra)]
-    witnesses = collectTxBodyScriptWitnesses txbodycontent
+    witnesses = collectTxBodyScriptWitnesses sbe txbodycontent
 
     scripts :: [Ledger.Script StandardBabbage]
     scripts = List.nub $ catMaybes
@@ -3995,7 +3995,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway
         txScriptValidity
   where
     witnesses :: [(ScriptWitnessIndex, AnyScriptWitness ConwayEra)]
-    witnesses = collectTxBodyScriptWitnesses txbodycontent
+    witnesses = collectTxBodyScriptWitnesses sbe txbodycontent
 
     scripts :: [Ledger.Script StandardConway]
     scripts = catMaybes
@@ -4181,10 +4181,10 @@ fromAlonzoRdmrPtr (Alonzo.RdmrPtr tag n) =
       Alonzo.Cert  -> ScriptWitnessIndexCertificate (fromIntegral n)
       Alonzo.Rewrd -> ScriptWitnessIndexWithdrawal  (fromIntegral n)
 
-collectTxBodyScriptWitnesses :: forall era.
-                                TxBodyContent BuildTx era
+collectTxBodyScriptWitnesses :: forall era. ShelleyBasedEra era
+                             -> TxBodyContent BuildTx era
                              -> [(ScriptWitnessIndex, AnyScriptWitness era)]
-collectTxBodyScriptWitnesses TxBodyContent {
+collectTxBodyScriptWitnesses sbe TxBodyContent {
                                txIns,
                                txWithdrawals,
                                txCertificates,
@@ -4227,15 +4227,10 @@ collectTxBodyScriptWitnesses TxBodyContent {
           -- The certs are indexed in list order
         | (ix, cert) <- zip [0..] certs
         , ScriptWitness _ witness <- maybeToList $ do
-                                       stakecred <- selectStakeCredential cert
+                                       stakecred <- obtainEraCryptoConstraints sbe $ selectStakeCredential sbe cert
                                        Map.lookup stakecred witnesses
         ]
 
-    selectStakeCredential cert =
-      case cert of
-        StakeAddressDeregistrationCertificate stakecred   -> Just stakecred
-        StakeAddressPoolDelegationCertificate stakecred _ -> Just stakecred
-        _                                                 -> Nothing
 
     scriptWitnessesMinting
       :: TxMintValue BuildTx era

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

@@ -31,7 +31,6 @@ module Cardano.Api.Utils
   , bounded
 
     -- ** Constraint solvers
-  , obtainCertificateConstraints
   , obtainCryptoConstraints
   , obtainEraConstraints
   , obtainEraPParamsConstraint
@@ -47,7 +46,6 @@ import qualified Cardano.Ledger.Core as Ledger
 import           Cardano.Ledger.Crypto (Crypto, StandardCrypto)
 import qualified Cardano.Ledger.Crypto as Ledger
 import           Cardano.Ledger.Shelley ()
-import qualified Cardano.Ledger.Shelley.TxCert as Shelley
 
 import           Control.Exception (bracket)
 import           Control.Monad (when)
@@ -204,16 +202,5 @@ obtainSafeToHashConstraint ShelleyBasedEraMary    f = f
 obtainSafeToHashConstraint ShelleyBasedEraAlonzo  f = f
 obtainSafeToHashConstraint ShelleyBasedEraBabbage f = f
 obtainSafeToHashConstraint ShelleyBasedEraConway  f = f
-obtainCertificateConstraints
 
-  :: ShelleyBasedEra era
-  -> (( Shelley.ShelleyEraTxCert (ShelleyLedgerEra era)
-      , EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-      ) => a)
-  -> a
-obtainCertificateConstraints ShelleyBasedEraShelley f = f
-obtainCertificateConstraints ShelleyBasedEraAllegra f = f
-obtainCertificateConstraints ShelleyBasedEraMary    f = f
-obtainCertificateConstraints ShelleyBasedEraAlonzo  f = f
-obtainCertificateConstraints ShelleyBasedEraBabbage f = f
-obtainCertificateConstraints ShelleyBasedEraConway  f = f
+

cardano-api/src/Cardano/Api.hs

@@ -391,8 +391,9 @@ module Cardano.Api (
     -- | Certificates that are embedded in transactions for registering and
     -- unregistering stake address, and for setting the stake pool delegation
     -- choice for a stake address.
+    StakeAddressRequirements(..),
     makeStakeAddressRegistrationCertificate,
-    makeStakeAddressDeregistrationCertificate,
+    makeStakeAddressUnregistrationCertificate,
     makeStakeAddressPoolDelegationCertificate,
 
     -- ** Registering stake pools
@@ -792,6 +793,7 @@ module Cardano.Api (
     makeMIRCertificate,
     makeGenesisKeyDelegationCertificate,
     MIRTarget (..),
+    MIRPot(..),
 
     -- * Protocol parameter updates
     UpdateProposal(..),
@@ -894,7 +896,10 @@ module Cardano.Api (
     querySystemStart,
     queryUtxo,
     determineEraExpr,
-    -- * Governance
+
+    -- ** Conway related
+    AtMostBabbageEra(..),
+    ConwayEraOnwards(..),
 
     -- ** DReps
     DRepKey,
@@ -903,9 +908,11 @@ module Cardano.Api (
     DRepMetadataValidationError,
     validateAndHashDRepMetadata,
 
-    -- ** Governance Committee
-    makeCommitteeDelegationCertificate,
-    makeCommitteeHotKeyUnregistrationCertificate,
+    -- ** Governance related certificates
+    makeCommitteeColdkeyResignationCertificate,
+    makeCommitteeHotKeyAuthorizationCertificate,
+    makeDrepRegistrationCertificate,
+    makeDrepUnregistrationCertificate,
 
     ResolvablePointers(..),
   ) where