Session.hs

module Mortred.Session where

import Mortred.Selenium
import Mortred.Types
import Mortred.Utilities
import Mortred.Xvfb
import RIO
import System.Process.Typed (stopProcess)

-- | Defines how to handle potential starting up of Xvfb & Selenium.
data SessionMode
  = -- | Start Xvfb and Selenium.
    SessionOnDemand
  | -- | Don't start Xvfb and Selenium.
    SessionAlreadyStarted SeleniumPort
  deriving (Eq, Show)

-- | The result of successfully starting a session.
data SessionStartResult
  = -- | Xvfb and Selenium were started and here is the Selenium process.
    StartedOnDemand !SeleniumProcess
  | -- | The session was premade and here is the port to connect to.
    PremadeSession !SeleniumPort
  deriving (Show)

data SessionStartError
  = XvfbSessionError XvfbStartError
  | SeleniumSessionError SeleniumStartError
  deriving (Show)

instance Exception SessionStartError

-- | Tries to start a session, returning 'Left' with a 'SessionStartError' if it fails or 'Right'
-- with a 'SessionStartResult' if it succeeds. Errors that can be expected to be caught here are
-- process read errors (for `google-chrome` & `chromedriver`), display allocation errors (for Xvfb),
-- and Selenium start errors (port allocation, unable to find selenium file) as well as HTTP errors
-- for automatically downloading `chromedriver`.
tryStartSession ::
  (MonadUnliftIO m, MonadThrow m, PrimMonad m, MonadFail m) =>
  SessionMode ->
  SeleniumPath ->
  m (Either SessionStartError SessionStartResult)
tryStartSession sessionMode =
  startSession sessionMode >>> try

-- | Starts a session, throwing a 'SessionStartError' on failure. Use 'tryStartSession' in order to
-- automatically capture this error.
startSession ::
  (MonadThrow m, MonadUnliftIO m, PrimMonad m, MonadFail m) =>
  SessionMode ->
  SeleniumPath ->
  m SessionStartResult
startSession SessionOnDemand seleniumPath = do
  xvfbProcess@XvfbProcess {process} <- mapExceptionM XvfbSessionError startXvfb
  (StartedOnDemand <$> startSelenium xvfbProcess seleniumPath)
    `catch` ( \(e :: SeleniumStartError) -> do
                stopProcess process
                throwM $ SeleniumSessionError e
            )
startSession (SessionAlreadyStarted seleniumPort) _seleniumPath = do
  pure $ PremadeSession seleniumPort

stopSession :: SeleniumProcess -> IO ()
stopSession SeleniumProcess {xvfbProcess = XvfbProcess {process = xvfbProcess}, process} = do
  stopProcess process
  stopProcess xvfbProcess