Stake pool for integration test

src/base/lib/Convex/NodeQueries.hs

@@ -8,7 +8,9 @@ module Convex.NodeQueries(
   querySystemStart,
   queryLocalState,
   queryTip,
-  queryProtocolParameters
+  queryProtocolParameters,
+  queryStakeAddresses,
+  queryStakePools
 ) where
 
 import           Cardano.Api                                        (CardanoMode,
@@ -22,9 +24,13 @@ import           Cardano.Api                                        (CardanoMode
                                                                      NetworkId (Mainnet, Testnet),
                                                                      NetworkMagic (..),
                                                                      SystemStart,
+                                                                     Lovelace,
                                                                      envSecurityParam)
 import qualified Cardano.Api                                        as CAPI
-import           Cardano.Api.Shelley                                (ProtocolParameters)
+import           Cardano.Api.Shelley                                (ProtocolParameters,
+                                                                     PoolId,
+                                                                     StakeAddress,
+                                                                     StakeCredential)
 import qualified Cardano.Chain.Genesis
 import           Cardano.Crypto                                     (RequiresNetworkMagic (..),
                                                                      getProtocolMagic)
@@ -33,6 +39,8 @@ import           Control.Monad.Except                               (MonadError,
 import           Control.Monad.IO.Class                             (MonadIO (..))
 import           Control.Monad.Trans.Except                         (runExceptT)
 import           Data.SOP.Strict                                    (NP ((:*)))
+import           Data.Set                                           (Set)
+import           Data.Map                                           (Map)
 import qualified Ouroboros.Consensus.Cardano.CanHardFork            as Consensus
 import qualified Ouroboros.Consensus.HardFork.Combinator            as Consensus
 import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as HFC
@@ -87,6 +95,26 @@ queryEraHistory = queryLocalState (CAPI.QueryEraHistory CAPI.CardanoModeIsMultiE
 queryTip :: LocalNodeConnectInfo CardanoMode -> IO ChainPoint
 queryTip = queryLocalState (CAPI.QueryChainPoint CAPI.CardanoMode)
 
+queryStakePools :: LocalNodeConnectInfo CardanoMode -> IO (Set PoolId)
+queryStakePools connectInfo = do
+  result <- queryLocalState
+              (CAPI.QueryInEra CAPI.BabbageEraInCardanoMode (CAPI.QueryInShelleyBasedEra CAPI.ShelleyBasedEraBabbage CAPI.QueryStakePools))
+              connectInfo
+  case result of
+    Left err -> do
+      fail ("queryStakePools: failed with: " <> show err)
+    Right k -> pure k
+
+queryStakeAddresses :: LocalNodeConnectInfo CardanoMode -> Set StakeCredential -> NetworkId -> IO (Map StakeAddress Lovelace, Map StakeAddress PoolId)
+queryStakeAddresses info creds nid = do
+  result <- queryLocalState
+              (CAPI.QueryInEra CAPI.BabbageEraInCardanoMode (CAPI.QueryInShelleyBasedEra CAPI.ShelleyBasedEraBabbage (CAPI.QueryStakeAddresses creds nid)))
+              info
+  case result of
+    Left err -> do
+      fail ("queryStakeAddresses: failed with: " <> show err)
+    Right k -> pure k
+
 queryLocalState :: CAPI.QueryInMode CardanoMode b -> LocalNodeConnectInfo CardanoMode -> IO b
 queryLocalState query connectInfo = do
   CAPI.queryNodeLocalState connectInfo Nothing query >>= \case

src/coin-selection/lib/Convex/CoinSelection.hs

@@ -44,7 +44,7 @@ module Convex.CoinSelection(
 
 import           Cardano.Api.Shelley       (BabbageEra, BuildTx, CardanoMode,
                                             EraHistory, PoolId, TxBodyContent,
-                                            TxOut, UTxO (..))
+                                            TxOut, UTxO (..), StakePoolParameters (..))
 import qualified Cardano.Api.Shelley       as C
 import qualified Cardano.Ledger.Core       as Core
 import           Cardano.Ledger.Crypto     (StandardCrypto)
@@ -699,13 +699,49 @@ keyWitnesses (requiredTxIns -> inputs) = do
 
 -- | The number of signatures required to spend the transaction's inputs
 --   and to satisfy the "extra key witnesses" constraint
+--   and required for certification.
 requiredSignatureCount :: MonadBlockchain m => C.TxBodyContent C.BuildTx C.BabbageEra -> m TransactionSignatureCount
 requiredSignatureCount content = do
   keyWits <- keyWitnesses content
   let hsh (C.PaymentKeyHash h) = h
       extraSigs = view (L.txExtraKeyWits . L._TxExtraKeyWitnesses) content
       allSigs = Set.union keyWits (Set.fromList $ fmap hsh extraSigs)
-  pure $ TransactionSignatureCount $ fromIntegral $ Set.size allSigs
+
+      certKeyWits = case view L.txCertificates content of
+        C.TxCertificates _ cs _ -> mconcat $ getCertKeyWits <$> cs
+        C.TxCertificatesNone -> Set.empty
+
+      getCertKeyWits :: C.Certificate -> Set CertificateKeyWitness
+      getCertKeyWits (C.StakeAddressRegistrationCertificate (C.StakeCredentialByKey hash)) =
+        Set.singleton $ CertificateStakeKey hash
+      getCertKeyWits (C.StakeAddressRegistrationCertificate _) =
+        Set.empty
+      getCertKeyWits (C.StakeAddressDeregistrationCertificate (C.StakeCredentialByKey hash)) =
+        Set.singleton $ CertificateStakeKey hash
+      getCertKeyWits (C.StakeAddressDeregistrationCertificate _) = 
+        Set.empty
+      getCertKeyWits (C.StakeAddressDelegationCertificate (C.StakeCredentialByKey hash) poolHash) =
+        Set.fromList [CertificateStakeKey hash, CertificateStakePoolKey poolHash]
+      getCertKeyWits (C.StakeAddressDelegationCertificate _ poolHash) =
+        Set.singleton (CertificateStakePoolKey poolHash)
+      getCertKeyWits (C.StakePoolRegistrationCertificate StakePoolParameters{stakePoolId, stakePoolOwners}) =
+           Set.singleton (CertificateStakePoolKey stakePoolId)
+        <> Set.fromList (CertificateStakeKey <$> stakePoolOwners)
+      getCertKeyWits (C.StakePoolRetirementCertificate hash _) =
+        Set.singleton $ CertificateStakePoolKey hash
+      getCertKeyWits C.GenesisKeyDelegationCertificate {} =
+        error "Genesis key delegation certificate key witness count not supported"
+      getCertKeyWits (C.MIRCertificate _ _) =
+        error "MIR certificate key witness count not supported"
+
+  pure $ TransactionSignatureCount (fromIntegral $ Set.size allSigs + Set.size certKeyWits)
+
+{- | Certificate key witness
+-}
+data CertificateKeyWitness =
+    CertificateStakeKey (C.Hash C.StakeKey)
+  | CertificateStakePoolKey (C.Hash C.StakePoolKey)
+  deriving stock (Eq, Ord)
 
 publicKeyCredential :: C.TxOut v C.BabbageEra -> Maybe (Keys.KeyHash 'Keys.Payment StandardCrypto)
 publicKeyCredential = preview (L._TxOut . _1 . L._ShelleyAddressInBabbageEra . _2 . L._ShelleyPaymentCredentialByKey)

src/devnet/config/devnet/genesis-shelley.json

@@ -9,7 +9,7 @@
         "609783be7d3c54f11377966dfabc9284cd6c32fca1cd42ef0a4f1cc45b": 900000000000
     },
     "maxKESEvolutions": 60,
-    "maxLovelaceSupply": 2000000000000,
+    "maxLovelaceSupply": 45000000000000000,
     "networkId": "Testnet",
     "networkMagic": 42,
     "protocolParams": {
@@ -33,8 +33,8 @@
             "major": 7,
             "minor": 0
         },
-        "rho": 0.1,
-        "tau": 0.1
+        "rho": 0.003,
+        "tau": 0.0
     },
     "slotsPerKESPeriod": 129600,
     "staking": {

src/devnet/convex-devnet.cabal

@@ -41,6 +41,7 @@ library
     import: lang
     exposed-modules:
       Convex.Devnet.CardanoNode
+      Convex.Devnet.CardanoNode.Types
       Convex.Devnet.Logging
       Convex.Devnet.NodeQueries
       Convex.Devnet.Utils
@@ -109,3 +110,5 @@ test-suite convex-devnet-test
     , mtl
     , text
     , aeson
+    , containers
+    , filepath