module Test.WebDriver.Commands
(
createSession, closeSession, sessions, getCaps
, openPage, forward, back, refresh
, getCurrentURL, getSource, getTitle, screenshot
, 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
, getAlertText, replyToAlert, acceptAlert, dismissAlert
, moveTo, moveToCenter, moveToFrom
, clickWith, MouseButton(..)
, mouseDown, mouseUp, withMouseDown, doubleClick
, WebStorageType(..), storageSize, getAllKeys, deleteAllKeys
, getKey, setKey, deleteKey
, Orientation(..)
, getOrientation, setOrientation
, getLocation, setLocation
, touchClick, touchDown, touchUp, touchMove
, touchScroll, touchScrollFrom, touchDoubleClick
, touchLongClick, touchFlick, touchFlickFrom
, availableIMEEngines, activeIMEEngine, checkIMEActive
, activateIME, deactivateIME
, uploadFile, uploadRawFile, uploadZipEntry
, serverStatus
) where
import Test.WebDriver.Classes
import Test.WebDriver.JSON
import Test.WebDriver.Capabilities
import Test.WebDriver.Internal
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.TH
import qualified Data.Text as T
import Data.Text (Text, splitOn, append, toUpper, toLower)
import Data.ByteString as SBS (ByteString, concat)
import Data.ByteString.Base64 as B64
import Data.ByteString.Lazy as LBS (ByteString, toChunks)
import Network.URI hiding (path)
import Codec.Archive.Zip
import Control.Applicative
import Control.Monad.State.Strict
import Control.Monad.Base
import Control.Exception (SomeException)
import Control.Exception.Lifted (throwIO, catch, handle)
import Data.Word
import Data.String (fromString)
import Data.Default
import qualified Data.Char as C
import Prelude hiding (catch)
serverStatus :: (WebDriver wd) => wd Value
serverStatus = doCommand GET "/status" ()
createSession :: WebDriver wd => Capabilities -> wd WDSession
createSession caps = do
sessUrl <- doCommand POST "/session" . single "desiredCapabilities" $ caps
let sessId = SessionId . last . filter (not . T.null) . splitOn "/" $ sessUrl
modifySession $ \sess -> sess {wdSessId = Just sessId}
return =<< getSession
sessions :: WebDriver wd => wd [(SessionId, Capabilities)]
sessions = do
objs <- doCommand GET "/sessions" ()
forM objs $ parsePair "id" "capabilities" "sessions"
getCaps :: WebDriver wd => wd Capabilities
getCaps = doSessCommand GET "" ()
closeSession :: WebDriver wd => wd ()
closeSession = do s <- getSession
doSessCommand DELETE "" () :: WebDriver wd => wd ()
putSession s { wdSessId = Nothing }
setImplicitWait :: WebDriver wd => Integer -> wd ()
setImplicitWait ms =
doSessCommand POST "/timeouts/implicit_wait" (object msField)
`catch` \(_ :: SomeException) ->
doSessCommand POST "/timeouts" (object allFields)
where msField = ["ms" .= ms]
allFields = ["type" .= ("implicit" :: String)] ++ msField
setScriptTimeout :: WebDriver wd => Integer -> wd ()
setScriptTimeout ms =
doSessCommand POST "/timeouts/async_script" (object msField)
`catch` \(_ :: SomeException) ->
doSessCommand POST "/timeouts" (object allFields)
where msField = ["ms" .= ms]
allFields = ["type" .= ("script" :: String)] ++ msField
setPageLoadTimeout :: WebDriver wd => Integer -> wd ()
setPageLoadTimeout ms = doSessCommand POST "/timeouts" params
where params = object ["type" .= ("page load" :: String)
,"ms" .= ms ]
getCurrentURL :: WebDriver wd => wd String
getCurrentURL = doSessCommand GET "/url" ()
openPage :: WebDriver wd => String -> wd ()
openPage url
| isURI url = doSessCommand POST "/url" . single "url" $ url
| otherwise = throwIO . InvalidURL $ url
forward :: WebDriver wd => wd ()
forward = doSessCommand POST "/forward" ()
back :: WebDriver wd => wd ()
back = doSessCommand POST "/back" ()
refresh :: WebDriver wd => wd ()
refresh = doSessCommand POST "/refresh" ()
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 $ fromJSON' =<< getResult
where
getResult = doSessCommand POST "/execute_async" . pair ("args", "script")
$ (a,s)
timeout (FailedCommand Timeout _) = return Nothing
timeout err = throwIO err
screenshot :: WebDriver wd => wd SBS.ByteString
screenshot = B64.decodeLenient <$> doSessCommand GET "/screenshot" ()
availableIMEEngines :: WebDriver wd => wd [Text]
availableIMEEngines = doSessCommand GET "/ime/available_engines" ()
activeIMEEngine :: WebDriver wd => wd Text
activeIMEEngine = doSessCommand GET "/ime/active_engine" ()
checkIMEActive :: WebDriver wd => wd Bool
checkIMEActive = doSessCommand GET "/ime/activated" ()
activateIME :: WebDriver wd => Text -> wd ()
activateIME = doSessCommand POST "/ime/activate" . single "engine"
deactivateIME :: WebDriver wd => wd ()
deactivateIME = doSessCommand POST "/ime/deactivate" ()
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 = doSessCommand POST "/frame" . single "id" $ s
newtype WindowHandle = WindowHandle Text
deriving (Eq, Ord, Show, Read,
FromJSON, ToJSON)
instance Default WindowHandle where
def = currentWindow
currentWindow :: WindowHandle
currentWindow = WindowHandle "current"
getCurrentWindow :: WebDriver wd => wd WindowHandle
getCurrentWindow = doSessCommand GET "/window_handle" ()
windows :: WebDriver wd => wd [WindowHandle]
windows = doSessCommand GET "/window_handles" ()
focusWindow :: WebDriver wd => WindowHandle -> wd ()
focusWindow w = doSessCommand POST "/window" . single "name" $ w
closeWindow :: WebDriver wd => WindowHandle -> wd ()
closeWindow = doSessCommand DELETE "/window" . single "name"
maximize :: WebDriver wd => wd ()
maximize = doWinCommand GET currentWindow "/maximize" ()
getWindowSize :: WebDriver wd => wd (Word, Word)
getWindowSize = doWinCommand GET currentWindow "/size" ()
>>= parsePair "width" "height" "getWindowSize"
setWindowSize :: WebDriver wd => (Word, Word) -> wd ()
setWindowSize = doWinCommand POST currentWindow "/size"
. pair ("width", "height")
getWindowPos :: WebDriver wd => wd (Int, Int)
getWindowPos = doWinCommand GET currentWindow "/position" ()
>>= parsePair "x" "y" "getWindowPos"
setWindowPos :: WebDriver wd => (Int, Int) -> wd ()
setWindowPos = doWinCommand POST currentWindow "/position" . pair ("x","y")
doWinCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>
RequestMethod -> WindowHandle -> Text -> a -> wd b
doWinCommand m (WindowHandle w) path a =
doSessCommand m (T.concat ["/window/", w, path]) a
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" ()
setCookie :: WebDriver wd => Cookie -> wd ()
setCookie = doSessCommand POST "/cookie" . single "cookie"
deleteCookie :: WebDriver wd => Cookie -> wd ()
deleteCookie c = doSessCommand DELETE ("/cookie/" `append` cookName c) ()
deleteVisibleCookies :: WebDriver wd => wd ()
deleteVisibleCookies = doSessCommand DELETE "/cookie" ()
getSource :: WebDriver wd => wd Text
getSource = doSessCommand GET "/source" ()
getTitle :: WebDriver wd => wd Text
getTitle = doSessCommand GET "/title" ()
newtype Element = Element Text
deriving (Eq, Ord, Show, Read)
instance FromJSON Element where
parseJSON (Object o) = Element <$> o .: "ELEMENT"
parseJSON v = typeMismatch "Element" v
instance ToJSON Element where
toJSON (Element e) = object ["ELEMENT" .= e]
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" ()
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 "" ()
click :: WebDriver wd => Element -> wd ()
click e = doElemCommand POST e "/click" ()
submit :: WebDriver wd => Element -> wd ()
submit e = doElemCommand POST e "/submit" ()
getText :: WebDriver wd => Element -> wd Text
getText e = doElemCommand GET e "/text" ()
sendKeys :: WebDriver wd => Text -> Element -> wd ()
sendKeys t e = doElemCommand POST e "/value" . single "value" $ [t]
sendRawKeys :: WebDriver wd => Text -> Element -> wd ()
sendRawKeys t e = doElemCommand POST e "/keys" . single "value" $ [t]
tagName :: WebDriver wd => Element -> wd Text
tagName e = doElemCommand GET e "/name" ()
clearInput :: WebDriver wd => Element -> wd ()
clearInput e = doElemCommand POST e "/clear" ()
isSelected :: WebDriver wd => Element -> wd Bool
isSelected e = doElemCommand GET e "/selected" ()
isEnabled :: WebDriver wd => Element -> wd Bool
isEnabled e = doElemCommand GET e "/enabled" ()
isDisplayed :: WebDriver wd => Element -> wd Bool
isDisplayed e = doElemCommand GET e "/displayed" ()
attr :: WebDriver wd => Element -> Text -> wd (Maybe Text)
attr e t = doElemCommand GET e ("/attribute/" `append` t) ()
cssProp :: WebDriver wd => Element -> Text -> wd (Maybe Text)
cssProp e t = doElemCommand GET e ("/css/" `append` t) ()
elemPos :: WebDriver wd => Element -> wd (Int, Int)
elemPos e = doElemCommand GET e "/location" () >>= parsePair "x" "y" "elemPos"
elemSize :: WebDriver wd => Element -> wd (Word, Word)
elemSize e = doElemCommand GET e "/size" ()
>>= parsePair "width" "height" "elemSize"
infix 4 <==>
(<==>) :: WebDriver wd => Element -> Element -> wd Bool
e1 <==> (Element e2) = doElemCommand GET e1 ("/equals/" `append` e2) ()
infix 4 </=>
(</=>) :: WebDriver wd => Element -> Element -> wd Bool
e1 </=> e2 = not <$> (e1 <==> e2)
doElemCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>
RequestMethod -> Element -> Text -> a -> wd b
doElemCommand m (Element e) path a =
doSessCommand m (T.concat ["/element/", e, path]) a
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" ()
setOrientation :: WebDriver wd => Orientation -> wd ()
setOrientation = doSessCommand POST "/orientation" . single "orientation"
getAlertText :: WebDriver wd => wd Text
getAlertText = doSessCommand GET "/alert_text" ()
replyToAlert :: WebDriver wd => Text -> wd ()
replyToAlert = doSessCommand POST "/alert_text" . single "text"
acceptAlert :: WebDriver wd => wd ()
acceptAlert = doSessCommand POST "/accept_alert" ()
dismissAlert :: WebDriver wd => wd ()
dismissAlert = doSessCommand POST "/dismiss_alert" ()
moveTo :: WebDriver wd => (Int, Int) -> wd ()
moveTo = doSessCommand POST "/moveto" . pair ("xoffset","yoffset")
moveToCenter :: WebDriver wd => Element -> wd ()
moveToCenter (Element e) =
doSessCommand POST "/moveto" . single "element" $ e
moveToFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()
moveToFrom (x,y) (Element e) =
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 = String . toUpper . fromString . show
instance FromJSON MouseButton where
parseJSON (String jStr) = case toLower jStr of
"left" -> return LeftButton
"middle" -> return MiddleButton
"right" -> return RightButton
err -> fail $ "Invalid MouseButton string " ++ show err
parseJSON v = typeMismatch "MouseButton" v
clickWith :: WebDriver wd => MouseButton -> wd ()
clickWith = doSessCommand POST "/click" . single "button"
withMouseDown :: WebDriver wd => wd a -> wd a
withMouseDown wd = mouseDown >> wd <* mouseUp
mouseDown :: WebDriver wd => wd ()
mouseDown = doSessCommand POST "/buttondown" ()
mouseUp :: WebDriver wd => wd ()
mouseUp = doSessCommand POST "/buttonup" ()
doubleClick :: WebDriver wd => wd ()
doubleClick = doSessCommand POST "/doubleclick" ()
touchClick :: WebDriver wd => Element -> wd ()
touchClick (Element e) =
doSessCommand POST "/touch/click" . single "element" $ e
touchDown :: WebDriver wd => (Int, Int) -> wd ()
touchDown = doSessCommand POST "/touch/down" . pair ("x","y")
touchUp :: WebDriver wd => (Int, Int) -> wd ()
touchUp = doSessCommand POST "/touch/up" . pair ("x","y")
touchMove :: WebDriver wd => (Int, Int) -> wd ()
touchMove = doSessCommand POST "/touch/move" . pair ("x","y")
touchScroll :: WebDriver wd => (Int, Int) -> wd ()
touchScroll = doSessCommand POST "/touch/scroll" . pair ("xoffset","yoffset")
touchScrollFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()
touchScrollFrom (x, y) (Element e) =
doSessCommand POST "/touch/scroll"
. triple ("xoffset", "yoffset", "element")
$ (x, y, e)
touchDoubleClick :: WebDriver wd => Element -> wd ()
touchDoubleClick (Element e) = doSessCommand POST "/touch/doubleclick"
. single "element" $ e
touchLongClick :: WebDriver wd => Element -> wd ()
touchLongClick (Element e) = doSessCommand POST "/touch/longclick"
. single "element" $ e
touchFlick :: WebDriver wd => (Int, Int) -> wd ()
touchFlick = doSessCommand POST "/touch/flick" . pair ("xSpeed", "ySpeed")
touchFlickFrom :: WebDriver wd =>
Int
-> (Int, Int)
-> Element
-> wd ()
touchFlickFrom s (x,y) (Element e) =
doSessCommand POST "/touch/flick" . object $
["xoffset" .= x
,"yoffset" .= y
,"speed" .= s
,"element" .= e
]
getLocation :: WebDriver wd => wd (Int, Int, Int)
getLocation = doSessCommand GET "/location" ()
>>= parseTriple "latitude" "longitude" "altitude" "getLocation"
setLocation :: WebDriver wd => (Int, Int, Int) -> wd ()
setLocation = 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 = doSessCommand POST "/file" . single "file"
. B64.encode . SBS.concat . toChunks
. fromArchive . (`addEntryToArchive` emptyArchive)
data WebStorageType = LocalStorage | SessionStorage
deriving (Eq, Show, Ord, Bounded, Enum)
storageSize :: WebDriver wd => WebStorageType -> wd Integer
storageSize s = doStorageCommand GET s "/size" ()
getAllKeys :: WebDriver wd => WebStorageType -> wd [Text]
getAllKeys s = doStorageCommand GET s "" ()
deleteAllKeys :: WebDriver wd => WebStorageType -> wd ()
deleteAllKeys s = doStorageCommand DELETE s "" ()
getKey :: WebDriver wd => WebStorageType -> Text -> wd Text
getKey s k = doStorageCommand GET s ("/key/" `T.append` k) ()
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 = doStorageCommand POST s ("/key/" `T.append` k) ()
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"
$( deriveToJSON (map C.toLower . drop 4) ''Cookie )