{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE CPP #-}

-- | The HTTP/JSON plumbing used to implement the 'WD' monad.
--
-- These functions can be used to create your own 'WebDriver' instances, providing extra functionality for your application if desired. All exports
-- of this module are subject to change at any point.
module Test.WebDriver.Internal
       ( mkRequest, sendHTTPRequest
       , getJSONResult, handleJSONErr, handleRespSessionId
       , WDResponse(..)
       ) where
import Test.WebDriver.Class
import Test.WebDriver.JSON
import Test.WebDriver.Session
import Test.WebDriver.Exceptions.Internal

import Network.HTTP.Client (httpLbs, Request(..), RequestBody(..), Response(..))
import qualified Network.HTTP.Client as HTTPClient

import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import Network.HTTP.Types.Header
import Network.HTTP.Types.Status (Status(..))

import qualified Data.ByteString.Base64.Lazy as B64
import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.ByteString.Lazy.Char8 as LBS (unpack, null)
import qualified Data.ByteString.Lazy.Internal as LBS (ByteString(..))
import Data.CallStack
import Data.Text as T (Text, splitOn, null)
import qualified Data.Text.Encoding as TE

import Control.Applicative
import Control.Exception (Exception, SomeException(..), toException, fromException, try)
import Control.Exception.Lifted (throwIO)
import Control.Monad.Base

import Data.String (fromString)
import Data.Word (Word8)

#if !MIN_VERSION_http_client(0,4,30)
import Data.Default.Class
#endif

import Prelude -- hides some "unused import" warnings

--This is the defintion of fromStrict used by bytestring >= 0.10; we redefine it here to support bytestring < 0.10
fromStrict :: BS.ByteString -> LBS.ByteString
fromStrict :: ByteString -> ByteString
fromStrict ByteString
bs | ByteString -> Bool
BS.null ByteString
bs = ByteString
LBS.Empty
              | Bool
otherwise = ByteString -> ByteString -> ByteString
LBS.Chunk ByteString
bs ByteString
LBS.Empty


--Compatability function to support http-client < 0.4.30
defaultRequest :: Request
#if MIN_VERSION_http_client(0,4,30)
defaultRequest :: Request
defaultRequest = Request
HTTPClient.defaultRequest
#else
defaultRequest = def
#endif

-- |Constructs an HTTP 'Request' value when given a list of headers, HTTP request method, and URL fragment
mkRequest :: (WDSessionState s, ToJSON a) =>
             Method -> Text -> a -> s Request
mkRequest :: forall (s :: * -> *) a.
(WDSessionState s, ToJSON a) =>
ByteString -> Text -> a -> s Request
mkRequest ByteString
meth Text
wdPath a
args = do
  WDSession {Int
RequestHeaders
[SessionHistory]
Maybe SessionId
ByteString
Manager
SessionHistoryConfig
wdSessAuthHeaders :: WDSession -> RequestHeaders
wdSessRequestHeaders :: WDSession -> RequestHeaders
wdSessHTTPRetryCount :: WDSession -> Int
wdSessHTTPManager :: WDSession -> Manager
wdSessHistUpdate :: WDSession -> SessionHistoryConfig
wdSessHist :: WDSession -> [SessionHistory]
wdSessId :: WDSession -> Maybe SessionId
wdSessBasePath :: WDSession -> ByteString
wdSessPort :: WDSession -> Int
wdSessHost :: WDSession -> ByteString
wdSessAuthHeaders :: RequestHeaders
wdSessRequestHeaders :: RequestHeaders
wdSessHTTPRetryCount :: Int
wdSessHTTPManager :: Manager
wdSessHistUpdate :: SessionHistoryConfig
wdSessHist :: [SessionHistory]
wdSessId :: Maybe SessionId
wdSessBasePath :: ByteString
wdSessPort :: Int
wdSessHost :: ByteString
..} <- forall (m :: * -> *). WDSessionState m => m WDSession
getSession
  let body :: ByteString
body = case forall a. ToJSON a => a -> Value
toJSON a
args of
        Value
Null  -> ByteString
""   --passing Null as the argument indicates no request body
        Value
other -> forall a. ToJSON a => a -> ByteString
encode Value
other
  forall (m :: * -> *) a. Monad m => a -> m a
return Request
defaultRequest
    { host :: ByteString
host = ByteString
wdSessHost
    , port :: Int
port = Int
wdSessPort
    , path :: ByteString
path = ByteString
wdSessBasePath ByteString -> ByteString -> ByteString
`BS.append`  Text -> ByteString
TE.encodeUtf8 Text
wdPath
    , requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
body
    , requestHeaders :: RequestHeaders
requestHeaders = RequestHeaders
wdSessRequestHeaders
                       forall a. [a] -> [a] -> [a]
++ [ (HeaderName
hAccept, ByteString
"application/json;charset=UTF-8")
                          , (HeaderName
hContentType, ByteString
"application/json;charset=UTF-8") ]
    , method :: ByteString
method = ByteString
meth
#if !MIN_VERSION_http_client(0,5,0)
    , checkStatus = \_ _ _ -> Nothing
#endif
    }

-- |Sends an HTTP request to the remote WebDriver server
sendHTTPRequest :: (WDSessionStateIO s) => Request -> s (Either SomeException (Response ByteString))
sendHTTPRequest :: forall (s :: * -> *).
WDSessionStateIO s =>
Request -> s (Either SomeException (Response ByteString))
sendHTTPRequest Request
req = do
  s :: WDSession
s@WDSession{Int
RequestHeaders
[SessionHistory]
Maybe SessionId
ByteString
Manager
SessionHistoryConfig
wdSessAuthHeaders :: RequestHeaders
wdSessRequestHeaders :: RequestHeaders
wdSessHTTPRetryCount :: Int
wdSessHTTPManager :: Manager
wdSessHistUpdate :: SessionHistoryConfig
wdSessHist :: [SessionHistory]
wdSessId :: Maybe SessionId
wdSessBasePath :: ByteString
wdSessPort :: Int
wdSessHost :: ByteString
wdSessAuthHeaders :: WDSession -> RequestHeaders
wdSessRequestHeaders :: WDSession -> RequestHeaders
wdSessHTTPRetryCount :: WDSession -> Int
wdSessHTTPManager :: WDSession -> Manager
wdSessHistUpdate :: WDSession -> SessionHistoryConfig
wdSessHist :: WDSession -> [SessionHistory]
wdSessId :: WDSession -> Maybe SessionId
wdSessBasePath :: WDSession -> ByteString
wdSessPort :: WDSession -> Int
wdSessHost :: WDSession -> ByteString
..} <- forall (m :: * -> *). WDSessionState m => m WDSession
getSession
  (Int
nRetries, Either SomeException (Response ByteString)
tryRes) <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IO a -> IO (Int, Either SomeException a)
retryOnTimeout Int
wdSessHTTPRetryCount forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
wdSessHTTPManager
  let h :: SessionHistory
h = SessionHistory { histRequest :: Request
histRequest = Request
req
                         , histResponse :: Either SomeException (Response ByteString)
histResponse = Either SomeException (Response ByteString)
tryRes
                         , histRetryCount :: Int
histRetryCount = Int
nRetries
                         }
  forall (m :: * -> *). WDSessionState m => WDSession -> m ()
putSession WDSession
s { wdSessHist :: [SessionHistory]
wdSessHist = SessionHistoryConfig
wdSessHistUpdate SessionHistory
h [SessionHistory]
wdSessHist }
  forall (m :: * -> *) a. Monad m => a -> m a
return Either SomeException (Response ByteString)
tryRes

retryOnTimeout :: Int -> IO a -> IO (Int, (Either SomeException a))
retryOnTimeout :: forall a. Int -> IO a -> IO (Int, Either SomeException a)
retryOnTimeout Int
maxRetry IO a
go = Int -> IO (Int, Either SomeException a)
retry' Int
0
  where
    retry' :: Int -> IO (Int, Either SomeException a)
retry' Int
nRetries = do
      Either SomeException a
eitherV <- forall e a. Exception e => IO a -> IO (Either e a)
try IO a
go
      case Either SomeException a
eitherV of
        (Left SomeException
e)
#if MIN_VERSION_http_client(0,5,0)
          | Just (HTTPClient.HttpExceptionRequest Request
_ HttpExceptionContent
HTTPClient.ResponseTimeout) <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
#else
          | Just HTTPClient.ResponseTimeout <- fromException e
#endif
          , Int
maxRetry forall a. Ord a => a -> a -> Bool
> Int
nRetries
          -> Int -> IO (Int, Either SomeException a)
retry' (forall a. Enum a => a -> a
succ Int
nRetries)
        Either SomeException a
