diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,16 +1,27 @@ #Change Log +##upcoming release +###API changes +* Test.WebDriver.Internal.FailedCommandInfo now stores screenshots as lazy bytestrings +* Test.WebDriver.Common.Profile now stores PreparedProfile as a lazy bytestring +* Test.WebDriver.Chrome.Extension now stores ChromeExtension as a lazy bytestring +* The LogPref type has been renamed to LogLevel to reflect its use within the new log interface + +###new features +* a new log interface as specified by webdriver standard. This includes the functions getLogs and getLogTypes, and the types LogType and LogEntry. + ##hs-webdriver 0.5.0.1 ###bug fixes * hs-webdriver now correctly handles a wider variety of server-specific responses when a webdriver command expects no return value. * An issue with the redirect status codes used during session creation has been fixed. * As a result of the above fixes, hs-webdriver should now work with chromedriver. Note that, prior to this version, you can still use chromedriver if you use the selenium standalone server jar as a proxy. + ##hs-webdriver 0.5 ###API changes * Test.WebDriver.Commands.Wait.unexpected now accepts a String argument, which is used as an error message * screenshot and uploadZipEntry from Test.WebDriver.Commands now use lazy bytestrings -*wdBasePath field added to WDSession. This allows you to specify a custom base path for all WebDriver requests. The default, as specified in the WebDriver standard, is "/wd/hub" +* wdBasePath field added to WDSession. This allows you to specify a custom base path for all WebDriver requests. The default, as specified in the WebDriver standard, is "/wd/hub" ###new features * added Test.WebDriver.Commands.screenshotBase64 diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -33,6 +33,4 @@ misc. unsorted ---Use lazy ByteString where possible. patch base64-bytestring to work with lazy bytestrings - --consider adding withSession to SessionState so that it can be overloaded easily, or rewriting it so that it's overloaded but not a method itself. diff --git a/src/Test/WebDriver.hs b/src/Test/WebDriver.hs --- a/src/Test/WebDriver.hs +++ b/src/Test/WebDriver.hs @@ -13,7 +13,7 @@ , Capabilities(..), defaultCaps, allCaps , Platform(..), ProxyType(..) -- ** Browser-specific configuration - , Browser(..), LogPref(..) + , Browser(..), LogLevel(..) , firefox, chrome, ie, opera, iPhone, iPad, android -- * Exceptions , module Test.WebDriver.Exceptions diff --git a/src/Test/WebDriver/Capabilities.hs b/src/Test/WebDriver/Capabilities.hs --- a/src/Test/WebDriver/Capabilities.hs +++ b/src/Test/WebDriver/Capabilities.hs @@ -219,7 +219,7 @@ -- and used. ffProfile :: Maybe (PreparedProfile Firefox) -- |Firefox logging preference - , ffLogPref :: LogPref + , ffLogPref :: LogLevel -- |Server-side path to Firefox binary. If Nothing, -- use a sensible system-based default. , ffBinary :: Maybe FilePath @@ -288,7 +288,7 @@ -- disabled. , operaLogFile :: Maybe FilePath -- |Log level preference. Defaults to 'LogInfo' - , operaLogPref :: LogPref + , operaLogPref :: LogLevel } | HTMLUnit | IPhone @@ -439,15 +439,15 @@ ,"httpProxy" .= http ] --- |Indicates log verbosity. Used in 'Firefox' and 'Opera' configuration. -data LogPref = LogOff | LogSevere | LogWarning | LogInfo | LogConfig - | LogFine | LogFiner | LogFinest | LogAll - deriving (Eq, Show, Ord, Bounded, Enum) +-- |Indicates a log verbosity level. Used in 'Firefox' and 'Opera' configuration. +data LogLevel = LogOff | LogSevere | LogWarning | LogInfo | LogConfig + | LogFine | LogFiner | LogFinest | LogAll + deriving (Eq, Show, Read, Ord, Bounded, Enum) -instance Default LogPref where +instance Default LogLevel where def = LogInfo -instance ToJSON LogPref where +instance ToJSON LogLevel where toJSON p= String $ case p of LogOff -> "OFF" LogSevere -> "SEVERE" @@ -459,7 +459,7 @@ LogFinest -> "FINEST" LogAll -> "ALL" -instance FromJSON LogPref where +instance FromJSON LogLevel where parseJSON (String s) = return $ case s of "OFF" -> LogOff "SEVERE" -> LogSevere @@ -471,4 +471,4 @@ "FINEST" -> LogFinest "ALL" -> LogAll _ -> throw . BadJSON $ "Invalid logging preference: " ++ show s - parseJSON other = typeMismatch "LogPref" other + parseJSON other = typeMismatch "LogLevel" other diff --git a/src/Test/WebDriver/Chrome/Extension.hs b/src/Test/WebDriver/Chrome/Extension.hs --- a/src/Test/WebDriver/Chrome/Extension.hs +++ b/src/Test/WebDriver/Chrome/Extension.hs @@ -5,8 +5,8 @@ , loadExtension , loadRawExtension ) where -import Data.ByteString as BS -import Data.ByteString.Base64 as B64 +import Data.ByteString.Lazy as LBS +import Data.ByteString.Base64.Lazy as B64 import Data.Aeson import Control.Applicative import Control.Monad.Base @@ -18,7 +18,7 @@ -- |Load a .crx file as a 'ChromeExtension'. loadExtension :: MonadBase IO m => FilePath -> m ChromeExtension -loadExtension path = liftBase $ loadRawExtension <$> BS.readFile path +loadExtension path = liftBase $ loadRawExtension <$> LBS.readFile path -- |Load raw .crx data as a 'ChromeExtension'. loadRawExtension :: ByteString -> ChromeExtension diff --git a/src/Test/WebDriver/Classes.hs b/src/Test/WebDriver/Classes.hs --- a/src/Test/WebDriver/Classes.hs +++ b/src/Test/WebDriver/Classes.hs @@ -62,11 +62,11 @@ monad before execution. -} data WDSession = WDSession { -- |Host name of the WebDriver server for this - -- session + -- session (default 127.0.0.1) wdHost :: String - -- |Port number of the server + -- |Port number of the server (default 4444) , wdPort :: Word16 - -- |Base path (usually "/wd/hub") + -- |Base path (default "/wd/hub") , wdBasePath :: String -- |An opaque reference identifying the session to -- use with 'WD' commands. diff --git a/src/Test/WebDriver/Commands.hs b/src/Test/WebDriver/Commands.hs --- a/src/Test/WebDriver/Commands.hs +++ b/src/Test/WebDriver/Commands.hs @@ -45,8 +45,6 @@ , clickWith, MouseButton(..) , mouseDown, mouseUp, withMouseDown, doubleClick -- * HTML 5 Web Storage - -- |As of Selenium 2.21, Web Storage is only supported on iOS and - -- Android platforms , WebStorageType(..), storageSize, getAllKeys, deleteAllKeys , getKey, setKey, deleteKey -- * Mobile device support @@ -67,8 +65,9 @@ -- Note that this operation isn't supported by all WebDriver servers, -- and the location where the file is stored is not standardized. , uploadFile, uploadRawFile, uploadZipEntry - -- * Server information + -- * Server information and logs , serverStatus + , getLogs, getLogTypes, LogType, LogEntry(..), LogLevel(..) ) where import Test.WebDriver.Commands.Internal @@ -94,6 +93,7 @@ import Control.Exception.Lifted (throwIO, catch, handle) import Data.Word import Data.String (fromString) +import Data.Maybe (fromMaybe) import qualified Data.Char as C import Prelude hiding (catch) @@ -103,13 +103,6 @@ noReturn :: WebDriver wd => wd NoReturn -> wd () noReturn = void --- |Get information from the server as a JSON 'Object'. For more information --- about this object see --- -serverStatus :: (WebDriver wd) => wd Value -- todo: make this a record type -serverStatus = doCommand GET "/status" Null - - -- |Create a new session with the given 'Capabilities'. This command -- resets the current session ID to that of the new session. createSession :: WebDriver wd => Capabilities -> wd WDSession @@ -571,7 +564,6 @@ 1 -> return MiddleButton 2 -> return RightButton err -> fail $ "Invalid JSON for MouseButton: " ++ show err - parseJSON v = typeMismatch "MouseButton" v -- |Click at the current mouse position with the given mouse button. clickWith :: WebDriver wd => MouseButton -> wd () @@ -735,6 +727,39 @@ LocalStorage -> "local_storage" SessionStorage -> "session_storage" +-- |Get information from the server as a JSON 'Object'. For more information +-- about this object see +-- +serverStatus :: (WebDriver wd) => wd Value -- todo: make this a record type +serverStatus = doCommand GET "/status" () + +-- |A record that represents a single log entry. +data LogEntry = + LogEntry { logTime :: Integer -- ^ timestamp for the log entry. The standard + -- does not specify the epoch or the unit of + -- time. + , logLevel :: LogLevel -- ^ log verbosity level + , 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 + +-- |Retrieve the log buffer for a given log type. The server-side log buffer is reset after each request. +getLogs :: WebDriver wd => LogType -> wd [LogEntry] +getLogs t = doSessCommand POST "/log" . object $ ["type" .= t] + +-- |Get a list of available log types. +getLogTypes :: WebDriver wd => wd [LogType] +getLogTypes = doSessCommand GET "/log/types" () -- Moving this closer to the definition of Cookie seems to cause strange compile -- errors, so I'm leaving it here for now. diff --git a/src/Test/WebDriver/Commands/Wait.hs b/src/Test/WebDriver/Commands/Wait.hs --- a/src/Test/WebDriver/Commands/Wait.hs +++ b/src/Test/WebDriver/Commands/Wait.hs @@ -67,10 +67,10 @@ ,Handler handleExpectFailed] ) where - handleFailedCommand (FailedCommand NoSuchElement _) = retry + handleFailedCommand e@(FailedCommand NoSuchElement _) = retry (show e) handleFailedCommand err = throwIO err - handleExpectFailed (_ :: ExpectFailed) = retry + handleExpectFailed (e :: ExpectFailed) = retry (show e) -- |Like 'waitUntil', but retries the action until it fails or until the timeout -- is exceeded. @@ -83,27 +83,28 @@ waitWhile' = wait' handler where handler retry wd = do - b <- (wd >> return True) `catches` [Handler handleFailedCommand - ,Handler handleExpectFailed - ] - when b retry + b <- (wd >> return Nothing) `catches` [Handler handleFailedCommand + ,Handler handleExpectFailed + ] + maybe (return ()) retry b where - handleFailedCommand (FailedCommand NoSuchElement _) = return False + handleFailedCommand e@(FailedCommand NoSuchElement _) = return (Just $ show e) handleFailedCommand err = throwIO err - handleExpectFailed (_ :: ExpectFailed) = return False + handleExpectFailed (e :: ExpectFailed) = return (Just $ show e) wait' :: SessionState m => - (m b -> m a -> m b) -> Int -> Double -> m a -> m b + ((String -> m b) -> m a -> m b) -> Int -> Double -> m a -> m b wait' handler waitAmnt t wd = waitLoop =<< liftBase getCurrentTime where timeout = realToFrac t waitLoop startTime = handler retry wd where - retry = do + retry why = do now <- liftBase getCurrentTime if diffUTCTime now startTime >= timeout then - failedCommand Timeout "wait': explicit wait timed out." + failedCommand Timeout $ + "wait': explicit wait timed out (" ++ why ++ ")." else do liftBase . threadDelay $ waitAmnt waitLoop startTime diff --git a/src/Test/WebDriver/Common/Profile.hs b/src/Test/WebDriver/Common/Profile.hs --- a/src/Test/WebDriver/Common/Profile.hs +++ b/src/Test/WebDriver/Common/Profile.hs @@ -32,10 +32,10 @@ import qualified Data.HashMap.Strict as HM import Data.Text (Text, pack) -import Data.ByteString (ByteString) -import qualified Data.ByteString as SBS +import Data.ByteString.Lazy (ByteString) +--import qualified Data.ByteString as SBS import qualified Data.ByteString.Lazy as LBS -import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.Lazy as B64 import Data.Fixed @@ -243,5 +243,5 @@ prepareZipArchive = prepareRawZip . fromArchive -- |Prepare a ByteString of raw zip data for network transmission -prepareRawZip :: LBS.ByteString -> PreparedProfile a -prepareRawZip = PreparedProfile . B64.encode . SBS.concat . LBS.toChunks +prepareRawZip :: ByteString -> PreparedProfile a +prepareRawZip = PreparedProfile . B64.encode diff --git a/src/Test/WebDriver/Firefox/Profile.hs b/src/Test/WebDriver/Firefox/Profile.hs --- a/src/Test/WebDriver/Firefox/Profile.hs +++ b/src/Test/WebDriver/Firefox/Profile.hs @@ -195,7 +195,7 @@ -- |Convenience function to load an existing Firefox profile from disk, apply -- a handler function, and then prepare the result for network transmission. --- +-- -- NOTE: like 'prepareProfile', the same caveat about large profiles applies. prepareLoadedProfile :: MonadBaseControl IO m => FilePath @@ -207,11 +207,11 @@ prefsParser :: Parser [(Text, ProfilePref)] prefsParser = many1 $ do - padSpaces $ string "user_pref(" + void . padSpaces $ string "user_pref(" k <- prefKey "preference key" - padSpaces $ char ',' + void . padSpaces $ char ',' v <- prefVal "preference value" - padSpaces $ string ");" + void . padSpaces $ string ");" return (k,v) where prefKey = jstring diff --git a/src/Test/WebDriver/Internal.hs b/src/Test/WebDriver/Internal.hs --- a/src/Test/WebDriver/Internal.hs +++ b/src/Test/WebDriver/Internal.hs @@ -2,6 +2,7 @@ module Test.WebDriver.Internal ( mkWDUri, mkRequest , handleHTTPErr, handleJSONErr, handleHTTPResp + , WDResponse(..) , InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..) , UnknownCommand(..), ServerError(..) @@ -21,9 +22,8 @@ import Data.Text as T (Text, unpack) import Data.ByteString.Lazy.Char8 (ByteString) -import Data.ByteString.Lazy.Char8 as BS (length, unpack, null) -import qualified Data.ByteString.Char8 as SBS (ByteString) -import qualified Data.ByteString.Base64 as B64 +import Data.ByteString.Lazy.Char8 as LBS (length, unpack, null) +import qualified Data.ByteString.Base64.Lazy as B64 import Control.Monad.Base import Control.Exception.Lifted (throwIO) @@ -37,13 +37,13 @@ import Data.Word (Word, Word8) mkWDUri :: (SessionState s) => String -> s URI -mkWDUri path = do +mkWDUri wdPath = do WDSession{wdHost = host, wdPort = port, wdBasePath = basePath } <- getSession let urlStr = "http://" ++ host ++ ":" ++ show port - relPath = basePath ++ path + relPath = basePath ++ wdPath mBaseURI = parseAbsoluteURI urlStr mRelURI = parseRelativeReference relPath case (mBaseURI, mRelURI) of @@ -53,8 +53,8 @@ mkRequest :: (SessionState s, ToJSON a) => [Header] -> RequestMethod -> Text -> a -> s (Response ByteString) -mkRequest headers method path args = do - uri <- mkWDUri (T.unpack path) +mkRequest headers method wdPath args = do + uri <- mkWDUri (T.unpack wdPath) let body = case toJSON args of Null -> "" --passing Null as the argument indicates no request body other -> encode other @@ -66,7 +66,7 @@ , Header HdrContentType "application/json;charset=UTF-8" , Header HdrContentLength - . show . BS.length $ body + . show . LBS.length $ body ] } r <- liftBase (simpleHTTP req) >>= either (throwIO . HTTPConnError) return @@ -102,9 +102,9 @@ (findHeader HdrLocation resp) where statusErr = throwIO . HTTPStatusUnknown code - $ (BS.unpack body) + $ (LBS.unpack body) other - | BS.null body -> noReturn + | LBS.null body -> noReturn | otherwise -> fromJSON' . rspVal =<< parseJSON' body where noReturn = fromJSON' Null @@ -147,6 +147,7 @@ _ -> e UnknownError +-- |Internal type representing the JSON response object data WDResponse = WDResponse { rspSessId :: Maybe SessionId , rspStatus :: Word8 , rspVal :: Value @@ -229,7 +230,7 @@ -- |A screen shot of the focused window -- when the exception occured, -- if provided. - , errScreen :: Maybe SBS.ByteString + , errScreen :: Maybe ByteString -- |The "class" in which the exception -- was raised, if provided. , errClass :: Maybe String diff --git a/src/Test/WebDriver/Types.hs b/src/Test/WebDriver/Types.hs --- a/src/Test/WebDriver/Types.hs +++ b/src/Test/WebDriver/Types.hs @@ -14,7 +14,7 @@ , Browser(..), -- ** Default settings for browsers firefox, chrome, ie, opera, iPhone, iPad, android - , LogPref(..) + , LogLevel(..) -- * WebDriver objects and command-specific types , Element(..) , WindowHandle(..), currentWindow diff --git a/webdriver.cabal b/webdriver.cabal --- a/webdriver.cabal +++ b/webdriver.cabal @@ -1,5 +1,5 @@ Name: webdriver -Version: 0.5.0.1 +Version: 0.5.1 Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE @@ -34,7 +34,7 @@ , HTTP >= 4000.1 && < 4000.3 , mtl >= 2.0 && < 2.2 , network == 2.4.* - , bytestring == 0.9.* + , bytestring >= 0.9 && < 0.11 , text >= 0.7 && < 0.12 , time == 1.* , transformers >= 0.2 && < 0.5 @@ -46,7 +46,7 @@ , monad-control == 0.3.* , transformers-base >= 0.1 && < 1.0 , vector >= 0.3 && < 0.11 - , lifted-base == 0.1.* + , lifted-base >= 0.1 && < 0.3 , MonadCatchIO-transformers >= 0.3 && < 0.4 , filesystem-trees >= 0.1.0.2 && < 0.2 , data-default >= 0.2 && < 1.0