{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module TestLib.Types ( StaticServerContext(..) , staticServer , HasStaticServerContext , BrowserDependencies(..) , browserDependencies , HasBrowserDependencies , driverConfig , HasDriverConfig , webdriverContext , HasWebDriverContext , getCapabilities , session , HasSession , SeleniumVersion(..) , SessionSpec , SpecWithWebDriver ) where import Control.Exception.Safe import Control.Monad.IO.Unlift import Data.ByteString import qualified Data.ByteString.Lazy as BL import Data.String.Interpolate import Lens.Micro import qualified Network.HTTP.Client as HC import Network.HTTP.Types.Status as N import Network.Socket (PortNumber) import Test.Sandwich import Test.Sandwich.Contexts.Nix import Test.WebDriver import Test.WebDriver.Capabilities import Test.WebDriver.Types import TestLib.Types.Cli -- * StaticServer data StaticServerContext = StaticServerContext { staticServerHostname :: String , staticServerPort :: PortNumber } staticServer :: Label "staticServer" StaticServerContext staticServer = Label type HasStaticServerContext context = HasLabel context "staticServer" StaticServerContext -- * BrowserDependencies data BrowserDependencies = BrowserDependenciesChrome { browserDependenciesChromeChrome :: FilePath , browserDependenciesChromeChromedriver :: FilePath , browserDependenciesChromeNoSandbox :: Maybe Bool } | BrowserDependenciesFirefox { browserDependenciesFirefoxFirefox :: FilePath , browserDependenciesFirefoxGeckodriver :: FilePath } deriving (Show) browserDependencies :: Label "browserDependencies" BrowserDependencies browserDependencies = Label type HasBrowserDependencies context = HasLabel context "browserDependencies" BrowserDependencies -- * WebDriver driverConfig :: Label "driverConfig" DriverConfig driverConfig = Label type HasDriverConfig context = HasLabel context "driverConfig" DriverConfig -- * WebDriver webdriverContext :: Label "webdriver" WebDriverContext webdriverContext = Label type HasWebDriverContext context = HasLabel context "webdriver" WebDriverContext -- * Session session :: Label "session" Session session = Label type HasSession context = HasLabel context "session" Session -- * Instances instance (HasSession context, MonadIO m) => SessionState (ExampleT context m) where getSession = getContext session -- putSession sess = do -- sessVar <- getContext wdSession -- writeIORef sessVar sess instance (MonadUnliftIO m, MonadCatch m) => WebDriverBase (ExampleT context m) where doCommandBase driver method path args = do let req = mkDriverRequest driver method path args -- debug [i|--> Full request: #{req} (#{showRequestBody (HC.requestBody req)})|] debug [i|--> #{HC.method req} #{HC.path req}#{HC.queryString req} (#{showRequestBody (HC.requestBody req)})|] response <- tryAny (liftIO $ HC.httpLbs req (_driverManager driver)) >>= either throwIO return let (N.Status code _) = HC.responseStatus response debug [i|<-- #{code} #{response}|] return response where showRequestBody :: HC.RequestBody -> ByteString showRequestBody (HC.RequestBodyLBS bytes) = BL.toStrict bytes showRequestBody (HC.RequestBodyBS bytes) = bytes showRequestBody _ = "" -- * Config getCapabilities :: MonadIO m => Bool -> BrowserDependencies -> m Capabilities getCapabilities headless (BrowserDependenciesChrome {..}) = pure $ defaultCaps { _capabilitiesBrowserName = Just "chrome" , _capabilitiesGoogChromeOptions = Just $ defaultChromeOptions & over (chromeOptionsArgs . non []) (if headless then (\xs -> "--headless" : [i|--window-size=1920,1080|] : xs) else id) & over (chromeOptionsArgs . non []) (if browserDependenciesChromeNoSandbox == Just True then ("--no-sandbox" :) else id) & set chromeOptionsBinary (Just browserDependenciesChromeChrome) } getCapabilities headless (BrowserDependenciesFirefox {..}) = pure $ defaultCaps { _capabilitiesBrowserName = Just "firefox" , _capabilitiesMozFirefoxOptions = Just $ defaultFirefoxOptions & set firefoxOptionsBinary (Just browserDependenciesFirefoxFirefox) & over (firefoxOptionsArgs . non []) (if headless then ("-headless" :) else id) } -- * Spec types type SpecWithWebDriver = forall context. ( HasBaseContext context , HasCommandLineOptions context UserOptions , HasBrowserDependencies context , HasDriverConfig context , HasWebDriverContext context , HasStaticServerContext context , HasNixContext context ) => SpecFree context IO () type SessionSpec = forall context. ( HasBaseContext context , HasCommandLineOptions context UserOptions , HasBrowserDependencies context , HasDriverConfig context , HasWebDriverContext context , HasStaticServerContext context ) => SpecFree context IO ()