other -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
nRetries, Either SomeException a
other)

-- |Parses a 'WDResponse' object from a given HTTP response.
getJSONResult :: (HasCallStack, WDSessionStateControl s, FromJSON a) => Response ByteString -> s (Either SomeException a)
getJSONResult :: forall (s :: * -> *) a.
(HasCallStack, WDSessionStateControl s, FromJSON a) =>
Response ByteString -> s (Either SomeException a)
getJSONResult Response ByteString
r
  --malformed request errors
  | Int
code forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
code forall a. Ord a => a -> a -> Bool
< Int
500 = do
    Maybe Request
lastReq <- WDSession -> Maybe Request
mostRecentHTTPRequest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). WDSessionState m => m WDSession
getSession
    forall e (m :: * -> *) a.
(Exception e, Monad m) =>
e -> m (Either SomeException a)
returnErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnknownCommand
UnknownCommand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
reason forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Maybe Request
lastReq
  --server-side errors
  | Int
code forall a. Ord a => a -> a -> Bool
>= Int
500 Bool -> Bool -> Bool
&& Int
code forall a. Ord a => a -> a -> Bool
< Int
600 =
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType RequestHeaders
headers of
      Just ByteString
ct
        | ByteString
"application/json" ByteString -> ByteString -> Bool
`BS.isInfixOf` ByteString
ct ->
          forall (wd :: * -> *) a.
