From 67542838e2978fd6752f26d190d2f5a869a54e32 Mon Sep 17 00:00:00 2001 From: Samir Talwar Date: Tue, 17 Aug 2021 19:16:19 +0200 Subject: [PATCH 1/4] Use the port file and dynamic port generation in client/server tests. This creates a runner named `runner_with_port_file` which knows how to interpolate two variables, `%PORT_FILE%` and `%PORT%`. This allows us to use the `port-file` argument to the kvutils runner rather than hard-coding a port for conformance tests. For now, we only use this for generating the kvutils reference ledger export. CHANGELOG_BEGIN CHANGELOG_END --- .../runner_with_port_file/BUILD.bazel | 25 +++++++ .../runner_with_port_file/Main.hs | 71 +++++++++++++++++++ ledger/participant-state/kvutils/BUILD.bazel | 10 ++- 3 files changed, 100 insertions(+), 6 deletions(-) create mode 100644 bazel_tools/client_server/runner_with_port_file/BUILD.bazel create mode 100644 bazel_tools/client_server/runner_with_port_file/Main.hs diff --git a/bazel_tools/client_server/runner_with_port_file/BUILD.bazel b/bazel_tools/client_server/runner_with_port_file/BUILD.bazel new file mode 100644 index 000000000000..6fee3e82e535 --- /dev/null +++ b/bazel_tools/client_server/runner_with_port_file/BUILD.bazel @@ -0,0 +1,25 @@ +# Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +load("//bazel_tools:haskell.bzl", "da_haskell_binary") + +da_haskell_binary( + name = "runner_with_port_file", + srcs = ["Main.hs"], + hackage_deps = [ + "base", + "extra", + "async", + "directory", + "monad-loops", + "network", + "process", + "safe", + "safe-exceptions", + "split", + "temporary", + "text", + ], + visibility = ["//visibility:public"], + deps = ["//libs-haskell/da-hs-base"], +) diff --git a/bazel_tools/client_server/runner_with_port_file/Main.hs b/bazel_tools/client_server/runner_with_port_file/Main.hs new file mode 100644 index 000000000000..321699c6a34d --- /dev/null +++ b/bazel_tools/client_server/runner_with_port_file/Main.hs @@ -0,0 +1,71 @@ +-- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +{-% LANGUAGE OverloadedStrings %-} + +module Main(main) where + +import Control.Concurrent +import Control.Exception.Safe +import Control.Monad (forM, forM_) +import Control.Monad.Loops (untilJust) +import Data.List.Split (splitOn) +import Network.Socket +import System.Directory (removeFile) +import System.Environment +import System.IO.Temp (emptySystemTempFile) +import System.Process +import qualified Data.Text as Text + +main :: IO () +main = do + [clientExe, clientArgs, serverExe, serverArgs, _] <- getArgs + let splitArgs = filter (/= "") . splitOn " " + (portFile, serverArgs') <- generatePortFile (splitArgs serverArgs) + let serverProc = proc serverExe serverArgs' + withCreateProcess serverProc $ \_stdin _stdout _stderr _ph -> do + maybePort <- forM portFile $ \file -> do + putStrLn $ "Waiting for the port in the file \"" <> file <> "\" to open..." + waitForConnectionInPortFile (threadDelay 500000) file + let clientArgs' = case maybePort of + Nothing -> splitArgs clientArgs + Just port -> map (interpolateVariable "PORT" (show port)) (splitArgs clientArgs) + callProcess clientExe clientArgs' + forM_ portFile removeFile + +interpolateVariable :: String -> String -> String -> String +interpolateVariable variable replacement = + Text.unpack . Text.replace ("%" <> Text.pack variable <> "%") (Text.pack replacement) . Text.pack + +generatePortFile :: [String] -> IO (Maybe String, [String]) +generatePortFile args = do + if any (Text.isInfixOf "%PORT_FILE%" . Text.pack) args + then do + portFile <- emptySystemTempFile "port" + removeFile portFile + let replacedArgs = map (interpolateVariable "PORT_FILE" portFile) args + return (Just portFile, replacedArgs) + else + return (Nothing, args) + +waitForConnectionInPortFile :: IO () -> FilePath -> IO Int +waitForConnectionInPortFile sleep portFile = do + let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream } + untilJust $ do + eitherPortFileContents <- tryIO (Text.unpack . Text.strip . Text.pack <$> readFile portFile) + case eitherPortFileContents of + Left _ -> sleep *> pure Nothing + Right portFileContents -> + case reads @Int portFileContents of + [(port, "")] -> do + addr : _ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just $ show port) + connectionResult <- tryIO $ checkConnection addr + case connectionResult of + Left _ -> sleep *> pure Nothing + Right _ -> pure $ Just port + _ -> sleep *> pure Nothing + where + checkConnection addr = bracket + (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) + close + (\s -> connect s (addrAddress addr)) diff --git a/ledger/participant-state/kvutils/BUILD.bazel b/ledger/participant-state/kvutils/BUILD.bazel index 41cdb042db0b..e9df1e6f1140 100644 --- a/ledger/participant-state/kvutils/BUILD.bazel +++ b/ledger/participant-state/kvutils/BUILD.bazel @@ -238,8 +238,6 @@ proto_jars( REFERENCE_LEDGER_EXPORT_NAME = "reference-ledger-export" -REFERENCE_LEDGER_EXPORT_PORT = 65102 - # Generates a ledger export by running the test tool against a kvutils-based ledger. client_server_build( name = REFERENCE_LEDGER_EXPORT_NAME, @@ -249,15 +247,15 @@ client_server_build( client_args = [ "--concurrent-test-runs=4", "--timeout-scale-factor=20", - "localhost:%d" % REFERENCE_LEDGER_EXPORT_PORT, + "localhost:%PORT%", ], output_env = "KVUTILS_LEDGER_EXPORT", - runner = "@//bazel_tools/client_server/runner_with_port_check:runner", - runner_args = [str(REFERENCE_LEDGER_EXPORT_PORT)], + runner = "@//bazel_tools/client_server/runner_with_port_file", + runner_args = [], server = "//ledger/ledger-on-memory:app", server_args = [ "--contract-id-seeding=testing-weak", - "--participant=participant-id=%s,port=%d" % (REFERENCE_LEDGER_EXPORT_NAME, REFERENCE_LEDGER_EXPORT_PORT), + "--participant=participant-id=export,port=0,port-file=%PORT_FILE%", ], visibility = [":__subpackages__"], ) if not is_windows else None From c9949612ced8f23f898f79435d1e950a9ea17e1e Mon Sep 17 00:00:00 2001 From: Samir Talwar Date: Wed, 18 Aug 2021 10:19:20 +0200 Subject: [PATCH 2/4] Simplify the runner_with_port_file considerably. It doesn't need to check if the port is open; we trust that the process will do it. This also makes sure the port file will be cleaned up, and reduces the number of dependencies by making use of more functions in `extra`. --- .../runner_with_port_file/BUILD.bazel | 9 +- .../runner_with_port_file/Main.hs | 89 ++++++------------- 2 files changed, 29 insertions(+), 69 deletions(-) diff --git a/bazel_tools/client_server/runner_with_port_file/BUILD.bazel b/bazel_tools/client_server/runner_with_port_file/BUILD.bazel index 6fee3e82e535..3af5e93a4cec 100644 --- a/bazel_tools/client_server/runner_with_port_file/BUILD.bazel +++ b/bazel_tools/client_server/runner_with_port_file/BUILD.bazel @@ -8,17 +8,10 @@ da_haskell_binary( srcs = ["Main.hs"], hackage_deps = [ "base", - "extra", - "async", "directory", - "monad-loops", - "network", + "extra", "process", - "safe", - "safe-exceptions", - "split", "temporary", - "text", ], visibility = ["//visibility:public"], deps = ["//libs-haskell/da-hs-base"], diff --git a/bazel_tools/client_server/runner_with_port_file/Main.hs b/bazel_tools/client_server/runner_with_port_file/Main.hs index 321699c6a34d..a3d213ac618e 100644 --- a/bazel_tools/client_server/runner_with_port_file/Main.hs +++ b/bazel_tools/client_server/runner_with_port_file/Main.hs @@ -1,71 +1,38 @@ -- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -{-% LANGUAGE OverloadedStrings %-} +module Main (main) where -module Main(main) where - -import Control.Concurrent -import Control.Exception.Safe -import Control.Monad (forM, forM_) -import Control.Monad.Loops (untilJust) -import Data.List.Split (splitOn) -import Network.Socket +import Data.List.Extra (replace, splitOn, stripInfix) +import Data.Maybe (isJust) import System.Directory (removeFile) -import System.Environment -import System.IO.Temp (emptySystemTempFile) -import System.Process -import qualified Data.Text as Text +import System.Environment (getArgs) +import System.Process (callProcess, proc, withCreateProcess) +import System.IO.Temp (emptyTempFile, withSystemTempDirectory) + +import DA.PortFile main :: IO () main = do [clientExe, clientArgs, serverExe, serverArgs, _] <- getArgs let splitArgs = filter (/= "") . splitOn " " - (portFile, serverArgs') <- generatePortFile (splitArgs serverArgs) - let serverProc = proc serverExe serverArgs' - withCreateProcess serverProc $ \_stdin _stdout _stderr _ph -> do - maybePort <- forM portFile $ \file -> do - putStrLn $ "Waiting for the port in the file \"" <> file <> "\" to open..." - waitForConnectionInPortFile (threadDelay 500000) file - let clientArgs' = case maybePort of - Nothing -> splitArgs clientArgs - Just port -> map (interpolateVariable "PORT" (show port)) (splitArgs clientArgs) - callProcess clientExe clientArgs' - forM_ portFile removeFile - -interpolateVariable :: String -> String -> String -> String -interpolateVariable variable replacement = - Text.unpack . Text.replace ("%" <> Text.pack variable <> "%") (Text.pack replacement) . Text.pack - -generatePortFile :: [String] -> IO (Maybe String, [String]) -generatePortFile args = do - if any (Text.isInfixOf "%PORT_FILE%" . Text.pack) args - then do - portFile <- emptySystemTempFile "port" - removeFile portFile - let replacedArgs = map (interpolateVariable "PORT_FILE" portFile) args - return (Just portFile, replacedArgs) - else - return (Nothing, args) - -waitForConnectionInPortFile :: IO () -> FilePath -> IO Int -waitForConnectionInPortFile sleep portFile = do - let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream } - untilJust $ do - eitherPortFileContents <- tryIO (Text.unpack . Text.strip . Text.pack <$> readFile portFile) - case eitherPortFileContents of - Left _ -> sleep *> pure Nothing - Right portFileContents -> - case reads @Int portFileContents of - [(port, "")] -> do - addr : _ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just $ show port) - connectionResult <- tryIO $ checkConnection addr - case connectionResult of - Left _ -> sleep *> pure Nothing - Right _ -> pure $ Just port - _ -> sleep *> pure Nothing - where - checkConnection addr = bracket - (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) - close - (\s -> connect s (addrAddress addr)) + let splitServerArgs = splitArgs serverArgs + withSystemTempDirectory "runner" $ \tempDir -> do + (portFile, interpolatedServerArgs) <- + if any (isJust . stripInfix "%PORT_FILE%") splitServerArgs + then do + portFile <- emptyTempFile tempDir "port" + removeFile portFile + let interpolatedArgs = map (replace "%PORT_FILE%" portFile) splitServerArgs + return (Just portFile, interpolatedArgs) + else + return (Nothing, splitServerArgs) + let serverProc = proc serverExe interpolatedServerArgs + withCreateProcess serverProc $ \_stdin _stdout _stderr _ph -> do + maybePort <- mapM (readPortFile maxRetries) portFile + let splitClientArgs = splitArgs clientArgs + let interpolatedClientArgs = + case maybePort of + Nothing -> splitClientArgs + Just port -> map (replace "%PORT%" (show port)) splitClientArgs + callProcess clientExe interpolatedClientArgs From a3eb1b46113463fbdb1bd72382c47d915c20d1d3 Mon Sep 17 00:00:00 2001 From: Samir Talwar Date: Wed, 18 Aug 2021 10:34:03 +0200 Subject: [PATCH 3/4] Simplify port file generation in the new client-server runner. Co-authored-by: Moritz Kiefer --- .../client_server/runner_with_port_file/BUILD.bazel | 1 + bazel_tools/client_server/runner_with_port_file/Main.hs | 7 +++---- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/bazel_tools/client_server/runner_with_port_file/BUILD.bazel b/bazel_tools/client_server/runner_with_port_file/BUILD.bazel index 3af5e93a4cec..fd5f744e0b08 100644 --- a/bazel_tools/client_server/runner_with_port_file/BUILD.bazel +++ b/bazel_tools/client_server/runner_with_port_file/BUILD.bazel @@ -10,6 +10,7 @@ da_haskell_binary( "base", "directory", "extra", + "filepath", "process", "temporary", ], diff --git a/bazel_tools/client_server/runner_with_port_file/Main.hs b/bazel_tools/client_server/runner_with_port_file/Main.hs index a3d213ac618e..6a39708e8e16 100644 --- a/bazel_tools/client_server/runner_with_port_file/Main.hs +++ b/bazel_tools/client_server/runner_with_port_file/Main.hs @@ -5,10 +5,10 @@ module Main (main) where import Data.List.Extra (replace, splitOn, stripInfix) import Data.Maybe (isJust) -import System.Directory (removeFile) import System.Environment (getArgs) +import System.FilePath (()) import System.Process (callProcess, proc, withCreateProcess) -import System.IO.Temp (emptyTempFile, withSystemTempDirectory) +import System.IO.Temp (withSystemTempDirectory) import DA.PortFile @@ -21,8 +21,7 @@ main = do (portFile, interpolatedServerArgs) <- if any (isJust . stripInfix "%PORT_FILE%") splitServerArgs then do - portFile <- emptyTempFile tempDir "port" - removeFile portFile + let portFile = tempDir "portfile" let interpolatedArgs = map (replace "%PORT_FILE%" portFile) splitServerArgs return (Just portFile, interpolatedArgs) else From a2fcb240bc6de7eb68c2ecbcb4aa24404d2cb89b Mon Sep 17 00:00:00 2001 From: Samir Talwar Date: Wed, 18 Aug 2021 14:43:56 +0200 Subject: [PATCH 4/4] Simplify the runner_with_port_file further. This doesn't need to work if the server doesn't take a port file. --- .../runner_with_port_file/Main.hs | 25 ++++++++----------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/bazel_tools/client_server/runner_with_port_file/Main.hs b/bazel_tools/client_server/runner_with_port_file/Main.hs index 6a39708e8e16..4a1c5fd1d24f 100644 --- a/bazel_tools/client_server/runner_with_port_file/Main.hs +++ b/bazel_tools/client_server/runner_with_port_file/Main.hs @@ -3,11 +3,14 @@ module Main (main) where +import Control.Monad (unless) import Data.List.Extra (replace, splitOn, stripInfix) import Data.Maybe (isJust) import System.Environment (getArgs) import System.FilePath (()) import System.Process (callProcess, proc, withCreateProcess) +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) import System.IO.Temp (withSystemTempDirectory) import DA.PortFile @@ -17,21 +20,15 @@ main = do [clientExe, clientArgs, serverExe, serverArgs, _] <- getArgs let splitArgs = filter (/= "") . splitOn " " let splitServerArgs = splitArgs serverArgs + let splitClientArgs = splitArgs clientArgs + unless (any (isJust . stripInfix "%PORT_FILE%") splitServerArgs) $ do + hPutStrLn stderr "No server parameters accept a port file." + exitFailure withSystemTempDirectory "runner" $ \tempDir -> do - (portFile, interpolatedServerArgs) <- - if any (isJust . stripInfix "%PORT_FILE%") splitServerArgs - then do - let portFile = tempDir "portfile" - let interpolatedArgs = map (replace "%PORT_FILE%" portFile) splitServerArgs - return (Just portFile, interpolatedArgs) - else - return (Nothing, splitServerArgs) + let portFile = tempDir "portfile" + let interpolatedServerArgs = map (replace "%PORT_FILE%" portFile) splitServerArgs let serverProc = proc serverExe interpolatedServerArgs withCreateProcess serverProc $ \_stdin _stdout _stderr _ph -> do - maybePort <- mapM (readPortFile maxRetries) portFile - let splitClientArgs = splitArgs clientArgs - let interpolatedClientArgs = - case maybePort of - Nothing -> splitClientArgs - Just port -> map (replace "%PORT%" (show port)) splitClientArgs + port <- readPortFile maxRetries portFile + let interpolatedClientArgs = map (replace "%PORT%" (show port)) splitClientArgs callProcess clientExe interpolatedClientArgs