module Test.WebDriver.Commands
(
createSession, closeSession, sessions, getActualCaps
, 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.Exceptions.Internal
import Test.WebDriver.Class
import Test.WebDriver.Session
import Test.WebDriver.JSON
import Test.WebDriver.Capabilities
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.Monad
import Control.Applicative
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
import Data.Foldable
import qualified Data.Char as C
import Prelude
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 . withAuthHeaders . doCommand methodPost "/session" . single "desiredCapabilities" $ caps
getSession
sessions :: WebDriver wd => wd [(SessionId, Capabilities)]
sessions = do
objs <- doCommand methodGet "/sessions" Null
mapM (parsePair "id" "capabilities" "sessions") objs
getActualCaps :: WebDriver wd => wd Capabilities
getActualCaps = doSessCommand methodGet "" Null
closeSession :: WebDriver wd => wd ()
closeSession = do s@WDSession {..} <- getSession
noReturn $ doSessCommand methodDelete "" Null
putSession s { wdSessId = Nothing }
setImplicitWait :: WebDriver wd => Integer -> wd ()
setImplicitWait ms =
noReturn $ doSessCommand methodPost "/timeouts/implicit_wait" (object msField)
`L.catch` \(_ :: SomeException) ->
doSessCommand methodPost "/timeouts" (object allFields)
where msField = ["ms" .= ms]
allFields = ["type" .= ("implicit" :: String)] ++ msField
setScriptTimeout :: WebDriver wd => Integer -> wd ()
setScriptTimeout ms =
noReturn $ doSessCommand methodPost "/timeouts/async_script" (object msField)
`L.catch` \( _ :: SomeException) ->
doSessCommand methodPost "/timeouts" (object allFields)
where msField = ["ms" .= ms]
allFields = ["type" .= ("script" :: String)] ++ msField
setPageLoadTimeout :: WebDriver wd => Integer -> wd ()
setPageLoadTimeout ms = noReturn $ doSessCommand methodPost "/timeouts" params
where params = object ["type" .= ("page load" :: String)
,"ms" .= ms ]
getCurrentURL :: WebDriver wd => wd String
getCurrentURL = doSessCommand methodGet "/url" Null
openPage :: WebDriver wd => String -> wd ()
openPage url
| isURI url = noReturn . doSessCommand methodPost "/url" . single "url" $ url
| otherwise = throwIO . InvalidURL $ url
forward :: WebDriver wd => wd ()
forward = noReturn $ doSessCommand methodPost "/forward" Null
back :: WebDriver wd => wd ()
back = noReturn $ doSessCommand methodPost "/back" Null
refresh :: WebDriver wd => wd ()
refresh = noReturn $ doSessCommand methodPost "/refresh" Null
data JSArg = forall a. ToJSON a => JSArg a
instance ToJSON JSArg where
toJSON (JSArg a) = toJSON a
executeJS :: (Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd a
executeJS a s = fromJSON' =<< getResult
where
getResult = doSessCommand methodPost "/execute" . pair ("args", "script") $ (a,s)
asyncJS :: (Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd (Maybe a)
asyncJS a s = handle timeout $ Just <$> (fromJSON' =<< getResult)
where
getResult = doSessCommand methodPost "/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 methodGet "/screenshot" Null
availableIMEEngines :: WebDriver wd => wd [Text]
availableIMEEngines = doSessCommand methodGet "/ime/available_engines" Null
activeIMEEngine :: WebDriver wd => wd Text
activeIMEEngine = doSessCommand methodGet "/ime/active_engine" Null
checkIMEActive :: WebDriver wd => wd Bool
checkIMEActive = doSessCommand methodGet "/ime/activated" Null
activateIME :: WebDriver wd => Text -> wd ()
activateIME = noReturn . doSessCommand methodPost "/ime/activate" . single "engine"
deactivateIME :: WebDriver wd => wd ()
deactivateIME = noReturn $ doSessCommand methodPost "/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 methodPost "/frame" . single "id" $ s
getCurrentWindow :: WebDriver wd => wd WindowHandle
getCurrentWindow = doSessCommand methodGet "/window_handle" Null
windows :: WebDriver wd => wd [WindowHandle]
windows = doSessCommand methodGet "/window_handles" Null
focusWindow :: WebDriver wd => WindowHandle -> wd ()
focusWindow w = noReturn $ doSessCommand methodPost "/window" . single "name" $ w
closeWindow :: WebDriver wd => WindowHandle -> wd ()
closeWindow = noReturn . doSessCommand methodDelete "/window" . single "name"
maximize :: WebDriver wd => wd ()
maximize = noReturn $ doWinCommand methodGet currentWindow "/maximize" Null
getWindowSize :: WebDriver wd => wd (Word, Word)
getWindowSize = doWinCommand methodGet currentWindow "/size" Null
>>= parsePair "width" "height" "getWindowSize"
setWindowSize :: WebDriver wd => (Word, Word) -> wd ()
setWindowSize = noReturn . doWinCommand methodPost currentWindow "/size"
. pair ("width", "height")
getWindowPos :: WebDriver wd => wd (Int, Int)
getWindowPos = doWinCommand methodGet currentWindow "/position" Null
>>= parsePair "x" "y" "getWindowPos"
setWindowPos :: WebDriver wd => (Int, Int) -> wd ()
setWindowPos = noReturn . doWinCommand methodPost 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 methodGet "/cookie" Null
setCookie :: WebDriver wd => Cookie -> wd ()
setCookie = noReturn . doSessCommand methodPost "/cookie" . single "cookie"
deleteCookie :: WebDriver wd => Cookie -> wd ()
deleteCookie c = noReturn $ doSessCommand methodDelete ("/cookie/" `append` urlEncode (cookName c)) Null
deleteCookieByName :: WebDriver wd => Text -> wd ()
deleteCookieByName n = noReturn $ doSessCommand methodDelete ("/cookie/" `append` n) Null
deleteVisibleCookies :: WebDriver wd => wd ()
deleteVisibleCookies = noReturn $ doSessCommand methodDelete "/cookie" Null
getSource :: WebDriver wd => wd Text
getSource = doSessCommand methodGet "/source" Null
getTitle :: WebDriver wd => wd Text
getTitle = doSessCommand methodGet "/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 methodPost "/element"
findElems :: WebDriver wd => Selector -> wd [Element]
findElems = doSessCommand methodPost "/elements"
activeElem :: WebDriver wd => wd Element
activeElem = doSessCommand methodPost "/element/active" Null
findElemFrom :: WebDriver wd => Element -> Selector -> wd Element
findElemFrom e = doElemCommand methodPost e "/element"
findElemsFrom :: WebDriver wd => Element -> Selector -> wd [Element]
findElemsFrom e = doElemCommand methodPost e "/elements"
elemInfo :: WebDriver wd => Element -> wd Value
elemInfo e = doElemCommand methodGet e "" Null
click :: WebDriver wd => Element -> wd ()
click e = noReturn $ doElemCommand methodPost e "/click" Null
submit :: WebDriver wd => Element -> wd ()
submit e = noReturn $ doElemCommand methodPost e "/submit" Null
getText :: WebDriver wd => Element -> wd Text
getText e = doElemCommand methodGet e "/text" Null
sendKeys :: WebDriver wd => Text -> Element -> wd ()
sendKeys t e = noReturn . doElemCommand methodPost e "/value" . single "value" $ [t]
sendRawKeys :: WebDriver wd => Text -> Element -> wd ()
sendRawKeys t e = noReturn . doElemCommand methodPost e "/keys" . single "value" $ [t]
tagName :: WebDriver wd => Element -> wd Text
tagName e = doElemCommand methodGet e "/name" Null
clearInput :: WebDriver wd => Element -> wd ()
clearInput e = noReturn $ doElemCommand methodPost e "/clear" Null
isSelected :: WebDriver wd => Element -> wd Bool
isSelected e = doElemCommand methodGet e "/selected" Null
isEnabled :: WebDriver wd => Element -> wd Bool
isEnabled e = doElemCommand methodGet e "/enabled" Null
isDisplayed :: WebDriver wd => Element -> wd Bool
isDisplayed e = doElemCommand methodGet e "/displayed" Null
attr :: WebDriver wd => Element -> Text -> wd (Maybe Text)
attr e t = doElemCommand methodGet e ("/attribute/" `append` urlEncode t) Null
cssProp :: WebDriver wd => Element -> Text -> wd (Maybe Text)
cssProp e t = doElemCommand methodGet e ("/css/" `append` urlEncode t) Null
elemPos :: WebDriver wd => Element -> wd (Int, Int)
elemPos e = doElemCommand methodGet e "/location" Null >>= parsePair "x" "y" "elemPos"
elemSize :: WebDriver wd => Element -> wd (Word, Word)
elemSize e = doElemCommand methodGet e "/size" Null
>>= parsePair "width" "height" "elemSize"
infix 4 <==>
(<==>) :: WebDriver wd => Element -> Element -> wd Bool
e1 <==> (Element e2) = doElemCommand methodGet 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 methodGet "/orientation" Null
setOrientation :: WebDriver wd => Orientation -> wd ()
setOrientation = noReturn . doSessCommand methodPost "/orientation" . single "orientation"
getAlertText :: WebDriver wd => wd Text
getAlertText = doSessCommand methodGet "/alert_text" Null
replyToAlert :: WebDriver wd => Text -> wd ()
replyToAlert = noReturn . doSessCommand methodPost "/alert_text" . single "text"
acceptAlert :: WebDriver wd => wd ()
acceptAlert = noReturn $ doSessCommand methodPost "/accept_alert" Null
dismissAlert :: WebDriver wd => wd ()
dismissAlert = noReturn $ doSessCommand methodPost "/dismiss_alert" Null
moveTo :: WebDriver wd => (Int, Int) -> wd ()
moveTo = noReturn . doSessCommand methodPost "/moveto" . pair ("xoffset","yoffset")
moveToCenter :: WebDriver wd => Element -> wd ()
moveToCenter (Element e) =
noReturn . doSessCommand methodPost "/moveto" . single "element" $ e
moveToFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()
moveToFrom (x,y) (Element e) =
noReturn . doSessCommand methodPost "/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 methodPost "/click" . single "button"
withMouseDown :: WebDriver wd => wd a -> wd a
withMouseDown wd = mouseDown >> wd <* mouseUp
mouseDown :: WebDriver wd => wd ()
mouseDown = noReturn $ doSessCommand methodPost "/buttondown" Null
mouseUp :: WebDriver wd => wd ()
mouseUp = noReturn $ doSessCommand methodPost "/buttonup" Null
doubleClick :: WebDriver wd => wd ()
doubleClick = noReturn $ doSessCommand methodPost "/doubleclick" Null
touchClick :: WebDriver wd => Element -> wd ()
touchClick (Element e) =
noReturn . doSessCommand methodPost "/touch/click" . single "element" $ e
touchDown :: WebDriver wd => (Int, Int) -> wd ()
touchDown = noReturn . doSessCommand methodPost "/touch/down" . pair ("x","y")
touchUp :: WebDriver wd => (Int, Int) -> wd ()
touchUp = noReturn . doSessCommand methodPost "/touch/up" . pair ("x","y")
touchMove :: WebDriver wd => (Int, Int) -> wd ()
touchMove = noReturn . doSessCommand methodPost "/touch/move" . pair ("x","y")
touchScroll :: WebDriver wd => (Int, Int) -> wd ()
touchScroll = noReturn . doSessCommand methodPost "/touch/scroll" . pair ("xoffset","yoffset")
touchScrollFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()
touchScrollFrom (x, y) (Element e) =
noReturn
. doSessCommand methodPost "/touch/scroll"
. triple ("xoffset", "yoffset", "element")
$ (x, y, e)
touchDoubleClick :: WebDriver wd => Element -> wd ()
touchDoubleClick (Element e) =
noReturn
. doSessCommand methodPost "/touch/doubleclick"
. single "element" $ e
touchLongClick :: WebDriver wd => Element -> wd ()
touchLongClick (Element e) =
noReturn
. doSessCommand methodPost "/touch/longclick"
. single "element" $ e
touchFlick :: WebDriver wd => (Int, Int) -> wd ()
touchFlick =
noReturn
. doSessCommand methodPost "/touch/flick"
. pair ("xSpeed", "ySpeed")
touchFlickFrom :: WebDriver wd =>
Int
-> (Int, Int)
-> Element
-> wd ()
touchFlickFrom s (x,y) (Element e) =
noReturn
. doSessCommand methodPost "/touch/flick" . object $
["xoffset" .= x
,"yoffset" .= y
,"speed" .= s
,"element" .= e
]
getLocation :: WebDriver wd => wd (Int, Int, Int)
getLocation = doSessCommand methodGet "/location" Null
>>= parseTriple "latitude" "longitude" "altitude" "getLocation"
setLocation :: WebDriver wd => (Int, Int, Int) -> wd ()
setLocation = noReturn . doSessCommand methodPost "/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 methodPost "/file" . single "file"
. TL.decodeUtf8 . B64.encode . fromArchive . (`addEntryToArchive` emptyArchive)
storageSize :: WebDriver wd => WebStorageType -> wd Integer
storageSize s = doStorageCommand methodGet s "/size" Null
getAllKeys :: WebDriver wd => WebStorageType -> wd [Text]
getAllKeys s = doStorageCommand methodGet s "" Null
deleteAllKeys :: WebDriver wd => WebStorageType -> wd ()
deleteAllKeys s = noReturn $ doStorageCommand methodDelete s "" Null
data WebStorageType = LocalStorage | SessionStorage
deriving (Eq, Show, Ord, Bounded, Enum)
getKey :: WebDriver wd => WebStorageType -> Text -> wd Text
getKey s k = doStorageCommand methodGet s ("/key/" `T.append` urlEncode k) Null
setKey :: WebDriver wd => WebStorageType -> Text -> Text -> wd Text
setKey s k v = doStorageCommand methodPost s "" . object $ ["key" .= k,
"value" .= v ]
deleteKey :: WebDriver wd => WebStorageType -> Text -> wd ()
deleteKey s k = noReturn $ doStorageCommand methodPost s ("/key/" `T.append` urlEncode k) Null
doStorageCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>
Method -> 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 methodGet "/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 methodPost "/log" . object $ ["type" .= t]
getLogTypes :: WebDriver wd => wd [LogType]
getLogTypes = doSessCommand methodGet "/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 methodGet "/application_cache/status" Null
$( deriveToJSON (defaultOptions{fieldLabelModifier = map C.toLower . drop 4}) ''Cookie )