mortred-0.0.1: src/Mortred.hs

module Mortred where

import Mortred.Session
import Mortred.Types
import Mortred.Utilities
import RIO
import System.IO (print, putStrLn)
import Test.WebDriver

webdriverConfig :: SeleniumPort -> WDConfig
webdriverConfig (SeleniumPort port) =
  defaultConfig {wdPort = port} & useBrowser chromeNoSandbox

chromeNoSandbox :: Browser
chromeNoSandbox =
  Chrome
    { chromeDriverVersion = Nothing,
      chromeOptions = ["--no-sandbox"],
      chromeBinary = Nothing,
      chromeExtensions = [],
      chromeExperimentalOptions = mempty
    }

applicationStart :: WD ()
applicationStart = do
  openPage "https://www.google.com/"
  metaContents <- findElems (ByCSS "meta") >>= mapM (getAttribute "content")
  liftIO $ print metaContents
  closeSession

getAttribute :: Text -> Element -> WD (Maybe Text)
getAttribute = flip attr

data SessionRunTimedout = SessionRunTimedout
  { port :: Int,
    host :: String,
    milliseconds :: Milliseconds
  }
  deriving (Show)

instance Exception SessionRunTimedout

-- | Wait N 'Milliseconds' for an action to succeed with a given WebDriver configuration. Throws a
-- 'SessionRunTimedout' exception if the action does not succeed within the alloted time.
waitRunSession :: (MonadThrow m, MonadUnliftIO m) => Milliseconds -> WDConfig -> WD a -> m a
waitRunSession milliseconds@(Milliseconds ms) configuration@WDConfig {wdPort, wdHost} action = do
  fromMaybeM (SessionRunTimedout wdPort wdHost milliseconds) timeoutRun
  where
    timeoutRun = timeout (ms * 1000) runSession'
    runSession' = do
      result <- tryAny $ liftIO $ runSession configuration action
      either (const runSession') pure result

runMain :: IO ()
runMain = do
  maybeSeleniumProcess <-
    tryStartSession SessionOnDemand $ SeleniumPath "./selenium-server-standalone-2.53.1.jar"

  case maybeSeleniumProcess of
    Right (StartedOnDemand seleniumProcess@SeleniumProcess {port}) -> do
      waitRunSession (Milliseconds 2500) (webdriverConfig port) applicationStart
        `finally` stopSession seleniumProcess
    Right (PremadeSession port) -> do
      waitRunSession (Milliseconds 2500) (webdriverConfig port) applicationStart
    Left e ->
      putStrLn $ "Unable to start session: " <> show e