(MonadBaseControl IO wd, FromJSON a) =>
ByteString -> wd a
parseJSON'
            (forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
body ByteString -> ByteString
fromStrict forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-Response-Body-Start" RequestHeaders
headers)
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (s :: * -> *).
(HasCallStack, WDSessionStateControl s) =>
WDResponse -> s (Maybe SomeException)
handleJSONErr
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. s (Either a a)
returnNull forall e (m :: * -> *) a.
(Exception e, Monad m) =>
e -> m (Either SomeException a)
returnErr
        | Bool
otherwise ->
          forall {b} {m :: * -> *} {a}.
(Exception b, Monad m) =>
(String -> b) -> m (Either SomeException a)
returnHTTPErr String -> ServerError
ServerError
      Maybe ByteString
Nothing ->
        forall {b} {m :: * -> *} {a}.
(Exception b, Monad m) =>
(String -> b) -> m (Either SomeException a)
returnHTTPErr (String -> ServerError
ServerError forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"HTTP response missing content type. Server reason was: "forall a. [a] -> [a] -> [a]
++))
  --redirect case (used as a response to createSession requests)
  | Int
code forall a. Eq a => a -> a -> Bool
== Int
302 Bool -> Bool -> Bool
|| Int
code forall a. Eq a => a -> a -> Bool
== Int
303 =
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hLocation RequestHeaders
headers of
      Maybe ByteString
Nothing ->  forall e (m :: * -> *) a.
(Exception e, Monad m) =>
e -> m (Either SomeException a)
returnErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> HTTPStatusUnknown
HTTPStatusUnknown Int
code forall a b. (a -> b) -> a -> b
$ ByteString -> String
LBS.unpack ByteString
body
      Just ByteString
loc -> do
        let sessId :: Text
sessId = forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
splitOn Text
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.unpack ByteString
loc
        forall (s :: * -> *).
WDSessionState s =>
(WDSession -> WDSession) -> s ()
modifySession forall a b. (a -> b) -> a -> b
$ \WDSession
sess -> WDSession
sess {wdSessId :: Maybe SessionId
wdSessId = forall a. a -> Maybe a
Just (Text -> SessionId
SessionId Text
sessId)}
        forall {a}. s (Either a a)
returnNull
  -- No Content response
  | Int
code forall a. Eq a => a -> a -> Bool
== Int
204 = forall {a}. s (Either a a)
returnNull
  -- HTTP Success
  | Int
code forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
code forall a. Ord a => a -> a -> Bool
< Int
300 =
    if ByteString -> Bool
LBS.null ByteString
body
      then forall {a}. s (Either a a)
returnNull
      else do
        rsp :: WDResponse
rsp@WDResponse {rspVal :: WDResponse -> Value
rspVal = Value
val} <- forall (wd :: * -> *) a.
(MonadBaseControl IO wd, FromJSON a) =>
ByteString -> wd a
parseJSON' ByteString
body
        forall (s :: * -> *).
(HasCallStack, WDSessionStateControl s) =>
WDResponse -> s (Maybe SomeException)
handleJSONErr WDResponse
rsp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (forall (s :: * -> *).
(HasCallStack, WDSessionStateIO s) =>
WDResponse -> s ()
handleRespSessionId WDResponse
rsp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (wd :: * -> *) a.
(MonadBaseControl IO wd, FromJSON a) =>
Value -> wd a
fromJSON' Value
val)
          forall e (m :: * -> *) a.
(Exception e, Monad m) =>
e -> m (Either SomeException a)
returnErr
  -- other status codes: return error
  | Bool
