Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Try reverting "Add SMASH integration test" #2345

Closed
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 1 addition & 15 deletions lib/core-integration/src/Test/Integration/Framework/DSL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,6 @@ module Test.Integration.Framework.DSL
, oneSecond
, getTTLSlots
, updateMetadataSource
, bracketSettings
, verifyMetadataSource
, triggerMaintenanceAction
, verifyMaintenanceAction
Expand Down Expand Up @@ -213,7 +212,6 @@ import Cardano.Wallet.Api.Types
, DecodeStakeAddress (..)
, EncodeAddress (..)
, Iso8601Time (..)
, SettingsPutData (..)
, WalletStyle (..)
, insertedAt
)
Expand Down Expand Up @@ -603,7 +601,7 @@ defaultTxTTL = 7200
--
updateMetadataSource :: (MonadIO m, MonadCatch m) => Context t -> Text -> m ()
updateMetadataSource ctx t = do
r <- request @SettingsPutData ctx Link.putSettings Default payload
r <- request @(ApiT Settings) ctx Link.putSettings Default payload
expectResponseCode HTTP.status204 r
where
payload = Json [aesonQQ| {
Expand All @@ -612,18 +610,6 @@ updateMetadataSource ctx t = do
}
} |]

bracketSettings :: (MonadIO m, MonadCatch m) => Context t -> m () -> m ()
bracketSettings ctx action = do
r@(_, response) <- request @(ApiT Settings) ctx Link.getSettings Default Empty
expectResponseCode HTTP.status200 r
case response of
Left e -> wantedSuccessButError e
Right s -> do
action
r' <- request @SettingsPutData ctx Link.putSettings Default
(Json $ Aeson.toJSON $ SettingsPutData s)
expectResponseCode HTTP.status204 r'

verifyMetadataSource
:: (MonadIO m, MonadCatch m)
=> Context t
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,7 @@ import Prelude

