@@ -1,3 +1,4 @@
1+{-# LANGUAGE DoAndIfThenElse #-}
12{-# LANGUAGE EmptyCase #-}
23{-# LANGUAGE LambdaCase #-}
34{-# LANGUAGE OverloadedStrings #-}
@@ -12,7 +13,7 @@ import Control.Monad
1213import Control.Monad.IO.Class
1314import Data.Bool (bool)
1415import Data.Function (fix)
15−import Data.Semigroup (Semigroup, (<>))
16+import Data.Semigroup ((<>))
1617import qualified Data.Set as Set
1718import Data.String
1819import Data.Text (Text)
@@ -23,13 +24,13 @@ import qualified Network.HTTP.Client as HTTP
2324import qualified Network.HTTP.Types as HTTP
2425import qualified Network.Socket as Socket
2526import Shelly hiding (cp)
26−import System.Directory (withCurrentDirectory, getDirectoryContents)
27+import System.Directory (getCurrentDirectory, withCurrentDirectory, getDirectoryContents)
2728import System.Environment
2829import System.Exit (ExitCode (..))
2930import System.FilePath (replaceBaseName, takeBaseName)
3031import System.Which (staticWhich)
3132import qualified System.Info
32−import System.IO (Handle, hClose)
33+import System.IO (Handle, hClose, hIsEOF, hGetContents)
3334import System.IO.Temp
3435import System.Process (readProcessWithExitCode, CreateProcess(cwd), readCreateProcessWithExitCode, proc)
3536import Test.Hspec
@@ -49,13 +50,35 @@ data ObRunState
4950cp :: FilePath
5051cp = $(staticWhich "cp")
5152
53+cabalPath :: FilePath
54+cabalPath = $(staticWhich "cabal")
55+
56+gitPath :: FilePath
57+gitPath = $(staticWhich "git")
58+
59+chownPath :: FilePath
60+chownPath = $(staticWhich "chown")
61+
62+chmodPath :: FilePath
63+chmodPath = $(staticWhich "chmod")
64+
65+whoamiPath :: FilePath
66+whoamiPath = $(staticWhich "whoami")
67+
68+nixBuildPath :: FilePath
69+nixBuildPath = $(staticWhich "nix-build")
70+
71+lnPath :: FilePath
72+lnPath = $(staticWhich "ln")
73+
74+rmPath :: FilePath
75+rmPath = $(staticWhich "rm")
76+
77+gitUserConfig :: [Text]
78+gitUserConfig = ["-c", "user.name=Obelisk Selftest", "-c", "user.email=noreply@example.com"]
79+
5280commit :: Text -> Sh ()
53−commit msg = void $ run "git"
54− [ "-c"
55− , "user.name=Obelisk Selftest"
56− , "-c"
57− , "user.email=noreply@example.com"
58− , "commit"
81+commit msg = void $ run gitPath $ gitUserConfig <> [ "commit"
5982 , "--no-gpg-sign"
6083 , "--allow-empty"
6184 , "-m"
@@ -75,6 +98,14 @@ tshow = T.pack . show
7598shellyOb :: MonadIO m => (Sh a -> Sh a) -> Sh a -> m a
7699shellyOb f obTest = shelly $ f obTest
77100
101+-- Set "ob" in a single place so it can be replaced with a
102+-- link to obelisk in the nix store in the future,
103+-- and avoid PATH hacking before calling this script.
104+ob :: FilePath
105+ob = "ob"
106+
107+augmentWithVerbosity :: (String -> [Text] -> a) -> String -> Bool -> [Text] -> a
108+augmentWithVerbosity runner executable isVerbose args = runner executable $ (if isVerbose then ("-v" :) else id) args
78109
79110main :: IO ()
80111main = do
@@ -83,82 +114,97 @@ main = do
83114 unless isVerbose $
84115 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"
85116 let verbosity = bool silently verbosely isVerbose
86− nixBuild args = run "nix-build" ("--no-out-link" : args)
87− obeliskImplRaw <- fromString <$> getEnv "OBELISK_IMPL"
117+ nixBuild args = run nixBuildPath ("--no-out-link" : args)
118+ obeliskImplDirtyReadOnly <- fromString <$> getCurrentDirectory
119+ let runOb_ = augmentWithVerbosity run_ ob isVerbose
120+ let runOb = augmentWithVerbosity run ob isVerbose
121+ let testObRunInDir' = augmentWithVerbosity testObRunInDir ob isVerbose ["run"]
122+ let testThunkPack' = augmentWithVerbosity testThunkPack ob isVerbose []
88123 let
89− withObeliskImpl f =
124+ withObeliskImplClean f =
125+ withSystemTempDirectory "obelisk-impl-clean" $ \(fromString -> obeliskImpl) -> do
126+ void . shellyOb verbosity $ chdir obeliskImpl $ do
127+ run_ gitPath ["clone", "file://" <> toTextIgnore obeliskImplDirtyReadOnly, toTextIgnore obeliskImpl]
128+ f obeliskImpl
129+
130+ withObeliskImplDirty f =
90131 withSystemTempDirectory "obelisk-impl-copy" $ \(fromString -> obeliskImpl) -> do
91132 void . shellyOb verbosity $ chdir obeliskImpl $ do
92− user <- T.strip <$> run "whoami" []
93− run_ cp ["-rT", toTextIgnore obeliskImplRaw, toTextIgnore obeliskImpl]
94− run_ "chown" ["-R", user, toTextIgnore obeliskImpl]
95− run_ "chmod" ["-R", "g-rw,o-rw", toTextIgnore obeliskImpl]
133+ user <- T.strip <$> run whoamiPath []
134+ run_ cp ["-rT", "--no-preserve=mode", toTextIgnore obeliskImplDirtyReadOnly, toTextIgnore obeliskImpl]
135+ run_ chownPath ["-R", user, toTextIgnore obeliskImpl]
136+ run_ chmodPath ["-R", "g-rw,o-rw", toTextIgnore obeliskImpl]
96137 f obeliskImpl
97138
98139 withInitCache f obeliskImpl =
99140 withSystemTempDirectory "init Cache λ" $ \initCache -> do
100141 -- Setup the ob init cache
101142 void . shellyOb verbosity $ chdir initCache $ do
102− run_ "ob" ["init", "--symlink", toTextIgnore obeliskImpl]
103− run_ "git" ["init"]
143+ runOb_ ["init", "--symlink", toTextIgnore obeliskImpl]
144+ run_ gitPath ["init"]
104145
105146 f initCache
106147
107− withObeliskImplAndInitCache f =
108− withObeliskImpl $ \impl -> withInitCache (f impl) impl
148+ withObeliskImplDirtyAndInitCache f =
149+ withObeliskImplDirty $ \impl -> withInitCache (f impl) impl
109150
110151 httpManager <- HTTP.newManager HTTP.defaultManagerSettings
111152
112− withObeliskImplAndInitCache $ \obeliskImpl initCache ->
153+ withObeliskImplDirtyAndInitCache $ \obeliskImplDirty initCache ->
113154 hspec $ parallel $ do
114155 let shelly_ = void . shellyOb verbosity
115156
116− inTmp :: (FilePath -> Sh a) -> IO ()
117− inTmp f = withTmp (chdir <*> f)
157+ defaultTmpDirName = "test λ"
158+
159+ inTmp' :: FilePath -> (FilePath -> Sh a) -> IO ()
160+ inTmp' dirname f = withTmp' dirname (chdir <*> f)
161+ inTmp = inTmp' defaultTmpDirName
118162
119− withTmp f = shelly_ . withSystemTempDirectory "test λ" $ f . fromString
163+ withTmp' dirname f = shelly_ . withSystemTempDirectory dirname $ f . fromString
164+ withTmp = withTmp' defaultTmpDirName
120165
121− inTmpObInit f = inTmp $ \dir -> do
166+ inTmpObInit' dirname f = inTmp' dirname $ \dir -> do
122167 run_ cp ["-rT", fromString initCache, toTextIgnore dir]
123168 f dir
169+ inTmpObInit = inTmpObInit' defaultTmpDirName
124170
125171 -- To be used in tests that change the obelisk impl directory
126172 inTmpObInitWithImplCopy f = inTmpObInit $ \dir ->
127− withObeliskImpl $ \(fromString -> implCopy) -> do
128− run_ "rm" [thunk]
129− run_ "ln" ["-s", implCopy, thunk]
173+ withObeliskImplClean $ \(fromString -> implClean) -> do
174+ run_ rmPath [thunk]
175+ run_ lnPath ["-s", implClean, thunk]
130176 f dir
131177
132178 assertRevEQ a b = liftIO . assertEqual "" "" =<< diff a b
133179 assertRevNE a b = liftIO . assertBool "" . (/= "") =<< diff a b
134180
135− revParseHead = T.strip <$> run "git" ["rev-parse", "HEAD"]
181+ revParseHead = T.strip <$> run gitPath ["rev-parse", "HEAD"]
136182
137183 commitAll = do
138− run_ "git" ["add", "."]
184+ run_ gitPath ["add", "."]
139185 commit "checkpoint"
140186 revParseHead
141187
142188 thunk = ".obelisk/impl"
143− update = run "ob" ["thunk", "update", thunk] >> commitAll
144− pack = run "ob" ["thunk", "pack", thunk] >> commitAll
145− unpack = run "ob" ["thunk", "unpack", thunk] >> commitAll
189+ update = runOb ["thunk", "update", thunk] >> commitAll
190+ pack = runOb ["thunk", "pack", thunk] >> commitAll
191+ unpack = runOb ["thunk", "unpack", thunk] >> commitAll
146192
147− diff a b = run "git" ["diff", a, b]
193+ diff a b = run gitPath ["diff", a, b]
148194
149195 describe "ob init" $ parallel $ do
150− it "works with default impl" $ inTmp $ \_ -> run "ob" ["init"]
151− it "works with master branch impl" $ inTmp $ \_ -> run "ob" ["init", "--branch", "master"]
152− it "works with symlink" $ inTmp $ \_ -> run "ob" ["init", "--symlink", toTextIgnore obeliskImpl]
196+ it "works with default impl" $ inTmp $ \_ -> runOb ["init"]
197+ it "works with master branch impl" $ inTmp $ \_ -> runOb ["init", "--branch", "master"]
198+ it "works with symlink" $ inTmp $ \_ -> runOb ["init", "--symlink", toTextIgnore obeliskImplDirty]
153199 it "doesn't silently overwrite existing files" $ withSystemTempDirectory "ob-init λ" $ \dir -> do
154− let p force = (System.Process.proc "ob" $ "--no-handoff" : "init" : ["--force"|force]) { cwd = Just dir }
200+ let p force = (System.Process.proc ob $ "--no-handoff" : "-v" : "init" : ["--force"|force]) { cwd = Just dir }
155201 (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p False) ""
156202 (ExitFailure _, _, _) <- readCreateProcessWithExitCode (p False) ""
157203 (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p True) ""
158204 pure ()
159205
160206 it "doesn't create anything when given an invalid impl" $ inTmp $ \tmp -> do
161− void $ errExit False $ run "ob" ["init", "--symlink", "/dev/null"]
207+ void $ errExit False $ runOb ["init", "--symlink", "/dev/null"]
162208 ls tmp >>= liftIO . assertEqual "" []
163209
164210 it "produces a valid route config" $ inTmpObInit $ \tmp -> liftIO $
@@ -169,17 +215,17 @@ main = do
169215 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"
170216 -- when not run by 'nix-build --attr selftest'
171217 describe "ob run" $ {- NOT parallel $ -} do
172− it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir Nothing httpManager
173− it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir (Just "frontend") httpManager
218+ it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager
219+ it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager
174220 it "works with differently named cabal files" $ inTmpObInit $ \_ -> do
175221 changeCabalPackageName "backend/backend.cabal" "new-backend"
176− testObRunInDir Nothing httpManager
222+ testObRunInDir' Nothing httpManager
177223
178224 describe "obelisk project" $ parallel $ do
179− it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskImpl]
180− it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskImpl]
181− it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskImpl]
182− it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskImpl]
225+ it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskImplDirty]
226+ it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskImplDirty]
227+ it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskImplDirty]
228+ it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskImplDirty]
183229
184230 describe "blank initialized project" $ parallel $ do
185231
@@ -200,9 +246,12 @@ main = do
200246 forM_ ["ghc", "ghcjs"] $ \compiler -> do
201247 let
202248 shellName = "shells." <> compiler
203− inShell cmd' = run "nix-shell" ["default.nix", "-A", fromString shellName, "--run", cmd']
249+ inShell cmd' = run_ "nix-shell" ["default.nix", "-A", fromString shellName, "--run", cmd']
204250 it ("can enter " <> shellName) $ inTmpObInit $ \_ -> inShell "exit"
205− it ("can build in " <> shellName) $ inTmpObInit $ \_ -> inShell $ "cabal new-build --" <> fromString compiler <> " all"
251+ -- NOTE: We override the temporary directory name because cabal has a bug preventing new-build from working
252+ -- in a path that has unicode characters.
253+ it ("can build in " <> shellName) $ inTmpObInit' "test" $ \_ -> inShell $
254+ T.pack cabalPath <> " --version; " <> T.pack cabalPath <> " new-build --" <> T.pack compiler <> " all"
206255
207256 it "has idempotent thunk update" $ inTmpObInitWithImplCopy $ \_ -> do
208257 _ <- pack
@@ -226,76 +275,93 @@ main = do
226275
227276 it "unpacks the correct branch" $ withTmp $ \dir -> do
228277 let branch = "master"
229− run_ "git" ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch]
230− run_ "ob" ["thunk", "pack", toTextIgnore dir]
231− run_ "ob" ["thunk", "unpack", toTextIgnore dir]
232− branch' <- chdir dir $ run "git" ["rev-parse", "--abbrev-ref", "HEAD"]
278+ run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch]
279+ runOb_ ["thunk", "pack", toTextIgnore dir]
280+ runOb_ ["thunk", "unpack", toTextIgnore dir]
281+ branch' <- chdir dir $ run gitPath ["rev-parse", "--abbrev-ref", "HEAD"]
233282 liftIO $ assertEqual "" branch (T.strip branch')
234283
235284 it "can pack and unpack plain git repos" $
236285 shelly_ $ withSystemTempDirectory "git-repo" $ \dir -> do
237286 let repo = toTextIgnore $ dir </> ("repo" :: String)
238− run_ "git" ["clone", "https://github.com/haskell/process.git", repo]
287+ run_ gitPath ["clone", "https://github.com/haskell/process.git", repo]
239288 origHash <- chdir (fromText repo) revParseHead
240289
241− run_ "ob" ["thunk", "pack", repo]
290+ runOb_ ["thunk", "pack", repo]
242291 packedFiles <- Set.fromList <$> ls (fromText repo)
243292 liftIO $ assertEqual "" packedFiles $ Set.fromList $ (repo </>) <$>
244293 ["default.nix", "github.json", ".attr-cache" :: String]
245294
246− run_ "ob" ["thunk", "unpack", repo]
295+ runOb_ ["thunk", "unpack", repo]
247296 chdir (fromText repo) $ do
248297 unpackHash <- revParseHead
249298 assertRevEQ origHash unpackHash
250299
251− testThunkPack $ fromText repo
300+ testThunkPack' $ fromText repo
252301
253− it "aborts thunk pack when there are uncommitted files" $ inTmpObInit $ \dir -> do
254− testThunkPack (dir </> thunk)
302+ it "aborts thunk pack when there are uncommitted files" $ inTmpObInitWithImplCopy $ \dir -> do
303+ testThunkPack' (dir </> thunk)
255304
256305 describe "ob thunk update --branch" $ parallel $ do
257306 it "can change a thunk to the latest version of a desired branch" $ withTmp $ \dir -> do
258307 let branch1 = "master"
259308 branch2 = "develop"
260− run_ "git" ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch1]
261− run_ "ob" ["thunk" , "pack", toTextIgnore dir]
262− run_ "ob" ["thunk", "update", toTextIgnore dir, "--branch", branch2]
309+ run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch1]
310+ runOb_ ["thunk" , "pack", toTextIgnore dir]
311+ runOb_ ["thunk", "update", toTextIgnore dir, "--branch", branch2]
263312
264313 it "doesn't create anything when given an invalid branch" $ withTmp $ \dir -> do
265314 let checkDir dir' = liftIO $ getDirectoryContents $ T.unpack $ toTextIgnore dir'
266− run_ "git" ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", "master"]
267− run_ "ob" ["thunk" , "pack", toTextIgnore dir]
315+ run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", "master"]
316+ runOb_ ["thunk" , "pack", toTextIgnore dir]
268317 startingContents <- checkDir dir
269− void $ errExit False $ run "ob" ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]
318+ void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]
270319 checkDir dir >>= liftIO . assertEqual "" startingContents
271320
321+ describe "ob hoogle" $ {- NOT parallel -} do
322+ it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do
323+ [p0] <- liftIO $ getFreePorts 1
324+ maskExitSuccess $ runHandle "ob" ["hoogle", "--port", T.pack (show p0)] $ \stdout -> fix $ \loop -> do
325+ ln <- liftIO $ T.hGetLine stdout
326+ echo ln
327+ let search = "Server starting on port " <> T.pack (show p0)
328+ case search `T.isInfixOf` ln of
329+ False -> loop -- keep waiting
330+ True -> do
331+ let req uri = liftIO $ HTTP.parseRequest uri >>= flip HTTP.httpLbs httpManager
332+ req ("http://127.0.0.1:" <> show p0) >>= \r -> case HTTP.responseStatus r == HTTP.ok200 of
333+ False -> errorExit $ "Request to hoogle server failed: " <> T.pack (show r)
334+ True -> exit 0
335+
336+maskExitSuccess :: Sh () -> Sh ()
337+maskExitSuccess = handle_sh (\case ExitSuccess -> pure (); e -> throw e)
272338
273339-- | Run `ob run` in the given directory (maximum of one level deep)
274−testObRunInDir :: Maybe FilePath -> HTTP.Manager -> Sh ()
275−testObRunInDir mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
340+testObRunInDir :: String -> [Text] -> Maybe FilePath -> HTTP.Manager -> Sh ()
341+testObRunInDir executable extraArgs mdir httpManager = maskExitSuccess $ do
276342 [p0, p1] <- liftIO $ getFreePorts 2
277343 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison
278344 writefile "config/common/route" $ uri p0
279− maybe id chdir mdir $ runHandle "ob" ["run", "-v"] $ \stdout -> do
280− firstUri <- handleObRunStdout httpManager stdout
345+ maybe id chdir mdir $ runHandles executable extraArgs [] $ \_stdin stdout stderr -> do
346+ firstUri <- handleObRunStdout httpManager stdout stderr
281347 let newUri = uri p1
282348 when (firstUri == newUri) $ errorExit $
283349 "Startup URI (" <> firstUri <> ") is the same as test URI (" <> newUri <> ")"
284350 maybe id (\_ -> chdir "..") mdir $ alterRouteTo newUri stdout
285− runningUri <- handleObRunStdout httpManager stdout
351+ runningUri <- handleObRunStdout httpManager stdout stderr
286352 if runningUri /= newUri
287353 then errorExit $ "Reloading failed: expected " <> newUri <> " but got " <> runningUri
288354 else exit 0
289355
290−testThunkPack :: FilePath -> Sh ()
291−testThunkPack path' = withTempFile (T.unpack $ toTextIgnore path') "test-file" $ \file handle -> do
292− let pack' = readProcessWithExitCode "ob" ["thunk", "pack", T.unpack $ toTextIgnore path'] ""
356+testThunkPack :: String -> [Text] -> FilePath -> Sh ()
357+testThunkPack executable args path' = withTempFile (T.unpack $ toTextIgnore path') "test-file" $ \file handle -> do
358+ let pack' = readProcessWithExitCode executable (T.unpack <$> ["thunk", "pack", toTextIgnore path'] ++ args) ""
293359 ensureThunkPackFails q = liftIO $ pack' >>= \case
294360 (code, out, err)
295− | code == ExitSuccess -> fail "ob thunk pack succeeded when it should have failed"
361+ | code == ExitSuccess -> fail $ "ob thunk pack succeeded when it should have failed with error '" <> show q <> "'"
296362 | q `T.isInfixOf` T.pack (out <> err) -> pure ()
297− | otherwise -> fail $ "ob thunk pack failed for an unexpected reason: " <> show out <> "\nstderr: " <> err
298− git = chdir path' . run "git"
363+ | otherwise -> fail $ "ob thunk pack failed for an unexpected reason, expecting '" <> show q <> "', received: " <> show out <> "\nstderr: " <> err
364+ git = chdir path' . run gitPath
299365 -- Untracked files
300366 ensureThunkPackFails "Untracked files"
301367 void $ git ["add", T.pack file]
@@ -308,7 +374,7 @@ testThunkPack path' = withTempFile (T.unpack $ toTextIgnore path') "test-file" $
308374 liftIO $ T.hPutStrLn handle "test file" >> hClose handle
309375 ensureThunkPackFails "modified"
310376 -- Existing stashes
311− void $ git ["stash"]
377+ void $ git $ gitUserConfig <> [ "stash" ]
312378 ensureThunkPackFails "has stashes"
313379
314380-- | Blocks until a non-empty line is available
@@ -329,9 +395,12 @@ alterRouteTo uri stdout = do
329395 "Reloading failed: " <> T.pack (show t)
330396
331397-- | Handle stdout of `ob run`: check that the frontend and backend servers are started correctly
332−handleObRunStdout :: HTTP.Manager -> Handle -> Sh Text
333−handleObRunStdout httpManager stdout = flip fix (ObRunState_Init, []) $ \loop (state, msgs) ->
334− liftIO (T.hGetLine stdout) >>= \t -> case state of
398+handleObRunStdout :: HTTP.Manager -> Handle -> Handle -> Sh Text
399+handleObRunStdout httpManager stdout stderr = flip fix (ObRunState_Init, []) $ \loop (state, msgs) -> do
400+ isEOF <- liftIO $ hIsEOF stdout
401+ if isEOF
402+ then handleObRunError msgs
403+ else liftIO (T.hGetLine stdout) >>= \t -> case state of
335404 ObRunState_Init
336405 | "Running test..." `T.isPrefixOf` t -> loop (ObRunState_BackendStarted, msgs)
337406 ObRunState_Startup
@@ -343,8 +412,12 @@ handleObRunStdout httpManager stdout = flip fix (ObRunState_Init, []) $ \loop (s
343412 obRunCheck httpManager stdout uri
344413 pure uri
345414 | not (T.null t) -> errorExit $ "Started: " <> t -- If theres any other output here, startup failed
346− _ | "Failed" `T.isPrefixOf` t -> errorExit $ "ob run failed: " <> T.unlines (reverse $ t : msgs)
415+ _ | "Failed" `T.isPrefixOf` t -> handleObRunError (t : msgs)
347416 | otherwise -> loop (state, t : msgs)
417+ where
418+ handleObRunError msgs = do
419+ stderrContent <- liftIO $ hGetContents stderr
420+ errorExit $ "ob run failed: " <> T.unlines (reverse msgs) <> " stderr: " <> T.pack stderrContent
348421
349422-- | Make requests to frontend/backend servers to check they are working properly
350423obRunCheck :: HTTP.Manager -> Handle -> Text -> Sh ()