From 63419265821176334d10383ff48bc6afe3cc3659 Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Tue, 22 Feb 2022 16:38:36 +0000 Subject: [PATCH 1/3] Resurrect 0MQ-based mock chain #203 --- .github/workflows/docker.yaml | 2 +- Dockerfile | 14 ++ hydra-cluster/bench/Bench/EndToEnd.hs | 1 + hydra-cluster/bench/Main.hs | 2 +- hydra-cluster/hydra-cluster.cabal | 6 +- hydra-cluster/src/HydraNode.hs | 19 +++ hydra-node/exe/hydra-node/Main.hs | 35 ++--- hydra-node/exe/mock-chain/Main.hs | 104 +++++++++++++ hydra-node/hydra-node.cabal | 18 ++- hydra-node/src/Hydra/Chain.hs | 17 +++ hydra-node/src/Hydra/Chain/ZeroMQ.hs | 174 ++++++++++++++++++++++ hydra-node/src/Hydra/Logging/Messages.hs | 12 +- hydra-node/src/Hydra/Network.hs | 24 +++ hydra-node/src/Hydra/Options.hs | 69 ++++++--- hydra-node/test/Hydra/BehaviorSpec.hs | 21 +-- hydra-node/test/Hydra/Chain/ZeroMQSpec.hs | 56 +++++++ hydra-node/test/Hydra/OptionsSpec.hs | 92 ++++-------- release.nix | 1 + shell.nix | 1 + 19 files changed, 541 insertions(+), 127 deletions(-) create mode 100644 hydra-node/exe/mock-chain/Main.hs create mode 100644 hydra-node/src/Hydra/Chain/ZeroMQ.hs create mode 100644 hydra-node/test/Hydra/Chain/ZeroMQSpec.hs diff --git a/.github/workflows/docker.yaml b/.github/workflows/docker.yaml index 542e4b25eb7..b81f18b5350 100644 --- a/.github/workflows/docker.yaml +++ b/.github/workflows/docker.yaml @@ -11,7 +11,7 @@ jobs: docker: strategy: matrix: - target: [ hydra-node, hydra-tui ] + target: [ hydra-node, hydra-tui, mock-chain ] runs-on: ubuntu-latest steps: diff --git a/Dockerfile b/Dockerfile index 62018786e70..c991a6d882d 100644 --- a/Dockerfile +++ b/Dockerfile @@ -16,9 +16,11 @@ COPY . . RUN nix-build -A hydra-node -o hydra-node-result release.nix > hydra-node.drv RUN nix-build -A hydra-tui -o hydra-tui-result release.nix > hydra-tui.drv +RUN nix-build -A mock-chain -o mock-chain-result release.nix > mock-chain.drv RUN nix-store --export $(nix-store -qR $(cat hydra-node.drv)) > hydra-node.closure RUN nix-store --export $(nix-store -qR $(cat hydra-tui.drv)) > hydra-tui.closure +RUN nix-store --export $(nix-store -qR $(cat mock-chain.drv)) > mock-chain.closure # ------------------------------------------------------------------- HYDRA-NODE @@ -43,3 +45,15 @@ RUN nix-store --import < hydra-tui.closure && nix-env -i $(cat hydra-tui.drv) STOPSIGNAL SIGINT ENTRYPOINT ["hydra-tui"] + +# ------------------------------------------------------------------- MOCK-CHAIN + +FROM nixos/nix:2.3.11 as mock-chain + +COPY --from=build /build/mock-chain.drv mock-chain.drv +COPY --from=build /build/mock-chain.closure mock-chain.closure + +RUN nix-store --import < mock-chain.closure && nix-env -i $(cat mock-chain.drv) + +STOPSIGNAL SIGINT +ENTRYPOINT ["mock-chain"] diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index 5841d47867c..b78dacccd3e 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -108,6 +108,7 @@ bench timeoutSeconds workDir dataset clusterSize = let contestationPeriod = 10 :: Natural send leader $ input "Init" ["contestationPeriod" .= contestationPeriod] + let parties = Set.fromList $ map (deriveParty . generateKey) [1 .. fromIntegral clusterSize] waitFor tracer (fromIntegral $ 10 * clusterSize) nodes $ output "ReadyToCommit" ["parties" .= parties] diff --git a/hydra-cluster/bench/Main.hs b/hydra-cluster/bench/Main.hs index eac4c6fdffe..dd7c81883d1 100644 --- a/hydra-cluster/bench/Main.hs +++ b/hydra-cluster/bench/Main.hs @@ -86,7 +86,7 @@ benchOptions = ( fullDesc <> progDesc "Starts a cluster of Hydra nodes interconnected through a network and \ - \ talking to a local cardano devnet, generates an initial UTxO set and a bunch \ + \ talking to mock-chain, generates an initial UTxO set and a bunch \ \ of valid transactions, and send those transactions to the cluster as \ \ fast as possible.\n \ \ Arguments can control various parameters of the run, like number of nodes, \ diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 3037ae6bd8d..10751d53bc7 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -248,7 +248,8 @@ test-suite integration build-tool-depends: hspec-discover:hspec-discover -any, hydra-node:hydra-node -any, - cardano-node:cardano-node -any, cardano-cli:cardano-cli -any + hydra-node:mock-chain -any, cardano-node:cardano-node -any, + cardano-cli:cardano-cli -any ghc-options: -threaded -rtsopts @@ -284,6 +285,7 @@ benchmark bench-e2e , time build-tool-depends: - hydra-node:hydra-node -any, cardano-node:cardano-node -any + hydra-node:hydra-node -any, hydra-node:mock-chain -any, + cardano-node:cardano-node -any, cardano-cli:cardano-cli -any ghc-options: -threaded -rtsopts diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index d68d0852ed9..3f5f94c66be 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -13,6 +13,7 @@ module HydraNode ( getMetrics, queryNode, defaultArguments, + withMockChain, hydraNodeProcess, module System.Process, waitForNodesConnected, @@ -59,6 +60,7 @@ import System.Process ( ) import System.Timeout (timeout) import Test.Hydra.Prelude (checkProcessHasNotDied, failAfter, failure, withFile') +import Test.Network.Ports (randomUnusedTCPPorts) import qualified Prelude data HydraClient = HydraClient @@ -346,3 +348,20 @@ waitForNodesConnected tracer clients = ] ) (filter (/= hydraNodeId) allNodeIds) + +withMockChain :: ((Int, Int, Int) -> IO ()) -> IO () +withMockChain action = do + [sync, catchUp, post] <- randomUnusedTCPPorts 3 + withCreateProcess (proc "mock-chain" (arguments sync catchUp post)) $ + \_in _out _err processHandle -> do + race_ (checkProcessHasNotDied "mock-chain" processHandle) (action (sync, catchUp, post)) + where + arguments s c p = + [ "--quiet" + , "--sync-address" + , "tcp://127.0.0.1:" <> show s + , "--catch-up-address" + , "tcp://127.0.0.1:" <> show c + , "--post-address" + , "tcp://127.0.0.1:" <> show p + ] diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 328467e8668..75094adfc60 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TypeApplications #-} module Main where @@ -9,6 +8,7 @@ import Hydra.API.Server (withAPIServer) import Hydra.Chain (Chain, ChainCallback) import Hydra.Chain.Direct (withDirectChain) import Hydra.Chain.Direct.Util (readKeyPair, readVerificationKey) +import Hydra.Chain.ZeroMQ (withMockChain) import Hydra.HeadLogic (Environment (..), Event (..)) import Hydra.Ledger.Cardano (Tx) import qualified Hydra.Ledger.Cardano as Ledger @@ -51,22 +51,23 @@ withChain :: ChainConfig -> (Chain Tx IO -> IO ()) -> IO () -withChain tracer party callback config action = do - keyPair@(vk, _) <- readKeyPair cardanoSigningKey - otherCardanoKeys <- mapM readVerificationKey cardanoVerificationKeys - withIOManager $ \iocp -> do - withDirectChain - (contramap DirectChain tracer) - networkMagic - iocp - nodeSocket - keyPair - party - (vk : otherCardanoKeys) - callback - action - where - DirectChainConfig{networkMagic, nodeSocket, cardanoSigningKey, cardanoVerificationKeys} = config +withChain tracer party callback config action = case config of + MockChainConfig mockChain -> + withMockChain (contramap MockChain tracer) mockChain callback action + DirectChainConfig{networkMagic, nodeSocket, cardanoSigningKey, cardanoVerificationKeys} -> do + keyPair@(vk, _) <- readKeyPair cardanoSigningKey + otherCardanoKeys <- mapM readVerificationKey cardanoVerificationKeys + withIOManager $ \iocp -> do + withDirectChain + (contramap DirectChain tracer) + networkMagic + iocp + nodeSocket + keyPair + party + (vk : otherCardanoKeys) + callback + action identifyNode :: Options -> Options identifyNode opt@Options{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} diff --git a/hydra-node/exe/mock-chain/Main.hs b/hydra-node/exe/mock-chain/Main.hs new file mode 100644 index 00000000000..77aba9590ef --- /dev/null +++ b/hydra-node/exe/mock-chain/Main.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +import Hydra.Prelude + +import Data.Aeson (eitherDecode) +import Hydra.Chain.ZeroMQ ( + catchUpTransactions, + mockChainClient, + runChainSync, + startChain, + ) +import Hydra.Ledger.Cardano (Tx) +import Hydra.Logging (Verbosity (Quiet, Verbose), withTracer) +import Options.Applicative ( + Parser, + ParserInfo, + auto, + execParser, + flag, + fullDesc, + header, + help, + helper, + info, + long, + option, + progDesc, + short, + strOption, + value, + ) + +data Option = Option + { mode :: ChainMode + , chainSyncAddress :: String + , catchUpAddress :: String + , postTxAddress :: String + , -- TODO: provide less binary behaviour? + verbosity :: Verbosity + } + deriving (Eq, Show) + +data ChainMode = NodeMode | ClientMode | CatchUpMode + deriving (Eq, Read, Show) + +mockChainParser :: Parser Option +mockChainParser = + Option + <$> option + auto + ( long "mode" + <> short 'm' + <> value NodeMode + <> help "Mode to run mock-chain, one of 'NodeMode', 'CatchUpMode' or 'ClientMode'" + ) + <*> strOption + ( long "sync-address" + <> short 's' + <> value "tcp://127.0.0.1:56789" + <> help "The address where clients can connect for syncing transactions" + ) + <*> strOption + ( long "catch-up-address" + <> short 'u' + <> value "tcp://127.0.0.1:56790" + <> help "The address where clients can connect for syncing transactions" + ) + <*> strOption + ( long "post-address" + <> short 'p' + <> value "tcp://127.0.0.1:56791" + <> help "The address where clients can post transactions" + ) + <*> flag + (Verbose "MockChain") + Quiet + ( long "quiet" + <> short 'q' + <> help "Turns off any logging" + ) + +mockChainOptions :: ParserInfo Option +mockChainOptions = + info + (mockChainParser <**> helper) + ( fullDesc + <> progDesc "Starts a mock Chain server" + <> header "mock-chain - a mock chain server" + ) + +main :: IO () +main = do + Option{mode, chainSyncAddress, catchUpAddress, postTxAddress, verbosity} <- execParser mockChainOptions + withTracer verbosity $ \tracer -> case mode of + NodeMode -> + startChain @Tx chainSyncAddress catchUpAddress postTxAddress tracer + CatchUpMode -> catchUpTransactions catchUpAddress print tracer + ClientMode -> do + withAsync (runChainSync chainSyncAddress print tracer) $ \_async -> forever $ do + msg <- getLine + case eitherDecode (encodeUtf8 msg) of + Right tx -> liftIO $ mockChainClient postTxAddress tracer tx + Left _ -> print $ "failed to read command: " <> msg diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index fcc85a94098..8b49e3e9ca6 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -84,6 +84,7 @@ library Hydra.Chain.Direct.Tx Hydra.Chain.Direct.Util Hydra.Chain.Direct.Wallet + Hydra.Chain.ZeroMQ Hydra.ClientInput Hydra.HeadLogic Hydra.Ledger @@ -139,9 +140,9 @@ library , formatting , gitrev , hedgehog-quickcheck + , hydra-cardano-api , hydra-plutus , hydra-prelude - , hydra-cardano-api , io-classes , iohk-monitoring , iproute @@ -172,6 +173,7 @@ library , typed-protocols-cborg , typed-protocols-examples , websockets + , zeromq4-haskell ghc-options: -haddock @@ -220,6 +222,19 @@ executable tx-cost -- NOTE(SN): should fix HLS choking on PlutusTx plugin ghc-options: -fplugin-opt PlutusTx.Plugin:defer-errors +executable mock-chain + import: project-config + hs-source-dirs: exe/mock-chain + main-is: Main.hs + build-depends: + , aeson + , base + , hydra-node + , hydra-prelude + , optparse-applicative + + ghc-options: -threaded -rtsopts + test-suite tests import: project-config ghc-options: -threaded -rtsopts -with-rtsopts=-N @@ -241,6 +256,7 @@ test-suite tests Hydra.Chain.Direct.TxSpec Hydra.Chain.Direct.WalletSpec Hydra.Chain.DirectSpec + Hydra.Chain.ZeroMQSpec Hydra.ClientInputSpec Hydra.FireForgetSpec Hydra.HeadLogicSpec diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs index 92d83cd684e..e798af9e702 100644 --- a/hydra-node/src/Hydra/Chain.hs +++ b/hydra-node/src/Hydra/Chain.hs @@ -116,6 +116,23 @@ instance where arbitrary = genericArbitrary +-- | Derive an 'OnChainTx' from 'PostChainTx'. This is primarily used in tests +-- and simplified "chains". NOTE(SN): This implementation does *NOT* honor the +-- 'HeadParameters' and announce hard-coded contestationDeadlines. +toOnChainTx :: UTCTime -> PostChainTx tx -> OnChainTx tx +toOnChainTx currentTime = \case + InitTx HeadParameters{contestationPeriod, parties} -> OnInitTx{contestationPeriod, parties} + (CommitTx pa ut) -> OnCommitTx pa ut + AbortTx{} -> OnAbortTx + CollectComTx{} -> OnCollectComTx + (CloseTx snap) -> + OnCloseTx + { contestationDeadline = addUTCTime 10 currentTime + , snapshotNumber = number (getSnapshot snap) + } + ContestTx{} -> OnContestTx + FanoutTx{} -> OnFanoutTx + -- | Handle to interface with the main chain network newtype Chain tx m = Chain { -- | Construct and send a transaction to the main chain corresponding to the diff --git a/hydra-node/src/Hydra/Chain/ZeroMQ.hs b/hydra-node/src/Hydra/Chain/ZeroMQ.hs new file mode 100644 index 00000000000..d5a3e24808e --- /dev/null +++ b/hydra-node/src/Hydra/Chain/ZeroMQ.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE UndecidableInstances #-} + +-- | A 0MQ based mock chain implementation. +-- +--This module provides both the "server-side" of the mock-chain and the "client-side" which +--can be used by `HydraNode` to post and receive TX from the mainchain +module Hydra.Chain.ZeroMQ where + +import Hydra.Prelude + +import Control.Monad.Class.MonadSTM (modifyTVar', newTBQueue, newTVarIO, readTBQueue, readTVarIO, writeTBQueue) +import Data.Aeson (eitherDecodeStrict, encode) +import qualified Data.Text.Encoding as Enc +import Hydra.Chain (Chain (..), ChainComponent, OnChainTx, PostChainTx, toOnChainTx) +import Hydra.Ledger (IsTx, UTxOType) +import Hydra.Logging (Tracer, traceWith) +import Hydra.Network (MockChain (..)) +import qualified Hydra.Network as Network +import System.ZMQ4.Monadic ( + Pub (..), + Rep (..), + Req (..), + Sub (..), + ZMQ, + bind, + connect, + receive, + runZMQ, + send, + socket, + subscribe, + ) + +data MockChainLog tx + = ConnectingToMockChain {chain :: MockChain} + | MockChainStarted {syncAddress :: String, catchupAddress :: String, postAddress :: String} + | TransactionListenerStarted {postAddress :: String} + | MessageReceived {message :: String} + | FailedToDecodeMessage {message :: String} + | TransactionPublisherStarted {postAddress :: String} + | PublishingTransaction {publishedTransaction :: PostChainTx tx} + | TransactionSyncerStarted {catchupAddress :: String} + | SyncingTransactions {numberOfTransactions :: Int} + | TransactionPosted {postAddress :: String, postedTransaction :: PostChainTx tx} + | ChainSyncStarted {syncAddress :: String} + | ReceivedTransaction {receivedTransaction :: OnChainTx tx} + | CatchingUpTransactions {catchupAddress :: String, numberOfTransactions :: Int} + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +instance (Arbitrary tx, Arbitrary (UTxOType tx)) => Arbitrary (MockChainLog tx) where + arbitrary = genericArbitrary + +startChain :: IsTx tx => String -> String -> String -> Tracer IO (MockChainLog tx) -> IO () +startChain chainSyncAddress chainCatchupAddress postTxAddress tracer = do + txQueue <- atomically $ newTBQueue 50 + transactionLog <- newTVarIO [] + traceWith tracer (MockChainStarted chainSyncAddress chainCatchupAddress postTxAddress) + race_ + ( runZMQ + ( transactionSyncer + chainCatchupAddress + transactionLog + tracer + ) + ) + $ race_ + ( runZMQ + ( transactionPublisher + chainSyncAddress + txQueue + tracer + ) + ) + ( runZMQ + ( transactionListener + postTxAddress + transactionLog + txQueue + tracer + ) + ) + +transactionListener :: IsTx tx => String -> TVar IO [OnChainTx tx] -> TBQueue IO (PostChainTx tx) -> Tracer IO (MockChainLog tx) -> ZMQ z () +transactionListener postTxAddress transactionLog txQueue tracer = do + rep <- socket Rep + bind rep postTxAddress + liftIO $ traceWith tracer (TransactionListenerStarted postTxAddress) + forever $ do + msg <- receive rep + liftIO $ traceWith tracer (MessageReceived $ toString . Enc.decodeUtf8 $ msg) + case eitherDecodeStrict msg of + Right tx -> do + liftIO $ do + time <- getCurrentTime + atomically $ do + writeTBQueue txQueue tx + modifyTVar' transactionLog (<> [toOnChainTx time tx]) + send rep [] "OK" + Left other -> do + liftIO $ traceWith tracer (FailedToDecodeMessage (show msg <> ", error: " <> show other)) + send rep [] "KO" + +transactionPublisher :: IsTx tx => String -> TBQueue IO (PostChainTx tx) -> Tracer IO (MockChainLog tx) -> ZMQ z () +transactionPublisher chainSyncAddress txQueue tracer = do + pub <- socket Pub + bind pub chainSyncAddress + liftIO $ traceWith tracer (TransactionPublisherStarted chainSyncAddress) + forever $ do + tx <- liftIO $ atomically $ readTBQueue txQueue + liftIO $ traceWith tracer (PublishingTransaction tx) + time <- liftIO getCurrentTime + send pub [] (toStrict . encode $ toOnChainTx time tx) + +transactionSyncer :: IsTx tx => String -> TVar IO [OnChainTx tx] -> Tracer IO (MockChainLog tx) -> ZMQ z () +transactionSyncer chainCatchupAddress transactionLog tracer = do + rep <- socket Rep + bind rep chainCatchupAddress + liftIO $ traceWith tracer (TransactionSyncerStarted chainCatchupAddress) + forever $ do + _ <- receive rep + txs <- liftIO $ readTVarIO transactionLog + liftIO $ traceWith tracer (SyncingTransactions $ length txs) + send rep [] (toStrict $ encode txs) + +mockChainClient :: (IsTx tx, MonadIO m) => String -> Tracer IO (MockChainLog tx) -> PostChainTx tx -> m () +mockChainClient postTxAddress tracer tx = runZMQ $ do + req <- socket Req + connect req postTxAddress + send req [] (toStrict $ encode tx) + resp <- receive req + case resp of + "OK" -> liftIO (traceWith tracer (TransactionPosted postTxAddress tx)) >> pure () + _ -> error $ "Something went wrong posting " <> show tx <> ", error: " <> show resp + +runChainSync :: (IsTx tx, MonadIO m) => String -> (OnChainTx tx -> IO ()) -> Tracer IO (MockChainLog tx) -> m () +runChainSync chainSyncAddress handler tracer = do + runZMQ $ do + sub <- socket Sub + subscribe sub "" + connect sub chainSyncAddress + liftIO (traceWith tracer (ChainSyncStarted chainSyncAddress)) + forever $ do + msg <- receive sub + case eitherDecodeStrict msg of + Right tx -> liftIO $ do + traceWith tracer (ReceivedTransaction tx) + handler tx + Left{} -> error $ "cannot decode transaction " <> show msg + +catchUpTransactions :: IsTx tx => String -> (OnChainTx tx -> IO ()) -> Tracer IO (MockChainLog tx) -> IO () +catchUpTransactions catchUpAddress handler tracer = runZMQ $ do + req <- socket Req + connect req catchUpAddress + send req [] "Hello" + message <- receive req + case eitherDecodeStrict message of + Right (txs :: [OnChainTx tx]) -> liftIO $ do + traceWith tracer (CatchingUpTransactions catchUpAddress $ length txs) + forM_ txs handler + Left{} -> error $ "cannot decode catch-up transactions " <> show message + +withMockChain :: + IsTx tx => + Tracer IO (MockChainLog tx) -> + MockChain -> + ChainComponent tx IO () +withMockChain tracer mockChain@MockChain{mockChainHost, Network.syncPort = chainSyncPort, catchUpPort, postTxPort} callback action = do + traceWith tracer $ ConnectingToMockChain mockChain + catchUpTransactions ("tcp://" <> mockChainHost <> ":" <> show catchUpPort) callback tracer + runChainSync ("tcp://" <> mockChainHost <> ":" <> show chainSyncPort) callback tracer + `race_` action chain + where + chain = Chain{postTx = mockChainClient ("tcp://" <> mockChainHost <> ":" <> show postTxPort) tracer} diff --git a/hydra-node/src/Hydra/Logging/Messages.hs b/hydra-node/src/Hydra/Logging/Messages.hs index a0e54364f61..f59fbd17c4f 100644 --- a/hydra-node/src/Hydra/Logging/Messages.hs +++ b/hydra-node/src/Hydra/Logging/Messages.hs @@ -12,11 +12,14 @@ import Hydra.Prelude import Hydra.API.Server (APIServerLog) import Hydra.Chain.Direct (DirectChainLog) +import Hydra.Chain.ZeroMQ (MockChainLog) import Hydra.Ledger (TxIdType, UTxOType) import Hydra.Node (HydraNodeLog) +import Test.QuickCheck (oneof) data HydraLog tx net = DirectChain {directChain :: DirectChainLog} + | MockChain {chain :: MockChainLog tx} | APIServer {api :: APIServerLog} | Network {network :: net} | Node {node :: HydraNodeLog tx} @@ -29,8 +32,15 @@ instance , Arbitrary DirectChainLog , Arbitrary (UTxOType tx) , Arbitrary (TxIdType tx) + , Arbitrary (MockChainLog tx) , Arbitrary APIServerLog ) => Arbitrary (HydraLog tx net) where - arbitrary = genericArbitrary + arbitrary = + oneof + [ DirectChain <$> arbitrary + , APIServer <$> arbitrary + , Network <$> arbitrary + , Node <$> arbitrary + ] diff --git a/hydra-node/src/Hydra/Network.hs b/hydra-node/src/Hydra/Network.hs index eed59e7230f..7cbc4656e25 100644 --- a/hydra-node/src/Hydra/Network.hs +++ b/hydra-node/src/Hydra/Network.hs @@ -23,6 +23,8 @@ module Hydra.Network ( readHost, PortNumber, readPort, + MockChain (..), + defaultMockChain, -- * Utility functions close, @@ -128,3 +130,25 @@ readPort s = else fail $ "readPort: " <> show n <> " not within " <> show maxPort where maxPort = fromIntegral (maxBound :: Word16) + +-- | Ports definition for Mock Chain client. +-- HACK: This is a temporary solution until we wire in a real chain client. +data MockChain = MockChain + { mockChainHost :: String + , syncPort :: PortNumber + , catchUpPort :: PortNumber + , postTxPort :: PortNumber + } + deriving (Eq, Show, Generic, ToJSON, FromJSON) + +instance Arbitrary MockChain where + arbitrary = genericArbitrary + +defaultMockChain :: MockChain +defaultMockChain = + MockChain + { mockChainHost = "localhost" + , syncPort = 56789 + , catchUpPort = 56790 + , postTxPort = 56791 + } diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 7ecc8d496a5..dd08d11add8 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -1,18 +1,17 @@ -{-# LANGUAGE TypeApplications #-} - module Hydra.Options ( Options (..), ChainConfig (..), parseHydraOptions, parseHydraOptionsFromString, getParseResult, + defaultOptions, ParserResult (..), ) where import Data.IP (IP) import Hydra.Chain.Direct (NetworkMagic (..)) import Hydra.Logging (Verbosity (..)) -import Hydra.Network (Host, PortNumber, readHost, readPort) +import Hydra.Network (Host, MockChain (..), PortNumber, defaultMockChain, readHost, readPort) import Hydra.Node.Version (gitRevision, showFullVersion, version) import Hydra.Prelude import Options.Applicative ( @@ -57,6 +56,9 @@ data Options = Options } deriving (Eq, Show) +defaultOptions :: Options +defaultOptions = Options (Verbose "HydraNode") 1 "127.0.0.1" 5001 [] "127.0.0.1" 4001 Nothing "hydra.sk" [] (MockChainConfig defaultMockChain) + hydraNodeParser :: Parser Options hydraNodeParser = Options @@ -72,21 +74,35 @@ hydraNodeParser = <*> many hydraVerificationKeyFileParser <*> chainConfigParser -data ChainConfig = DirectChainConfig - { networkMagic :: NetworkMagic - , nodeSocket :: FilePath - , cardanoSigningKey :: FilePath - , cardanoVerificationKeys :: [FilePath] - } +data ChainConfig + = MockChainConfig MockChain + | DirectChainConfig + { networkMagic :: NetworkMagic + , nodeSocket :: FilePath + , cardanoSigningKey :: FilePath + , cardanoVerificationKeys :: [FilePath] + } deriving (Eq, Show) chainConfigParser :: Parser ChainConfig -chainConfigParser = - DirectChainConfig - <$> networkMagicParser - <*> nodeSocketParser - <*> cardanoSigningKeyFileParser - <*> many cardanoVerificationKeyFileParser +chainConfigParser = do + mockChainConfigParser <|> directChainConfigParser + where + mockChainConfigParser = + fmap + MockChainConfig + (makeMockChain <$> mockChainHostParser <*> mockChainPortsParser) + where + makeMockChain :: String -> (PortNumber, PortNumber, PortNumber) -> MockChain + makeMockChain mockChainHost (syncPort, catchUpPort, postTxPort) = + MockChain{mockChainHost, syncPort, catchUpPort, postTxPort} + + directChainConfigParser = + DirectChainConfig + <$> networkMagicParser + <*> nodeSocketParser + <*> cardanoSigningKeyFileParser + <*> many cardanoVerificationKeyFileParser networkMagicParser :: Parser NetworkMagic networkMagicParser = @@ -96,7 +112,7 @@ networkMagicParser = ( long "network-magic" <> metavar "MAGIC" <> value 42 - <> help "Network magic for the target network." + <> help "Network magic for the target network (default: 42)." ) nodeSocketParser :: Parser FilePath @@ -104,7 +120,6 @@ nodeSocketParser = strOption ( long "node-socket" <> metavar "FILE" - <> value "node.socket" <> help "Local (Unix) socket path to connect to cardano node." ) @@ -113,7 +128,6 @@ cardanoSigningKeyFileParser = strOption ( long "cardano-signing-key" <> metavar "FILE" - <> value "cardano.sk" <> help "Signing key for the internal wallet use for Chain interactions." ) @@ -226,6 +240,25 @@ monitoringPortParser = <> help "The port this node listens on for monitoring and metrics. If left empty, monitoring server is not started" ) +mockChainHostParser :: Parser String +mockChainHostParser = do + strOption + ( long "mock-chain-host" + <> value "localhost" + <> metavar "HOSTNAME" + <> help "Address or hostname of the mock-chain (default: 'localhost')" + ) + +mockChainPortsParser :: Parser (PortNumber, PortNumber, PortNumber) +mockChainPortsParser = do + option + auto + ( long "mock-chain-ports" + <> value (56789, 56790, 56791) + <> metavar "[PORT]" + <> help "The 3-tuple of ports to connect to mock-chain, in the order: sync, catch-up, post (default: (56789, 56790, 56791))" + ) + hydraNodeOptions :: ParserInfo Options hydraNodeOptions = info diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs index 3dfc8d5d630..839498726a6 100644 --- a/hydra-node/test/Hydra/BehaviorSpec.hs +++ b/hydra-node/test/Hydra/BehaviorSpec.hs @@ -20,7 +20,7 @@ import Control.Monad.Class.MonadTimer (timeout) import Control.Monad.IOSim (Failure (FailureDeadlock), IOSim, runSimTrace, selectTraceEventsDynamic) import GHC.Records (getField) import Hydra.API.Server (Server (..)) -import Hydra.Chain (Chain (..), HeadParameters (..), OnChainTx (..), PostChainTx (..)) +import Hydra.Chain (Chain (..), PostChainTx (FanoutTx), toOnChainTx) import Hydra.ClientInput import Hydra.HeadLogic ( Effect (ClientEffect), @@ -43,7 +43,7 @@ import Hydra.Node ( ) import Hydra.Party (Party, SigningKey, aggregate, deriveParty, sign) import Hydra.ServerOutput (ServerOutput (..)) -import Hydra.Snapshot (Snapshot (..), getSnapshot) +import Hydra.Snapshot (Snapshot (..)) import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.Util (shouldBe, shouldNotBe, shouldReturn, shouldRunInSim, shouldSatisfy, traceInIOSim) @@ -439,23 +439,6 @@ simulatedChainAndNetwork = do getNodeId = getField @"party" . env --- | Derive an 'OnChainTx' from 'PostChainTx' to simulate a "perfect" chain. --- NOTE(SN): This implementation does *NOT* honor the 'HeadParameters' and --- announces hard-coded contestationDeadlines. -toOnChainTx :: UTCTime -> PostChainTx tx -> OnChainTx tx -toOnChainTx currentTime = \case - InitTx HeadParameters{contestationPeriod, parties} -> OnInitTx{contestationPeriod, parties} - (CommitTx pa ut) -> OnCommitTx pa ut - AbortTx{} -> OnAbortTx - CollectComTx{} -> OnCollectComTx - (CloseTx confirmedSnapshot) -> - OnCloseTx - { contestationDeadline = addUTCTime 10 currentTime - , snapshotNumber = number (getSnapshot confirmedSnapshot) - } - ContestTx{} -> OnContestTx - FanoutTx{} -> OnFanoutTx - -- NOTE(SN): Deliberately long to emphasize that we run these tests in IOSim. testContestationPeriod :: DiffTime testContestationPeriod = 3600 diff --git a/hydra-node/test/Hydra/Chain/ZeroMQSpec.hs b/hydra-node/test/Hydra/Chain/ZeroMQSpec.hs new file mode 100644 index 00000000000..9ec71735b7b --- /dev/null +++ b/hydra-node/test/Hydra/Chain/ZeroMQSpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE TypeApplications #-} + +module Hydra.Chain.ZeroMQSpec where + +import Hydra.Prelude +import Test.Hydra.Prelude hiding (shouldReturn) + +import Control.Concurrent (newChan, readChan, writeChan) +import Control.Monad.Class.MonadSTM (newEmptyTMVarIO, putTMVar, takeTMVar) +import Control.Monad.Class.MonadTimer (timeout) +import Hydra.Chain (HeadParameters (HeadParameters), OnChainTx (OnInitTx), PostChainTx (InitTx)) +import Hydra.Chain.ZeroMQ (catchUpTransactions, mockChainClient, runChainSync, startChain) +import Hydra.Ledger.Simple (SimpleTx) +import Hydra.Logging (nullTracer) +import Test.Util (shouldReturn) + +spec :: Spec +spec = + parallel $ + describe "Mock 0MQ-Based Chain" $ do + let sentTx = InitTx $ HeadParameters 10 [1, 2] + receivedTx = OnInitTx 10 [1, 2] + numberOfTxs :: Int + numberOfTxs = 3 + + it "publish transactions received from a client given chain is started" $ do + withMockZMQChain 54321 54322 54323 $ \syncAddress _catchUpAddress postAddress -> do + mvar <- newEmptyTMVarIO + void $ + concurrently + ( -- we lack proper synchronisation so better give chain sync time to join the party + threadDelay 0.5 >> mockChainClient @SimpleTx postAddress nullTracer sentTx + ) + (within3second $ runChainSync @SimpleTx syncAddress (atomically . putTMVar mvar) nullTracer) + + within3second (atomically $ takeTMVar mvar) `shouldReturn` Just receivedTx + + it "catches up transacions with mock chain" $ do + chan <- newChan + withMockZMQChain 54324 54325 54326 $ \_syncAddress catchUpAddress postAddress -> do + forM_ [1 .. numberOfTxs] $ const $ mockChainClient @SimpleTx postAddress nullTracer sentTx + catchUpTransactions @SimpleTx catchUpAddress (writeChan chan) nullTracer + within3second (forM [1 .. numberOfTxs] (const $ readChan chan)) + `shouldReturn` Just [receivedTx, receivedTx, receivedTx] + +withMockZMQChain :: Int -> Int -> Int -> (String -> String -> String -> IO ()) -> IO () +withMockZMQChain syncPort catchUpPort postPort action = + withAsync (startChain @SimpleTx syncAddress catchUpAddress postAddress nullTracer) $ \_ -> do + action syncAddress catchUpAddress postAddress + where + syncAddress = "tcp://127.0.0.1:" <> show syncPort + catchUpAddress = "tcp://127.0.0.1:" <> show catchUpPort + postAddress = "tcp://127.0.0.1:" <> show postPort + +within3second :: IO a -> IO (Maybe a) +within3second = timeout 3 diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index 0c694458595..845aeccb08e 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -4,21 +4,18 @@ import Hydra.Prelude import Test.Hydra.Prelude import Hydra.Chain.Direct (NetworkMagic (NetworkMagic)) -import Hydra.Logging (Verbosity (Verbose)) -import Hydra.Network (Host (Host)) +import Hydra.Network (Host (Host), MockChain (..), defaultMockChain) import Hydra.Options ( ChainConfig (..), Options (..), ParserResult (..), + defaultOptions, parseHydraOptionsFromString, ) spec :: Spec spec = parallel $ describe "Hydra Node Options" $ do - it "has defaults" $ - [] `shouldParse` defaultOptions - it "parses --host option given valid IPv4 and IPv6 addresses" $ do ["--host", "127.0.0.1"] `shouldParse` defaultOptions{host = "127.0.0.1"} @@ -73,81 +70,42 @@ spec = parallel $ it "parses --hydra-signing-key option as a filepath" $ ["--hydra-signing-key", "./alice.sk"] `shouldParse` defaultOptions{hydraSigningKey = "./alice.sk"} - it "parses --network-magic option as a number" $ do - shouldNotParse ["--network-magic", "abc"] - ["--network-magic", "0"] + it "parses --mock-chain-ports option as a list of ports to connect to" $ + ["--mock-chain-ports", "(1,2,3)"] `shouldParse` defaultOptions { chainConfig = - defaultChainConfig - { networkMagic = NetworkMagic 0 - } - } - ["--network-magic", "-1"] -- Word32 overflow expected - `shouldParse` defaultOptions - { chainConfig = - defaultChainConfig - { networkMagic = NetworkMagic 4294967295 - } - } - ["--network-magic", "123"] - `shouldParse` defaultOptions - { chainConfig = - defaultChainConfig - { networkMagic = NetworkMagic 123 - } - } - - it "parses --node-socket as a filepath" $ - ["--node-socket", "foo.sock"] - `shouldParse` defaultOptions - { chainConfig = - defaultChainConfig - { nodeSocket = "foo.sock" - } + MockChainConfig + defaultMockChain + { syncPort = 1 + , catchUpPort = 2 + , postTxPort = 3 + } } - it "parses --cardano-signing-key option as a filepath" $ - ["--cardano-signing-key", "./alice-cardano.sk"] + it "parses --mock-chain-host option as the mock-chain host to connect to" $ + ["--mock-chain-host", "1.2.3.4"] `shouldParse` defaultOptions { chainConfig = - defaultChainConfig - { cardanoSigningKey = "./alice-cardano.sk" - } + MockChainConfig + defaultMockChain + { mockChainHost = "1.2.3.4" + } } - it "parses --cardano-verification-key option as a filepath" $ - ["--cardano-verification-key", "./alice-cardano.vk"] + it "parses mandatory options for direct chain configuration" $ + ["--node-socket", "foo.sock", "--cardano-signing-key", "my.sk"] `shouldParse` defaultOptions { chainConfig = - defaultChainConfig - { cardanoVerificationKeys = ["./alice-cardano.vk"] + DirectChainConfig + { networkMagic = NetworkMagic 42 + , nodeSocket = "foo.sock" + , cardanoSigningKey = "my.sk" + , cardanoVerificationKeys = [] } } -defaultOptions :: Options -defaultOptions = - Options - { verbosity = Verbose "HydraNode" - , nodeId = 1 - , host = "127.0.0.1" - , port = 5001 - , peers = [] - , apiHost = "127.0.0.1" - , apiPort = 4001 - , monitoringPort = Nothing - , hydraSigningKey = "hydra.sk" - , hydraVerificationKeys = [] - , chainConfig = defaultChainConfig - } - -defaultChainConfig :: ChainConfig -defaultChainConfig = - DirectChainConfig - { networkMagic = NetworkMagic 42 - , nodeSocket = "node.socket" - , cardanoSigningKey = "cardano.sk" - , cardanoVerificationKeys = [] - } + it "fails to parse options for direct chain when missing --cardano-signing-key" $ + shouldNotParse ["--node-socket", "foo.sock"] shouldParse :: [String] -> Options -> Expectation shouldParse args options = diff --git a/release.nix b/release.nix index 2d4746d984f..f45af6d3ec8 100644 --- a/release.nix +++ b/release.nix @@ -11,4 +11,5 @@ in # Build executables only (for now) hydra-node = hsPkgs.hydra-node.components.exes.hydra-node; hydra-tui = hsPkgs.hydra-tui.components.exes.hydra-tui; + mock-chain = hsPkgs.hydra-node.components.exes.mock-chain; } diff --git a/shell.nix b/shell.nix index 5027fe889ea..63170d04833 100644 --- a/shell.nix +++ b/shell.nix @@ -25,6 +25,7 @@ let libsodium-vrf pkgs.zlib pkgs.lzma + pkgs.zeromq ] ++ pkgs.lib.optionals (pkgs.stdenv.isLinux) [ pkgs.systemd ]; From 3f4a98605bc9a4398fb37a3cc5b180fd1547c1eb Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Tue, 22 Feb 2022 19:00:59 +0000 Subject: [PATCH 2/3] Adapt HydraNode to handle both mock and direct chain connection --- hydra-cluster/bench/Bench/EndToEnd.hs | 13 +++---- hydra-cluster/src/HydraNode.hs | 50 +++++++++++++++++-------- hydra-cluster/test/Test/EndToEndSpec.hs | 11 +++--- hydra-tui/test/Hydra/TUISpec.hs | 4 +- 4 files changed, 48 insertions(+), 30 deletions(-) diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index b78dacccd3e..4f3ac2b6e78 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -18,8 +18,7 @@ import CardanoClient ( submit, waitForTransaction, ) -import CardanoCluster (defaultNetworkId, newNodeConfig, withBFTNode) -import CardanoNode (RunningNode (..)) +import CardanoCluster (defaultNetworkId) import Control.Lens (to, (^?)) import Control.Monad.Class.MonadAsync (mapConcurrently) import Control.Monad.Class.MonadSTM ( @@ -46,7 +45,7 @@ import Hydra.Ledger (txId) import Hydra.Logging (withTracerOutputTo) import Hydra.Party (deriveParty, generateKey) import HydraNode ( - EndToEndLog (..), + ChainConnection (ConnectToMockChain), HydraClient, hydraNodeId, input, @@ -56,6 +55,7 @@ import HydraNode ( waitForNodesConnected, waitMatch, withHydraCluster, + withMockChain, withNewClient, ) import System.Directory (findExecutable) @@ -97,14 +97,13 @@ bench timeoutSeconds workDir dataset clusterSize = let cardanoKeys = map (\Dataset{signingKey} -> (getVerificationKey signingKey, signingKey)) dataset let hydraKeys = generateKey <$> [1 .. toInteger (length cardanoKeys)] let parties = Set.fromList (deriveParty <$> hydraKeys) - config <- newNodeConfig workDir withOSStats workDir $ - withBFTNode (contramap FromCluster tracer) config (fst <$> cardanoKeys) $ \(RunningNode _ nodeSocket) -> do - withHydraCluster tracer workDir nodeSocket 1 cardanoKeys hydraKeys $ \(leader :| followers) -> do + withMockChain $ \ports -> do + withHydraCluster tracer workDir (ConnectToMockChain ports) cardanoKeys $ \(leader :| followers) -> do let nodes = leader : followers waitForNodesConnected tracer nodes - initialUTxOs <- createUTxOToCommit dataset nodeSocket + initialUTxOs <- error "undefined" let contestationPeriod = 10 :: Natural send leader $ input "Init" ["contestationPeriod" .= contestationPeriod] diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 3f5f94c66be..eeed0d4dbf4 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -4,6 +4,7 @@ module HydraNode ( HydraClient (..), + ChainConnection (..), withHydraNode, send, input, @@ -187,12 +188,14 @@ data EndToEndLog | FromCluster ClusterLog deriving (Eq, Show, Generic, ToJSON, FromJSON, ToObject) --- XXX: The two lists need to be of same length. Also the verification keys can --- be derived from the signing keys. +data ChainConnection + = ConnectToCardanoNode FilePath + | ConnectToMockChain (Int, Int, Int) + withHydraCluster :: Tracer IO EndToEndLog -> FilePath -> - FilePath -> + ChainConnection -> -- | First node id Int -> -- | NOTE: This decides on the size of the cluster! @@ -200,7 +203,7 @@ withHydraCluster :: [Hydra.SigningKey] -> (NonEmpty HydraClient -> IO ()) -> IO () -withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys action = do +withHydraCluster tracer workDir chainConnection firstNodeId allKeys hydraKeys action = do -- We have been bitten by this in the past when (clusterSize == 0) $ error "Cannot run a cluster with 0 number of nodes" @@ -228,7 +231,7 @@ withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys action cardanoSKey cardanoVKeys workDir - nodeSocket + chainConnection nodeId hydraSKey hydraVKeys @@ -242,14 +245,14 @@ withHydraNode :: String -> [String] -> FilePath -> - FilePath -> + ChainConnection -> Int -> SignKeyDSIGN alg -> [VerKeyDSIGN alg] -> [Int] -> (HydraClient -> IO ()) -> IO () -withHydraNode tracer cardanoSKeyPath cardanoVKeysPaths workDir nodeSocket hydraNodeId hydraSKey hydraVKeys allNodeIds action = do +withHydraNode tracer cardanoSKeyPath cardanoVKeysPaths workDir chainConnection hydraNodeId hydraSKey hydraVKeys allNodeIds action = do withFile' (workDir show hydraNodeId) $ \out -> do withSystemTempDirectory "hydra-node" $ \dir -> do let hydraSKeyPath = dir (show hydraNodeId <> ".sk") @@ -257,10 +260,12 @@ withHydraNode tracer cardanoSKeyPath cardanoVKeysPaths workDir nodeSocket hydraN hydraVKeysPaths <- forM (zip [1 ..] hydraVKeys) $ \(i :: Int, vKey) -> do let filepath = dir (show i <> ".vk") filepath <$ BS.writeFile filepath (rawSerialiseVerKeyDSIGN vKey) - let p = - (hydraNodeProcess $ defaultArguments hydraNodeId cardanoSKeyPath cardanoVKeysPaths hydraSKeyPath hydraVKeysPaths nodeSocket allNodeIds) + let args = defaultArguments hydraNodeId cardanoSKeyPath cardanoVKeysPaths hydraSKeyPath hydraVKeysPaths chainConnection allNodeIds + p = + (hydraNodeProcess $ args) { std_out = UseHandle out } + print args withCreateProcess p $ \_stdin _stdout _stderr processHandle -> do race_ @@ -302,10 +307,10 @@ defaultArguments :: [FilePath] -> FilePath -> [FilePath] -> - FilePath -> + ChainConnection -> [Int] -> [String] -defaultArguments nodeId cardanoSKey cardanoVKeys hydraSKey hydraVKeys nodeSocket allNodeIds = +defaultArguments nodeId cardanoSKey cardanoVKeys hydraSKey hydraVKeys chainConnection allNodeIds = [ "--node-id" , show nodeId , "--host" @@ -320,14 +325,27 @@ defaultArguments nodeId cardanoSKey cardanoVKeys hydraSKey hydraVKeys nodeSocket , show (6000 + nodeId) , "--hydra-signing-key" , hydraSKey - , "--cardano-signing-key" - , cardanoSKey ] <> concat [["--peer", "127.0.0.1:" <> show (5000 + i)] | i <- allNodeIds, i /= nodeId] <> concat [["--hydra-verification-key", vKey] | vKey <- hydraVKeys] - <> concat [["--cardano-verification-key", vKey] | vKey <- cardanoVKeys] - <> ["--network-magic", "42"] - <> ["--node-socket", nodeSocket] + <> chainConnectionArguments + where + chainConnectionArguments = case chainConnection of + (ConnectToCardanoNode nodeSocket) -> + [ "--network-magic" + , "42" + , "--node-socket" + , nodeSocket + , "--cardano-signing-key" + , cardanoSKey + ] + <> concat [["--cardano-verification-key", vKey] | vKey <- cardanoVKeys] + (ConnectToMockChain (sync, catchUp, post)) -> + [ "--mock-chain-host" + , "127.0.0.1" + , "--mock-chain-ports" + , "(" <> show sync <> "," <> show catchUp <> "," <> show post <> ")" + ] waitForNodesConnected :: HasCallStack => Tracer IO EndToEndLog -> [HydraClient] -> IO () waitForNodesConnected tracer clients = diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 53a1b1e3171..68092906cf9 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -53,6 +53,7 @@ import Hydra.Logging (Tracer, showLogsOnFailure) import Hydra.Party (Party, deriveParty) import qualified Hydra.Party as Party import HydraNode ( + ChainConnection (ConnectToCardanoNode), EndToEndLog (..), getMetrics, hydraNodeProcess, @@ -118,8 +119,8 @@ spec = around showLogsOnFailure $ (aliceVkPath, aliceSkPath) <- writeKeysFor tmpDir Alice (_, bobSkPath) <- writeKeysFor tmpDir Bob pparams <- queryProtocolParameters defaultNetworkId nodeSocket - withHydraNode tracer aliceSkPath [] tmpDir nodeSocket 1 aliceSk [] allNodeIds $ \n1 -> - withHydraNode tracer bobSkPath [aliceVkPath] tmpDir nodeSocket 2 bobSk [aliceVk] allNodeIds $ \n2 -> do + withHydraNode tracer aliceSkPath [] tmpDir (ConnectToCardanoNode nodeSocket) 1 aliceSk [] allNodeIds $ \n1 -> + withHydraNode tracer bobSkPath [aliceVkPath] tmpDir (ConnectToCardanoNode nodeSocket) 2 bobSk [aliceVk] allNodeIds $ \n2 -> do postSeedPayment defaultNetworkId pparams availableInitialFunds nodeSocket aliceCardanoSk 100_000_000 postSeedPayment defaultNetworkId pparams availableInitialFunds nodeSocket bobCardanoSk 100_000_000 @@ -169,9 +170,9 @@ spec = around showLogsOnFailure $ (carolVkPath, carolSkPath) <- writeKeysFor tmpDir Carol pparams <- queryProtocolParameters defaultNetworkId nodeSocket failAfter 20 $ - withHydraNode tracer aliceSkPath [bobVkPath, carolVkPath] tmpDir nodeSocket 1 aliceSk [bobVk, carolVk] allNodeIds $ \n1 -> - withHydraNode tracer bobSkPath [aliceVkPath, carolVkPath] tmpDir nodeSocket 2 bobSk [aliceVk, carolVk] allNodeIds $ \_ -> - withHydraNode tracer carolSkPath [aliceVkPath, bobVkPath] tmpDir nodeSocket 3 carolSk [aliceVk, bobVk] allNodeIds $ \_ -> do + withHydraNode tracer aliceSkPath [bobVkPath, carolVkPath] tmpDir (ConnectToCardanoNode nodeSocket) 1 aliceSk [bobVk, carolVk] allNodeIds $ \n1 -> + withHydraNode tracer bobSkPath [aliceVkPath, carolVkPath] tmpDir (ConnectToCardanoNode nodeSocket) 2 bobSk [aliceVk, carolVk] allNodeIds $ \_ -> + withHydraNode tracer carolSkPath [aliceVkPath, bobVkPath] tmpDir (ConnectToCardanoNode nodeSocket) 3 carolSk [aliceVk, bobVk] allNodeIds $ \_ -> do postSeedPayment defaultNetworkId pparams availableInitialFunds nodeSocket aliceCardanoSk 100_000_000 waitForNodesConnected tracer [n1] send n1 $ input "Init" ["contestationPeriod" .= int 10] diff --git a/hydra-tui/test/Hydra/TUISpec.hs b/hydra-tui/test/Hydra/TUISpec.hs index c250a22398d..8d6eb6e30e2 100644 --- a/hydra-tui/test/Hydra/TUISpec.hs +++ b/hydra-tui/test/Hydra/TUISpec.hs @@ -41,7 +41,7 @@ import Hydra.Party (generateKey) import qualified Hydra.Party as Hydra import Hydra.TUI (runWithVty) import Hydra.TUI.Options (Options (..)) -import HydraNode (EndToEndLog, HydraClient (HydraClient, hydraNodeId), withHydraNode) +import HydraNode (ChainConnection (ConnectToCardanoNode), EndToEndLog, HydraClient (HydraClient, hydraNodeId), withHydraNode) import System.Posix (OpenMode (WriteOnly), closeFd, defaultFileFlags, openFd) spec :: Spec @@ -101,7 +101,7 @@ setupNodeAndTUI action = -- XXX(SN): API port id is inferred from nodeId, in this case 4001 let nodeId = 1 pparams <- queryProtocolParameters defaultNetworkId nodeSocket - withHydraNode (contramap FromHydra tracer) aliceSkPath [] tmpDir nodeSocket nodeId aliceSk [] [nodeId] $ \HydraClient{hydraNodeId} -> do + withHydraNode (contramap FromHydra tracer) aliceSkPath [] tmpDir (ConnectToCardanoNode nodeSocket) nodeId aliceSk [] [nodeId] $ \HydraClient{hydraNodeId} -> do postSeedPayment defaultNetworkId pparams availableInitialFunds nodeSocket aliceCardanoSk 900_000_000 withTUITest (150, 10) $ \brickTest@TUITest{buildVty} -> do race_ From 5a4f3c00fc4fac5a172a3b419332781f5218a5c0 Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Tue, 22 Feb 2022 20:19:16 +0000 Subject: [PATCH 3/3] Benchmark runs on mock chain --- hydra-cluster/bench/Bench/EndToEnd.hs | 10 +++++++--- hydra-node/src/Hydra/Chain.hs | 2 +- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index 4f3ac2b6e78..f5b18247547 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -39,7 +39,7 @@ import Data.Scientific (Scientific) import Data.Set ((\\)) import qualified Data.Set as Set import Data.Time (UTCTime (UTCTime), nominalDiffTimeToSeconds, utctDayTime) -import Hydra.Cardano.Api (Tx, TxId, UTxO, getVerificationKey) +import Hydra.Cardano.Api (Tx, TxId, TxIn (TxIn), TxIx (TxIx), UTxO, UTxO' (UTxO), getVerificationKey, toUTxOContext, txOuts') import Hydra.Generator (Dataset (..)) import Hydra.Ledger (txId) import Hydra.Logging (withTracerOutputTo) @@ -69,7 +69,7 @@ import System.Process ( ) import Text.Printf (printf) import Text.Regex.TDFA (getAllTextMatches, (=~)) -import Prelude (read) +import Prelude (head, read) aliceSk, bobSk, carolSk :: SignKeyDSIGN MockDSIGN aliceSk = 10 @@ -103,7 +103,11 @@ bench timeoutSeconds workDir dataset clusterSize = let nodes = leader : followers waitForNodesConnected tracer nodes - initialUTxOs <- error "undefined" + let initialUTxOs = + UTxO . uncurry Map.singleton + <$> zip + ((`TxIn` TxIx 0) . txId . fundingTransaction <$> dataset) + (toUTxOContext . Prelude.head . txOuts' . fundingTransaction <$> dataset) let contestationPeriod = 10 :: Natural send leader $ input "Init" ["contestationPeriod" .= contestationPeriod] diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs index e798af9e702..09259088785 100644 --- a/hydra-node/src/Hydra/Chain.hs +++ b/hydra-node/src/Hydra/Chain.hs @@ -19,7 +19,7 @@ import Hydra.Cardano.Api ( ) import Hydra.Ledger (IsTx, TxIdType, UTxOType) import Hydra.Party (Party) -import Hydra.Snapshot (ConfirmedSnapshot, Snapshot, SnapshotNumber) +import Hydra.Snapshot (ConfirmedSnapshot, Snapshot (number), SnapshotNumber, getSnapshot) -- | Contains the head's parameters as established in the initial transaction. data HeadParameters = HeadParameters