otherwise = forall {b} {m :: * -> *} {a}.
(Exception b, Monad m) =>
(String -> b) -> m (Either SomeException a)
returnHTTPErr (Int -> String -> HTTPStatusUnknown
HTTPStatusUnknown Int
code)
  where
    --helper functions
    returnErr :: (Exception e, Monad m) => e -> m (Either SomeException a)
    returnErr :: forall e (m :: * -> *) a.
(Exception e, Monad m) =>
e -> m (Either SomeException a)
returnErr = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException
    returnHTTPErr :: (String -> b) -> m (Either SomeException a)
returnHTTPErr String -> b
errType = forall e (m :: * -> *) a.
(Exception e, Monad m) =>
e -> m (Either SomeException a)
returnErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> b
errType forall a b. (a -> b) -> a -> b
$ String
reason
    returnNull :: s (Either a a)
returnNull = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (wd :: * -> *) a.
(MonadBaseControl IO wd, FromJSON a) =>
Value -> wd a
fromJSON' Value
Null
    --HTTP response variables
    code :: Int
code = Status -> Int
statusCode Status
status
    reason :: String
reason = ByteString -> String
BS.unpack forall a b. (a -> b) -> a -> b
$ Status -> ByteString
statusMessage Status
status
    status :: Status
status = forall body. Response body -> Status
responseStatus Response ByteString
r
    body :: ByteString
body = forall body. Response body -> body
responseBody Response ByteString
r
    headers :: RequestHeaders
headers = forall body. Response body -> RequestHeaders
responseHeaders Response ByteString
r

