Skip to content

Commit

Permalink
Stake pool for integration test (#141)
Browse files Browse the repository at this point in the history
* new withCardanoStakePoolNodeDevnetConfig function

* Using filepath combinator

* Added queryStakePools and queryStakeAddresses to the NodeQueries module

* Added stake pool registration test

* Additional signature count when balancing + witness keys for devnet wallet balancing

* withCardanoStakePoolNodeDevnetConfig stake and pool registration

* Stake reward test

* Added CardanoNode.Types module

* Export waitForNextBlock

* better temp dirs for stake pool nodes

* relative file path for the staking pool arguments

* Removed submit argument function

* RunningStakePoolNode type

* Inherit node conf from main node and genesis shelley adjustment

* PortsConfig type

* Removed DevnetConfig type

* Moving types to CardanoNode.Types

* requiredSignatureCount with certificate key wit count support
  • Loading branch information
the-headless-ghost authored Apr 24, 2024
1 parent 4070e56 commit beb2d6f
Show file tree
Hide file tree
Showing 10 changed files with 562 additions and 166 deletions.
32 changes: 30 additions & 2 deletions src/base/lib/Convex/NodeQueries.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,9 @@ module Convex.NodeQueries(
querySystemStart,
queryLocalState,
queryTip,
queryProtocolParameters
queryProtocolParameters,
queryStakeAddresses,
queryStakePools
) where

import Cardano.Api (CardanoMode,
Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
40 changes: 38 additions & 2 deletions src/coin-selection/lib/Convex/CoinSelection.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
6 changes: 3 additions & 3 deletions src/devnet/config/devnet/genesis-shelley.json
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
"609783be7d3c54f11377966dfabc9284cd6c32fca1cd42ef0a4f1cc45b": 900000000000
},
"maxKESEvolutions": 60,
"maxLovelaceSupply": 2000000000000,
"maxLovelaceSupply": 45000000000000000,
"networkId": "Testnet",
"networkMagic": 42,
"protocolParams": {
Expand All @@ -33,8 +33,8 @@
"major": 7,
"minor": 0
},
"rho": 0.1,
"tau": 0.1
"rho": 0.003,
"tau": 0.0
},
"slotsPerKESPeriod": 129600,
"staking": {
Expand Down
3 changes: 3 additions & 0 deletions src/devnet/convex-devnet.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -109,3 +110,5 @@ test-suite convex-devnet-test
, mtl
, text
, aeson
, containers
, filepath
Loading

0 comments on commit beb2d6f

Please sign in to comment.