diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index cebbe6c9eb5..5dde0004d81 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -8,8 +8,8 @@ import Hydra.Prelude import Test.Hydra.Prelude import CardanoClient (submit, waitForTransaction) -import CardanoCluster (Marked (Fuel), defaultNetworkId, newNodeConfig, seedFromFaucet, withBFTNode) -import CardanoNode (RunningNode (..)) +import CardanoCluster (Marked (Fuel), defaultNetworkId, seedFromFaucet) +import CardanoNode (RunningNode (..), newNodeConfig, withBFTNode) import Control.Lens (to, (^?)) import Control.Monad.Class.MonadAsync (mapConcurrently) import Control.Monad.Class.MonadSTM ( @@ -37,7 +37,7 @@ import Hydra.Ledger (txId) import Hydra.Logging (withTracerOutputTo) import Hydra.Party (deriveParty) import HydraNode ( - EndToEndLog (..), + EndToEndLog (FromCardanoNode), HydraClient, hydraNodeId, input, @@ -81,7 +81,7 @@ bench timeoutSeconds workDir dataset@Dataset{clientDatasets} clusterSize = let parties = Set.fromList (deriveParty <$> hydraKeys) config <- newNodeConfig workDir withOSStats workDir $ - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromCardanoNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do withHydraCluster tracer workDir nodeSocket 0 cardanoKeys hydraKeys $ \(leader :| followers) -> do let clients = leader : followers waitForNodesConnected tracer clients diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index c3ba5b8600c..97171181737 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -190,6 +190,7 @@ test-suite integration Paths_hydra_cluster Spec Test.CardanoClusterSpec + Test.CardanoNodeSpec Test.DirectChainSpec Test.EndToEndSpec Test.GeneratorSpec @@ -207,6 +208,7 @@ test-suite integration , cardano-ledger-shelley , cardano-ledger-shelley-ma , containers + , directory , filepath , hedgehog-quickcheck , hspec @@ -266,7 +268,5 @@ benchmark bench-e2e , strict-containers , time - build-tool-depends: - hydra-node:hydra-node -any - + build-tool-depends: hydra-node:hydra-node -any ghc-options: -threaded -rtsopts diff --git a/hydra-cluster/src/CardanoCluster.hs b/hydra-cluster/src/CardanoCluster.hs index b5773fcaa42..1fccfa279bb 100644 --- a/hydra-cluster/src/CardanoCluster.hs +++ b/hydra-cluster/src/CardanoCluster.hs @@ -18,30 +18,17 @@ import CardanoClient ( waitForPayment, ) import CardanoNode ( - CardanoNodeArgs ( - nodeAlonzoGenesisFile, - nodeByronGenesisFile, - nodeConfigFile, - nodeDlgCertFile, - nodeKesKeyFile, - nodeOpCertFile, - nodePort, - nodeShelleyGenesisFile, - nodeSignKeyFile, - nodeVrfKeyFile - ), CardanoNodeConfig (..), NodeId, NodeLog, Port, PortsConfig (..), RunningNode (..), - defaultCardanoNodeArgs, - withCardanoNode, + initSystemStart, + withBFTNode, ) -import Control.Tracer (Tracer, traceWith) +import Control.Tracer (Tracer) import qualified Data.Aeson as Aeson -import qualified Data.ByteString as BS import Hydra.Chain.Direct.Util (markerDatumHash, retry) import qualified Hydra.Chain.Direct.Util as Cardano import Hydra.Cluster.Util (readConfigFile) @@ -49,14 +36,8 @@ import Hydra.Options ( ChainConfig (..), defaultChainConfig, ) -import qualified Paths_hydra_cluster as Pkg -import System.Directory (createDirectoryIfMissing, doesFileExist) import System.FilePath ((<.>), ()) -import System.Posix.Files ( - ownerReadMode, - setFileMode, - ) -import Test.Network.Ports (randomUnusedTCPPort, randomUnusedTCPPorts) +import Test.Network.Ports (randomUnusedTCPPorts) -- | TODO: This is hard-coded and must match what's in the genesis file, so -- ideally, we want to either: @@ -115,7 +96,6 @@ chainConfigFor me targetDir nodeSocket them = do vkTarget x = targetDir vkName x skName x = actorName x <.> ".sk" vkName x = actorName x <.> ".vk" - -- * Starting a cluster or single nodes data RunningCluster = RunningCluster ClusterConfig [RunningNode] @@ -137,88 +117,25 @@ withCluster tr cfg@ClusterConfig{parentStateDirectory} action = do makeNodesConfig parentStateDirectory systemStart <$> randomUnusedTCPPorts 3 - withBFTNode tr cfgA $ \nodeA -> do - withBFTNode tr cfgB $ \nodeB -> do - withBFTNode tr cfgC $ \nodeC -> do + withBFTNode (nodeTracer cfgA) cfgA $ \nodeA -> do + withBFTNode (nodeTracer cfgB) cfgB $ \nodeB -> do + withBFTNode (nodeTracer cfgC) cfgC $ \nodeC -> do let nodes = [nodeA, nodeB, nodeC] action (RunningCluster cfg nodes) - --- | Start a cardano-node in BFT mode using the config from config/ and --- credentials from config/credentials/ using given 'nodeId'. NOTE: This means --- that nodeId should only be 1,2 or 3 and that only the faucet receives --- 'initialFunds'. Use 'seedFromFaucet' to distribute funds other wallets. -withBFTNode :: - Tracer IO ClusterLog -> - CardanoNodeConfig -> - (RunningNode -> IO ()) -> - IO () -withBFTNode clusterTracer cfg action = do - createDirectoryIfMissing False (stateDirectory cfg) - - [dlgCert, signKey, vrfKey, kesKey, opCert] <- - forM - [ dlgCertFilename nid - , signKeyFilename nid - , vrfKeyFilename nid - , kesKeyFilename nid - , opCertFilename nid - ] - (copyCredential (stateDirectory cfg)) - - let args = - defaultCardanoNodeArgs - { nodeDlgCertFile = Just dlgCert - , nodeSignKeyFile = Just signKey - , nodeVrfKeyFile = Just vrfKey - , nodeKesKeyFile = Just kesKey - , nodeOpCertFile = Just opCert - , nodePort = Just (ours (ports cfg)) - } - - readConfigFile "cardano-node.json" - >>= writeFileBS - (stateDirectory cfg nodeConfigFile args) - - readConfigFile "genesis-byron.json" - >>= writeFileBS - (stateDirectory cfg nodeByronGenesisFile args) - - readConfigFile "genesis-shelley.json" - >>= writeFileBS - (stateDirectory cfg nodeShelleyGenesisFile args) - - readConfigFile "genesis-alonzo.json" - >>= writeFileBS - (stateDirectory cfg nodeAlonzoGenesisFile args) - - withCardanoNode nodeTracer cfg args $ \rn -> do - traceWith clusterTracer $ MsgNodeStarting cfg - waitForSocket rn - action rn where - dlgCertFilename i = "delegation-cert.00" <> show (i - 1) <> ".json" - signKeyFilename i = "delegate-keys.00" <> show (i - 1) <> ".key" - vrfKeyFilename i = "delegate" <> show i <> ".vrf.skey" - kesKeyFilename i = "delegate" <> show i <> ".kes.skey" - opCertFilename i = "opcert" <> show i <> ".cert" - - copyCredential parentDir file = do - bs <- readConfigFile ("credentials" file) - let destination = parentDir file - unlessM (doesFileExist destination) $ - writeFileBS destination bs - setFileMode destination ownerReadMode - pure destination - - nid = nodeId cfg - - nodeTracer = contramap (MsgFromNode nid) clusterTracer - - waitForSocket :: RunningNode -> IO () - waitForSocket node@(RunningNode _ socket) = do - unlessM (doesFileExist socket) $ do - threadDelay 0.1 - waitForSocket node + nodeTracer CardanoNodeConfig{nodeId} = contramap (MsgFromNode nodeId) tr + + makeNodesConfig :: + FilePath -> + UTCTime -> + [Port] -> + (CardanoNodeConfig, CardanoNodeConfig, CardanoNodeConfig) + makeNodesConfig stateDirectory systemStart [a, b, c] = + ( CardanoNodeConfig 1 (stateDirectory "node-1") systemStart (PortsConfig a [b, c]) + , CardanoNodeConfig 2 (stateDirectory "node-2") systemStart (PortsConfig b [a, c]) + , CardanoNodeConfig 3 (stateDirectory "node-3") systemStart (PortsConfig c [a, b]) + ) + makeNodesConfig _ _ _ = error "we only support topology for 3 nodes" data Marked = Fuel | Normal @@ -287,37 +204,6 @@ seedFromFaucet_ :: seedFromFaucet_ nid node vk ll marked = void $ seedFromFaucet nid node vk ll marked --- | Initialize the system start time to now (modulo a small offset needed to --- give time to the system to bootstrap correctly). -initSystemStart :: IO UTCTime -initSystemStart = do - addUTCTime 1 <$> getCurrentTime - -makeNodesConfig :: - FilePath -> - UTCTime -> - [Port] -> - (CardanoNodeConfig, CardanoNodeConfig, CardanoNodeConfig) -makeNodesConfig stateDirectory systemStart [a, b, c] = - ( CardanoNodeConfig 1 (stateDirectory "node-1") systemStart (PortsConfig a [b, c]) - , CardanoNodeConfig 2 (stateDirectory "node-2") systemStart (PortsConfig b [a, c]) - , CardanoNodeConfig 3 (stateDirectory "node-3") systemStart (PortsConfig c [a, b]) - ) -makeNodesConfig _ _ _ = error "we only support topology for 3 nodes" - -newNodeConfig :: - FilePath -> - IO CardanoNodeConfig -newNodeConfig stateDirectory = do - nodePort <- randomUnusedTCPPort - systemStart <- initSystemStart - pure $ - CardanoNodeConfig - { nodeId = 1 - , stateDirectory - , systemStart - , ports = PortsConfig nodePort [] - } -- -- Logging -- diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs index 72a815610cd..931a0655cf2 100644 --- a/hydra-cluster/src/CardanoNode.hs +++ b/hydra-cluster/src/CardanoNode.hs @@ -8,27 +8,27 @@ module CardanoNode where import Hydra.Prelude import Control.Retry (constantDelay, limitRetriesByCumulativeDelay, retrying) -import Control.Tracer ( - Tracer, - traceWith, - ) +import Control.Tracer (Tracer, traceWith) import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HM import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Hydra.Cardano.Api (AsType (AsPaymentKey), PaymentKey, SigningKey, VerificationKey, generateSigningKey, getVerificationKey) -import System.Directory (doesFileExist, removeFile) import Hydra.Cluster.Util (readConfigFile) +import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile) import System.Exit (ExitCode (..)) import System.FilePath ((<.>), ()) +import System.Posix (ownerReadMode, setFileMode) import System.Process ( CreateProcess (..), StdStream (UseHandle), proc, readCreateProcessWithExitCode, + readProcess, withCreateProcess, ) import Test.Hydra.Prelude +import Test.Network.Ports (randomUnusedTCPPort) type Port = Int @@ -97,6 +97,80 @@ data PortsConfig = PortsConfig deriving stock (Show, Eq, Generic) deriving anyclass (ToJSON, FromJSON) +getCardanoNodeVersion :: IO String +getCardanoNodeVersion = + readProcess "cardano-node" ["--version"] "" + +-- | Start a cardano-node in BFT mode using the config from config/ and +-- credentials from config/credentials/ using given 'nodeId'. NOTE: This means +-- that nodeId should only be 1,2 or 3 and that only the faucet receives +-- 'initialFunds'. Use 'seedFromFaucet' to distribute funds other wallets. +withBFTNode :: + Tracer IO NodeLog -> + CardanoNodeConfig -> + (RunningNode -> IO ()) -> + IO () +withBFTNode tracer cfg action = do + createDirectoryIfMissing False (stateDirectory cfg) + + [dlgCert, signKey, vrfKey, kesKey, opCert] <- + forM + [ dlgCertFilename nid + , signKeyFilename nid + , vrfKeyFilename nid + , kesKeyFilename nid + , opCertFilename nid + ] + (copyCredential (stateDirectory cfg)) + + let args = + defaultCardanoNodeArgs + { nodeDlgCertFile = Just dlgCert + , nodeSignKeyFile = Just signKey + , nodeVrfKeyFile = Just vrfKey + , nodeKesKeyFile = Just kesKey + , nodeOpCertFile = Just opCert + , nodePort = Just (ours (ports cfg)) + } + + readConfigFile "cardano-node.json" + >>= writeFileBS + (stateDirectory cfg nodeConfigFile args) + + readConfigFile "genesis-byron.json" + >>= writeFileBS + (stateDirectory cfg nodeByronGenesisFile args) + + readConfigFile "genesis-shelley.json" + >>= writeFileBS + (stateDirectory cfg nodeShelleyGenesisFile args) + + readConfigFile "genesis-alonzo.json" + >>= writeFileBS + (stateDirectory cfg nodeAlonzoGenesisFile args) + + withCardanoNode tracer cfg args $ \rn@(RunningNode _ socket) -> do + traceWith tracer $ MsgNodeStarting cfg + waitForSocket rn + traceWith tracer $ MsgSocketIsReady socket + action rn + where + dlgCertFilename i = "delegation-cert.00" <> show (i - 1) <> ".json" + signKeyFilename i = "delegate-keys.00" <> show (i - 1) <> ".key" + vrfKeyFilename i = "delegate" <> show i <> ".vrf.skey" + kesKeyFilename i = "delegate" <> show i <> ".kes.skey" + opCertFilename i = "opcert" <> show i <> ".cert" + + copyCredential parentDir file = do + bs <- readConfigFile ("credentials" file) + let destination = parentDir file + unlessM (doesFileExist destination) $ + writeFileBS destination bs + setFileMode destination ownerReadMode + pure destination + + nid = nodeId cfg + withCardanoNode :: Tracer IO NodeLog -> CardanoNodeConfig -> @@ -126,6 +200,25 @@ withCardanoNode tr cfg@CardanoNodeConfig{stateDirectory, nodeId} args action = d socketFile = stateDirectory nodeSocket args +newNodeConfig :: FilePath -> IO CardanoNodeConfig +newNodeConfig stateDirectory = do + nodePort <- randomUnusedTCPPort + systemStart <- initSystemStart + pure $ + CardanoNodeConfig + { nodeId = 1 + , stateDirectory + , systemStart + , ports = PortsConfig nodePort [] + } + +-- | Wait for the node socket file to become available. +waitForSocket :: RunningNode -> IO () +waitForSocket node@(RunningNode _ socket) = do + unlessM (doesFileExist socket) $ do + threadDelay 0.1 + waitForSocket node + -- | Generate command-line arguments for launching @cardano-node@. cardanoNodeProcess :: Maybe FilePath -> CardanoNodeArgs -> CreateProcess cardanoNodeProcess cwd args = (proc "cardano-node" strArgs){cwd} @@ -150,6 +243,12 @@ cardanoNodeProcess cwd args = (proc "cardano-node" strArgs){cwd} Nothing -> [] Just val -> [arg, val] +-- | Initialize the system start time to now (modulo a small offset needed to +-- give time to the system to bootstrap correctly). +initSystemStart :: IO UTCTime +initSystemStart = do + addUTCTime 1 <$> getCurrentTime + -- | Re-generate configuration and genesis files with fresh system start times. refreshSystemStart :: CardanoNodeConfig -> CardanoNodeArgs -> IO () refreshSystemStart cfg args = do @@ -277,6 +376,7 @@ data NodeLog | MsgCLIStatus Text Text | MsgCLIRetry Text | MsgCLIRetryResult Text Int + | MsgNodeStarting CardanoNodeConfig | MsgSocketIsReady FilePath deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index fc5d9bbd52c..cdcc393b338 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -25,7 +25,7 @@ import Hydra.Cardano.Api import Hydra.Prelude hiding (delete) import Cardano.BM.Tracing (ToObject) -import CardanoCluster (ClusterLog) +import CardanoNode (NodeLog) import Control.Concurrent.Async ( forConcurrently_, ) @@ -183,7 +183,7 @@ data EndToEndLog | StartWaiting [Int] [Aeson.Value] | ReceivedMessage Int Aeson.Value | EndWaiting Int - | FromCluster ClusterLog + | FromCardanoNode NodeLog deriving (Eq, Show, Generic, ToJSON, FromJSON, ToObject) -- XXX: The two lists need to be of same length. Also the verification keys can diff --git a/hydra-cluster/test/Test/CardanoNodeSpec.hs b/hydra-cluster/test/Test/CardanoNodeSpec.hs new file mode 100644 index 00000000000..9b1cfa110c1 --- /dev/null +++ b/hydra-cluster/test/Test/CardanoNodeSpec.hs @@ -0,0 +1,35 @@ +module Test.CardanoNodeSpec where + +import Hydra.Prelude +import Test.Hydra.Prelude + +-- Unit under test +import CardanoNode + +import Hydra.Logging (showLogsOnFailure) +import System.Directory (doesFileExist) +import Test.Network.Ports (randomUnusedTCPPort) + +spec :: Spec +spec = do + -- NOTE: We also hard-code the cardano-node version here to allow prevent + -- false positives test errors in case someone uses an "untested" / + -- different than in shell.nix version of cardano-node and cardano-cli. + it "has expected cardano-node version available" $ + getCardanoNodeVersion >>= (`shouldContain` "1.31.0") + + it "withBFTNode does start a node within 3 seconds" $ + failAfter 3 $ + showLogsOnFailure $ \tr -> do + withTempDir "hydra-cluster" $ \tmp -> do + systemStart <- initSystemStart + ourPort <- randomUnusedTCPPort + let config = + CardanoNodeConfig + { nodeId = 1 + , stateDirectory = tmp + , systemStart + , ports = PortsConfig{ours = ourPort, peers = []} + } + withBFTNode tr config $ \(RunningNode _ socketFile) -> do + doesFileExist socketFile `shouldReturn` True diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index 0f4ef2f28df..264407f34a3 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -14,16 +14,13 @@ import CardanoClient ( ) import CardanoCluster ( Actor (Alice, Bob, Carol), - ClusterLog, Marked (Fuel, Normal), defaultNetworkId, keysFor, - newNodeConfig, seedFromFaucet, seedFromFaucet_, - withBFTNode, ) -import CardanoNode (NodeLog, RunningNode (..)) +import CardanoNode (NodeLog, RunningNode (..), newNodeConfig, withBFTNode) import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar) import qualified Data.ByteString.Char8 as B8 import Hydra.Cardano.Api ( @@ -63,7 +60,7 @@ spec = around showLogsOnFailure $ do withTempDir "hydra-cluster" $ \tmp -> do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do bobKeys <- keysFor Bob cardanoKeys <- fmap fst <$> mapM keysFor [Alice, Bob, Carol] withIOManager $ \iocp -> do @@ -86,7 +83,7 @@ spec = around showLogsOnFailure $ do withTempDir "hydra-cluster" $ \tmp -> do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do bobKeys <- keysFor Bob cardanoKeys <- fmap fst <$> mapM keysFor [Alice, Bob, Carol] withIOManager $ \iocp -> do @@ -124,7 +121,7 @@ spec = around showLogsOnFailure $ do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice (carolCardanoVk, _) <- keysFor Carol - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do bobKeys <- keysFor Bob let cardanoKeys = [aliceCardanoVk, carolCardanoVk] withIOManager $ \iocp -> do @@ -143,7 +140,7 @@ spec = around showLogsOnFailure $ do withTempDir "hydra-cluster" $ \tmp -> do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do let cardanoKeys = [aliceCardanoVk] withIOManager $ \iocp -> do withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing (putMVar alicesCallback) $ \Chain{postTx} -> do @@ -172,7 +169,7 @@ spec = around showLogsOnFailure $ do withTempDir "hydra-cluster" $ \tmp -> do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do let cardanoKeys = [aliceCardanoVk] withIOManager $ \iocp -> do withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing (putMVar alicesCallback) $ \Chain{postTx} -> do @@ -189,7 +186,7 @@ spec = around showLogsOnFailure $ do withTempDir "hydra-cluster" $ \tmp -> do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do let cardanoKeys = [aliceCardanoVk] withIOManager $ \iocp -> do withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing (putMVar alicesCallback) $ \Chain{postTx} -> do @@ -238,7 +235,7 @@ spec = around showLogsOnFailure $ do withTempDir "direct-chain" $ \tmp -> do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do let cardanoKeys = [aliceCardanoVk] withIOManager $ \iocp -> do tip <- withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing (putMVar alicesCallback) $ \Chain{postTx = alicePostTx} -> do @@ -256,7 +253,7 @@ spec = around showLogsOnFailure $ do withTempDir "direct-chain" $ \tmp -> do config <- newNodeConfig tmp aliceKeys@(aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromNode tracer) config $ \(RunningNode _ nodeSocket) -> do let aliceTrace = contramap (FromDirectChain "alice") tracer let cardanoKeys = [aliceCardanoVk] withIOManager $ \iocp -> do @@ -275,8 +272,7 @@ aliceSigningKey :: Hydra.SigningKey aliceSigningKey = generateSigningKey "alice" data TestClusterLog - = FromCluster ClusterLog - | FromNode NodeLog + = FromNode NodeLog | FromDirectChain Text DirectChainLog deriving (Show) diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 7eaa671b029..f566607095a 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -13,12 +13,10 @@ import CardanoCluster ( chainConfigFor, defaultNetworkId, keysFor, - newNodeConfig, seedFromFaucet, seedFromFaucet_, - withBFTNode, ) -import CardanoNode (RunningNode (RunningNode)) +import CardanoNode (RunningNode (RunningNode), newNodeConfig, withBFTNode) import Control.Lens ((^?)) import Data.Aeson (Result (..), Value (Object, String), fromJSON, object, (.=)) import Data.Aeson.Lens (key) @@ -91,14 +89,14 @@ spec = around showLogsOnFailure $ do failAfter 60 $ withTempDir "end-to-end-cardano-node" $ \tmpDir -> do config <- newNodeConfig tmpDir - withBFTNode (contramap FromCluster tracer) config $ \node -> do + withBFTNode (contramap FromCardanoNode tracer) config $ \node -> do initAndClose tracer 1 node describe "start chain observer from the past" $ it "can restart head to point in the past and replay on-chain events" $ \tracer -> do withTempDir "end-to-end-chain-observer" $ \tmp -> do config <- newNodeConfig tmp - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromCardanoNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do (aliceCardanoVk, _aliceCardanoSk) <- keysFor Alice aliceChainConfig <- chainConfigFor Alice tmp nodeSocket [] tip <- withHydraNode tracer aliceChainConfig tmp 1 aliceSk [] [1] $ \n1 -> do @@ -123,7 +121,7 @@ spec = around showLogsOnFailure $ do failAfter 60 $ withTempDir "end-to-end-cardano-node" $ \tmpDir -> do config <- newNodeConfig tmpDir - withBFTNode (contramap FromCluster tracer) config $ \node -> do + withBFTNode (contramap FromCardanoNode tracer) config $ \node -> do concurrently_ (initAndClose tracer 0 node) (initAndClose tracer 1 node) @@ -132,7 +130,7 @@ spec = around showLogsOnFailure $ do failAfter 60 $ withTempDir "end-to-end-two-heads" $ \tmpDir -> do config <- newNodeConfig tmpDir - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromCardanoNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do (aliceCardanoVk, _aliceCardanoSk) <- keysFor Alice (bobCardanoVk, _bobCardanoSk) <- keysFor Bob aliceChainConfig <- chainConfigFor Alice tmpDir nodeSocket [] @@ -168,7 +166,7 @@ spec = around showLogsOnFailure $ do withTempDir "end-to-end-prometheus-metrics" $ \tmpDir -> do config <- newNodeConfig tmpDir (aliceCardanoVk, _) <- keysFor Alice - withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do + withBFTNode (contramap FromCardanoNode tracer) config $ \node@(RunningNode _ nodeSocket) -> do aliceChainConfig <- chainConfigFor Alice tmpDir nodeSocket [Bob, Carol] bobChainConfig <- chainConfigFor Bob tmpDir nodeSocket [Alice, Carol] carolChainConfig <- chainConfigFor Carol tmpDir nodeSocket [Bob, Carol] diff --git a/hydra-tui/test/Hydra/TUISpec.hs b/hydra-tui/test/Hydra/TUISpec.hs index fd2ad58b425..8c83ba0df83 100644 --- a/hydra-tui/test/Hydra/TUISpec.hs +++ b/hydra-tui/test/Hydra/TUISpec.hs @@ -8,16 +8,13 @@ import Test.Hydra.Prelude import Blaze.ByteString.Builder.Char8 (writeChar) import CardanoCluster ( Actor (Alice), - ClusterLog, Marked (Fuel, Normal), chainConfigFor, defaultNetworkId, keysFor, - newNodeConfig, seedFromFaucet_, - withBFTNode, ) -import CardanoNode (RunningNode (RunningNode)) +import CardanoNode (NodeLog, RunningNode (RunningNode), newNodeConfig, withBFTNode) import Control.Monad.Class.MonadSTM (newTQueueIO, readTQueue, tryReadTQueue, writeTQueue) import qualified Data.ByteString as BS import Graphics.Vty ( @@ -215,7 +212,7 @@ withTUITest region action = do } data TUILog - = FromCardano ClusterLog + = FromCardano NodeLog | FromHydra EndToEndLog deriving (Show)