diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 2c95de4651d..9167c45308f 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -1227,7 +1227,7 @@ listAllTransactions -> w -> IO [ApiTransaction n] listAllTransactions ctx w = - listTransactions ctx w Nothing Nothing Nothing + listTransactions ctx w Nothing Nothing (Just Descending) listTransactions :: forall n t w. (DecodeAddress n, HasType (ApiT WalletId) w) diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index dbe50c6dfa3..47ac5eb155f 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -75,6 +75,7 @@ library , persistent-template , process , random + , random-shuffle , retry , safe , scientific diff --git a/lib/core/src/Cardano/Wallet/Network/Ports.hs b/lib/core/src/Cardano/Wallet/Network/Ports.hs index d4b637dbb08..4b5b88bbea3 100644 --- a/lib/core/src/Cardano/Wallet/Network/Ports.hs +++ b/lib/core/src/Cardano/Wallet/Network/Ports.hs @@ -26,16 +26,20 @@ module Cardano.Wallet.Network.Ports -- * Helpers , waitForPort , unsafePortNumber + , findPort + , randomUnusedTCPPorts ) where import Prelude +import Control.Monad + ( filterM ) import Control.Monad.IO.Class ( liftIO ) import Control.Retry ( RetryPolicyM, retrying ) import Data.List - ( isInfixOf ) + ( isInfixOf, sort ) import Data.Streaming.Network ( bindRandomPortTCP ) import Data.Word @@ -54,6 +58,8 @@ import Network.Socket , socket , tupleToHostAddress ) +import System.Random.Shuffle + ( shuffleM ) import UnliftIO.Exception ( bracket, throwIO, try ) @@ -113,3 +119,21 @@ unsafePortNumber = \case SockAddrInet p _ -> p SockAddrInet6 p _ _ _ -> p SockAddrUnix _ -> error "unsafePortNumber: no port for unix sockets." + +-- | Get a list of random TCPv4 ports that currently do not have any servers +-- listening on them. It may return less than the requested number of ports. +-- +-- Note that this method of allocating ports is subject to race +-- conditions. Production code should use better methods such as passing a +-- listening socket to the child process. +randomUnusedTCPPorts :: Int -> IO [Int] +randomUnusedTCPPorts count = do + usablePorts <- shuffleM [1024..49151] + sort <$> filterM unused (take count usablePorts) + where + unused = fmap not . isPortOpen . simpleSockAddr (127,0,0,1) . fromIntegral + +-- | Returen a single TCP port that was unused at the time this function was +-- called. +findPort :: IO Int +findPort = head <$> randomUnusedTCPPorts 1 diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index 405dcbb26c0..8df6ce11f52 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/lib/jormungandr/cardano-wallet-jormungandr.cabal @@ -245,7 +245,6 @@ test-suite jormungandr-integration , monad-control , persistent , process - , random-shuffle , retry , safe , servant @@ -281,7 +280,6 @@ test-suite jormungandr-integration Test.Integration.Jormungandr.Scenario.CLI.StakePools Test.Integration.Jormungandr.Scenario.CLI.Transactions Test.Integration.Jormungandr.Scenario.CLI.Port - Test.Utils.Ports benchmark latency default-language: diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs index 174f1fe3fd7..7dd1f7b6f11 100644 --- a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs +++ b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs @@ -57,6 +57,8 @@ import Cardano.Wallet.Network ) import Cardano.Wallet.Network.BlockHeaders ( emptyBlockHeaders ) +import Cardano.Wallet.Network.Ports + ( randomUnusedTCPPorts ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..), Passphrase (..) ) import Cardano.Wallet.Primitive.Types @@ -122,8 +124,6 @@ import Test.Hspec ) import Test.QuickCheck ( Arbitrary (..), generate, vector ) -import Test.Utils.Ports - ( randomUnusedTCPPorts ) import qualified Cardano.Wallet.Jormungandr.Api.Client as Jormungandr import qualified Data.ByteString as BS diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs index 47cd207aecf..dcdfa0d6001 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs @@ -20,6 +20,8 @@ import Cardano.Launcher ( Command (..), StdStream (..), withBackendProcess ) import Cardano.Wallet.Api.Types ( ApiWallet ) +import Cardano.Wallet.Network.Ports + ( findPort ) import Cardano.Wallet.Primitive.Types ( SyncProgress (..) ) import Control.Exception @@ -68,8 +70,6 @@ import Test.Integration.Framework.DSL ) import Test.Utils.Paths ( getTestData ) -import Test.Utils.Ports - ( findPort ) import qualified Data.Text as T import qualified Data.Text.IO as TIO diff --git a/lib/jormungandr/test/integration/Test/Utils/Ports.hs b/lib/jormungandr/test/integration/Test/Utils/Ports.hs deleted file mode 100644 index deade049f03..00000000000 --- a/lib/jormungandr/test/integration/Test/Utils/Ports.hs +++ /dev/null @@ -1,43 +0,0 @@ --- | --- Copyright: © 2018-2020 IOHK --- License: Apache-2.0 --- --- Provides functions for checking if TCP ports are available to listen --- on. These can be used to start servers for testing when there may be multiple --- test suites running in parallel. --- --- Includes code from nh2: https://stackoverflow.com/a/57022572 - -module Test.Utils.Ports - ( randomUnusedTCPPorts - , findPort - ) where - -import Prelude - -import Cardano.Wallet.Network.Ports - ( isPortOpen, simpleSockAddr ) -import Control.Monad - ( filterM ) -import Data.List - ( sort ) -import System.Random.Shuffle - ( shuffleM ) - --- | Get a list of random TCPv4 ports that currently do not have any servers --- listening on them. It may return less than the requested number of ports. --- --- Note that this method of allocating ports is subject to race --- conditions. Production code should use better methods such as passing a --- listening socket to the child process. -randomUnusedTCPPorts :: Int -> IO [Int] -randomUnusedTCPPorts count = do - usablePorts <- shuffleM [1024..49151] - sort <$> filterM unused (take count usablePorts) - where - unused = fmap not . isPortOpen . simpleSockAddr (127,0,0,1) . fromIntegral - --- | Returen a single TCP port that was unused at the time this function was --- called. -findPort :: IO Int -findPort = head <$> randomUnusedTCPPorts 1 diff --git a/lib/shelley/cardano-wallet-shelley.cabal b/lib/shelley/cardano-wallet-shelley.cabal index 99cbcce24f5..a61d57a5ce3 100644 --- a/lib/shelley/cardano-wallet-shelley.cabal +++ b/lib/shelley/cardano-wallet-shelley.cabal @@ -43,6 +43,7 @@ library , cardano-wallet-cli , cardano-wallet-core , cardano-wallet-launcher + , cardano-wallet-test-utils , cborg , containers , contra-tracer diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs index d0bfe9a35b6..d3468872f01 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs @@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -16,7 +17,9 @@ module Cardano.Wallet.Shelley.Launch ( -- * Integration Launcher - withCardanoNode + withCluster + , withBFTNode + , withStakePool , NetworkConfiguration (..) , nodeSocketOption @@ -26,7 +29,6 @@ module Cardano.Wallet.Shelley.Launch import Prelude - import Cardano.BM.Data.Severity ( Severity (..) ) import Cardano.BM.Trace @@ -36,11 +38,11 @@ import Cardano.CLI import Cardano.Config.Shelley.Genesis ( ShelleyGenesis ) import Cardano.Launcher - ( Command (..), StdStream (..), withBackendProcess ) + ( Command (..), ProcessHasExited (..), StdStream (..), withBackendProcess ) import Cardano.Wallet.Logging ( trMessageText ) import Cardano.Wallet.Network.Ports - ( getRandomPort ) + ( randomUnusedTCPPorts ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.Types @@ -49,16 +51,26 @@ import Cardano.Wallet.Shelley ( SomeNetworkDiscriminant (..) ) import Cardano.Wallet.Shelley.Compatibility ( NodeVersionData, fromGenesisData, testnetVersionData ) +import Control.Concurrent.Async + ( withAsync ) +import Control.Concurrent.Chan + ( newChan, readChan, writeChan ) import Control.Exception - ( bracket, throwIO ) + ( finally, throwIO ) import Control.Monad - ( forM_, unless, when ) + ( forM, forM_, replicateM, replicateM_, void ) import Control.Monad.Fail ( MonadFail ) import Control.Monad.Trans.Except ( ExceptT (..) ) import Data.Aeson - ( eitherDecode, toJSON ) + ( eitherDecode, toJSON, (.=) ) +import Data.Functor + ( ($>) ) +import Data.List + ( nub, permutations, sort ) +import Data.Maybe + ( catMaybes ) import Data.Proxy ( Proxy (..) ) import Data.Text @@ -78,15 +90,19 @@ import Ouroboros.Network.Magic import Ouroboros.Network.NodeToClient ( NodeToClientVersionData (..), nodeToClientCodecCBORTerm ) import System.Directory - ( copyFile, doesDirectoryExist, removeDirectoryRecursive ) -import System.Environment - ( lookupEnv ) + ( copyFile ) +import System.Exit + ( ExitCode (..) ) import System.FilePath ( takeFileName, () ) import System.Info ( os ) import System.IO.Temp - ( createTempDirectory, getCanonicalTemporaryDirectory ) + ( withSystemTempDirectory ) +import System.Process + ( readProcess ) +import Test.Utils.Paths + ( getTestData ) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as BL @@ -163,152 +179,242 @@ parseGenesisData = \case -- For Integration -------------------------------------------------------------------------------- -data CardanoNodeConfig = CardanoNodeConfig - { nodeConfigFile :: FilePath - , nodeDatabaseDir :: FilePath - , nodeSocketFile :: FilePath - , nodeTopologyFile :: FilePath - , nodeVrfKey :: FilePath - , nodeKesKey :: FilePath - , nodeOpCert :: FilePath - } - --- | Spins up a @cardano-node@ in another process. +-- | A quick helper to interact with the 'cardano-cli'. Assumes the cardano-cli +-- is available in PATH. +cli :: [String] -> IO String +cli args = + readProcess "cardano-cli" args stdin + where + stdin = "" + +-- | Execute an action after starting a cluster of stake pools. The cluster also +-- contains a single BFT node that is pre-configured with keys available in the +-- test data. -- --- IMPORTANT: @cardano-node@ must be available on the current path. -withCardanoNode +-- This BFT node is essential in order to bootstrap the chain and allow +-- registering pools. Passing `0` as a number of pool will simply start a single +-- BFT node. +withCluster :: Trace IO Text - -- ^ Some trace for logging - -> FilePath - -- ^ Test directory + -- ^ Trace for subprocess control logging -> Severity + -- ^ Minimal logging severity + -> Int + -- ^ How many pools should the cluster spawn. -> (FilePath -> Block -> (NetworkParameters, NodeVersionData) -> IO a) - -- ^ Callback function with a socket description and genesis params - -> IO a -withCardanoNode tr tdir severity action = - orThrow $ withConfig tdir severity $ \cfg block0 (np, vData) -> do - nodePort <- getRandomPort - let args = mkArgs cfg nodePort + -- ^ Action to run with the cluster up + -> IO (Either ProcessHasExited a) +withCluster tr severity n action = do + ports <- randomUnusedTCPPorts (n + 1) + withBFTNode tr severity (head $ rotate ports) $ \socket block0 params -> do + waitGroup <- newChan + doneGroup <- newChan + let waitAll = replicateM n (readChan waitGroup) + let cancelAll = replicateM_ n (writeChan doneGroup ()) + + forM_ (init $ rotate ports) $ \(port, peers) -> do + withAsync + (withStakePool tr severity (port, peers) $ readChan doneGroup) + (writeChan waitGroup . Just) -- FIXME: register pool + `finally` (writeChan waitGroup Nothing) + + group <- waitAll + if length (catMaybes group) /= n then do + cancelAll + throwIO $ ProcessHasExited + "cluster didn't start correctly" + (ExitFailure 1) + else do + action socket block0 params `finally` cancelAll + where + -- | Get permutations of the size (n-1) for a list of n elements, alongside with + -- the element left aside. `[a]` is really expected to be `Set a`. + -- + -- >>> rotate [1,2,3] + -- [(1,[2,3]), (2, [1,3]), (3, [1,2])] + rotate :: Ord a => [a] -> [(a, [a])] + rotate = nub . fmap (\(x:xs) -> (x, sort xs)) . permutations + +withBFTNode + :: Trace IO Text + -- ^ Trace for subprocess control logging + -> Severity + -- ^ Minimal logging severity + -> (Int, [Int]) + -- ^ A list of ports used by peers and this pool. + -> (FilePath -> Block -> (NetworkParameters, NodeVersionData) -> IO a) + -- ^ Callback function with genesis parameters + -> IO (Either ProcessHasExited a) +withBFTNode tr severity (port, peers) action = + withSystemTempDirectory "stake-pool" $ \dir -> do + [vrfPrv, kesPrv, opCert] <- forM + ["node-vrf.skey", "node-kes.skey", "node.opcert"] + (\f -> copyFile (source f) (dir f) $> (dir f)) + + (config, block0, networkParams, versionData) <- genConfig dir severity + topology <- genTopology dir peers + let socket = genSocketPath dir + + let args = + [ "run" + , "--config", config + , "--topology", topology + , "--database-path", dir "db" + , "--socket-path", socket + , "--port", show port + , "--shelley-kes-key", kesPrv + , "--shelley-vrf-key", vrfPrv + , "--shelley-operational-certificate", opCert + ] let cmd = Command "cardano-node" args (pure ()) Inherit Inherit - withBackendProcess (trMessageText tr) cmd $ do - action (nodeSocketFile cfg) block0 (np, vData) + withBackendProcess (trMessageText tr) cmd $ + action socket block0 (networkParams, versionData) where - orThrow = (=<<) (either throwIO pure) - mkArgs cfg port = - [ "run" - , "--config", nodeConfigFile cfg - , "--topology", nodeTopologyFile cfg - , "--database-path", nodeDatabaseDir cfg - , "--socket-path", nodeSocketFile cfg - , "--port", show port - , "--shelley-vrf-key", nodeVrfKey cfg - , "--shelley-kes-key", nodeKesKey cfg - , "--shelley-operational-certificate", nodeOpCert cfg - ] + source :: FilePath + source = $(getTestData) "cardano-node-shelley" +-- | Start a "stake pool node". The pool will register itself. +withStakePool + :: Trace IO Text + -- ^ Trace for subprocess control logging + -> Severity + -- ^ Minimal logging severity + -> (Int, [Int]) + -- ^ A list of ports used by peers and this pool. + -> IO a + -- ^ Callback function called once the pool has started. + -> IO (Either ProcessHasExited a) +withStakePool tr severity (port, peers) action = + withSystemTempDirectory "stake-pool" $ \dir -> do + (opPrv, _opPub) <- genOperatorKeyPair dir + (vrfPrv, _vrfPub) <- genVrfKeyPair dir + (kesPrv, kesPub) <- genKesKeyPair dir + opCert <- issueOpCert dir kesPub opPrv + (config, _, _, _) <- genConfig dir severity + topology <- genTopology dir peers + let args = + [ "run" + , "--config", config + , "--topology", topology + , "--database-path", dir "db" + , "--socket-path", genSocketPath dir + , "--port", show port + , "--shelley-kes-key", kesPrv + , "--shelley-vrf-key", vrfPrv + , "--shelley-operational-certificate", opCert + ] + let cmd = Command "cardano-node" args (pure ()) Inherit Inherit + withBackendProcess (trMessageText tr) cmd action --- | Generate a new integration configuration based on a partial configuration --- located in @./test/data/cardano-node-shelley@. --- --- The 'startTime' from the partial genesis file will be overriden with a new --- fresh recent one (resulting in a different genesis hash). --- --- As a result, this function creates a temporary directory which is cleaned up --- after use (unless the ENV var NO_CLEANUP is set): --- --- $ tree /tmp/cardano-wallet-byron-2cbb1ea94edb1cea/ --- ├── genesis.json --- ├── node.cert --- ├── node.config --- ├── node.key --- └── node.topology --- -withConfig +genConfig :: FilePath + -- ^ A top-level directory where to put the configuration. -> Severity - -- ^ Test data directory - -> ( CardanoNodeConfig - -> Block - -> (NetworkParameters, NodeVersionData) - -> IO a - ) - -- ^ Callback function with the node configuration and genesis params - -> IO a -withConfig tdir severity action = - bracket setupConfig teardownConfig $ \(_a,b,c,d) -> action b c d + -- ^ Minimum severity level for logging + -> IO (FilePath, Block, NetworkParameters, NodeVersionData) +genConfig dir severity = do + -- we need to specify genesis file location every run in tmp + Yaml.decodeFileThrow (source "node.config") + >>= withObject (addGenesisFilePath (T.pack nodeGenesisFile)) + >>= withObject (addMinSeverity (T.pack $ show severity)) + >>= Yaml.encodeFile (dir "node.config") + + Yaml.decodeFileThrow @_ @Aeson.Value (source "genesis.yaml") + >>= withObject updateStartTime + >>= Aeson.encodeFile nodeGenesisFile + + (genesisData :: ShelleyGenesis TPraosStandardCrypto) + <- either (error . show) id . eitherDecode <$> BL.readFile nodeGenesisFile + + let (networkParameters, block0) = fromGenesisData genesisData + let nm = sgNetworkMagic genesisData + pure + ( dir "node.config" + , block0 + , networkParameters + , (NodeToClientVersionData nm, nodeToClientCodecCBORTerm) + ) where source :: FilePath - source = tdir "cardano-node-shelley" - - setupConfig - :: IO ( FilePath - , CardanoNodeConfig - , Block - , (NetworkParameters, NodeVersionData) - ) - setupConfig = do - dir <- getCanonicalTemporaryDirectory - >>= \tmpRoot -> createTempDirectory tmpRoot "cw-shelley" - - let nodeConfigFile = dir "node.config" - let nodeDatabaseDir = dir "node.db" - let nodeGenesisFile = dir "genesis.json" - let nodeTopologyFile = dir "node.topology" - let nodeVrfKey = dir "node-vrf.skey" - let nodeKesKey = dir "node-kes.skey" - let nodeOpCert = dir "node.opcert" - let nodeSocketFile = - if os == "mingw32" - then "\\\\.\\pipe\\" ++ takeFileName dir - else dir "node.socket" - - -- we need to specify genesis file location every run in tmp - Yaml.decodeFileThrow (source "node.config") - >>= withObject (addGenesisFilePath (T.pack nodeGenesisFile)) - >>= withObject (addMinSeverity (T.pack $ show severity)) - >>= Yaml.encodeFile (dir "node.config") - - Yaml.decodeFileThrow @_ @Aeson.Value (source "genesis.yaml") - >>= withObject updateStartTime - >>= Aeson.encodeFile nodeGenesisFile - forM_ ["node.topology", "node-vrf.skey", "node-kes.skey", "node.opcert"] $ \f -> - copyFile (source f) (dir f) - - (genesisData :: ShelleyGenesis TPraosStandardCrypto) - <- either (error . show) id . eitherDecode <$> BL.readFile nodeGenesisFile - - let (np, block0) = fromGenesisData genesisData - - let nm = sgNetworkMagic genesisData + source = $(getTestData) "cardano-node-shelley" - pure - ( dir - , CardanoNodeConfig - { nodeConfigFile - , nodeDatabaseDir - , nodeSocketFile - , nodeTopologyFile - , nodeVrfKey - , nodeKesKey - , nodeOpCert - } - , block0 - , ( np - , ( NodeToClientVersionData nm - , nodeToClientCodecCBORTerm - ) - ) - ) + nodeGenesisFile :: FilePath + nodeGenesisFile = dir "genesis.json" + +-- | Generate a valid socket path based on the OS. +genSocketPath :: FilePath -> FilePath +genSocketPath dir = + if os == "mingw32" + then "\\\\.\\pipe\\" ++ takeFileName dir + else dir "node.socket" - teardownConfig - :: (FilePath, b, c, d) - -> IO () - teardownConfig (dir, _, _, _) = do - noCleanup <- maybe False (not . null) <$> lookupEnv "NO_CLEANUP" - exists <- doesDirectoryExist dir - unless noCleanup $ when exists $ removeDirectoryRecursive dir +-- | Generate a topology file from a list of peers. +genTopology :: FilePath -> [Int] -> IO FilePath +genTopology dir peers = do + let file = dir "node.topology" + Aeson.encodeFile file $ Aeson.object [ "Producers" .= map encodePeer peers ] + pure file + where + encodePeer :: Int -> Aeson.Value + encodePeer port = Aeson.object + [ "addr" .= ("127.0.0.1" :: String) + , "port" .= port + , "valency" .= (1 :: Int) + ] + +-- | Create a key pair for a node operator's offline key and a new certificate +-- issue counter +genOperatorKeyPair :: FilePath -> IO (FilePath, FilePath) +genOperatorKeyPair dir = do + let opPub = dir "op.pub" + let opPrv = dir "op.prv" + let opCounter = dir "op.count" + void $ cli + [ "shelley", "node", "key-gen" + , "--verification-key-file", opPub + , "--signing-key-file", opPrv + , "--operational-certificate-issue-counter", opCounter + ] + pure (opPrv, opPub) + +-- | Create a key pair for a node KES operational key +genKesKeyPair :: FilePath -> IO (FilePath, FilePath) +genKesKeyPair dir = do + let kesPub = dir "kes.pub" + let kesPrv = dir "kes.prv" + void $ cli + [ "shelley", "node", "key-gen-KES" + , "--verification-key-file", kesPub + , "--signing-key-file", kesPrv + ] + pure (kesPrv, kesPub) + +-- | Create a key pair for a node VRF operational key +genVrfKeyPair :: FilePath -> IO (FilePath, FilePath) +genVrfKeyPair dir = do + let vrfPub = dir "vrf.pub" + let vrfPrv = dir "vrf.prv" + void $ cli + [ "shelley", "node", "key-gen-VRF" + , "--verification-key-file", vrfPub + , "--signing-key-file", vrfPrv + ] + pure (vrfPrv, vrfPub) + +-- | Issue a node operational certificate +issueOpCert :: FilePath -> FilePath -> FilePath -> IO FilePath +issueOpCert dir kesPub opPrv = do + let file = dir "op.cert" + void $ cli + [ "shelley", "node", "issue-op-cert" + , "--hot-kes-verification-key-file", kesPub + , "--cold-signing-key-file", opPrv + , "--kes-period", "0" + , "--out-file", file + ] + pure file --- | Add a "startTime" field in a given object with the current POSIX time as a +-- | Add a "systemStart" field in a given object with the current POSIX time as a -- value. updateStartTime :: Aeson.Object diff --git a/lib/shelley/test/data/cardano-node-shelley/genesis.yaml b/lib/shelley/test/data/cardano-node-shelley/genesis.yaml index 60eeb29a2ac..7e9a1a3a26e 100644 --- a/lib/shelley/test/data/cardano-node-shelley/genesis.yaml +++ b/lib/shelley/test/data/cardano-node-shelley/genesis.yaml @@ -34,10 +34,10 @@ initialFunds: {} maxLovelaceSupply: 45000000000000000 networkMagic: 1 networkId: Mainnet -epochLength: 1215 +epochLength: 100 staking: slotsPerKESPeriod: 86400 -slotLength: 8 +slotLength: 0.2 maxKESEvolutions: 90 securityParam: 2160 initialFunds: diff --git a/lib/shelley/test/data/cardano-node-shelley/node.topology b/lib/shelley/test/data/cardano-node-shelley/node.topology deleted file mode 100644 index 156b75ae0e1..00000000000 --- a/lib/shelley/test/data/cardano-node-shelley/node.topology +++ /dev/null @@ -1,3 +0,0 @@ -{ - "Producers":[] -} diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs index 824ef87afda..a1a33c92c6d 100644 --- a/lib/shelley/test/integration/Main.hs +++ b/lib/shelley/test/integration/Main.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -59,7 +58,7 @@ import Cardano.Wallet.Shelley.Compatibility import Cardano.Wallet.Shelley.Faucet ( initFaucet ) import Cardano.Wallet.Shelley.Launch - ( withCardanoNode ) + ( withCluster ) import Cardano.Wallet.Shelley.Transaction ( _estimateSize ) import Control.Concurrent.Async @@ -101,8 +100,6 @@ import Test.Integration.Framework.DSL , request , unsafeRequest ) -import Test.Utils.Paths - ( getTestData ) import qualified Cardano.Wallet.Api.Link as Link import qualified Data.Aeson as Aeson @@ -183,7 +180,8 @@ specWithServer tr = aroundAll withContext . after tearDown either pure (throwIO . ProcessHasExited "integration") withServer action = - withCardanoNode tr $(getTestData) Info $ \socketPath block0 (gp,vData) -> + ((either throwIO pure) =<<) $ + withCluster tr Info 0 $ \socketPath block0 (gp,vData) -> withSystemTempDirectory "cardano-wallet-databases" $ \db -> do serveWallet @(IO Shelley) (SomeNetworkDiscriminant $ Proxy @'Mainnet) diff --git a/nix/.stack.nix/cardano-wallet-core.nix b/nix/.stack.nix/cardano-wallet-core.nix index 6ac59a55e3f..63b87a172e2 100644 --- a/nix/.stack.nix/cardano-wallet-core.nix +++ b/nix/.stack.nix/cardano-wallet-core.nix @@ -71,6 +71,7 @@ (hsPkgs."persistent-template" or (errorHandler.buildDepError "persistent-template")) (hsPkgs."process" or (errorHandler.buildDepError "process")) (hsPkgs."random" or (errorHandler.buildDepError "random")) + (hsPkgs."random-shuffle" or (errorHandler.buildDepError "random-shuffle")) (hsPkgs."retry" or (errorHandler.buildDepError "retry")) (hsPkgs."safe" or (errorHandler.buildDepError "safe")) (hsPkgs."scientific" or (errorHandler.buildDepError "scientific")) diff --git a/nix/.stack.nix/cardano-wallet-jormungandr.nix b/nix/.stack.nix/cardano-wallet-jormungandr.nix index a714b02b834..7e5d6cf98eb 100644 --- a/nix/.stack.nix/cardano-wallet-jormungandr.nix +++ b/nix/.stack.nix/cardano-wallet-jormungandr.nix @@ -204,7 +204,6 @@ (hsPkgs."monad-control" or (errorHandler.buildDepError "monad-control")) (hsPkgs."persistent" or (errorHandler.buildDepError "persistent")) (hsPkgs."process" or (errorHandler.buildDepError "process")) - (hsPkgs."random-shuffle" or (errorHandler.buildDepError "random-shuffle")) (hsPkgs."retry" or (errorHandler.buildDepError "retry")) (hsPkgs."safe" or (errorHandler.buildDepError "safe")) (hsPkgs."servant" or (errorHandler.buildDepError "servant")) diff --git a/nix/.stack.nix/cardano-wallet-shelley.nix b/nix/.stack.nix/cardano-wallet-shelley.nix index 82598ce94f3..7b12f808bad 100644 --- a/nix/.stack.nix/cardano-wallet-shelley.nix +++ b/nix/.stack.nix/cardano-wallet-shelley.nix @@ -40,6 +40,7 @@ (hsPkgs."cardano-wallet-cli" or (errorHandler.buildDepError "cardano-wallet-cli")) (hsPkgs."cardano-wallet-core" or (errorHandler.buildDepError "cardano-wallet-core")) (hsPkgs."cardano-wallet-launcher" or (errorHandler.buildDepError "cardano-wallet-launcher")) + (hsPkgs."cardano-wallet-test-utils" or (errorHandler.buildDepError "cardano-wallet-test-utils")) (hsPkgs."cborg" or (errorHandler.buildDepError "cborg")) (hsPkgs."containers" or (errorHandler.buildDepError "containers")) (hsPkgs."contra-tracer" or (errorHandler.buildDepError "contra-tracer"))