{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Test.WebDriver.Types (
  WebDriverContext(..)
  -- , HasWebDriverContext
  , mkEmptyWebDriverContext

  , Driver(..)
  , DriverConfig(..)
  , SeleniumVersion(..)

  -- * SessionState class
  , SessionState(..)
  , SessionStatePut(..)

  -- ** WebDriver sessions
  , SessionId(..)
  , Session(..)

  -- * Exceptions
  , SessionException(..)

  -- * Stack frames
  , StackFrame(..)
  , callStackItemToStackFrame

  -- * WebDriver class
  , WebDriver
  , WebDriverBase(..)
  , Method
  , methodDelete
  , methodGet
  , methodPost
  ) where

import Control.Monad.IO.Unlift
import Data.Aeson
import Data.Aeson.Types (Parser, typeMismatch)
import qualified Data.ByteString.Lazy as LBS
import Data.Map as M
import Data.String
import Data.String.Interpolate
import Data.Text as T
import GHC.Stack
import Network.HTTP.Client
import Network.HTTP.Types (RequestHeaders)
import Network.HTTP.Types.Method (methodDelete, methodGet, methodPost, Method)
import Test.WebDriver.Util.Aeson (aesonKeyFromText)
import UnliftIO.Async
import UnliftIO.Concurrent
import UnliftIO.Exception
import UnliftIO.Process


-- | The 'WebDriverContext' is an opaque type used by this library for
-- bookkeeping purposes. It tracks all the processes we spin up and all the
-- sessions we create.
--
-- Currently, we will create at most 1 Selenium or Chromedriver process per
-- 'WebDriverContext', and N Geckodriver processes, where N is the number of
-- Firefox sessions you request.
data WebDriverContext = WebDriverContext {
  WebDriverContext -> MVar (Map String Session)
_webDriverSessions :: MVar (Map String Session)
  , WebDriverContext -> MVar (Maybe Driver)
_webDriverSelenium :: MVar (Maybe Driver)
  , WebDriverContext -> MVar (Maybe Driver)
_webDriverChromedriver :: MVar (Maybe Driver)
  }

-- | Create a new 'WebDriverContext'.
mkEmptyWebDriverContext :: MonadIO m => m WebDriverContext
mkEmptyWebDriverContext :: forall (m :: * -> *). MonadIO m => m WebDriverContext
mkEmptyWebDriverContext = MVar (Map String Session)
-> MVar (Maybe Driver) -> MVar (Maybe Driver) -> WebDriverContext
WebDriverContext
  (MVar (Map String Session)
 -> MVar (Maybe Driver) -> MVar (Maybe Driver) -> WebDriverContext)
-> m (MVar (Map String Session))
-> m (MVar (Maybe Driver)
      -> MVar (Maybe Driver) -> WebDriverContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Session -> m (MVar (Map String Session))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Map String Session
forall a. Monoid a => a
mempty
  m (MVar (Maybe Driver) -> MVar (Maybe Driver) -> WebDriverContext)
-> m (MVar (Maybe Driver))
-> m (MVar (Maybe Driver) -> WebDriverContext)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Driver -> m (MVar (Maybe Driver))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Maybe Driver
forall a. Maybe a
Nothing
  m (MVar (Maybe Driver) -> WebDriverContext)
-> m (MVar (Maybe Driver)) -> m WebDriverContext
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Driver -> m (MVar (Maybe Driver))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Maybe Driver
forall a. Maybe a
Nothing

data Driver = Driver {
  Driver -> String
_driverHostname :: String
  , Driver -> Int
_driverPort :: Int
  , Driver -> String
_driverBasePath :: String
  , Driver -> RequestHeaders
_driverRequestHeaders :: RequestHeaders
  , Driver -> Manager
_driverManager :: Manager
  , Driver -> Maybe ProcessHandle
_driverProcess :: Maybe ProcessHandle
  , Driver -> Maybe (Async ())
_driverLogAsync :: Maybe (Async ())
  , Driver -> DriverConfig
_driverConfig :: DriverConfig
  }

data SeleniumVersion =
  Selenium3
  | Selenium4
  deriving (Int -> SeleniumVersion -> ShowS
[SeleniumVersion] -> ShowS
SeleniumVersion -> String
(Int -> SeleniumVersion -> ShowS)
-> (SeleniumVersion -> String)
-> ([SeleniumVersion] -> ShowS)
-> Show SeleniumVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeleniumVersion -> ShowS
showsPrec :: Int -> SeleniumVersion -> ShowS
$cshow :: SeleniumVersion -> String
show :: SeleniumVersion -> String
$cshowList :: [SeleniumVersion] -> ShowS
showList :: [SeleniumVersion] -> ShowS
Show, SeleniumVersion -> SeleniumVersion -> Bool
(SeleniumVersion -> SeleniumVersion -> Bool)
-> (SeleniumVersion -> SeleniumVersion -> Bool)
-> Eq SeleniumVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeleniumVersion -> SeleniumVersion -> Bool
== :: SeleniumVersion -> SeleniumVersion -> Bool
$c/= :: SeleniumVersion -> SeleniumVersion -> Bool
/= :: SeleniumVersion -> SeleniumVersion -> Bool
Eq)

-- | Configuration for how to launch a given driver.
data DriverConfig =
  -- | For launching a WebDriver via "java -jar selenium.jar".
  -- Selenium can launch other drivers on your behalf. You should pass these as 'driverConfigSubDrivers'.
  DriverConfigSeleniumJar {
    -- | Path to @java@ binary.
    DriverConfig -> String
driverConfigJava :: FilePath
    -- | Extra flags to pass to @java@.
    , DriverConfig -> [String]
driverConfigJavaFlags :: [String]
    -- | Path to @selenium.jar@ file.
    , DriverConfig -> String
driverConfigSeleniumJar :: FilePath
    -- | Specify if this is Selenium 3 or 4. If this is not provided, we'll try to autodetect.
    , DriverConfig -> Maybe SeleniumVersion
driverConfigSeleniumVersion :: Maybe SeleniumVersion
    -- | Drivers to configure Selenium to use.
    , DriverConfig -> [DriverConfig]
driverConfigSubDrivers :: [DriverConfig]
    -- | Directory in which to place driver logs.
    , DriverConfig -> Maybe String
driverConfigLogDir :: Maybe FilePath
    }
  | DriverConfigGeckodriver {
      -- | Path to @geckodriver@ binary.
      DriverConfig -> String
driverConfigGeckodriver :: FilePath
      -- | Extra flags to pass to @geckodriver@.
      , DriverConfig -> [String]
driverConfigGeckodriverFlags :: [String]
      -- | Path to @firefox@ binary.
      , DriverConfig -> String
driverConfigFirefox :: FilePath
      -- | Directory in which to place driver logs.
      , driverConfigLogDir :: Maybe FilePath
      }
  | DriverConfigChromedriver {
      -- | Path to @chromedriver@ binary.
      DriverConfig -> String
driverConfigChromedriver :: FilePath
      -- | Extra flags to pass to @chromedriver@.
      , DriverConfig -> [String]
driverConfigChromedriverFlags :: [String]
      -- | Path to @chrome@ binary.
      , DriverConfig -> String
driverConfigChrome :: FilePath
      -- | Directory in which to place driver logs.
      , driverConfigLogDir :: Maybe FilePath
      }

-- | An opaque identifier for a WebDriver session. These handles are produced by
-- the server on session creation, and act to identify a session in progress.
newtype SessionId = SessionId T.Text
  deriving (SessionId -> SessionId -> Bool
(SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool) -> Eq SessionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionId -> SessionId -> Bool
== :: SessionId -> SessionId -> Bool
$c/= :: SessionId -> SessionId -> Bool
/= :: SessionId -> SessionId -> Bool
Eq, Eq SessionId
Eq SessionId =>
(SessionId -> SessionId -> Ordering)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> Bool)
-> (SessionId -> SessionId -> SessionId)
-> (SessionId -> SessionId -> SessionId)
-> Ord SessionId
SessionId -> SessionId -> Bool
SessionId -> SessionId -> Ordering
SessionId -> SessionId -> SessionId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SessionId -> SessionId -> Ordering
compare :: SessionId -> SessionId -> Ordering
$c< :: SessionId -> SessionId -> Bool
< :: SessionId -> SessionId -> Bool
$c<= :: SessionId -> SessionId -> Bool
<= :: SessionId -> SessionId -> Bool
$c> :: SessionId -> SessionId -> Bool
> :: SessionId -> SessionId -> Bool
$c>= :: SessionId -> SessionId -> Bool
>= :: SessionId -> SessionId -> Bool
$cmax :: SessionId -> SessionId -> SessionId
max :: SessionId -> SessionId -> SessionId
$cmin :: SessionId -> SessionId -> SessionId
min :: SessionId -> SessionId -> SessionId
Ord, Int -> SessionId -> ShowS
[SessionId] -> ShowS
SessionId -> String
(Int -> SessionId -> ShowS)
-> (SessionId -> String)
-> ([SessionId] -> ShowS)
-> Show SessionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionId -> ShowS
showsPrec :: Int -> SessionId -> ShowS
$cshow :: SessionId -> String
show :: SessionId -> String
$cshowList :: [SessionId] -> ShowS
showList :: [SessionId] -> ShowS
Show, ReadPrec [SessionId]
ReadPrec SessionId
Int -> ReadS SessionId
ReadS [SessionId]
(Int -> ReadS SessionId)
-> ReadS [SessionId]
-> ReadPrec SessionId
-> ReadPrec [SessionId]
-> Read SessionId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SessionId
readsPrec :: Int -> ReadS SessionId
$creadList :: ReadS [SessionId]
readList :: ReadS [SessionId]
$creadPrec :: ReadPrec SessionId
readPrec :: ReadPrec SessionId
$creadListPrec :: ReadPrec [SessionId]
readListPrec :: ReadPrec [SessionId]
Read, Maybe SessionId
Value -> Parser [SessionId]
Value -> Parser SessionId
(Value -> Parser SessionId)
-> (Value -> Parser [SessionId])
-> Maybe SessionId
-> FromJSON SessionId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SessionId
parseJSON :: Value -> Parser SessionId
$cparseJSONList :: Value -> Parser [SessionId]
parseJSONList :: Value -> Parser [SessionId]
$comittedField :: Maybe SessionId
omittedField :: Maybe SessionId
FromJSON, [SessionId] -> Value
[SessionId] -> Encoding
SessionId -> Bool
SessionId -> Value
SessionId -> Encoding
(SessionId -> Value)
-> (SessionId -> Encoding)
-> ([SessionId] -> Value)
-> ([SessionId] -> Encoding)
-> (SessionId -> Bool)
-> ToJSON SessionId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SessionId -> Value
toJSON :: SessionId -> Value
$ctoEncoding :: SessionId -> Encoding
toEncoding :: SessionId -> Encoding
$ctoJSONList :: [SessionId] -> Value
toJSONList :: [SessionId] -> Value
$ctoEncodingList :: [SessionId] -> Encoding
toEncodingList :: [SessionId] -> Encoding
$comitField :: SessionId -> Bool
omitField :: SessionId -> Bool
ToJSON)
instance IsString SessionId where
  fromString :: String -> SessionId
fromString String
s = Text -> SessionId
SessionId (String -> Text
T.pack String
s)

data Session = Session {
  Session -> Driver
sessionDriver :: Driver
  , Session -> SessionId
sessionId :: SessionId
  , Session -> String
sessionName :: String
  , Session -> Maybe String
sessionWebSocketUrl :: Maybe String
  }
instance Show Session where
  show :: Session -> String
show (Session {sessionDriver :: Session -> Driver
sessionDriver=(Driver {Int
String
RequestHeaders
Maybe (Async ())
Maybe ProcessHandle
Manager
DriverConfig
_driverHostname :: Driver -> String
_driverPort :: Driver -> Int
_driverBasePath :: Driver -> String
_driverRequestHeaders :: Driver -> RequestHeaders
_driverManager :: Driver -> Manager
_driverProcess :: Driver -> Maybe ProcessHandle
_driverLogAsync :: Driver -> Maybe (Async ())
_driverConfig :: Driver -> DriverConfig
_driverHostname :: String
_driverPort :: Int
_driverBasePath :: String
_driverRequestHeaders :: RequestHeaders
_driverManager :: Manager
_driverProcess :: Maybe ProcessHandle
_driverLogAsync :: Maybe (Async ())
_driverConfig :: DriverConfig
..}), String
Maybe String
SessionId
sessionId :: Session -> SessionId
sessionName :: Session -> String
sessionWebSocketUrl :: Session -> Maybe String
sessionId :: SessionId
sessionName :: String
sessionWebSocketUrl :: Maybe String
..}) = [i|Session<[#{sessionId}] at #{_driverHostname}:#{_driverPort}#{_driverBasePath}>|]

-- class HasLens ctx a where
--   getLens :: Lens' ctx a

data SessionException =
  SessionNameAlreadyExists
  | SessionCreationFailed (Response LBS.ByteString)
  | SessionCreationResponseHadNoSessionId (Response LBS.ByteString)
  deriving (Int -> SessionException -> ShowS
[SessionException] -> ShowS
SessionException -> String
(Int -> SessionException -> ShowS)
-> (SessionException -> String)
-> ([SessionException] -> ShowS)
-> Show SessionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionException -> ShowS
showsPrec :: Int -> SessionException -> ShowS
$cshow :: SessionException -> String
show :: SessionException -> String
$cshowList :: [SessionException] -> ShowS
showList :: [SessionException] -> ShowS
Show)
instance Exception SessionException


class SessionState m where
  getSession :: m Session

class (SessionState m) => SessionStatePut m where
  withModifiedSession :: (Session -> Session) -> m a -> m a

type WebDriver m = (WebDriverBase m, SessionState m)

-- | A class for monads that can handle wire protocol requests. This is the
-- operation underlying all of the high-level commands exported in
-- "Test.WebDriver.Commands".
class (MonadUnliftIO m) => WebDriverBase m where
  doCommandBase :: (
    HasCallStack, ToJSON a
    )
    => Driver
    -- | HTTP request method
    -> Method
    -- | URL of request
    -> Text
    -- | JSON parameters passed in the body of the request. Note that, as a
    -- special case, anything that converts to Data.Aeson.Null will result in an
    -- empty request body.
    -> a
    -- | The response of the HTTP request.
    -> m (Response LBS.ByteString)

-- | An individual stack frame from the stack trace provided by the server
-- during a FailedCommand.
data StackFrame = StackFrame {
  StackFrame -> String
sfFileName :: String
  , StackFrame -> String
sfClassName  :: String
  , StackFrame -> String
sfMethodName :: String
  , StackFrame -> Int
sfLineNumber :: Int
  } deriving (StackFrame -> StackFrame -> Bool
(StackFrame -> StackFrame -> Bool)
-> (StackFrame -> StackFrame -> Bool) -> Eq StackFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StackFrame -> StackFrame -> Bool
== :: StackFrame -> StackFrame -> Bool
$c/= :: StackFrame -> StackFrame -> Bool
/= :: StackFrame -> StackFrame -> Bool
Eq)
instance Show StackFrame where
  show :: StackFrame -> String
show StackFrame
f = String -> ShowS
showString (StackFrame -> String
sfClassName StackFrame
f) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.'
           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (StackFrame -> String
sfMethodName StackFrame
f) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS -> ShowS
showParen Bool
True ( String -> ShowS
showString (StackFrame -> String
sfFileName StackFrame
f) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':'
                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (StackFrame -> Int
sfLineNumber StackFrame
f))
           ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"\n"
instance FromJSON StackFrame where
  parseJSON :: Value -> Parser StackFrame
parseJSON (Object Object
o) = String -> String -> String -> Int -> StackFrame
StackFrame (String -> String -> String -> Int -> StackFrame)
-> Parser String -> Parser (String -> String -> Int -> StackFrame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser String
reqStr Text
"fileName"
                                    Parser (String -> String -> Int -> StackFrame)
-> Parser String -> Parser (String -> Int -> StackFrame)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser String
reqStr Text
"className"
                                    Parser (String -> Int -> StackFrame)
-> Parser String -> Parser (Int -> StackFrame)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser String
reqStr Text
"methodName"
                                    Parser (Int -> StackFrame) -> Parser Int -> Parser StackFrame
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser Int
forall a. FromJSON a => Text -> Parser a
req    Text
"lineNumber"
    where req :: FromJSON a => Text -> Parser a
          req :: forall a. FromJSON a => Text -> Parser a
req = (Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.:) (Key -> Parser a) -> (Text -> Key) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
aesonKeyFromText -- all keys are required
          reqStr :: Text -> Parser String
          reqStr :: Text -> Parser String
reqStr Text
k = Text -> Parser (Maybe String)
forall a. FromJSON a => Text -> Parser a
req Text
k Parser (Maybe String)
-> (Maybe String -> Parser String) -> Parser String
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser String
-> (String -> Parser String) -> Maybe String -> Parser String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser String
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"") String -> Parser String
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return
  parseJSON Value
v = String -> Value -> Parser StackFrame
forall a. String -> Value -> Parser a
typeMismatch String
"StackFrame" Value
v

callStackItemToStackFrame :: (String, SrcLoc) -> StackFrame
callStackItemToStackFrame :: (String, SrcLoc) -> StackFrame
callStackItemToStackFrame (String
functionName, SrcLoc {Int
String
srcLocPackage :: String
srcLocModule :: String
srcLocFile :: String
srcLocStartLine :: Int
srcLocStartCol :: Int
srcLocEndLine :: Int
srcLocEndCol :: Int
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
..}) = StackFrame {
  sfFileName :: String
sfFileName = String
srcLocFile
  , sfClassName :: String
sfClassName = String
srcLocModule
  , sfMethodName :: String
sfMethodName = String
functionName
  , sfLineNumber :: Int
sfLineNumber = Int
srcLocStartLine
  }