diff --git a/cabal.project b/cabal.project index 855ad8121e4..57b2d2d9ce4 100644 --- a/cabal.project +++ b/cabal.project @@ -31,8 +31,8 @@ packages: trace-resources trace-forward -program-options - ghc-options: -Werror +-- program-options +-- ghc-options: -Werror test-show-details: direct diff --git a/cardano-testnet/src/Testnet/Components/SPO.hs b/cardano-testnet/src/Testnet/Components/SPO.hs index a8a4b5def0f..78b024ccc29 100644 --- a/cardano-testnet/src/Testnet/Components/SPO.hs +++ b/cardano-testnet/src/Testnet/Components/SPO.hs @@ -3,6 +3,7 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} module Testnet.Components.SPO @@ -15,17 +16,14 @@ module Testnet.Components.SPO , registerSingleSpo ) where +import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley hiding (cardanoEra) import qualified Cardano.Ledger.Api.State.Query as L -import qualified Cardano.Ledger.Coin as L -import qualified Cardano.Ledger.Credential as L -import qualified Cardano.Ledger.Keys as L import qualified Cardano.Ledger.Shelley.LedgerState as L import Control.Monad import Control.Monad.Catch (MonadCatch) -import Control.Monad.State.Strict (StateT) import Control.Monad.State.Strict as StateT import qualified Data.Aeson as Aeson import Data.Map.Strict (Map) @@ -45,7 +43,7 @@ import Testnet.Property.Utils import Testnet.Start.Types import Hedgehog -import Hedgehog.Extras (ExecConfig, threadDelay) +import Hedgehog.Extras (ExecConfig) import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H @@ -89,7 +87,7 @@ checkStakeKeyRegistered => TmpAbsolutePath -> NodeConfigFile 'In -> SocketPath - -> EpochNo + -> EpochNo -- ^ Termination epoch -> ExecConfig -> String -- ^ Stake address -> FilePath -- ^ Output file path of stake address info @@ -112,7 +110,6 @@ checkStakeKeyRegistered tempAbsP nodeConfigFile sPath terminationEpoch execConfi case result of Right (_, dag) -> return dag Left e -> do - void $ execCli' execConfig [ "query", "stake-address-info" , "--address", stakeAddr @@ -130,20 +127,31 @@ checkStakeKeyRegistered tempAbsP nodeConfigFile sPath terminationEpoch execConfi , "foldEpochStateError: " <> show e ] where - handler :: StakeAddress -> AnyNewEpochState -> StateT DelegationsAndRewards IO LedgerStateCondition - handler (StakeAddress _ sCred) (AnyNewEpochState sbe newEpochState) = + handler :: StakeAddress -> AnyNewEpochState -> SlotNo -> BlockNo -> StateT DelegationsAndRewards IO LedgerStateCondition + handler (StakeAddress network sCred) (AnyNewEpochState sbe newEpochState) _ _ = let umap = shelleyBasedEraConstraints sbe $ newEpochState ^. L.nesEsL . L.epochStateUMapL dag@(registeredStakeCredentials, _) = L.filterStakePoolDelegsAndRewards umap $ Set.singleton sCred - delegsAndRewards = toDelegationsAndRewards dag + delegsAndRewards = shelleyBasedEraConstraints sbe $ toDelegationsAndRewards network sbe dag in case Map.lookup sCred registeredStakeCredentials of Nothing -> return ConditionNotMet Just _ -> StateT.put delegsAndRewards >> return ConditionMet toDelegationsAndRewards - :: (Map (L.Credential L.Staking c) (L.KeyHash L.StakePool c), Map (L.Credential 'L.Staking c) L.Coin) + :: L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto + => L.Network + -> ShelleyBasedEra era + -> (Map (L.Credential L.Staking (L.EraCrypto (ShelleyLedgerEra era))) (L.KeyHash L.StakePool (L.EraCrypto (ShelleyLedgerEra era))), Map (L.Credential 'L.Staking (L.EraCrypto (ShelleyLedgerEra era))) L.Coin) -> DelegationsAndRewards - toDelegationsAndRewards = error "TODO" + toDelegationsAndRewards n _ (delegationMap, rewardsMap) = + let apiDelegationMap = Map.map toApiPoolId $ Map.mapKeys (toApiStakeAddress n) delegationMap + apiRewardsMap = Map.mapKeys (toApiStakeAddress n) rewardsMap + in DelegationsAndRewards (apiRewardsMap, apiDelegationMap) + +toApiStakeAddress :: L.Network -> L.Credential 'L.Staking L.StandardCrypto -> StakeAddress +toApiStakeAddress = StakeAddress +toApiPoolId :: L.KeyHash L.StakePool L.StandardCrypto -> PoolId +toApiPoolId = StakePoolKeyHash createStakeDelegationCertificate :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) @@ -213,6 +221,9 @@ registerSingleSpo :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => Int -- ^ Identifier for stake pool -> TmpAbsolutePath + -> NodeConfigFile 'In + -> SocketPath + -> EpochNo -- ^ Termination epoch -> CardanoTestnetOptions -> ExecConfig -> (TxIn, FilePath, String) @@ -227,7 +238,7 @@ registerSingleSpo -- 3. FilePath: Stake pool cold verification key -- 4. FilePath: Stake pool VRF signing key -- 5. FilePath: Stake pool VRF verification key -registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions execConfig +registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile socketPath termEpoch cTestnetOptions execConfig (fundingInput, fundingSigninKey, changeAddr) = GHC.withFrozenCallStack $ do let testnetMag = cardanoTestnetMagic cTestnetOptions eraFlag= convertToEraFlag $ cardanoNodeEra cTestnetOptions @@ -348,18 +359,17 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions ] -- TODO: Currently we can't propagate the error message thrown by checkStakeKeyRegistered when using byDurationM -- Instead we wait 15 seconds - threadDelay 15_000000 + -- Check the pledger/owner stake key was registered delegsAndRewards <- - checkStakeKeyRegistered - undefined - undefined - undefined - undefined - tap - execConfig - poolownerstakeaddr - ("spo-"<> show identifier <> "-requirements" "pledger.stake.info") + checkStakeKeyRegistered + tap + nodeConfigFile + socketPath + termEpoch + execConfig + poolownerstakeaddr + ("spo-"<> show identifier <> "-requirements" "pledger.stake.info") (pledgerSAddr, _rewards, _poolId) <- H.headM $ mergeDelegsAndRewards delegsAndRewards diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs index 80afa1b97c1..89e980ff517 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs @@ -47,7 +47,6 @@ import Testnet.Runtime import Hedgehog (Property, (===)) import qualified Hedgehog as H -import Hedgehog.Extras (threadDelay) import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H @@ -92,9 +91,17 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" UTxO utxo1 <- H.noteShowM $ decodeEraUTxO sbe utxo1Json txin1 <- H.noteShow =<< H.headM (Map.keys utxo1) - + let node1SocketPath = Api.File $ IO.sprocketSystemName node1sprocket + nodeConfigFile = Api.File configurationFile + termEpoch = 15 (stakePoolIdNewSpo, stakePoolColdSigningKey, stakePoolColdVKey, vrfSkey, _) - <- registerSingleSpo 1 tempAbsPath cTestnetOptions execConfig (txin1, utxoSKeyFile, utxoAddr) + <- registerSingleSpo 1 tempAbsPath + (Api.File configurationFile) + node1SocketPath + 10 + cTestnetOptions + execConfig + (txin1, utxoSKeyFile, utxoAddr) -- Create test stake address to delegate to the new stake pool -- NB: We need to fund the payment credential of the overall address @@ -193,14 +200,14 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch , "--tx-file", delegRegTestDelegatorTxFp ] - -- TODO: Can be removed if checkStakeKeyRegistered uses foldEpochState - threadDelay 15_000000 - ------------------------------------------------------------------- let testDelegatorStakeAddressInfoOutFp = work "test-delegator-stake-address-info.json" void $ checkStakeKeyRegistered tempAbsPath + nodeConfigFile + node1SocketPath + termEpoch execConfig testDelegatorStakeAddress testDelegatorStakeAddressInfoOutFp @@ -257,7 +264,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch -- Wait for 2 epochs to pass void $ waitUntilEpoch (Api.File configurationFile) - (Api.File $ IO.sprocketSystemName node1sprocket) (EpochNo 3) + node1SocketPath (EpochNo 3) currentLeaderShipScheduleFile <- H.noteTempFile work "current-schedule.log" diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs index cc7c7c90e91..2c11964665f 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs @@ -42,6 +42,7 @@ import Hedgehog (Property) import qualified Hedgehog as H import Hedgehog.Extras (threadDelay) import Hedgehog.Extras.Stock (sprocketSystemName) +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H @@ -85,8 +86,17 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA UTxO utxo1 <- H.noteShowM $ decodeEraUTxO sbe utxo1Json txin1 <- H.noteShow =<< H.headM (Map.keys utxo1) + let node1SocketPath = Api.File $ IO.sprocketSystemName node1sprocket + nodeConfigFile = Api.File configurationFile + termEpoch = 15 (stakePoolId, stakePoolColdSigningKey, stakePoolColdVKey, _, _) - <- registerSingleSpo 1 tempAbsPath cTestnetOptions execConfig (txin1, utxoSKeyFile, utxoAddr) + <- registerSingleSpo 1 tempAbsPath + nodeConfigFile + node1SocketPath + termEpoch + cTestnetOptions + execConfig + (txin1, utxoSKeyFile, utxoAddr) -- Create test stake address to delegate to the new stake pool -- NB: We need to fund the payment credential of the overall address @@ -185,11 +195,12 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA , "--tx-file", delegRegTestDelegatorTxFp ] - threadDelay 20_000_000 - let testDelegatorStakeAddressInfoOutFp = work "test-delegator-stake-address-info.json" void $ checkStakeKeyRegistered tempAbsPath + nodeConfigFile + node1SocketPath + termEpoch execConfig testDelegatorStakeAddress testDelegatorStakeAddressInfoOutFp