From 5a263bc2f6db213ca9a222968525607b0a45e117 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 5 Jun 2020 17:35:24 +0200 Subject: [PATCH 1/8] move content of 'Test.Utils.Ports' to 'Cardano.Wallet.Network.Ports' --- lib/core/cardano-wallet-core.cabal | 1 + lib/core/src/Cardano/Wallet/Network/Ports.hs | 26 +++++++++++ .../cardano-wallet-jormungandr.cabal | 2 - .../Cardano/Wallet/Jormungandr/NetworkSpec.hs | 4 +- .../Jormungandr/Scenario/CLI/Launcher.hs | 4 +- .../test/integration/Test/Utils/Ports.hs | 43 ------------------- 6 files changed, 31 insertions(+), 49 deletions(-) delete mode 100644 lib/jormungandr/test/integration/Test/Utils/Ports.hs 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..bcd5d254734 100644 --- a/lib/core/src/Cardano/Wallet/Network/Ports.hs +++ b/lib/core/src/Cardano/Wallet/Network/Ports.hs @@ -26,16 +26,22 @@ 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 ) +import Data.List + ( sort ) import Data.Streaming.Network ( bindRandomPortTCP ) import Data.Word @@ -54,6 +60,8 @@ import Network.Socket , socket , tupleToHostAddress ) +import System.Random.Shuffle + ( shuffleM ) import UnliftIO.Exception ( bracket, throwIO, try ) @@ -113,3 +121,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 From 6ed9efca634aa960137d1966be49215be7bede0f Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 5 Jun 2020 18:26:48 +0200 Subject: [PATCH 2/8] rework the shelley launcher code so that we can start a cluster of nodes using 'withCluster ... ... 0' will result in the same behavior as before. Right now, pools would exists as process but not on chain. In order to exist on chain, pools need to be registered, which will be done in a separate commit. --- lib/shelley/cardano-wallet-shelley.cabal | 1 + .../src/Cardano/Wallet/Shelley/Launch.hs | 398 +++++++++++------- .../data/cardano-node-shelley/genesis.yaml | 4 +- .../data/cardano-node-shelley/node.topology | 3 - lib/shelley/test/integration/Main.hs | 8 +- 5 files changed, 262 insertions(+), 152 deletions(-) delete mode 100644 lib/shelley/test/data/cardano-node-shelley/node.topology 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..6f3dd18d5fc 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 + ( subsequences, (\\) ) +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,250 @@ 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) + print $ permutations ports + withBFTNode tr severity (head $ permutations ports) $ \socket block0 params -> do + waitGroup <- newChan + doneGroup <- newChan + let waitAll = replicateM n (readChan waitGroup) + let cancelAll = replicateM_ n (writeChan doneGroup ()) + + forM_ (init $ permutations 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`. + -- + -- >>> permutations [1,2,3] + -- [(1,[2,3]), (2, [1,3]), (3, [1,2])] + permutations :: Eq a => [a] -> [(a, [a])] + permutations [x] = [(x, [])] + permutations xs = + map (\ys -> (head (xs \\ ys), ys)) (sizedSubsequences (length xs - 1) xs) + where + -- | Get all subsequences of a given size + sizedSubsequences :: Int -> [a] -> [[a]] + sizedSubsequences 0 = const [] + sizedSubsequences i = filter ((== i) . length) . subsequences + +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 + , "--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 + , "--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..d8a5f18b472 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) From 1a8b720a95870a0834e737f64656fd0ce597dfbc Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 8 Jun 2020 10:27:34 +0200 Subject: [PATCH 3/8] fix database path --- lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs index 6f3dd18d5fc..631480c9348 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs @@ -267,7 +267,7 @@ withBFTNode tr severity (port, peers) action = [ "run" , "--config", config , "--topology", topology - , "--database-path", dir + , "--database-path", dir "db" , "--socket-path", socket , "--port", show port , "--shelley-kes-key", kesPrv @@ -304,7 +304,7 @@ withStakePool tr severity (port, peers) action = [ "run" , "--config", config , "--topology", topology - , "--database-path", dir + , "--database-path", dir "db" , "--socket-path", genSocketPath dir , "--port", show port , "--shelley-kes-key", kesPrv From 6745ea944d20752353d6e4c978b6670ae7b75be2 Mon Sep 17 00:00:00 2001 From: IOHK Date: Mon, 8 Jun 2020 08:40:54 +0000 Subject: [PATCH 4/8] Regenerate nix --- nix/.stack.nix/cardano-wallet-core.nix | 1 + nix/.stack.nix/cardano-wallet-jormungandr.nix | 1 - nix/.stack.nix/cardano-wallet-shelley.nix | 1 + 3 files changed, 2 insertions(+), 1 deletion(-) 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")) From 6b7b94763e4d3e4ceb9663dee0beb530b0a49e15 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 8 Jun 2020 10:47:34 +0200 Subject: [PATCH 5/8] assign sensible default ordering to 'listAllTransactions' --- lib/core-integration/src/Test/Integration/Framework/DSL.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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) From 152ae3f76527d46865f45f520e987b933d8048c8 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 8 Jun 2020 12:37:10 +0200 Subject: [PATCH 6/8] rewrite 'permutations' using built-in composition from Data.List --- .../src/Cardano/Wallet/Shelley/Launch.hs | 20 ++++++------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs index 631480c9348..d3468872f01 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs @@ -68,7 +68,7 @@ import Data.Aeson import Data.Functor ( ($>) ) import Data.List - ( subsequences, (\\) ) + ( nub, permutations, sort ) import Data.Maybe ( catMaybes ) import Data.Proxy @@ -206,14 +206,13 @@ withCluster -> IO (Either ProcessHasExited a) withCluster tr severity n action = do ports <- randomUnusedTCPPorts (n + 1) - print $ permutations ports - withBFTNode tr severity (head $ permutations ports) $ \socket block0 params -> do + 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 $ permutations ports) $ \(port, peers) -> do + forM_ (init $ rotate ports) $ \(port, peers) -> do withAsync (withStakePool tr severity (port, peers) $ readChan doneGroup) (writeChan waitGroup . Just) -- FIXME: register pool @@ -231,17 +230,10 @@ withCluster tr severity n action = do -- | 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`. -- - -- >>> permutations [1,2,3] + -- >>> rotate [1,2,3] -- [(1,[2,3]), (2, [1,3]), (3, [1,2])] - permutations :: Eq a => [a] -> [(a, [a])] - permutations [x] = [(x, [])] - permutations xs = - map (\ys -> (head (xs \\ ys), ys)) (sizedSubsequences (length xs - 1) xs) - where - -- | Get all subsequences of a given size - sizedSubsequences :: Int -> [a] -> [[a]] - sizedSubsequences 0 = const [] - sizedSubsequences i = filter ((== i) . length) . subsequences + rotate :: Ord a => [a] -> [(a, [a])] + rotate = nub . fmap (\(x:xs) -> (x, sort xs)) . permutations withBFTNode :: Trace IO Text From 771b90f1e8b67b006aa4662022f529975461e86a Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 8 Jun 2020 12:58:06 +0200 Subject: [PATCH 7/8] fix hlint suggestions --- lib/core/src/Cardano/Wallet/Network/Ports.hs | 4 +--- lib/shelley/test/integration/Main.hs | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Network/Ports.hs b/lib/core/src/Cardano/Wallet/Network/Ports.hs index bcd5d254734..4b5b88bbea3 100644 --- a/lib/core/src/Cardano/Wallet/Network/Ports.hs +++ b/lib/core/src/Cardano/Wallet/Network/Ports.hs @@ -39,9 +39,7 @@ import Control.Monad.IO.Class import Control.Retry ( RetryPolicyM, retrying ) import Data.List - ( isInfixOf ) -import Data.List - ( sort ) + ( isInfixOf, sort ) import Data.Streaming.Network ( bindRandomPortTCP ) import Data.Word diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs index d8a5f18b472..a1a33c92c6d 100644 --- a/lib/shelley/test/integration/Main.hs +++ b/lib/shelley/test/integration/Main.hs @@ -180,7 +180,7 @@ specWithServer tr = aroundAll withContext . after tearDown either pure (throwIO . ProcessHasExited "integration") withServer action = - ((=<<) (either throwIO pure)) $ + ((either throwIO pure) =<<) $ withCluster tr Info 0 $ \socketPath block0 (gp,vData) -> withSystemTempDirectory "cardano-wallet-databases" $ \db -> do serveWallet @(IO Shelley) From 79dfc132b196731f719a138da3821bc446b12632 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 9 Jun 2020 15:27:16 +0200 Subject: [PATCH 8/8] use smaller delta for transaction list test. One second is actually pretty large and we ended up in cases where, adding one second to the time of the first transaction would make it later than the second transaction! Causing some tests to fail for a wrong reason. This delta needs to be at most the slot length, so I've made it 100ms. --- .../Scenario/API/Shelley/Transactions.hs | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index a6661c133f9..c3773b4afa2 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -910,7 +910,7 @@ spec = do , TestCase -- 2 { query = toQueryString [ ("start", utcIso8601ToText t1) - , ("end", utcIso8601ToText $ plusOneSecond t2) + , ("end", utcIso8601ToText $ plusDelta t2) , ("order", "descending") ] , assertions = @@ -922,7 +922,7 @@ spec = do , TestCase -- 3 { query = toQueryString [ ("start", utcIso8601ToText t1) - , ("end", utcIso8601ToText $ minusOneSecond t2) + , ("end", utcIso8601ToText $ minusDelta t2) ] , assertions = [ expectListSize 1 @@ -940,8 +940,8 @@ spec = do } , TestCase --5 { query = toQueryString - [ ("start", utcIso8601ToText $ plusOneSecond t1) - , ("end", utcIso8601ToText $ plusOneSecond t2) + [ ("start", utcIso8601ToText $ plusDelta t1) + , ("end", utcIso8601ToText $ plusDelta t2) ] , assertions = [ expectListSize 1 @@ -950,15 +950,15 @@ spec = do } , TestCase -- 6 { query = toQueryString - [ ("start", utcIso8601ToText $ plusOneSecond t1) - , ("end", utcIso8601ToText $ minusOneSecond t2) + [ ("start", utcIso8601ToText $ plusDelta t1) + , ("end", utcIso8601ToText $ minusDelta t2) ] , assertions = [ expectListSize 0 ] } , TestCase -- 7 { query = toQueryString - [ ("start", utcIso8601ToText $ plusOneSecond t1) + [ ("start", utcIso8601ToText $ plusDelta t1) , ("order", "ascending") ] , assertions = @@ -969,7 +969,7 @@ spec = do , TestCase -- 8 { query = toQueryString [ ("order", "descending") - , ("start", utcIso8601ToText $ plusOneSecond t1) + , ("start", utcIso8601ToText $ plusDelta t1) , ("end", utcIso8601ToText t2) ] , assertions = @@ -980,8 +980,8 @@ spec = do , TestCase -- 9 { query = toQueryString [ ("order", "ascending") - , ("start", utcIso8601ToText $ minusOneSecond t1) - , ("end", utcIso8601ToText $ minusOneSecond t2) + , ("start", utcIso8601ToText $ minusDelta t1) + , ("end", utcIso8601ToText $ minusDelta t2) ] , assertions = [ expectListSize 1 @@ -991,7 +991,7 @@ spec = do , TestCase -- 10 { query = toQueryString [ ("order", "descending") - , ("start", utcIso8601ToText $ minusOneSecond t1) + , ("start", utcIso8601ToText $ minusDelta t1) ] , assertions = [ expectListSize 2 @@ -1001,7 +1001,7 @@ spec = do } , TestCase -- 11 { query = toQueryString - [ ("start", utcIso8601ToText $ minusOneSecond t1) + [ ("start", utcIso8601ToText $ minusDelta t1) , ("end", utcIso8601ToText t2) ] , assertions = @@ -1012,8 +1012,8 @@ spec = do } , TestCase -- 12 { query = toQueryString - [ ("start", utcIso8601ToText $ minusOneSecond t1) - , ("end", utcIso8601ToText $ plusOneSecond t2) + [ ("start", utcIso8601ToText $ minusDelta t1) + , ("end", utcIso8601ToText $ plusDelta t2) ] , assertions = [ expectListSize 2 @@ -1040,7 +1040,7 @@ spec = do } , TestCase -- 15 { query = toQueryString - [ ("end", utcIso8601ToText $ plusOneSecond t2) ] + [ ("end", utcIso8601ToText $ plusDelta t2) ] , assertions = [ expectListSize 2 , expectListField 0 #amount (`shouldBe` a2) @@ -1049,7 +1049,7 @@ spec = do } , TestCase -- 16 { query = toQueryString - [ ("end", utcIso8601ToText $ minusOneSecond t2) ] + [ ("end", utcIso8601ToText $ minusDelta t2) ] , assertions = [ expectListSize 1 , expectListField 0 #amount (`shouldBe` a1) @@ -1511,6 +1511,6 @@ spec = do }|] return (wSrc, payload) - plusOneSecond, minusOneSecond :: UTCTime -> UTCTime - plusOneSecond = addUTCTime 1 - minusOneSecond = addUTCTime (-1) + plusDelta, minusDelta :: UTCTime -> UTCTime + plusDelta = addUTCTime (toEnum 1000000000) + minusDelta = addUTCTime (toEnum (-1000000000))