diff --git a/wallet-new/README.md b/wallet-new/README.md index b979add6d32..d4c9f5a2732 100755 --- a/wallet-new/README.md +++ b/wallet-new/README.md @@ -188,14 +188,17 @@ $ nix-build -A walletIntegrationTests --arg useStackBinaries true > test, you can pass the `--check` flag to force the test to run again. `--check` > is used to confirm that results from one test match the results again. -Wallet integration tests can be used also with seed/match options that behave like hspec test runner (and are passed to). ---match PATTERN - behave exactly like Hspec's --match allowing to run only a subset of tests ---seed SEED - enable passing an external, predictable seed to the test runner -Example allowing the use of concrete seed and testing Address related tests only: - +The wallet integration tests support --hspec-options to pass options to HSpec. +This can be used to set a seed for the PRNG, only run a matching set of tests or to +skip some tests. +Examples: ``` $ nix-build -A walletIntegrationTests -o launch_integration_tests -$ ./launch_integration_tests --match 'Address' --seed 47286650 +$ ./launch_integration_tests --hspec-options '--skip Address --seed 47286650' + +$ nix-build -A walletIntegrationTests -o launch_integration_tests +$ ./launch_integration_tests --hspec-options '--match Address --seed 47286650' + ``` diff --git a/wallet-new/cardano-sl-wallet-new.cabal b/wallet-new/cardano-sl-wallet-new.cabal index 6d59b3d94f3..e251e8db157 100755 --- a/wallet-new/cardano-sl-wallet-new.cabal +++ b/wallet-new/cardano-sl-wallet-new.cabal @@ -363,12 +363,13 @@ executable wal-integr-test -O2 other-modules: CLI Types - Functions Error Util WalletSpecs AccountSpecs AddressSpecs + RandomStateWalk + SetupTestEnv TransactionSpecs QuickCheckSpecs diff --git a/wallet-new/integration/AccountSpecs.hs b/wallet-new/integration/AccountSpecs.hs index 19ab9deba25..0ae9fd48a61 100644 --- a/wallet-new/integration/AccountSpecs.hs +++ b/wallet-new/integration/AccountSpecs.hs @@ -10,7 +10,6 @@ import Cardano.Wallet.API.Indices (accessIx) import Cardano.Wallet.Client.Http import Control.Lens import qualified Data.Text as T -import Functions (randomTest) import Pos.Core.Common (mkCoin) import Test.Hspec import Test.QuickCheck (arbitrary, shuffle) diff --git a/wallet-new/integration/AddressSpecs.hs b/wallet-new/integration/AddressSpecs.hs index 8c302ce00ba..0320ffd67e6 100644 --- a/wallet-new/integration/AddressSpecs.hs +++ b/wallet-new/integration/AddressSpecs.hs @@ -7,14 +7,11 @@ import Universum import Cardano.Wallet.Client.Http import Control.Lens -import Functions (randomTest) import Test.Hspec import Test.QuickCheck.Monadic (run) - import Util - addressSpecs :: WalletRef -> WalletClient IO -> Spec addressSpecs wRef wc = do describe "Addresses" $ do diff --git a/wallet-new/integration/CLI.hs b/wallet-new/integration/CLI.hs index 0898505b177..ae3a121603b 100644 --- a/wallet-new/integration/CLI.hs +++ b/wallet-new/integration/CLI.hs @@ -3,17 +3,16 @@ -- | Functions for working with command-line options. module CLI - ( CLOptions (..) + ( CLIOptions (..) , getOptions ) where -import Universum - +import Data.String (words) import Options.Applicative - +import Universum -- | Parser for command-line options. -optionsParser :: Parser CLOptions +optionsParser :: Parser CLIOptions optionsParser = do tlsClientCertPath <- strOption $ long "tls-client-cert" @@ -44,24 +43,18 @@ optionsParser = do <> help "Server port" <> showDefault - testRunnerMatch <- optional . strOption $ - long "match" - <> metavar "PATTERN" - <> help "Only tests that match PATTERN will be run" + hSpecOptions <- fmap Data.String.words $ strOption $ + long "hspec-options" + <> metavar "OPTIONS" + <> value "" + <> help "extra options to pass to HSpec" <> showDefault - testRunnerSeed <- optional . option auto $ - long "seed" - <> metavar "SEED" - <> help "Seed for a test runner" - <> showDefault - - - pure CLOptions{..} + pure CLIOptions{..} -- | Get command-line options. -getOptions :: IO CLOptions +getOptions :: IO CLIOptions getOptions = execParser programInfo where programInfo = info (helper <*> optionsParser) $ @@ -70,12 +63,11 @@ getOptions = execParser programInfo -- | The configuration for the application. -data CLOptions = CLOptions +data CLIOptions = CLIOptions { tlsClientCertPath :: FilePath , tlsPrivKeyPath :: FilePath , tlsCACertPath :: FilePath , serverHost :: String , serverPort :: Int - , testRunnerMatch :: Maybe String - , testRunnerSeed :: Maybe Integer + , hSpecOptions :: [String] } deriving (Show, Eq) diff --git a/wallet-new/integration/Main.hs b/wallet-new/integration/Main.hs index 44d38bb002d..a489f07f8cf 100644 --- a/wallet-new/integration/Main.hs +++ b/wallet-new/integration/Main.hs @@ -5,115 +5,43 @@ module Main where import Universum -import Cardano.Wallet.Client.Http -import Data.Map (fromList) -import Data.Traversable (for) -import Data.X509.File (readSignedObject) +import Cardano.Wallet.Client.Http (WalletClient) import Network.HTTP.Client (Manager) +import qualified QuickCheckSpecs as QuickCheck import System.Environment (withArgs) -import System.IO (hSetEncoding, stdout, utf8) -import Test.Hspec +import Test.Hspec (Spec, hspec) import AccountSpecs (accountSpecs) import AddressSpecs (addressSpecs) -import CLI -import Functions +import CLI (CLIOptions (..), getOptions) +import RandomStateWalk (randomStateWalkTest) +import SetupTestEnv (setupClient) +import System.IO (hSetEncoding, stdout, utf8) import TransactionSpecs (transactionSpecs) -import Types -import Util (WalletRef, newWalletRef) +import Util (WalletRef, newWalletRef, printT) import WalletSpecs (walletSpecs) -import qualified Data.ByteString.Char8 as B8 -import qualified QuickCheckSpecs as QuickCheck - - --- | Here we want to run main when the (local) nodes --- have started. +-- | Here we want to run main when the (local) nodes have started. main :: IO () main = do hSetEncoding stdout utf8 - CLOptions {..} <- getOptions - - -- TODO (akegalj): run server cluster in haskell, instead of using shell scripts - -- serverThread <- async (runWalletServer options) + options@CLIOptions {..} <- getOptions printT "Starting the integration testing for wallet." - - let serverId = (serverHost, B8.pack $ show serverPort) - caChain <- readSignedObject tlsCACertPath - clientCredentials <- orFail =<< credentialLoadX509 tlsClientCertPath tlsPrivKeyPath - manager <- newManager $ mkHttpsManagerSettings serverId caChain clientCredentials - - let baseUrl = BaseUrl Https serverHost serverPort mempty - - let walletClient :: MonadIO m => WalletClient m - walletClient = withThrottlingRetry - . liftClient - $ mkHttpClient baseUrl manager - + (walletClient, manager) <- setupClient options -- Acquire the initial state for the deterministic tests wRef <- newWalletRef - -- NOTE Our own CLI options interfere with `hspec` which parse them for - -- itself when executed, leading to a VERY unclear message: - -- - -- cardano-integration-test: unrecognized option `--tls-ca-cert' - -- Try `cardano-integration-test --help' for more information. - -- - -- See also: https://github.com/hspec/hspec/issues/135 - - let optionsFromAbove = case (testRunnerMatch, testRunnerSeed) of - (Nothing, Nothing) -> [] - (Nothing, Just seed) -> ["--seed", show seed] - (Just match, Nothing) -> ["-m", match] - (Just match, Just seed) -> ["-m", match, "--seed", show seed] - - withArgs optionsFromAbove $ do +-- main uses its own argument parsing. +-- Don't use 'hspec $ do' it would cause strange error messages, +-- because hspec would try to interpret the integration-test cmd arguments. + withArgs hSpecOptions $ do printT "Starting deterministic tests." - printT $ "match from options: " <> show testRunnerMatch - printT $ "seed from options: " <> show testRunnerSeed - + printT $ "HSpec options: " <> show hSpecOptions hspec $ deterministicTests wRef walletClient manager printT $ "The 'runActionCheck' tests were disabled because they were highly un-reliable." - when False $ do - walletState <- initialWalletState walletClient - - printT $ "Initial wallet state: " <> show walletState - - -- some monadic fold or smth similar - void $ runActionCheck - walletClient - walletState - actionDistribution - where - orFail :: MonadFail m => Either String a -> m a - orFail = - either (fail . ("Error decoding X509 certificates: " <>)) return - - actionDistribution :: ActionProbabilities - actionDistribution = - (PostWallet, Weight 2) - :| (PostTransaction, Weight 5) - : fmap (, Weight 1) [minBound .. maxBound] - -initialWalletState :: WalletClient IO -> IO WalletState -initialWalletState wc = do - -- We will have single genesis wallet in intial state that was imported from launching script - _wallets <- fromResp $ getWallets wc - _accounts <- concat <$> for _wallets (fromResp . getAccounts wc . walId) - -- Lets set all wallet passwords for initial wallets (genesis) to default (emptyPassphrase) - let _lastAction = NoOp - _walletsPass = fromList $ map ((, V1 mempty) . walId) _wallets - _addresses = concatMap accAddresses _accounts - -- TODO(akegalj): I am not sure does importing a genesis wallet (which we do prior launching integration tests) creates a transaction - -- If it does, we should add this transaction to the list - _transactions = mempty - _actionsNum = 0 - _successActions = mempty - return WalletState {..} - where - fromResp = (either throwM (pure . wrData) =<<) + when False $ randomStateWalkTest walletClient deterministicTests :: WalletRef -> WalletClient IO -> Manager -> Spec deterministicTests wref wc manager = do diff --git a/wallet-new/integration/Functions.hs b/wallet-new/integration/RandomStateWalk.hs similarity index 94% rename from wallet-new/integration/Functions.hs rename to wallet-new/integration/RandomStateWalk.hs index 266157ba274..4a1fa10fb26 100644 --- a/wallet-new/integration/Functions.hs +++ b/wallet-new/integration/RandomStateWalk.hs @@ -7,11 +7,8 @@ {-# LANGUAGE TypeApplications #-} -module Functions - ( runActionCheck - , printT - , randomTest - ) where +module RandomStateWalk (randomStateWalkTest) +where import Universum hiding (init, throwM, uncons) @@ -23,16 +20,18 @@ import Data.Aeson.Diff (diff) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Coerce (coerce) import Data.List (isInfixOf, nub, uncons, (!!), (\\)) +import Data.Map (fromList) +import Data.Traversable (for) + import Servant.Client (GenResponse (..)) -import Test.Hspec (Spec, describe, expectationFailure, hspec, - shouldBe, shouldContain) +import Test.Hspec (describe, expectationFailure, hspec, shouldBe, + shouldContain) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (arbitrary, choose, elements, frequency, quickCheck, suchThat, withMaxSuccess) import Test.QuickCheck.Monadic (PropertyM, monadic, monadicIO, pick, pre, run, stop) -import Test.QuickCheck.Property (Property, Testable, ioProperty, - rejected) +import Test.QuickCheck.Property (Property, ioProperty, rejected) import Text.Show.Pretty (ppShow) import Cardano.Wallet.API.Response (WalletResponse (..)) @@ -50,6 +49,13 @@ import Error (WalletTestError (..)) import Types import Util +randomStateWalkTest :: WalletClient IO -> IO () +randomStateWalkTest walletClient = do + printT "Starting the integration testing for wallet." + walletState <- initialWalletState walletClient + printT $ "Initial wallet state: " <> show walletState + void $ runActionCheck walletClient walletState actionDistribution + newtype RefT s m a = RefT { unRefT :: ReaderT (IORef s) m a @@ -722,13 +728,33 @@ checkInvariant checkInvariant True _ = pure () checkInvariant False walletTestErr = liftIO $ throwM walletTestErr +actionDistribution :: ActionProbabilities +actionDistribution = + (PostWallet, Weight 2) + :| (PostTransaction, Weight 5) + : fmap (, Weight 1) [minBound .. maxBound] + +initialWalletState :: WalletClient IO -> IO WalletState +initialWalletState wc = do + -- We will have single genesis wallet in intial state that was imported from launching script + _wallets <- fromResp $ getWallets wc + _accounts <- concat <$> for _wallets (fromResp . getAccounts wc . walId) + -- Lets set all wallet passwords for initial wallets (genesis) to default (emptyPassphrase) + let _lastAction = NoOp + _walletsPass = fromList $ map ((, V1 mempty) . walId) _wallets + _addresses = concatMap accAddresses _accounts + -- TODO(akegalj): I am not sure does importing a genesis wallet (which we do prior launching integration tests) creates a transaction + -- If it does, we should add this transaction to the list + _transactions = mempty + _actionsNum = 0 + _successActions = mempty + return WalletState {..} + where + fromResp = (either throwM (pure . wrData) =<<) + log :: MonadIO m => Text -> m () log = putStrLn . mappend "[TEST-LOG] " --- | Output for @Text@. -printT :: Text -> IO () -printT = putStrLn - ppShowT :: Show a => a -> Text ppShowT = fromString . ppShow @@ -741,8 +767,3 @@ walletIdIsNotGenesis walletId = do mwallet <- (fmap fst . uncons) . filter ((walletId ==) . walId) <$> use wallets whenJust mwallet $ \wal -> pre (walName wal /= "Genesis wallet") - - -randomTest :: (Testable a) => String -> Int -> PropertyM IO a -> Spec -randomTest msg maxSuccesses = - prop msg . withMaxSuccess maxSuccesses . monadicIO diff --git a/wallet-new/integration/SetupTestEnv.hs b/wallet-new/integration/SetupTestEnv.hs new file mode 100644 index 00000000000..333824bfe90 --- /dev/null +++ b/wallet-new/integration/SetupTestEnv.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE LambdaCase #-} +module SetupTestEnv where +import Universum + +import Cardano.Wallet.Client.Http +import CLI +import qualified Data.ByteString.Char8 as B8 +import Data.X509.File (readSignedObject) +import Network.HTTP.Client (Manager) + +setupClient :: CLIOptions -> IO (WalletClient IO, Manager) +setupClient CLIOptions {..} = do + let serverId = (serverHost, B8.pack $ show serverPort) + caChain <- readSignedObject tlsCACertPath + clientCredentials <- credentialLoadX509 tlsClientCertPath tlsPrivKeyPath >>= \case + Right a -> return a + Left err -> fail $ "Error decoding X509 certificates: " <> err + manager <- newManager $ mkHttpsManagerSettings serverId caChain clientCredentials + + let + baseUrl = BaseUrl Https serverHost serverPort mempty + walletClient :: MonadIO m => WalletClient m + walletClient = withThrottlingRetry + . liftClient + $ mkHttpClient baseUrl manager + + return (walletClient, manager) + diff --git a/wallet-new/integration/TransactionSpecs.hs b/wallet-new/integration/TransactionSpecs.hs index 7b6740bc7e1..12776c011b4 100644 --- a/wallet-new/integration/TransactionSpecs.hs +++ b/wallet-new/integration/TransactionSpecs.hs @@ -7,7 +7,6 @@ import Universum import Cardano.Wallet.Client.Http import Control.Lens -import Functions (randomTest) import Test.Hspec import Test.QuickCheck.Monadic (PropertyM, run) import Text.Show.Pretty (ppShow) diff --git a/wallet-new/integration/Util.hs b/wallet-new/integration/Util.hs index 4262eb8fc5f..0d74bdb329b 100644 --- a/wallet-new/integration/Util.hs +++ b/wallet-new/integration/Util.hs @@ -10,7 +10,10 @@ import Control.Concurrent.Async (race) import Control.Lens import System.IO.Unsafe (unsafePerformIO) import Test.Hspec -import Test.QuickCheck (arbitrary, generate) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (arbitrary, generate, withMaxSuccess) +import Test.QuickCheck.Monadic (PropertyM, monadicIO) +import Test.QuickCheck.Property (Testable) import qualified Pos.Chain.Txp as Txp @@ -166,3 +169,12 @@ noLongerThan action maxWaitingTime = do case res of Left _ -> return Nothing Right a -> return $ Just a + + +-- | Output for @Text@. +printT :: Text -> IO () +printT = putStrLn + +randomTest :: (Testable a) => String -> Int -> PropertyM IO a -> Spec +randomTest msg maxSuccesses = + prop msg . withMaxSuccess maxSuccesses . monadicIO diff --git a/wallet-new/integration/WalletSpecs.hs b/wallet-new/integration/WalletSpecs.hs index 6f5bf31e403..d0f2f64be66 100644 --- a/wallet-new/integration/WalletSpecs.hs +++ b/wallet-new/integration/WalletSpecs.hs @@ -7,7 +7,6 @@ import Universum import Cardano.Wallet.Client.Http import Control.Lens -import Functions (randomTest) import Test.Hspec import Test.QuickCheck.Monadic (run)