on master help sign in
Merge pull request #21 from tomsmalley/tom-tests-use-random-port

Use random port for ob run tests

commitbdfe06d71783434971fada2a0f9ea26a13703597 authorLuigy Leon <luichi.19@gmail.com> dateFri 25 May 2018, 14:26 (8 years ago) parent68f0725d89ce14
2 files changed+18−3
lib/selftest/obelisk-selftest.cabal+1 lib/selftest/src/Obelisk/SelfTest.hs+17−3
lib/selftest/obelisk-selftest.cabal+1
@@ -16,6 +16,7 @@ library
1616 , http-types
1717 , HUnit
1818 , process
19+ , network
1920 , shelly
2021 , temporary
2122 , text
lib/selftest/src/Obelisk/SelfTest.hs+17−3
@@ -3,7 +3,7 @@
33{-# LANGUAGE TypeApplications #-}
44module Obelisk.SelfTest where
55
6−import Control.Exception (Exception, throw)
6+import Control.Exception (Exception, throw, bracket)
77import Control.Monad
88import Control.Monad.IO.Class
99import Data.Function (fix)
@@ -15,6 +15,7 @@ import qualified Data.Text as T
1515import qualified Data.Text.IO as T
1616import qualified Network.HTTP.Client as HTTP
1717import qualified Network.HTTP.Types as HTTP
18+import qualified Network.Socket as Socket
1819import Shelly
1920import System.Environment
2021import System.Exit (ExitCode (..))
@@ -143,11 +144,14 @@ main = do
143144
144145testObRun :: HTTP.Manager -> Sh ()
145146testObRun httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
147+ let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison
148+ writefile "config/common/route" . uri =<< liftIO getFreePort -- Use a free port initially
146149 runHandle "ob" ["run"] $ \stdout -> do
150+ freePort <- liftIO getFreePort
147151 (_, firstUri) <- handleObRunStdout httpManager stdout
148− let newUri = "http://localhost:8080/" -- trailing slash required for comparison
152+ let newUri = uri freePort
149153 when (firstUri == newUri) $ errorExit $
150− "Default URI (" <> firstUri <> ") is the same as test URI (" <> newUri <> ")"
154+ "Startup URI (" <> firstUri <> ") is the same as test URI (" <> newUri <> ")"
151155 alterRouteTo newUri stdout
152156 (_, runningUri) <- handleObRunStdout httpManager stdout
153157 if runningUri /= newUri
@@ -224,3 +228,13 @@ obRunCheck httpManager stdout backendPort frontendUri = do
224228 liftIO (timeout 1000000 $ T.hGetLine stdout) >>= \case
225229 Just t | "127.0.0.1" `T.isPrefixOf` t -> pure () -- Backend request logged
226230 x -> errorExit $ "Couldn't get backend request log: " <> T.pack (show x)
231+
232+getFreePort :: IO Socket.PortNumber
233+getFreePort = Socket.withSocketsDo $ do
234+ addr:_ <- Socket.getAddrInfo (Just Socket.defaultHints) (Just "127.0.0.1") (Just "0")
235+ bracket (open addr) Socket.close Socket.socketPort
236+ where
237+ open addr = do
238+ sock <- Socket.socket (Socket.addrFamily addr) (Socket.addrSocketType addr) (Socket.addrProtocol addr)
239+ Socket.bind sock (Socket.addrAddress addr)
240+ pure sock