module Test.WebDriver.Commands
(
createSession, closeSession, sessions, getCaps
, openPage, forward, back, refresh
, getCurrentURL, getSource, getTitle, screenshot, screenshotBase64
, setImplicitWait, setScriptTimeout, setPageLoadTimeout
, Element(..), Selector(..)
, findElem, findElems, findElemFrom, findElemsFrom
, click, submit, getText
, sendKeys, sendRawKeys, clearInput
, attr, cssProp, elemPos, elemSize
, isSelected, isEnabled, isDisplayed
, tagName, activeElem, elemInfo
, (<==>), (</=>)
, executeJS, asyncJS
, JSArg(..)
, WindowHandle(..), currentWindow
, getCurrentWindow, closeWindow, windows, focusWindow, maximize
, getWindowSize, setWindowSize, getWindowPos, setWindowPos
, focusFrame, FrameSelector(..)
, Cookie(..), mkCookie
, cookies, setCookie, deleteCookie, deleteVisibleCookies, deleteCookieByName
, getAlertText, replyToAlert, acceptAlert, dismissAlert
, moveTo, moveToCenter, moveToFrom
, clickWith, MouseButton(..)
, mouseDown, mouseUp, withMouseDown, doubleClick
, WebStorageType(..), storageSize, getAllKeys, deleteAllKeys
, getKey, setKey, deleteKey
, ApplicationCacheStatus(..)
, getApplicationCacheStatus
, Orientation(..)
, getOrientation, setOrientation
, getLocation, setLocation
, touchClick, touchDown, touchUp, touchMove
, touchScroll, touchScrollFrom, touchDoubleClick
, touchLongClick, touchFlick, touchFlickFrom
, availableIMEEngines, activeIMEEngine, checkIMEActive
, activateIME, deactivateIME
, uploadFile, uploadRawFile, uploadZipEntry
, serverStatus
, getLogs, getLogTypes, LogType, LogEntry(..), LogLevel(..)
) where
import Test.WebDriver.Commands.Internal
import Test.WebDriver.Classes
import Test.WebDriver.JSON
import Test.WebDriver.Capabilities
import Test.WebDriver.Internal
import Test.WebDriver.Utils (urlEncode)
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.TH
import qualified Data.Text as T
import Data.Text (Text, append, toUpper, toLower)
import Data.ByteString.Base64.Lazy as B64
import Data.ByteString.Lazy as LBS (ByteString)
import Network.URI hiding (path)
import Codec.Archive.Zip
import qualified Data.Text.Lazy.Encoding as TL
import Control.Applicative
import Control.Monad.State.Strict
import Control.Monad.Base
import Control.Exception (SomeException)
import Control.Exception.Lifted (throwIO, handle)
import qualified Control.Exception.Lifted as L
import Data.Word
import Data.String (fromString)
import Data.Maybe (fromMaybe)
import qualified Data.Char as C
noReturn :: WebDriver wd => wd NoReturn -> wd ()
noReturn = void
ignoreReturn :: WebDriver wd => wd Value -> wd ()
ignoreReturn = void
createSession :: WebDriver wd => Capabilities -> wd WDSession
createSession caps = do
ignoreReturn . doCommand POST "/session" . single "desiredCapabilities" $ caps
getSession
sessions :: WebDriver wd => wd [(SessionId, Capabilities)]
sessions = do
objs <- doCommand GET "/sessions" Null
forM objs $ parsePair "id" "capabilities" "sessions"
getCaps :: WebDriver wd => wd Capabilities
getCaps = doSessCommand GET "" Null
closeSession :: WebDriver wd => wd ()
closeSession = do s <- getSession
noReturn $ doSessCommand DELETE "" Null
putSession s { wdSessId = Nothing }
setImplicitWait :: WebDriver wd => Integer -> wd ()
setImplicitWait ms =
noReturn $ doSessCommand POST "/timeouts/implicit_wait" (object msField)
`L.catch` \(_ :: SomeException) ->
doSessCommand POST "/timeouts" (object allFields)
where msField = ["ms" .= ms]
allFields = ["type" .= ("implicit" :: String)] ++ msField
setScriptTimeout :: WebDriver wd => Integer -> wd ()
setScriptTimeout ms =
noReturn $ doSessCommand POST "/timeouts/async_script" (object msField)
`L.catch` \( _ :: SomeException) ->
doSessCommand POST "/timeouts" (object allFields)
where msField = ["ms" .= ms]
allFields = ["type" .= ("script" :: String)] ++ msField
setPageLoadTimeout :: WebDriver wd => Integer -> wd ()
setPageLoadTimeout ms = noReturn $ doSessCommand POST "/timeouts" params
where params = object ["type" .= ("page load" :: String)
,"ms" .= ms ]
getCurrentURL :: WebDriver wd => wd String
getCurrentURL = doSessCommand GET "/url" Null
openPage :: WebDriver wd => String -> wd ()
openPage url
| isURI url = noReturn . doSessCommand POST "/url" . single "url" $ url
| otherwise = throwIO . InvalidURL $ url
forward :: WebDriver wd => wd ()
forward = noReturn $ doSessCommand POST "/forward" Null
back :: WebDriver wd => wd ()
back = noReturn $ doSessCommand POST "/back" Null
refresh :: WebDriver wd => wd ()
refresh = noReturn $ doSessCommand POST "/refresh" Null
data JSArg = forall a. ToJSON a => JSArg a
instance ToJSON JSArg where
toJSON (JSArg a) = toJSON a
executeJS :: (WebDriver wd, FromJSON a) => [JSArg] -> Text -> wd a
executeJS a s = fromJSON' =<< getResult
where
getResult = doSessCommand POST "/execute" . pair ("args", "script") $ (a,s)
asyncJS :: (WebDriver wd, FromJSON a) => [JSArg] -> Text -> wd (Maybe a)
asyncJS a s = handle timeout $ Just <$> (fromJSON' =<< getResult)
where
getResult = doSessCommand POST "/execute_async" . pair ("args", "script")
$ (a,s)
timeout (FailedCommand Timeout _) = return Nothing
timeout (FailedCommand ScriptTimeout _) = return Nothing
timeout err = throwIO err
screenshot :: WebDriver wd => wd LBS.ByteString
screenshot = B64.decodeLenient <$> screenshotBase64
screenshotBase64 :: WebDriver wd => wd LBS.ByteString
screenshotBase64 = TL.encodeUtf8 <$> doSessCommand GET "/screenshot" Null
availableIMEEngines :: WebDriver wd => wd [Text]
availableIMEEngines = doSessCommand GET "/ime/available_engines" Null
activeIMEEngine :: WebDriver wd => wd Text
activeIMEEngine = doSessCommand GET "/ime/active_engine" Null
checkIMEActive :: WebDriver wd => wd Bool
checkIMEActive = doSessCommand GET "/ime/activated" Null
activateIME :: WebDriver wd => Text -> wd ()
activateIME = noReturn . doSessCommand POST "/ime/activate" . single "engine"
deactivateIME :: WebDriver wd => wd ()
deactivateIME = noReturn $ doSessCommand POST "/ime/deactivate" Null
data FrameSelector = WithIndex Integer
| WithName Text
| WithElement Element
| DefaultFrame
deriving (Eq, Show, Read)
instance ToJSON FrameSelector where
toJSON s = case s of
WithIndex i -> toJSON i
WithName n -> toJSON n
WithElement e -> toJSON e
DefaultFrame -> Null
focusFrame :: WebDriver wd => FrameSelector -> wd ()
focusFrame s = noReturn $ doSessCommand POST "/frame" . single "id" $ s
getCurrentWindow :: WebDriver wd => wd WindowHandle
getCurrentWindow = doSessCommand GET "/window_handle" Null
windows :: WebDriver wd => wd [WindowHandle]
windows = doSessCommand GET "/window_handles" Null
focusWindow :: WebDriver wd => WindowHandle -> wd ()
focusWindow w = noReturn $ doSessCommand POST "/window" . single "name" $ w
closeWindow :: WebDriver wd => WindowHandle -> wd ()
closeWindow = noReturn . doSessCommand DELETE "/window" . single "name"
maximize :: WebDriver wd => wd ()
maximize = noReturn $ doWinCommand GET currentWindow "/maximize" Null
getWindowSize :: WebDriver wd => wd (Word, Word)
getWindowSize = doWinCommand GET currentWindow "/size" Null
>>= parsePair "width" "height" "getWindowSize"
setWindowSize :: WebDriver wd => (Word, Word) -> wd ()
setWindowSize = noReturn . doWinCommand POST currentWindow "/size"
. pair ("width", "height")
getWindowPos :: WebDriver wd => wd (Int, Int)
getWindowPos = doWinCommand GET currentWindow "/position" Null
>>= parsePair "x" "y" "getWindowPos"
setWindowPos :: WebDriver wd => (Int, Int) -> wd ()
setWindowPos = noReturn . doWinCommand POST currentWindow "/position" . pair ("x","y")
data Cookie = Cookie { cookName :: Text
, cookValue :: Text
, cookPath :: Maybe Text
, cookDomain :: Maybe Text
, cookSecure :: Maybe Bool
, cookExpiry :: Maybe Integer
} deriving (Eq, Show)
mkCookie :: Text -> Text -> Cookie
mkCookie name value = Cookie { cookName = name, cookValue = value,
cookPath = Nothing, cookDomain = Nothing,
cookSecure = Nothing, cookExpiry = Nothing
}
instance FromJSON Cookie where
parseJSON (Object o) = Cookie <$> req "name"
<*> req "value"
<*> opt "path" Nothing
<*> opt "domain" Nothing
<*> opt "secure" Nothing
<*> opt "expiry" Nothing
where
req :: FromJSON a => Text -> Parser a
req = (o .:)
opt :: FromJSON a => Text -> a -> Parser a
opt k d = o .:? k .!= d
parseJSON v = typeMismatch "Cookie" v
cookies :: WebDriver wd => wd [Cookie]
cookies = doSessCommand GET "/cookie" Null
setCookie :: WebDriver wd => Cookie -> wd ()
setCookie = noReturn . doSessCommand POST "/cookie" . single "cookie"
deleteCookie :: WebDriver wd => Cookie -> wd ()
deleteCookie c = noReturn $ doSessCommand DELETE ("/cookie/" `append` urlEncode (cookName c)) Null
deleteCookieByName :: WebDriver wd => Text -> wd ()
deleteCookieByName n = noReturn $ doSessCommand DELETE ("/cookie/" `append` n) Null
deleteVisibleCookies :: WebDriver wd => wd ()
deleteVisibleCookies = noReturn $ doSessCommand DELETE "/cookie" Null
getSource :: WebDriver wd => wd Text
getSource = doSessCommand GET "/source" Null
getTitle :: WebDriver wd => wd Text
getTitle = doSessCommand GET "/title" Null
data Selector = ById Text
| ByName Text
| ByClass Text
| ByTag Text
| ByLinkText Text
| ByPartialLinkText Text
| ByCSS Text
| ByXPath Text
deriving (Eq, Show, Ord)
instance ToJSON Selector where
toJSON s = case s of
ById t -> selector "id" t
ByName t -> selector "name" t
ByClass t -> selector "class name" t
ByTag t -> selector "tag name" t
ByLinkText t -> selector "link text" t
ByPartialLinkText t -> selector "partial link text" t
ByCSS t -> selector "css selector" t
ByXPath t -> selector "xpath" t
where
selector :: Text -> Text -> Value
selector sn t = object ["using" .= sn, "value" .= t]
findElem :: WebDriver wd => Selector -> wd Element
findElem = doSessCommand POST "/element"
findElems :: WebDriver wd => Selector -> wd [Element]
findElems = doSessCommand POST "/elements"
activeElem :: WebDriver wd => wd Element
activeElem = doSessCommand POST "/element/active" Null
findElemFrom :: WebDriver wd => Element -> Selector -> wd Element
findElemFrom e = doElemCommand POST e "/element"
findElemsFrom :: WebDriver wd => Element -> Selector -> wd [Element]
findElemsFrom e = doElemCommand POST e "/elements"
elemInfo :: WebDriver wd => Element -> wd Value
elemInfo e = doElemCommand GET e "" Null
click :: WebDriver wd => Element -> wd ()
click e = noReturn $ doElemCommand POST e "/click" Null
submit :: WebDriver wd => Element -> wd ()
submit e = noReturn $ doElemCommand POST e "/submit" Null
getText :: WebDriver wd => Element -> wd Text
getText e = doElemCommand GET e "/text" Null
sendKeys :: WebDriver wd => Text -> Element -> wd ()
sendKeys t e = noReturn . doElemCommand POST e "/value" . single "value" $ [t]
sendRawKeys :: WebDriver wd => Text -> Element -> wd ()
sendRawKeys t e = noReturn . doElemCommand POST e "/keys" . single "value" $ [t]
tagName :: WebDriver wd => Element -> wd Text
tagName e = doElemCommand GET e "/name" Null
clearInput :: WebDriver wd => Element -> wd ()
clearInput e = noReturn $ doElemCommand POST e "/clear" Null
isSelected :: WebDriver wd => Element -> wd Bool
isSelected e = doElemCommand GET e "/selected" Null
isEnabled :: WebDriver wd => Element -> wd Bool
isEnabled e = doElemCommand GET e "/enabled" Null
isDisplayed :: WebDriver wd => Element -> wd Bool
isDisplayed e = doElemCommand GET e "/displayed" Null
attr :: WebDriver wd => Element -> Text -> wd (Maybe Text)
attr e t = doElemCommand GET e ("/attribute/" `append` urlEncode t) Null
cssProp :: WebDriver wd => Element -> Text -> wd (Maybe Text)
cssProp e t = doElemCommand GET e ("/css/" `append` urlEncode t) Null
elemPos :: WebDriver wd => Element -> wd (Int, Int)
elemPos e = doElemCommand GET e "/location" Null >>= parsePair "x" "y" "elemPos"
elemSize :: WebDriver wd => Element -> wd (Word, Word)
elemSize e = doElemCommand GET e "/size" Null
>>= parsePair "width" "height" "elemSize"
infix 4 <==>
(<==>) :: WebDriver wd => Element -> Element -> wd Bool
e1 <==> (Element e2) = doElemCommand GET e1 ("/equals/" `append` urlEncode e2) Null
infix 4 </=>
(</=>) :: WebDriver wd => Element -> Element -> wd Bool
e1 </=> e2 = not <$> (e1 <==> e2)
data Orientation = Landscape | Portrait
deriving (Eq, Show, Ord, Bounded, Enum)
instance ToJSON Orientation where
toJSON = String . toUpper . fromString . show
instance FromJSON Orientation where
parseJSON (String jStr) = case toLower jStr of
"landscape" -> return Landscape
"portrait" -> return Portrait
err -> fail $ "Invalid Orientation string " ++ show err
parseJSON v = typeMismatch "Orientation" v
getOrientation :: WebDriver wd => wd Orientation
getOrientation = doSessCommand GET "/orientation" Null
setOrientation :: WebDriver wd => Orientation -> wd ()
setOrientation = noReturn . doSessCommand POST "/orientation" . single "orientation"
getAlertText :: WebDriver wd => wd Text
getAlertText = doSessCommand GET "/alert_text" Null
replyToAlert :: WebDriver wd => Text -> wd ()
replyToAlert = noReturn . doSessCommand POST "/alert_text" . single "text"
acceptAlert :: WebDriver wd => wd ()
acceptAlert = noReturn $ doSessCommand POST "/accept_alert" Null
dismissAlert :: WebDriver wd => wd ()
dismissAlert = noReturn $ doSessCommand POST "/dismiss_alert" Null
moveTo :: WebDriver wd => (Int, Int) -> wd ()
moveTo = noReturn . doSessCommand POST "/moveto" . pair ("xoffset","yoffset")
moveToCenter :: WebDriver wd => Element -> wd ()
moveToCenter (Element e) =
noReturn . doSessCommand POST "/moveto" . single "element" $ e
moveToFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()
moveToFrom (x,y) (Element e) =
noReturn . doSessCommand POST "/moveto"
. triple ("element","xoffset","yoffset") $ (e,x,y)
data MouseButton = LeftButton | MiddleButton | RightButton
deriving (Eq, Show, Ord, Bounded, Enum)
instance ToJSON MouseButton where
toJSON = toJSON . fromEnum
instance FromJSON MouseButton where
parseJSON v = do
n <- parseJSON v
case n :: Integer of
0 -> return LeftButton
1 -> return MiddleButton
2 -> return RightButton
err -> fail $ "Invalid JSON for MouseButton: " ++ show err
clickWith :: WebDriver wd => MouseButton -> wd ()
clickWith = noReturn . doSessCommand POST "/click" . single "button"
withMouseDown :: WebDriver wd => wd a -> wd a
withMouseDown wd = mouseDown >> wd <* mouseUp
mouseDown :: WebDriver wd => wd ()
mouseDown = noReturn $ doSessCommand POST "/buttondown" Null
mouseUp :: WebDriver wd => wd ()
mouseUp = noReturn $ doSessCommand POST "/buttonup" Null
doubleClick :: WebDriver wd => wd ()
doubleClick = noReturn $ doSessCommand POST "/doubleclick" Null
touchClick :: WebDriver wd => Element -> wd ()
touchClick (Element e) =
noReturn . doSessCommand POST "/touch/click" . single "element" $ e
touchDown :: WebDriver wd => (Int, Int) -> wd ()
touchDown = noReturn . doSessCommand POST "/touch/down" . pair ("x","y")
touchUp :: WebDriver wd => (Int, Int) -> wd ()
touchUp = noReturn . doSessCommand POST "/touch/up" . pair ("x","y")
touchMove :: WebDriver wd => (Int, Int) -> wd ()
touchMove = noReturn . doSessCommand POST "/touch/move" . pair ("x","y")
touchScroll :: WebDriver wd => (Int, Int) -> wd ()
touchScroll = noReturn . doSessCommand POST "/touch/scroll" . pair ("xoffset","yoffset")
touchScrollFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()
touchScrollFrom (x, y) (Element e) =
noReturn
. doSessCommand POST "/touch/scroll"
. triple ("xoffset", "yoffset", "element")
$ (x, y, e)
touchDoubleClick :: WebDriver wd => Element -> wd ()
touchDoubleClick (Element e) =
noReturn
. doSessCommand POST "/touch/doubleclick"
. single "element" $ e
touchLongClick :: WebDriver wd => Element -> wd ()
touchLongClick (Element e) =
noReturn
. doSessCommand POST "/touch/longclick"
. single "element" $ e
touchFlick :: WebDriver wd => (Int, Int) -> wd ()
touchFlick =
noReturn
. doSessCommand POST "/touch/flick"
. pair ("xSpeed", "ySpeed")
touchFlickFrom :: WebDriver wd =>
Int
-> (Int, Int)
-> Element
-> wd ()
touchFlickFrom s (x,y) (Element e) =
noReturn
. doSessCommand POST "/touch/flick" . object $
["xoffset" .= x
,"yoffset" .= y
,"speed" .= s
,"element" .= e
]
getLocation :: WebDriver wd => wd (Int, Int, Int)
getLocation = doSessCommand GET "/location" Null
>>= parseTriple "latitude" "longitude" "altitude" "getLocation"
setLocation :: WebDriver wd => (Int, Int, Int) -> wd ()
setLocation = noReturn . doSessCommand POST "/location"
. triple ("latitude",
"longitude",
"altitude")
uploadFile :: WebDriver wd => FilePath -> wd ()
uploadFile path = uploadZipEntry =<< liftBase (readEntry [] path)
uploadRawFile :: WebDriver wd =>
FilePath
-> Integer
-> LBS.ByteString
-> wd ()
uploadRawFile path t str = uploadZipEntry (toEntry path t str)
uploadZipEntry :: WebDriver wd => Entry -> wd ()
uploadZipEntry = noReturn . doSessCommand POST "/file" . single "file"
. TL.decodeUtf8 . B64.encode . fromArchive . (`addEntryToArchive` emptyArchive)
storageSize :: WebDriver wd => WebStorageType -> wd Integer
storageSize s = doStorageCommand GET s "/size" Null
getAllKeys :: WebDriver wd => WebStorageType -> wd [Text]
getAllKeys s = doStorageCommand GET s "" Null
deleteAllKeys :: WebDriver wd => WebStorageType -> wd ()
deleteAllKeys s = noReturn $ doStorageCommand DELETE s "" Null
data WebStorageType = LocalStorage | SessionStorage
deriving (Eq, Show, Ord, Bounded, Enum)
getKey :: WebDriver wd => WebStorageType -> Text -> wd Text
getKey s k = doStorageCommand GET s ("/key/" `T.append` urlEncode k) Null
setKey :: WebDriver wd => WebStorageType -> Text -> Text -> wd Text
setKey s k v = doStorageCommand POST s "" . object $ ["key" .= k,
"value" .= v ]
deleteKey :: WebDriver wd => WebStorageType -> Text -> wd ()
deleteKey s k = noReturn $ doStorageCommand POST s ("/key/" `T.append` urlEncode k) Null
doStorageCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>
RequestMethod -> WebStorageType -> Text -> a -> wd b
doStorageCommand m s path a = doSessCommand m (T.concat ["/", s', path]) a
where s' = case s of
LocalStorage -> "local_storage"
SessionStorage -> "session_storage"
serverStatus :: (WebDriver wd) => wd Value
serverStatus = doCommand GET "/status" Null
data LogEntry =
LogEntry { logTime :: Integer
, logLevel :: LogLevel
, logMsg :: Text
}
deriving (Eq, Ord, Show, Read)
instance FromJSON LogEntry where
parseJSON (Object o) =
LogEntry <$> o .: "timestamp"
<*> o .: "level"
<*> (fromMaybe "" <$> o .: "message")
parseJSON v = typeMismatch "LogEntry" v
type LogType = String
getLogs :: WebDriver wd => LogType -> wd [LogEntry]
getLogs t = doSessCommand POST "/log" . object $ ["type" .= t]
getLogTypes :: WebDriver wd => wd [LogType]
getLogTypes = doSessCommand GET "/log/types" Null
data ApplicationCacheStatus = Uncached | Idle | Checking | Downloading | UpdateReady | Obsolete deriving (Eq, Enum, Bounded, Ord, Show, Read)
instance FromJSON ApplicationCacheStatus where
parseJSON val = do
n <- parseJSON val
case n :: Integer of
0 -> return Uncached
1 -> return Idle
2 -> return Checking
3 -> return Downloading
4 -> return UpdateReady
5 -> return Obsolete
err -> fail $ "Invalid JSON for ApplicationCacheStatus: " ++ show err
getApplicationCacheStatus :: (WebDriver wd) => wd ApplicationCacheStatus
getApplicationCacheStatus = doSessCommand GET "/application_cache/status" Null
$( deriveToJSON (defaultOptions{fieldLabelModifier = map C.toLower . drop 4}) ''Cookie )