Refactor deployment tests: (#5342)

- Move deployment tests (deployTest, fetchTest) out of integration-tests.
- Use DA.Test.Sandbox where appropriate.
- Split out code for useful test patterns: i.e. calling commands quietly, getFreePort.

changelog_begin
changelog_end

BUILD

@@ -271,10 +271,14 @@ da_haskell_repl(
         "//compiler/damlc/tests:daml-doctest",
         "//compiler/damlc/tests:damlc-test",
         "//compiler/damlc/tests:generate-simple-dalf",
+        "//compiler/damlc/tests:incremental",
         "//compiler/damlc/tests:integration-dev",
         "//compiler/damlc/tests:packaging",
         "//daml-assistant:daml",
+        "//daml-assistant:test",
         "//daml-assistant/daml-helper",
+        "//daml-assistant/daml-helper:test-deployment",
+        "//daml-assistant/daml-helper:test-tls",
         "//daml-assistant/integration-tests",
         "//language-support/hs/bindings:hs-ledger",
         "//language-support/hs/bindings:test",

compiler/damlc/tests/src/DA/Test/IncrementalBuilds.hs

@@ -11,7 +11,7 @@ import Data.Traversable
 import System.Directory.Extra
 import System.FilePath
 import System.IO.Extra
-import DA.Test.Util
+import DA.Test.Process
 import Test.Tasty
 import Test.Tasty.HUnit
 

compiler/damlc/tests/src/DA/Test/Packaging.hs

@@ -10,6 +10,7 @@ import DA.Bazel.Runfiles
 import qualified DA.Daml.LF.Ast as LF
 import DA.Daml.LF.Reader (readDalfManifest, readDalfs, packageName, Dalfs(..), DalfManifest(DalfManifest), mainDalfPath, dalfPaths)
 import qualified DA.Daml.LF.Proto3.Archive as LFArchive
+import DA.Test.Process
 import DA.Test.Util
 import Data.Conduit.Tar.Extra (dropDirectory1)
 import qualified Data.ByteString.Lazy as BSL

compiler/damlc/tests/src/DamlcTest.hs

@@ -19,6 +19,7 @@ import qualified Data.ByteString.Lazy.Char8 as BSL (pack)
 import qualified Data.Text.Extended as T
 
 import DA.Bazel.Runfiles
+import DA.Test.Process
 import DA.Test.Util
 import SdkVersion
 

daml-assistant/BUILD.bazel

@@ -30,10 +30,6 @@ da_haskell_library(
     name = "daml-lib",
     srcs = glob(
         ["src/**/*.hs"],
-        exclude = [
-            "src/DA/Daml/Assistant.hs",
-            "src/DA/Daml/Assistant/Tests.hs",
-        ],
     ),
     hackage_deps = [
         "aeson",

daml-assistant/daml-helper/BUILD.bazel

@@ -69,7 +69,7 @@ package_app(
 )
 
 da_haskell_test(
-    name = "ledger-tls",
+    name = "test-tls",
     srcs = ["test/DA/Daml/Helper/Test/Tls.hs"],
     data = [
         "daml-helper",
@@ -92,3 +92,36 @@ da_haskell_test(
         "//libs-haskell/test-utils",
     ],
 )
+
+da_haskell_test(
+    name = "test-deployment",
+    srcs = glob(["test/DA/Daml/Helper/Test/Deployment.hs"]),
+    data = [
+        "//compiler/damlc",
+        "//daml-assistant/daml-helper",
+        "//ledger/sandbox:sandbox-binary",
+    ],
+    hackage_deps = [
+        "aeson",
+        "async",
+        "base",
+        "containers",
+        "extra",
+        "filepath",
+        "jwt",
+        "main-tester",
+        "network",
+        "process",
+        "tasty",
+        "tasty-hunit",
+        "text",
+    ],
+    main_function = "DA.Daml.Helper.Test.Deployment.main",
+    src_strip_prefix = "test",
+    visibility = ["//visibility:public"],
+    deps = [
+        "//:sdk-version-hs-lib",
+        "//libs-haskell/bazel-runfiles",
+        "//libs-haskell/test-utils",
+    ],
+)

daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Deployment.hs

@@ -0,0 +1,129 @@
+-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module DA.Daml.Helper.Test.Deployment (main) where
+
+import Data.List.Extra (isInfixOf,splitOn)
+import System.Directory.Extra (withCurrentDirectory)
+import System.Environment.Blank (setEnv)
+import System.FilePath ((</>))
+import System.IO.Extra (withTempDir,writeFileUTF8)
+import Test.Tasty (TestTree,defaultMain,testGroup)
+import Test.Tasty.HUnit (testCaseSteps)
+import qualified Data.Aeson as Aeson
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import qualified Web.JWT as JWT
+
+import DA.Bazel.Runfiles (mainWorkspace,locateRunfiles,exe)
+import DA.Test.Sandbox (mbSharedSecret,withSandbox,defaultSandboxConf)
+import DA.Test.Process (callProcessSilent,callProcessForStdout)
+import SdkVersion (sdkVersion)
+
+data Tools = Tools { damlc :: FilePath, damlHelper :: FilePath }
+
+main :: IO ()
+main = do
+  -- We manipulate global state via the working directory
+  -- so running tests in parallel will cause trouble.
+  setEnv "TASTY_NUM_THREADS" "1" True
+  damlc <- locateRunfiles (mainWorkspace </> "compiler" </> "damlc" </> exe "damlc")
+  damlHelper <- locateRunfiles (mainWorkspace </> "daml-assistant" </> "daml-helper" </> exe "daml-helper")
+  let tools = Tools {..}
+  defaultMain $ testGroup "Deployment"
+    [ authenticatedUploadTest tools
+    , fetchTest tools
+    ]
+
+-- | Test `daml ledger upload-dar --access-token-file`
+authenticatedUploadTest :: Tools -> TestTree
+authenticatedUploadTest Tools{..} = do
+  let sharedSecret = "TheSharedSecret"
+  withSandbox defaultSandboxConf { mbSharedSecret = Just sharedSecret } $ \getSandboxPort ->
+    testCaseSteps "authenticatedUploadTest" $ \step -> do
+    port <- getSandboxPort
+    withTempDir $ \deployDir -> do
+      withCurrentDirectory deployDir $ do
+        writeMinimalProject
+        step "build"
+        callProcessSilent damlc ["build"]
+        let dar = ".daml/dist/proj1-0.0.1.dar"
+        let tokenFile = deployDir </> "secretToken.jwt"
+        step "upload"
+        -- The trailing newline is not required but we want to test that it is supported.
+        writeFileUTF8 tokenFile ("Bearer " <> makeSignedJwt sharedSecret <> "\n")
+        callProcessSilent damlHelper
+          [ "ledger", "upload-dar"
+          , "--access-token-file", tokenFile
+          , "--host", "localhost", "--port", show port
+          , dar
+          ]
+
+makeSignedJwt :: String -> String
+makeSignedJwt sharedSecret = do
+  let urc = JWT.ClaimsMap $ Map.fromList [ ("admin", Aeson.Bool True)]
+  let cs = mempty { JWT.unregisteredClaims = urc }
+  let key = JWT.hmacSecret $ T.pack sharedSecret
+  let text = JWT.encodeSigned key mempty cs
+  T.unpack text
+
+-- | Test `daml ledger fetch-dar`
+fetchTest :: Tools -> TestTree
+fetchTest tools@Tools{..} = do
+  withSandbox defaultSandboxConf $ \getSandboxPort ->
+    testCaseSteps "fetchTest" $ \step -> do
+    port <- getSandboxPort
+    withTempDir $ \fetchDir -> do
+      withCurrentDirectory fetchDir $ do
+        writeMinimalProject
+        let origDar = ".daml/dist/proj1-0.0.1.dar"
+        step "build/upload"
+        callProcessSilent damlc ["build"]
+        callProcessSilent damlHelper
+          [ "ledger", "upload-dar"
+          , "--host", "localhost" , "--port" , show port
+          , origDar
+          ]
+        pid <- getMainPidByInspecingDar tools origDar "proj1"
+        step "fetch/validate"
+        let fetchedDar = "fetched.dar"
+        callProcessSilent damlHelper
+          [ "ledger", "fetch-dar"
+          , "--host", "localhost" , "--port", show port
+          , "--main-package-id", pid
+          , "-o", fetchedDar
+          ]
+        callProcessSilent damlc ["validate-dar", fetchedDar]
+
+-- | Using `daml inspect-dar`, discover the main package-identifier of a dar.
+getMainPidByInspecingDar :: Tools -> FilePath -> String -> IO String
+getMainPidByInspecingDar Tools{damlc} dar projName = do
+  stdout <- callProcessForStdout damlc ["inspect-dar", dar]
+  [grepped] <- pure $
+        [ line
+        | line <- lines stdout
+        -- expect a single line containing double quotes and the projName
+        , "\"" `isInfixOf` line
+        , projName `isInfixOf` line
+        ]
+  -- and the main pid is found between the 1st and 2nd double-quotes
+  [_,pid,_] <- pure $ splitOn "\"" grepped
+  return pid
+
+-- | Write `daml.yaml` and `Main.daml` files in the current directory.
+writeMinimalProject :: IO ()
+writeMinimalProject = do
+  writeFileUTF8 "daml.yaml" $ unlines
+      [ "sdk-version: " <> sdkVersion
+      , "name: proj1"
+      , "version: 0.0.1"
+      , "source: ."
+      , "dependencies:"
+      , "  - daml-prim"
+      , "  - daml-stdlib"
+      ]
+  writeFileUTF8 "Main.daml" $ unlines
+    [ "daml 1.2"
+    , "module Main where"
+    , "template T with p : Party where signatory p"
+    ]

daml-assistant/integration-tests/src/DA/Daml/Assistant/FreePort.hs

@@ -0,0 +1,30 @@
+-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module DA.Daml.Assistant.FreePort (getFreePort,socketHints) where
+
+import Control.Exception (bracket)
+import Network.Socket
+
+-- This is slightly hacky: we need to find a free port but pass it to an
+-- external process. Technically this port could be reused between us
+-- getting it from the kernel and the external process listening
+-- on that port but ports are usually not reused aggressively so this should
+-- be fine and is certainly better than hardcoding the port.
+getFreePort :: IO PortNumber
+getFreePort = do
+    addr : _ <- getAddrInfo
+        (Just socketHints)
+        (Just "127.0.0.1")
+        (Just "0")
+    bracket
+        (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
+        close
+        (\s -> do bind s (addrAddress addr)
+                  name <- getSocketName s
+                  case name of
+                      SockAddrInet p _ -> pure p
+                      _ -> fail $ "Expected a SockAddrInet but got " <> show name)
+
+socketHints :: AddrInfo
+socketHints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream }

daml-assistant/integration-tests/src/DA/Daml/Assistant/IntegrationTests.hs

@@ -17,25 +17,27 @@ import qualified Data.Map as Map
 import Data.Maybe (maybeToList)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import Data.Typeable
+import Data.Typeable (Typeable)
 import Network.HTTP.Client
 import Network.HTTP.Types
 import Network.Socket
 import System.Directory.Extra
 import System.Environment.Blank
+import System.Exit
 import System.FilePath
 import System.IO.Extra
 import System.Info.Extra
 import System.Process
-import Test.Main hiding (withEnv)
 import Test.Tasty
 import Test.Tasty.HUnit
 import qualified Web.JWT as JWT
 
 import DA.Directory
 import DA.Bazel.Runfiles
-import DA.Daml.Helper.Run
-import DA.Test.Daml2TsUtils
+import DA.Daml.Assistant.FreePort (getFreePort,socketHints)
+import DA.Daml.Helper.Run (waitForHttpServer,waitForConnectionOnPort)
+import DA.Test.Daml2TsUtils (writeRootPackageJson)
+import DA.Test.Process (callCommandQuiet,callProcessSilent)
 import DA.Test.Util
 import SdkVersion
 
@@ -70,14 +72,11 @@ tests tmpDir damlTypesDir = withSdkResource $ \_ -> testGroup "Integration tests
     , quickstartTests quickstartDir mvnDir
     , cleanTests cleanDir
     , templateTests
-    , deployTest deployDir
-    , fetchTest tmpDir
     , codegenTests codegenDir damlTypesDir
     ]
     where quickstartDir = tmpDir </> "q-u-i-c-k-s-t-a-r-t"
           cleanDir = tmpDir </> "clean"
           mvnDir = tmpDir </> "m2"
-          deployDir = tmpDir </> "deploy"
           codegenDir = tmpDir </> "codegen"
 
 -- | Install the SDK in a temporary directory and provide the path to the SDK directory.
@@ -97,7 +96,7 @@ withSdkResource f =
                     .| Tar.Conduit.Extra.untar (Tar.Conduit.Extra.restoreFile throwError extractDir)
                 setEnv "DAML_HOME" targetDir True
                 if isWindows
-                    then callProcessQuiet
+                    then callProcessSilent
                         (extractDir </> "daml" </> damlInstallerName)
                         ["install", "--install-assistant=yes", "--set-path=no", extractDir]
                     else callCommandQuiet $ extractDir </> "install.sh"
@@ -552,179 +551,18 @@ codegenTests codegenDir damlTypes = testGroup "daml codegen" (
                         contents <- listDirectory outDir
                         assertBool "bindings were written" (not $ null contents)
 
--- | Start a sandbox on any free port
-withSandboxOnFreePort :: (Int -> IO ()) -> IO ()
-withSandboxOnFreePort f = do
-  port :: Int <- fromIntegral <$> getFreePort
-  withDevNull $ \devNull -> do
-    let sandboxProc =
-          (shell $ unwords
-           ["daml"
-           , "sandbox"
-           , "--wall-clock-time"
-           , "--port", show port
-           ]) { std_out = UseHandle devNull, std_in = CreatePipe }
-    withCreateProcess sandboxProc  $ \_ _ _ ph -> do
-      race_ (waitForProcess' sandboxProc ph) $ do
-        waitForConnectionOnPort (threadDelay 100000) port
-        f port
-        -- waitForProcess' will block on Windows so we explicitly kill the process.
-        terminateProcess ph
-
--- | Using `daml inspect-dar`, discover the main package-identifier of a dar.
-getMainPidByInspecingDar :: FilePath -> String -> IO String
-getMainPidByInspecingDar dar projName = do
-  stdout <- callCommandForStdout $ unwords ["daml damlc inspect-dar", dar ]
-  [grepped] <- pure $
-        [ line
-        | line <- lines stdout
-        -- expect a single line containing double quotes and the projName
-        , "\"" `isInfixOf` line
-        , projName `isInfixOf` line
-        ]
-  -- and the main pid is found between the 1st and 2nd double-quotes
-  [_,pid,_] <- pure $ splitOn "\"" grepped
-  return pid
-
--- | Tests for the `daml ledger fetch-dar` command
-fetchTest :: FilePath -> TestTree
-fetchTest tmpDir = testCaseSteps "daml ledger fetch-dar" $ \step -> do
-  let fetchDir = tmpDir </> "fetchTest"
-  withSandboxOnFreePort $ \port -> do
-    createDirectoryIfMissing True fetchDir
-    withCurrentDirectory fetchDir $ do
-      callCommandQuiet $ unwords ["daml new", "proj1"]
-      withCurrentDirectory "proj1" $ do
-        let origDar = ".daml/dist/proj1-0.0.1.dar"
-        step "build/upload"
-        callCommandQuiet $ unwords ["daml ledger upload-dar --port", show port]
-        pid <- getMainPidByInspecingDar origDar "proj1"
-        step "fetch/validate"
-        let fetchedDar = "fetched.dar"
-        callCommandQuiet $ unwords [ "daml ledger fetch-dar"
-                                   , "--port", show port
-                                   , "--main-package-id", pid
-                                   , "-o", fetchedDar
-                                   ]
-        callCommandQuiet $ unwords ["daml damlc validate-dar", fetchedDar]
-
-deployTest :: FilePath -> TestTree
-deployTest deployDir = testCase "daml deploy" $ do
-    createDirectoryIfMissing True deployDir
-    withCurrentDirectory deployDir $ do
-        callCommandQuiet $ unwords ["daml new", deployDir </> "proj1"]
-        callCommandQuiet $ unwords ["daml new", deployDir </> "proj2", "quickstart-java"]
-        withCurrentDirectory (deployDir </> "proj1") $ do
-            callCommandQuiet "daml build"
-            withDevNull $ \devNull -> do
-                port :: Int <- fromIntegral <$> getFreePort
-                let sharedSecret = "TheSharedSecret"
-                let sandboxProc =
-                        (shell $ unwords
-                            ["daml"
-                            , "sandbox"
-                            , "--wall-clock-time"
-                            , "--auth-jwt-hs256-unsafe=" <> sharedSecret
-                            , "--port", show port
-                            , ".daml/dist/proj1-0.0.1.dar"
-                            ]) { std_out = UseHandle devNull, std_in = CreatePipe }
-                let tokenFile = deployDir </> "secretToken.jwt"
-                -- The trailing newline is not required but we want to test that it is supported.
-                writeFileUTF8 tokenFile ("Bearer " <> makeSignedJwt sharedSecret <> "\n")
-                withCreateProcess sandboxProc  $ \_ _ _ ph ->
-                    race_ (waitForProcess' sandboxProc ph) $ do
-                        waitForConnectionOnPort (threadDelay 100000) port
-                        withCurrentDirectory (deployDir </> "proj2") $ do
-                            callCommandQuiet $ unwords
-                                [ "daml deploy"
-                                , "--access-token-file " <> tokenFile
-                                , "--port", show port
-                                , "--host localhost"
-                                ]
-                        -- waitForProcess' will block on Windows so we explicitly kill the process.
-                        terminateProcess ph
-
-makeSignedJwt :: String -> String
-makeSignedJwt sharedSecret = do
-  let urc = JWT.ClaimsMap $ Map.fromList [ ("admin", Aeson.Bool True)]
-  let cs = mempty { JWT.unregisteredClaims = urc }
-  let key = JWT.hmacSecret $ T.pack sharedSecret
-  let text = JWT.encodeSigned key mempty cs
-  T.unpack text
-
-
 damlInstallerName :: String
 damlInstallerName
     | isWindows = "daml.exe"
     | otherwise = "daml"
 
--- | Like call process but returning stdout.
-runCreateProcessForStdout :: CreateProcess -> IO String
-runCreateProcessForStdout createProcess = do
-    -- We use `repeat ' '` to keep stdin open. Really we would just
-    -- like to inherit stdin but readCreateProcessWithExitCode does
-    -- not allow us to overwrite just that and I don’t want to
-    -- reimplement everything.
-    (exit, out, err) <- readCreateProcessWithExitCode createProcess (repeat ' ')
-    hPutStr stderr err
-    unless (exit == ExitSuccess) $ throwIO $ ProcessExitFailure exit createProcess
-    return out
-
-callCommandForStdout :: String -> IO String
-callCommandForStdout cmd =
-    runCreateProcessForStdout (shell cmd)
-
--- | Like call process but hiding stdout.
-runCreateProcessQuiet :: CreateProcess -> IO ()
-runCreateProcessQuiet createProcess = do
-  _ <- runCreateProcessForStdout createProcess
-  return ()
-
--- | Like callProcess but hides stdout.
-callProcessQuiet :: FilePath -> [String] -> IO ()
-callProcessQuiet cmd args =
-    runCreateProcessQuiet (proc cmd args)
-
--- | Like callCommand but hides stdout.
-callCommandQuiet :: String -> IO ()
-callCommandQuiet cmd =
-    runCreateProcessQuiet (shell cmd)
-
-data ProcessExitFailure = ProcessExitFailure !ExitCode !CreateProcess
-    deriving (Show, Typeable)
-
-instance Exception ProcessExitFailure
-
--- This is slightly hacky: we need to find a free port but pass it to an
--- external process. Technically this port could be reused between us
--- getting it from the kernel and the external process listening
--- on that port but ports are usually not reused aggressively so this should
--- be fine and is certainly better than hardcoding the port.
-getFreePort :: IO PortNumber
-getFreePort = do
-    addr : _ <- getAddrInfo
-        (Just socketHints)
-        (Just "127.0.0.1")
-        (Just "0")
-    bracket
-        (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
-        close
-        (\s -> do bind s (addrAddress addr)
-                  name <- getSocketName s
-                  case name of
-                      SockAddrInet p _ -> pure p
-                      _ -> fail $ "Expected a SockAddrInet but got " <> show name)
-
-socketHints :: AddrInfo
-socketHints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream }
-
--- | Like waitForProcess' but throws ProcessExitFailure if the process fails to start.
+-- | Like `waitForProcess` but throws ProcessExitFailure if the process fails to start.
 waitForProcess' :: CreateProcess -> ProcessHandle -> IO ()
 waitForProcess' cp ph = do
     e <- waitForProcess ph
     unless (e == ExitSuccess) $ throwIO $ ProcessExitFailure e cp
 
--- | Getting a dev-null handle in a cross-platform way seems to be somewhat tricky so we instead
--- use a temporary file.
-withDevNull :: (Handle -> IO a) -> IO a
-withDevNull a = withTempFile $ \f -> withFile f WriteMode a
+data ProcessExitFailure = ProcessExitFailure !ExitCode !CreateProcess
+    deriving (Show, Typeable)
+
+instance Exception ProcessExitFailure

language-support/ts/codegen/tests/src/DA/Test/Daml2Ts.hs

@@ -19,6 +19,7 @@ import qualified Data.ByteString.Lazy as BSL
 import Data.Aeson
 import Test.Tasty
 import Test.Tasty.HUnit
+import DA.Test.Process
 import DA.Test.Util
 
 -- Version of eslint we use for linting the generated code.

libs-haskell/test-utils/BUILD.bazel

@@ -13,6 +13,7 @@ da_haskell_library(
         "base",
         "extra",
         "filepath",
+        "network",
         "process",
         "safe-exceptions",
         "tasty",

libs-haskell/test-utils/DA/Test/Process.hs

@@ -0,0 +1,43 @@
+-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module DA.Test.Process
+  ( ShouldSucceed(..)
+  , callProcessSilent
+  , callProcessSilentError
+  , callProcessForStdout
+  , callCommandQuiet
+  ) where
+
+import Control.Monad (unless,void)
+import System.IO.Extra (hPutStrLn,stderr)
+import System.Exit (ExitCode(ExitSuccess),exitFailure)
+import System.Process (CreateProcess,proc,shell,readCreateProcessWithExitCode)
+
+newtype ShouldSucceed = ShouldSucceed Bool
+
+callProcessSilent :: FilePath -> [String] -> IO ()
+callProcessSilent cmd args =
+  void $ run (ShouldSucceed True) (proc cmd args)
+
+callProcessSilentError :: FilePath -> [String] -> IO ()
+callProcessSilentError cmd args =
+  void $ run (ShouldSucceed False) (proc cmd args)
+
+callProcessForStdout :: FilePath -> [String] -> IO String
+callProcessForStdout cmd args =
+  run (ShouldSucceed True) (proc cmd args)
+
+callCommandQuiet :: String -> IO ()
+callCommandQuiet cmd =
+  void $ run (ShouldSucceed True) (shell cmd)
+
+run :: ShouldSucceed -> CreateProcess -> IO String
+run (ShouldSucceed shouldSucceed) cp = do
+    (exitCode, out, err) <- readCreateProcessWithExitCode cp ""
+    unless (shouldSucceed == (exitCode == ExitSuccess)) $ do
+      hPutStrLn stderr $ "Failure: Command \"" <> show cp <> "\" exited with " <> show exitCode
+      hPutStrLn stderr $ unlines ["stdout: ", out]
+      hPutStrLn stderr $ unlines ["stderr: ", err]
+      exitFailure
+    return out

libs-haskell/test-utils/DA/Test/Util.hs

@@ -10,9 +10,7 @@ module DA.Test.Util (
     withTempDirResource,
     withEnv,
     nullDevice,
-    ShouldSucceed(..),
-    callProcessSilent,
-    callProcessSilentError,
+    withDevNull,
 ) where
 
 import Control.Monad
@@ -22,8 +20,6 @@ import qualified Data.Text as T
 import System.IO.Extra
 import System.Info.Extra
 import System.Environment.Blank
-import System.Exit
-import System.Process
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -53,6 +49,11 @@ nullDevice
     | isWindows = "\\\\.\\NUL"
     | otherwise =  "/dev/null"
 
+-- | Getting a dev-null handle in a cross-platform way seems to be somewhat tricky so we instead
+-- use a temporary file.
+withDevNull :: (Handle -> IO a) -> IO a
+withDevNull a = withTempFile $ \f -> withFile f WriteMode a
+
 -- | Replace all environment variables for test action, then restore them.
 -- Avoids System.Environment.setEnv because it treats empty strings as
 -- "delete environment variable", unlike main-tester's withEnv which
@@ -74,18 +75,3 @@ withEnv vs m = bracket pushEnv popEnv (const m)
                     Nothing -> unsetEnv key
                     Just val -> setEnv key val True
                 pure (key, oldVal)
-
-newtype ShouldSucceed = ShouldSucceed Bool
-
-callProcessSilent, callProcessSilentError :: FilePath -> [String] -> IO ()
-callProcessSilent = callProcessSilent' (ShouldSucceed True)
-callProcessSilentError = callProcessSilent' (ShouldSucceed False)
-
-callProcessSilent' :: ShouldSucceed -> FilePath -> [String] -> IO ()
-callProcessSilent' (ShouldSucceed shouldSucceed) cmd args = do
-    (exitCode, out, err) <- readProcessWithExitCode cmd args ""
-    unless (shouldSucceed == (exitCode == ExitSuccess)) $ do
-      hPutStrLn stderr $ "Failure: Command \"" <> cmd <> " " <> unwords args <> "\" exited with " <> show exitCode
-      hPutStrLn stderr $ unlines ["stdout: ", out]
-      hPutStrLn stderr $ unlines ["stderr: ", err]
-      exitFailure