handleRespSessionId :: (HasCallStack, WDSessionStateIO s) => WDResponse -> s ()
handleRespSessionId :: forall (s :: * -> *).
(HasCallStack, WDSessionStateIO s) =>
WDResponse -> s ()
handleRespSessionId WDResponse{rspSessId :: WDResponse -> Maybe SessionId
rspSessId = Maybe SessionId
sessId'} = do
    sess :: WDSession
sess@WDSession { wdSessId :: WDSession -> Maybe SessionId
wdSessId = Maybe SessionId
sessId} <- forall (m :: * -> *). WDSessionState m => m WDSession
getSession
    case (Maybe SessionId
sessId, forall a. Eq a => a -> a -> Bool
(==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SessionId
sessId forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe SessionId
sessId') of
       -- if our monad has an uninitialized session ID, initialize it from the response object
       (Maybe SessionId
Nothing, Maybe Bool
_)    -> forall (m :: * -> *). WDSessionState m => WDSession -> m ()
putSession WDSession
sess { wdSessId :: Maybe SessionId
wdSessId = Maybe SessionId
sessId' }
       -- if the response ID doesn't match our local ID, throw an error.
       (Maybe SessionId
_, Just Bool
False) -> forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ServerError
ServerError forall a b. (a -> b) -> a -> b
$ String
"Server response session ID (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe SessionId
sessId'
                                 forall a. [a] -> [a] -> [a]
++ String
") does not match local session ID (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe SessionId
sessId forall a. [a] -> [a] -> [a]
++ String
")"
       (Maybe SessionId, Maybe Bool)
_ ->  forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleJSONErr :: (HasCallStack, WDSessionStateControl s) => WDResponse -> s (Maybe SomeException)
handleJSONErr :: forall (s :: * -> *).
(HasCallStack, WDSessionStateControl s) =>
WDResponse -> s (Maybe SomeException)
handleJSONErr WDResponse{rspStatus :: WDResponse -> Word8
rspStatus = Word8
0} = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleJSONErr WDResponse{rspVal :: WDResponse -> Value
rspVal = Value
val, rspStatus :: WDResponse -> Word8
rspStatus = Word8
status} = do
  WDSession
sess <- forall (m :: * -> *). WDSessionState m => m WDSession
getSession
  FailedCommandInfo
errInfo <- forall (wd :: * -> *) a.
(MonadBaseControl IO wd, FromJSON a) =>
Value -> wd a
fromJSON' Value
val
  let screen :: Maybe ByteString
screen = ByteString -> ByteString
B64.decodeLenient forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FailedCommandInfo -> Maybe ByteString
errScreen FailedCommandInfo
errInfo
      seleniumStack :: [StackFrame]
seleniumStack = FailedCommandInfo -> [StackFrame]
errStack FailedCommandInfo
errInfo
      errInfo' :: FailedCommandInfo
errInfo' = FailedCommandInfo
errInfo { errSess :: Maybe WDSession
errSess = forall a. a -> Maybe a
Just WDSession
sess
                         -- Append the Haskell stack frames to the ones returned from Selenium
                         , errScreen :: Maybe ByteString
errScreen = Maybe ByteString
screen
                         , errStack :: [StackFrame]
errStack = [StackFrame]
seleniumStack forall a. [a] -> [a] -> [a]
++ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, SrcLoc) -> StackFrame
callStackItemToStackFrame HasCallStack => CallStack
externalCallStack) }
      e :: FailedCommandType -> SomeException
e FailedCommandType
errType = forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ FailedCommandType -> FailedCommandInfo -> FailedCommand
FailedCommand FailedCommandType
errType FailedCommandInfo
errInfo'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Word8
status of
    Word8
7   -> FailedCommandType -> SomeException
e FailedCommandType
NoSuchElement
    Word8
8   -> FailedCommandType -> SomeException
e FailedCommandType
NoSuchFrame
    Word8
9   -> forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnknownCommand
UnknownCommand forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailedCommandInfo -> String
errMsg forall a b. (a -> b) -> a -> b
$ FailedCommandInfo
errInfo
    Word8
10  -> FailedCommandType -> SomeException
e FailedCommandType
StaleElementReference
    Word8
11  -> FailedCommandType -> SomeException
e FailedCommandType
ElementNotVisible
    Word8
12  -> FailedCommandType -> SomeException
e FailedCommandType
InvalidElementState
    Word8
13  -> FailedCommandType -> SomeException
e FailedCommandType
UnknownError
    Word8
15  -> FailedCommandType -> SomeException
e FailedCommandType
ElementIsNotSelectable
    Word8
17  -> FailedCommandType -> SomeException
e FailedCommandType
JavascriptError
    Word8
19  -> FailedCommandType -> SomeException
e FailedCommandType
XPathLookupError
    Word8
21  -> FailedCommandType -> SomeException
e FailedCommandType
Timeout
    Word8
23  -> FailedCommandType -> SomeException
e FailedCommandType
NoSuchWindow
    Word8
24  -> FailedCommandType -> SomeException
e FailedCommandType
InvalidCookieDomain
    Word8
25  -> FailedCommandType -> SomeException
e FailedCommandType
UnableToSetCookie
    Word8
26  -> FailedCommandType -> SomeException
e FailedCommandType
UnexpectedAlertOpen
    Word8
27  -> FailedCommandType -> SomeException
e FailedCommandType
NoAlertOpen
    Word8
28  -> FailedCommandType -> SomeException
e FailedCommandType
ScriptTimeout
    Word8
29  -> FailedCommandType -> SomeException
e FailedCommandType
InvalidElementCoordinates
    Word8
30  -> FailedCommandType -> SomeException
e FailedCommandType
IMENotAvailable
    Word8
31  -> FailedCommandType -> SomeException
e FailedCommandType
IMEEngineActivationFailed
    Word8
32  -> FailedCommandType -> SomeException
e FailedCommandType
InvalidSelector
    Word8
33  -> FailedCommandType -> SomeException
e FailedCommandType
SessionNotCreated
    Word8
34  -> FailedCommandType -> SomeException
e FailedCommandType
MoveTargetOutOfBounds
    Word8
51  -> FailedCommandType -> SomeException
e FailedCommandType
InvalidXPathSelector
    Word8
52  -> FailedCommandType -> SomeException
e FailedCommandType
InvalidXPathSelectorReturnType
    Word8
_   -> FailedCommandType -> SomeException
e FailedCommandType
UnknownError


-- |Internal type representing the JSON response object
data WDResponse = WDResponse {
                               WDResponse -> Maybe SessionId
rspSessId :: Maybe SessionId
                             , WDResponse -> Word8
rspStatus :: Word8
                             , WDResponse -> Value
rspVal    :: Value
                             }
                  deriving (WDResponse -> WDResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WDResponse -> WDResponse -> Bool
$c/= :: WDResponse -> WDResponse -> Bool
== :: WDResponse -> WDResponse -> Bool
$c== :: WDResponse -> WDResponse -> Bool
Eq, Int -> WDResponse -> String -> String
[WDResponse] -> String -> String
WDResponse -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [WDResponse] -> String -> String
$cshowList :: [WDResponse] -> String -> String
show :: WDResponse -> String
$cshow :: WDResponse -> String
showsPrec :: Int -> WDResponse -> String -> String
$cshowsPrec :: Int -> WDResponse -> String -> String
Show)

instance FromJSON WDResponse where
  parseJSON :: Value -> Parser WDResponse
parseJSON (Object Object
o) = Maybe SessionId -> Word8 -> Value -> WDResponse
WDResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?? Text
"sessionId" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Maybe a
Nothing
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?? Text
"value" forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
Null
  parseJSON Value
v = forall a. String -> Value -> Parser a
typeMismatch String
"WDResponse" Value
v