import Cardano.Wallet.Api.Types
( ApiCertificate (JoinPool, QuitPool, RegisterRewardAccount)
, ApiStakePool (flags)
, ApiStakePoolFlag (..)
, ApiStakePool
, ApiT (..)
, ApiTransaction
, ApiWallet
Expand Down Expand Up @@ -78,8 +77,6 @@ import Data.Text.Class
( showT, toText )
import Numeric.Natural
( Natural )
import System.Environment
( getEnv )
import Test.Hspec
( SpecWith, describe, pendingWith )
import Test.Hspec.Expectations.Lifted
Expand All @@ -91,7 +88,6 @@ import Test.Integration.Framework.Context
import Test.Integration.Framework.DSL
( Headers (..)
, Payload (..)
, bracketSettings
, delegating
, delegationFee
, emptyWallet
Expand Down Expand Up @@ -142,7 +138,6 @@ import Test.Integration.Framework.TestData
import qualified Cardano.Wallet.Api.Link as Link
import qualified Data.ByteString as BS
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Network.HTTP.Types.Status as HTTP

spec :: forall n t.
Expand All @@ -156,7 +151,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
(Link.listStakePools stake) Default Empty

it "STAKE_POOLS_MAINTENANCE_01 - \
\trigger GC action when metadata source = direct" $ \ctx -> runResourceT $ bracketSettings ctx $ do
\trigger GC action when metadata source = direct" $ \ctx -> runResourceT $ do
updateMetadataSource ctx "direct"
verifyMetadataSource ctx FetchDirect
triggerMaintenanceAction ctx "gc_stake_pools"
Expand All @@ -166,7 +161,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
verifyMaintenanceAction ctx NotApplicable

it "STAKE_POOLS_MAINTENANCE_02 - \
\trigger GC action when metadata source = none" $ \ctx -> runResourceT $ bracketSettings ctx $ do
\trigger GC action when metadata source = none" $ \ctx -> runResourceT $ do
updateMetadataSource ctx "none"
verifyMetadataSource ctx FetchNone
triggerMaintenanceAction ctx "gc_stake_pools"
Expand Down Expand Up @@ -968,10 +963,37 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
production `shouldSatisfy` (> 0)
saturation `shouldSatisfy` (any (> 0))

it "contains pool metadata" $ \ctx -> runResourceT $ bracketSettings ctx $ do
it "contains pool metadata" $ \ctx -> runResourceT $ do
updateMetadataSource ctx "direct"
eventually "metadata is fetched" $ do
r <- listPools ctx arbitraryStake
let metadataPossible = Set.fromList
[ StakePoolMetadata
{ ticker = (StakePoolTicker "GPA")
, name = "Genesis Pool A"
, description = Nothing
, homepage = "https://iohk.io"
}
, StakePoolMetadata
{ ticker = (StakePoolTicker "GPB")
, name = "Genesis Pool B"
, description = Nothing
, homepage = "https://iohk.io"
}
, StakePoolMetadata
{ ticker = (StakePoolTicker "GPC")
, name = "Genesis Pool C"
, description = Just "Lorem Ipsum Dolor Sit Amet."
, homepage = "https://iohk.io"
}
, StakePoolMetadata
{ ticker = (StakePoolTicker "GPD")
, name = "Genesis Pool D"
, description = Just "Lorem Ipsum Dolor Sit Amet."
, homepage = "https://iohk.io"
}
]

verify r
[ expectListSize 3
, expectField Prelude.id $ \pools' -> do
Expand Down Expand Up @@ -1099,74 +1121,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
let epochs = poolGarbageCollectionEpochNo <$> events
(reverse epochs `zip` [1 ..]) `shouldSatisfy` all (uncurry (==))

it "STAKE_POOLS_SMASH_01 - fetching metadata from SMASH works with delisted pools" $
\ctx -> runResourceT $ bracketSettings ctx $ do
smashUrl <- liftIO $ getEnv "CARDANO_WALLET_SMASH_URL"
updateMetadataSource ctx (T.pack smashUrl)
eventually "metadata is fetched" $ do
r <- listPools ctx arbitraryStake
verify r
[ expectListSize 3
, expectField Prelude.id $ \pools' -> do
let metadataActual = Set.fromList $
mapMaybe (fmap getApiT . view #metadata) pools'
delistedPools = filter (\pool -> Delisted `elem` flags pool)
pools'
metadataActual
`shouldSatisfy` (`Set.isSubsetOf` metadataPossible)
metadataActual
`shouldSatisfy` (not . Set.null)
(fmap (getApiT . view #id) delistedPools)
`shouldBe` [PoolId . unsafeFromHex $
"b45768c1a2da4bd13ebcaa1ea51408eda31dcc21765ccbd407cda9f2"]
]

updateMetadataSource ctx "direct"
eventually "pools are not delisted anymore" $ do
r <- listPools ctx arbitraryStake
verify r
[ expectListSize 3
, expectField Prelude.id $ \pools' -> do
let metadataActual = Set.fromList $
mapMaybe (fmap getApiT . view #metadata) pools'
delistedPools = filter (\pool -> Delisted `elem` flags pool)
pools'
metadataActual
`shouldSatisfy` (`Set.isSubsetOf` metadataPossible)
metadataActual
`shouldSatisfy` (not . Set.null)
(fmap (getApiT . view #id) delistedPools)
`shouldBe` []
]

where
metadataPossible = Set.fromList
[ StakePoolMetadata
{ ticker = (StakePoolTicker "GPA")
, name = "Genesis Pool A"
, description = Nothing
, homepage = "https://iohk.io"
}
, StakePoolMetadata
{ ticker = (StakePoolTicker "GPB")
, name = "Genesis Pool B"
, description = Nothing
, homepage = "https://iohk.io"
}
, StakePoolMetadata
{ ticker = (StakePoolTicker "GPC")
, name = "Genesis Pool C"
, description = Just "Lorem Ipsum Dolor Sit Amet."
, homepage = "https://iohk.io"
}
, StakePoolMetadata
{ ticker = (StakePoolTicker "GPD")
, name = "Genesis Pool D"
, description = Just "Lorem Ipsum Dolor Sit Amet."
, homepage = "https://iohk.io"
}
]

arbitraryStake :: Maybe Coin
arbitraryStake = Just $ ada 10_000_000_000
where ada = Coin . (1000*1000*)
Expand Down
3 changes: 1 addition & 2 deletions lib/core/src/Cardano/Pool/DB/Model.hs
Original file line number Diff line number Diff line change
Expand Up @@ -209,10 +209,9 @@ mCleanDatabase :: ModelOp ()
mCleanDatabase = State.put emptyPoolDatabase

mCleanPoolMetadata :: ModelOp ()
mCleanPoolMetadata = do
mCleanPoolMetadata =
modify #metadata
$ const mempty
mPutDelistedPools []

mPutPoolProduction :: BlockHeader -> PoolId -> ModelOp ()
mPutPoolProduction point poolId = getPoints >>= \points -> if
Expand Down
1 change: 0 additions & 1 deletion lib/core/src/Cardano/Pool/DB/Sqlite.hs
Original file line number Diff line number Diff line change
Expand Up @@ -404,7 +404,6 @@ newDBLayer trace fp timeInterpreter = do
removePoolMetadata = do
deleteWhere ([] :: [Filter PoolMetadata])
deleteWhere ([] :: [Filter PoolMetadataFetchAttempts])
deleteWhere ([] :: [Filter PoolDelistment])

readPoolMetadata = do
Map.fromList . map (fromPoolMeta . entityVal)
Expand Down
3 changes: 0 additions & 3 deletions lib/core/src/Cardano/Pool/Metadata.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,9 +27,6 @@ module Cardano.Pool.Metadata
-- * re-exports
, newManager
, defaultManagerSettings

-- * Types
, SMASHPoolId (..)
) where

import Prelude
Expand Down
32 changes: 0 additions & 32 deletions lib/core/test/unit/Cardano/Pool/DB/Properties.hs
Original file line number Diff line number Diff line change
Expand Up @@ -225,8 +225,6 @@ properties = do
(property . prop_putLastMetadataGCReadLastMetadataGC)
it "putDelistedPools >> readDelistedPools shows the pool as delisted"
(property . prop_putDelistedPools)
it "clearing metadata also clears delisted pools"
(property . prop_removePoolMetadataDelistedPools)

{-------------------------------------------------------------------------------
Properties
Expand Down Expand Up @@ -1459,36 +1457,6 @@ prop_putLastMetadataGCReadLastMetadataGC DBLayer{..} posixTime = do
assertWith "Setting sync time and reading afterwards works"
(time == Just posixTime)

-- Check that removing pool metadata removes delisted pools.
prop_removePoolMetadataDelistedPools
:: DBLayer IO
-> Set.Set PoolId
-> Property
prop_removePoolMetadataDelistedPools DBLayer {..} pools =
monadicIO (setup >> prop)
where
setup = run $ atomically cleanDB

prop = do
run $ atomically $ putDelistedPools (Set.toList pools)
poolsActuallyDelisted <- Set.fromList . L.sort <$>
run (atomically readDelistedPools)
monitor $ counterexample $ unlines
[ "Pools to mark as delisted: "
, pretty $ Set.toList pools
, "Pools actually delisted: "
, pretty $ Set.toList poolsActuallyDelisted
]
assertWith "pools == poolsActuallyDelisted"
$ pools == poolsActuallyDelisted

-- now should be empty
run $ atomically removePoolMetadata
poolsAfter <- Set.fromList . L.sort <$>
run (atomically readDelistedPools)
assertWith "[] == poolsAfter"
$ null (Set.toList poolsAfter)

-- Check that 'putDelistedPools' completely overwrites the existing set
-- of delisted pools every time:
--
Expand Down
48 changes: 4 additions & 44 deletions lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,6 @@ module Cardano.Wallet.Shelley.Launch
withCluster
, withBFTNode
, withStakePool
, withSMASH
, NodeParams (..)
, singleNodeParams
, PoolConfig (..)
Expand All @@ -54,9 +53,6 @@ module Cardano.Wallet.Shelley.Launch
, testLogDirFromEnv
, walletListenFromEnv

-- * global vars
, operators

-- * Logging
, ClusterLog (..)
) where
Expand Down Expand Up @@ -89,8 +85,6 @@ import Cardano.Launcher.Node
, NodePort (..)
, withCardanoNode
)
import Cardano.Pool.Metadata
( SMASHPoolId (..) )
import Cardano.Wallet.Api.Server
( Listen (..) )
import Cardano.Wallet.Logging
Expand Down Expand Up @@ -128,7 +122,7 @@ import Control.Concurrent.Async
import Control.Concurrent.Chan
( newChan, readChan, writeChan )
import Control.Concurrent.MVar
( MVar, modifyMVar, newMVar, putMVar, readMVar, takeMVar )
( MVar, modifyMVar, newMVar, putMVar, takeMVar )
import Control.Exception
( SomeException, finally, handle, throwIO )
import Control.Monad
Expand Down Expand Up @@ -827,40 +821,6 @@ withStakePool tr baseDir idx params pledgeAmt poolConfig action =
dir = baseDir </> name
name = "pool-" ++ show idx

-- | Run a SMASH stub server, serving some delisted pool IDs.
withSMASH
:: Tracer IO ClusterLog
-> IO a
-> IO a
withSMASH tr action =
withSystemTempDir tr "smash" $ \fp -> do
let baseDir = fp </> "api/v1"

-- write pool metadatas
pools <- readMVar operators
forM_ pools $ \(poolId, _, _, _, metadata) -> do
let bytes = Aeson.encode metadata

let metadataDir = baseDir </> "metadata"
poolDir = metadataDir </> T.unpack (toText poolId)
hash = blake2b256S (BL.toStrict bytes)
hashFile = poolDir </> hash

createDirectoryIfMissing True poolDir
BL8.writeFile (poolDir </> hashFile) bytes

-- write delisted pools
let delisted = [SMASHPoolId (T.pack
"b45768c1a2da4bd13ebcaa1ea51408eda31dcc21765ccbd407cda9f2")]
bytes = Aeson.encode delisted
BL8.writeFile (baseDir </> "delisted") bytes

withStaticServer fp $ \baseUrl -> do
setEnv envVar baseUrl
action
where
envVar :: String
envVar = "CARDANO_WALLET_SMASH_URL"

updateVersion :: Tracer IO ClusterLog -> FilePath -> IO ()
updateVersion tr tmpDir = do
Expand Down Expand Up @@ -1444,7 +1404,7 @@ faucetIndex = unsafePerformIO $ newMVar 1
operators :: MVar [(PoolId, Aeson.Value, Aeson.Value, Aeson.Value, Aeson.Value)]
operators = unsafePerformIO $ newMVar
[ ( PoolId $ unsafeFromHex
"ec28f33dcbe6d6400a1e5e339bd0647c0973ca6c0cf9c2bbe6838dc6"
"c7258ccc42a43b653aaf2f80dde3120df124ebc3a79353eed782267f78d04739"
, Aeson.object
[ "type" .= Aeson.String "StakePoolVerificationKey_ed25519"
, "description" .= Aeson.String "Stake pool operator key"
Expand All @@ -1471,7 +1431,7 @@ operators = unsafePerformIO $ newMVar
]
)
, ( PoolId $ unsafeFromHex
"1b3dc19c6ab89eaffc8501f375bb03c11bf8ed5d183736b1d80413d6"
"775af3b22eff9ff53a0bdd3ac6f8e1c5013ab68445768c476ccfc1e1c6b629b4"
, Aeson.object
[ "type" .= Aeson.String "StakePoolVerificationKey_ed25519"
, "description" .= Aeson.String "Stake pool operator key"
Expand All @@ -1498,7 +1458,7 @@ operators = unsafePerformIO $ newMVar
]
)
, ( PoolId $ unsafeFromHex
"b45768c1a2da4bd13ebcaa1ea51408eda31dcc21765ccbd407cda9f2"
"5a7b67c7dcfa8c4c25796bea05bcdfca01590c8c7612cc537c97012bed0dec35"
, Aeson.object
[ "type" .= Aeson.String "StakePoolVerificationKey_ed25519"
, "description" .= Aeson.String "Stake pool operator key"
Expand Down
Loading