{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- Because of webdriver using dangerous constructors
{-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-}
-- For the undefined trick
{-# OPTIONS_GHC -fno-warn-unused-pattern-binds #-}

module Test.Syd.Webdriver
  ( -- * Defining webdriver tests
    WebdriverSpec,
    webdriverSpec,
    WebdriverTestM (..),
    runWebdriverTestM,
    WebdriverTestEnv (..),
    webdriverTestEnvSetupFunc,

    -- * Writing webdriver tests
    openPath,
    setWindowSize,

    -- * Running a selenium server
    SeleniumServerHandle (..),
    seleniumServerSetupFunc,
  )
where

import Control.Monad.Base
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Data.Aeson as JSON
import GHC.Stack
import Network.HTTP.Client as HTTP
import Network.Socket
import Network.Socket.Free
import Network.Socket.Wait as Port
import Network.URI
import Path
import Path.IO
import System.Exit
import System.Process.Typed
import Test.Syd
import Test.Syd.Path
import Test.Syd.Process.Typed
import Test.Syd.Wai
import Test.WebDriver as WD hiding (setWindowSize)
import Test.WebDriver.Class (WebDriver (..))
import qualified Test.WebDriver.Commands.Internal as WD
import qualified Test.WebDriver.JSON as WD
import Test.WebDriver.Session (WDSessionState (..))

-- | Type synonym for webdriver tests
type WebdriverSpec app = TestDef '[SeleniumServerHandle, HTTP.Manager] (WebdriverTestEnv app)

-- | A monad for webdriver tests.
-- This instantiates the 'WebDriver' class, as well as the 'IsTest' class.
newtype WebdriverTestM app a = WebdriverTestM
  { WebdriverTestM app a -> ReaderT (WebdriverTestEnv app) WD a
unWebdriverTestM :: ReaderT (WebdriverTestEnv app) WD a
  }
  deriving
    ( a -> WebdriverTestM app b -> WebdriverTestM app a
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
(forall a b.
 (a -> b) -> WebdriverTestM app a -> WebdriverTestM app b)
-> (forall a b. a -> WebdriverTestM app b -> WebdriverTestM app a)
-> Functor (WebdriverTestM app)
forall a b. a -> WebdriverTestM app b -> WebdriverTestM app a
forall a b.
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
forall app a b. a -> WebdriverTestM app b -> WebdriverTestM app a
forall app a b.
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WebdriverTestM app b -> WebdriverTestM app a
$c<$ :: forall app a b. a -> WebdriverTestM app b -> WebdriverTestM app a
fmap :: (a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
$cfmap :: forall app a b.
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
Functor,
      Functor (WebdriverTestM app)
a -> WebdriverTestM app a
Functor (WebdriverTestM app)
-> (forall a. a -> WebdriverTestM app a)
-> (forall a b.
    WebdriverTestM app (a -> b)
    -> WebdriverTestM app a -> WebdriverTestM app b)
-> (forall a b c.
    (a -> b -> c)
    -> WebdriverTestM app a
    -> WebdriverTestM app b
    -> WebdriverTestM app c)
-> (forall a b.
    WebdriverTestM app a
    -> WebdriverTestM app b -> WebdriverTestM app b)
-> (forall a b.
    WebdriverTestM app a
    -> WebdriverTestM app b -> WebdriverTestM app a)
-> Applicative (WebdriverTestM app)
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
forall app. Functor (WebdriverTestM app)
forall a. a -> WebdriverTestM app a
forall app a. a -> WebdriverTestM app a
forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall a b.
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall app a b.
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
forall a b c.
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
forall app a b c.
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
$c<* :: forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
*> :: WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
$c*> :: forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
liftA2 :: (a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
$cliftA2 :: forall app a b c.
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
<*> :: WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
$c<*> :: forall app a b.
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
pure :: a -> WebdriverTestM app a
$cpure :: forall app a. a -> WebdriverTestM app a
$cp1Applicative :: forall app. Functor (WebdriverTestM app)
Applicative,
      Applicative (WebdriverTestM app)
a -> WebdriverTestM app a
Applicative (WebdriverTestM app)
-> (forall a b.
    WebdriverTestM app a
    -> (a -> WebdriverTestM app b) -> WebdriverTestM app b)
-> (forall a b.
    WebdriverTestM app a
    -> WebdriverTestM app b -> WebdriverTestM app b)
-> (forall a. a -> WebdriverTestM app a)
-> Monad (WebdriverTestM app)
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall app. Applicative (WebdriverTestM app)
forall a. a -> WebdriverTestM app a
forall app a. a -> WebdriverTestM app a
forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall a b.
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall app a b.
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> WebdriverTestM app a
$creturn :: forall app a. a -> WebdriverTestM app a
>> :: WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
$c>> :: forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
>>= :: WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
$c>>= :: forall app a b.
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
$cp1Monad :: forall app. Applicative (WebdriverTestM app)
Monad,
      Monad (WebdriverTestM app)
Monad (WebdriverTestM app)
-> (forall a. IO a -> WebdriverTestM app a)
-> MonadIO (WebdriverTestM app)
IO a -> WebdriverTestM app a
forall app. Monad (WebdriverTestM app)
forall a. IO a -> WebdriverTestM app a
forall app a. IO a -> WebdriverTestM app a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> WebdriverTestM app a
$cliftIO :: forall app a. IO a -> WebdriverTestM app a
$cp1MonadIO :: forall app. Monad (WebdriverTestM app)
MonadIO,
      MonadReader (WebdriverTestEnv app),
      -- We don't want 'MonadBaseControl IO' or 'MonadBase IO', but we have to
      -- because webdriver uses them.
      MonadBaseControl IO,
      MonadBase IO
    )

data WebdriverTestEnv app = WebdriverTestEnv
  { -- | The base url of the app we test, so that we can test external sites just like local ones.
    WebdriverTestEnv app -> URI
webdriverTestEnvURI :: !URI,
    -- | The webdriver configuration
    WebdriverTestEnv app -> WDConfig
webdriverTestEnvConfig :: !WDConfig,
    -- | The app that we'll test.
    --
    -- You can put any piece of data here. In the case of yesod tests, we'll put an @App@ here.
    WebdriverTestEnv app -> app
webdriverTestEnvApp :: !app
  }

instance WDSessionState (WebdriverTestM app) where
  getSession :: WebdriverTestM app WDSession
getSession = ReaderT (WebdriverTestEnv app) WD WDSession
-> WebdriverTestM app WDSession
forall app a.
ReaderT (WebdriverTestEnv app) WD a -> WebdriverTestM app a
WebdriverTestM ReaderT (WebdriverTestEnv app) WD WDSession
forall (m :: * -> *). WDSessionState m => m WDSession
getSession
  putSession :: WDSession -> WebdriverTestM app ()
putSession = ReaderT (WebdriverTestEnv app) WD () -> WebdriverTestM app ()
forall app a.
ReaderT (WebdriverTestEnv app) WD a -> WebdriverTestM app a
WebdriverTestM (ReaderT (WebdriverTestEnv app) WD () -> WebdriverTestM app ())
-> (WDSession -> ReaderT (WebdriverTestEnv app) WD ())
-> WDSession
-> WebdriverTestM app ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WDSession -> ReaderT (WebdriverTestEnv app) WD ()
forall (m :: * -> *). WDSessionState m => WDSession -> m ()
putSession

instance WebDriver (WebdriverTestM app) where
  doCommand :: Method -> Text -> a -> WebdriverTestM app b
doCommand Method
m Text
p a
a = ReaderT (WebdriverTestEnv app) WD b -> WebdriverTestM app b
forall app a.
ReaderT (WebdriverTestEnv app) WD a -> WebdriverTestM app a
WebdriverTestM (ReaderT (WebdriverTestEnv app) WD b -> WebdriverTestM app b)
-> ReaderT (WebdriverTestEnv app) WD b -> WebdriverTestM app b
forall a b. (a -> b) -> a -> b
$ Method -> Text -> a -> ReaderT (WebdriverTestEnv app) WD b
forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
m Text
p a
a

instance IsTest (WebdriverTestM app ()) where
  type Arg1 (WebdriverTestM app ()) = ()
  type Arg2 (WebdriverTestM app ()) = WebdriverTestEnv app
  runTest :: WebdriverTestM app ()
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (WebdriverTestM app ())
     -> Arg2 (WebdriverTestM app ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest WebdriverTestM app ()
wdTestFunc = (() -> WebdriverTestEnv app -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> WebdriverTestEnv app -> IO ())
     -> Arg2 (() -> WebdriverTestEnv app -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() WebdriverTestEnv app
wdte -> WebdriverTestEnv app -> WebdriverTestM app () -> IO ()
forall app a. WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM WebdriverTestEnv app
wdte WebdriverTestM app ()
wdTestFunc)

instance IsTest (WebdriverTestM app (GoldenTest a)) where
  type Arg1 (WebdriverTestM app (GoldenTest a)) = ()
  type Arg2 (WebdriverTestM app (GoldenTest a)) = WebdriverTestEnv app
  runTest :: WebdriverTestM app (GoldenTest a)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (WebdriverTestM app (GoldenTest a))
     -> Arg2 (WebdriverTestM app (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest WebdriverTestM app (GoldenTest a)
wdTestFunc = (() -> WebdriverTestEnv app -> IO (GoldenTest a))
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> WebdriverTestEnv app -> IO (GoldenTest a))
     -> Arg2 (() -> WebdriverTestEnv app -> IO (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() WebdriverTestEnv app
wdte -> WebdriverTestEnv app
-> WebdriverTestM app (GoldenTest a) -> IO (GoldenTest a)
forall app a. WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM WebdriverTestEnv app
wdte WebdriverTestM app (GoldenTest a)
wdTestFunc)

-- | Run a webdriver test.
runWebdriverTestM :: WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM :: WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM WebdriverTestEnv app
env (WebdriverTestM ReaderT (WebdriverTestEnv app) WD a
func) = WDConfig -> WD a -> IO a
forall conf a. WebDriverConfig conf => conf -> WD a -> IO a
WD.runSession (WebdriverTestEnv app -> WDConfig
forall app. WebdriverTestEnv app -> WDConfig
webdriverTestEnvConfig WebdriverTestEnv app
env) (WD a -> IO a) -> WD a -> IO a
forall a b. (a -> b) -> a -> b
$
  WD a -> WD a
forall (wd :: * -> *) a. WebDriver wd => wd a -> wd a
WD.finallyClose (WD a -> WD a) -> WD a -> WD a
forall a b. (a -> b) -> a -> b
$ do
    Integer -> WD ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setImplicitWait Integer
10_000
    Integer -> WD ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setScriptTimeout Integer
10_000
    Integer -> WD ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setPageLoadTimeout Integer
10_000
    ReaderT (WebdriverTestEnv app) WD a -> WebdriverTestEnv app -> WD a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (WebdriverTestEnv app) WD a
func WebdriverTestEnv app
env

-- | Open a page on the URI in the 'WebdriverTestEnv'.
openPath :: String -> WebdriverTestM app ()
openPath :: String -> WebdriverTestM app ()
openPath String
p = do
  URI
uri <- (WebdriverTestEnv app -> URI) -> WebdriverTestM app URI
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebdriverTestEnv app -> URI
forall app. WebdriverTestEnv app -> URI
webdriverTestEnvURI
  let url :: String
url = URI -> String
forall a. Show a => a -> String
show URI
uri String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
p
  String -> WebdriverTestM app ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
String -> wd ()
openPage String
url

-- We have to override this because it returns something.
-- So we remove the 'noReturn'.
setWindowSize ::
  (HasCallStack, WebDriver wd) =>
  -- | (Width, Height)
  (Word, Word) ->
  wd ()
setWindowSize :: (Word, Word) -> wd ()
setWindowSize (Word
w, Word
h) =
  wd Value -> wd ()
forall (wd :: * -> *). WebDriver wd => wd Value -> wd ()
WD.ignoreReturn (wd Value -> wd ()) -> wd Value -> wd ()
forall a b. (a -> b) -> a -> b
$
    Method -> WindowHandle -> Text -> Value -> wd Value
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WindowHandle -> Text -> a -> wd b
WD.doWinCommand Method
methodPost WindowHandle
currentWindow Text
"/size" (Value -> wd Value) -> Value -> wd Value
forall a b. (a -> b) -> a -> b
$
      [Pair] -> Value
object [Text
"width" Text -> Word -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word
w, Text
"height" Text -> Word -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word
h]

webdriverSpec ::
  (HTTP.Manager -> SetupFunc (URI, app)) ->
  WebdriverSpec app ->
  Spec
webdriverSpec :: (Manager -> SetupFunc (URI, app)) -> WebdriverSpec app -> Spec
webdriverSpec Manager -> SetupFunc (URI, app)
appSetupFunc =
  TestDefM '[Manager] () () -> Spec
forall (outers :: [*]) inner result.
TestDefM (Manager : outers) inner result
-> TestDefM outers inner result
managerSpec
    (TestDefM '[Manager] () () -> Spec)
-> (WebdriverSpec app -> TestDefM '[Manager] () ())
-> WebdriverSpec app
-> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int)
-> TestDefM '[Manager] () () -> TestDefM '[Manager] () ()
forall (a :: [*]) b c.
(Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxSuccess (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
50)
    (TestDefM '[Manager] () () -> TestDefM '[Manager] () ())
-> (WebdriverSpec app -> TestDefM '[Manager] () ())
-> WebdriverSpec app
-> TestDefM '[Manager] () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manager -> () -> SetupFunc (URI, app))
-> TestDefM '[Manager] (URI, app) () -> TestDefM '[Manager] () ()
forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' (\Manager
man () -> Manager -> SetupFunc (URI, app)
appSetupFunc Manager
man)
    (TestDefM '[Manager] (URI, app) () -> TestDefM '[Manager] () ())
-> (WebdriverSpec app -> TestDefM '[Manager] (URI, app) ())
-> WebdriverSpec app
-> TestDefM '[Manager] () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetupFunc SeleniumServerHandle
-> TestDefM '[SeleniumServerHandle, Manager] (URI, app) ()
-> TestDefM '[Manager] (URI, app) ()
forall outer (outers :: [*]) inner result.
SetupFunc outer
-> TestDefM (outer : outers) inner result
-> TestDefM outers inner result
setupAroundAll SetupFunc SeleniumServerHandle
seleniumServerSetupFunc
    (TestDefM '[SeleniumServerHandle, Manager] (URI, app) ()
 -> TestDefM '[Manager] (URI, app) ())
-> (WebdriverSpec app
    -> TestDefM '[SeleniumServerHandle, Manager] (URI, app) ())
-> WebdriverSpec app
-> TestDefM '[Manager] (URI, app) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebdriverSpec app
-> TestDefM '[SeleniumServerHandle, Manager] (URI, app) ()
forall app.
TestDef '[SeleniumServerHandle, Manager] (WebdriverTestEnv app)
-> TestDef '[SeleniumServerHandle, Manager] (URI, app)
webdriverTestEnvSpec

webdriverTestEnvSpec ::
  TestDef '[SeleniumServerHandle, HTTP.Manager] (WebdriverTestEnv app) ->
  TestDef '[SeleniumServerHandle, HTTP.Manager] (URI, app)
webdriverTestEnvSpec :: TestDef '[SeleniumServerHandle, Manager] (WebdriverTestEnv app)
-> TestDef '[SeleniumServerHandle, Manager] (URI, app)
webdriverTestEnvSpec = (Manager
 -> (URI, app)
 -> SetupFunc
      (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)))
-> TestDefM
     '[SeleniumServerHandle, Manager]
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
     ()
-> TestDef '[SeleniumServerHandle, Manager] (URI, app)
forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' Manager
-> (URI, app)
-> SetupFunc
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
forall app.
Manager
-> (URI, app)
-> SetupFunc
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
go2 (TestDefM
   '[SeleniumServerHandle, Manager]
   (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
   ()
 -> TestDef '[SeleniumServerHandle, Manager] (URI, app))
-> (TestDef '[SeleniumServerHandle, Manager] (WebdriverTestEnv app)
    -> TestDefM
         '[SeleniumServerHandle, Manager]
         (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
         ())
-> TestDef '[SeleniumServerHandle, Manager] (WebdriverTestEnv app)
-> TestDef '[SeleniumServerHandle, Manager] (URI, app)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SeleniumServerHandle
 -> (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
 -> SetupFunc (WebdriverTestEnv app))
-> TestDef '[SeleniumServerHandle, Manager] (WebdriverTestEnv app)
-> TestDefM
     '[SeleniumServerHandle, Manager]
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
     ()
forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' SeleniumServerHandle
-> (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
-> SetupFunc (WebdriverTestEnv app)
forall app.
SeleniumServerHandle
-> (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
-> SetupFunc (WebdriverTestEnv app)
go1
  where
    go1 ::
      SeleniumServerHandle ->
      (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)) ->
      SetupFunc (WebdriverTestEnv app)
    go1 :: SeleniumServerHandle
-> (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
-> SetupFunc (WebdriverTestEnv app)
go1 SeleniumServerHandle
ssh SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)
func = SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)
func SeleniumServerHandle
ssh
    go2 ::
      HTTP.Manager ->
      (URI, app) ->
      SetupFunc (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
    go2 :: Manager
-> (URI, app)
-> SetupFunc
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
go2 Manager
man (URI
uri, app
app) = (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
-> SetupFunc
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
 -> SetupFunc
      (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)))
-> (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
-> SetupFunc
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
forall a b. (a -> b) -> a -> b
$ \SeleniumServerHandle
ssh -> SeleniumServerHandle
-> Manager -> URI -> app -> SetupFunc (WebdriverTestEnv app)
forall app.
SeleniumServerHandle
-> Manager -> URI -> app -> SetupFunc (WebdriverTestEnv app)
webdriverTestEnvSetupFunc SeleniumServerHandle
ssh Manager
man URI
uri app
app

-- | Set up a 'WebdriverTestEnv' for your app by readying a webdriver session
webdriverTestEnvSetupFunc ::
  SeleniumServerHandle ->
  HTTP.Manager ->
  URI ->
  app ->
  SetupFunc (WebdriverTestEnv app)
webdriverTestEnvSetupFunc :: SeleniumServerHandle
-> Manager -> URI -> app -> SetupFunc (WebdriverTestEnv app)
webdriverTestEnvSetupFunc SeleniumServerHandle {PortNumber
seleniumServerHandlePort :: SeleniumServerHandle -> PortNumber
seleniumServerHandlePort :: PortNumber
..} Manager
manager URI
uri app
app = do
  Path Abs File
chromeExecutable <- IO (Path Abs File) -> SetupFunc (Path Abs File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs File) -> SetupFunc (Path Abs File))
-> IO (Path Abs File) -> SetupFunc (Path Abs File)
forall a b. (a -> b) -> a -> b
$ do
    Path Rel File
chromeFile <- String -> IO (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
"chromium"
    Maybe (Path Abs File)
mExecutable <- Path Rel File -> IO (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Rel File -> m (Maybe (Path Abs File))
findExecutable Path Rel File
chromeFile
    case Maybe (Path Abs File)
mExecutable of
      Maybe (Path Abs File)
Nothing -> String -> IO (Path Abs File)
forall a. String -> IO a
die String
"No chromium found on PATH."
      Just Path Abs File
executable -> Path Abs File -> IO (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
executable

  Path Abs Dir
userDataDir <- String -> SetupFunc (Path Abs Dir)
tempDirSetupFunc String
"chromium-user-data"

  let browser :: Browser
browser =
        Browser
chrome
          { chromeOptions :: [String]
chromeOptions =
              [ String
"--user-data-dir=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Path Abs Dir -> String
fromAbsDir Path Abs Dir
userDataDir,
                String
"--headless",
                String
"--no-sandbox", -- Bypass OS security model to run on nix as well
                String
"--disable-dev-shm-usage", -- Overcome limited resource problem
                String
"--disable-gpu",
                String
"--use-gl=angle",
                String
"--use-angle=swiftshader",
                String
"--window-size=1920,1080"
              ],
            chromeBinary :: Maybe String
chromeBinary = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String
fromAbsFile Path Abs File
chromeExecutable
          }
  let caps :: Capabilities
caps =
        Capabilities
WD.defaultCaps
          { browser :: Browser
browser = Browser
browser
          }
  let webdriverTestEnvConfig :: WDConfig
webdriverTestEnvConfig =
        WDConfig
WD.defaultConfig
          { wdPort :: Int
wdPort = (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: PortNumber -> Int) PortNumber
seleniumServerHandlePort,
            wdHTTPManager :: Maybe Manager
wdHTTPManager = Manager -> Maybe Manager
forall a. a -> Maybe a
Just Manager
manager,
            wdCapabilities :: Capabilities
wdCapabilities = Capabilities
caps
          }
  let webdriverTestEnvURI :: URI
webdriverTestEnvURI = URI
uri
      webdriverTestEnvApp :: app
webdriverTestEnvApp = app
app
  WebdriverTestEnv app -> SetupFunc (WebdriverTestEnv app)
forall (f :: * -> *) a. Applicative f => a -> f a
pure WebdriverTestEnv :: forall app. URI -> WDConfig -> app -> WebdriverTestEnv app
WebdriverTestEnv {app
URI
WDConfig
webdriverTestEnvApp :: app
webdriverTestEnvURI :: URI
webdriverTestEnvConfig :: WDConfig
webdriverTestEnvApp :: app
webdriverTestEnvConfig :: WDConfig
webdriverTestEnvURI :: URI
..}

data SeleniumServerHandle = SeleniumServerHandle
  { SeleniumServerHandle -> PortNumber
seleniumServerHandlePort :: PortNumber
  }

-- | Run, and clean up, a selenium server
seleniumServerSetupFunc :: SetupFunc SeleniumServerHandle
seleniumServerSetupFunc :: SetupFunc SeleniumServerHandle
seleniumServerSetupFunc = do
  Path Abs Dir
tempDir <- String -> SetupFunc (Path Abs Dir)
tempDirSetupFunc String
"selenium-server"
  Int
portInt <- IO Int -> SetupFunc Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getFreePort
  let processConfig :: ProcessConfig () () ()
processConfig =
        StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$
          StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$
            String -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
String
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir (Path Abs Dir -> String
fromAbsDir Path Abs Dir
tempDir) (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$
              String -> [String] -> ProcessConfig () () ()
proc
                String
"selenium-server"
                [ String
"-port",
                  Int -> String
forall a. Show a => a -> String
show Int
portInt
                ]
  Process () () ()
_ <- ProcessConfig () () () -> SetupFunc (Process () () ())
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> SetupFunc (Process stdin stdout stderr)
typedProcessSetupFunc ProcessConfig () () ()
processConfig
  IO () -> SetupFunc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SetupFunc ()) -> IO () -> SetupFunc ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> IO ()
Port.wait String
"127.0.0.1" Int
portInt
  let seleniumServerHandlePort :: PortNumber
seleniumServerHandlePort = Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
portInt
  SeleniumServerHandle -> SetupFunc SeleniumServerHandle
forall (f :: * -> *) a. Applicative f => a -> f a
pure SeleniumServerHandle :: PortNumber -> SeleniumServerHandle
SeleniumServerHandle {PortNumber
seleniumServerHandlePort :: PortNumber
seleniumServerHandlePort :: PortNumber
..}