@@ -48,6 +48,7 @@ import qualified GHCJS.DOM.GlobalEventHandlers as Events
4848import qualified Data.ByteString.Lazy as LBS
4949import qualified Data.Text as T
5050import qualified Data.Text.Encoding as TE
51+import Network.Socket
5152import qualified Network.Wai.Handler.Warp as Warp
5253import qualified Test.WebDriver as WD
5354
@@ -55,7 +56,7 @@ testTimeLimit :: Int
5556testTimeLimit = 1 * 1000 * 1000
5657
5758chromeConfig :: FilePath -> WD.WDConfig
58−chromeConfig chromePath = WD.useBrowser (WD.chrome { WD.chromeBinary = Just "/nix/store/hf9r4nmjsz03mb73c11gn4prdcf47sxa-chromium-69.0.3497.81/bin/chromium", WD.chromeOptions = ["--headless"]}) WD.defaultConfig
59+chromeConfig chromePath = WD.useBrowser (WD.chrome { WD.chromeBinary = Just chromePath, WD.chromeOptions = ["--headless"]}) WD.defaultConfig
5960
6061-- TODO list
6162-- use only available ports
@@ -676,16 +677,15 @@ testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out")
676677 mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) $ bodyWidget
677678 syncPoint
678679 application <- jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html
679− --port <- randomRIO (3000, 50000)
680− let port = 3911 -- TODO
681− let settings = Warp.setPort port Warp.defaultSettings
680+ port <- getFreePort
681+ let settings = Warp.setPort (fromIntegral $ toInteger port) Warp.defaultSettings
682682 -- hSilence to get rid of ConnectionClosed logs
683683 jsaddleWarp = forkIO $ Warp.runSettings settings application
684684 bracket jsaddleWarp killThread $ \_ -> do
685685 (_, Just out, Just err, _) <- createProcess $ (shell "whereis chromium") { std_out = CreatePipe }
686686 whereisRes <- liftIO $ TE.decodeUtf8 <$> BS.hGetContents out
687687 let chromePath = case T.words whereisRes of
688− _:path:_ -> path
688+ _:path':_ -> path'
689689 _ -> "/run/current-system/sw/bin/chromium" -- TODO: Need proper error if chrome not found
690690 WD.runSession (chromeConfig (T.unpack chromePath)) . WD.finallyClose $ do
691691 WD.openPage $ "http://localhost:" <> show port
@@ -694,3 +694,14 @@ testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out")
694694 liftIO $ takeMVar waitUntilSwitchover
695695 liftIO $ threadDelay 100000 -- wait a bit
696696 afterSwitchover a
697+
698+-- TODO: Should this be part of more widely used module?
699+getFreePort :: MonadIO m => m PortNumber
700+getFreePort = liftIO $ withSocketsDo $ do
701+ addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")
702+ bracket (open addr) close socketPort
703+ where
704+ open addr = do
705+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
706+ bind sock (addrAddress addr)
707+ return sock