diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `webdriver-wrapper` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright 2024 Gabriel Tollini + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +# webdriver-wrapper + +This package was created so end-users don't need to manually manage Selenium or their webdriver when dealing with the [webdriver](https://hackage.haskell.org/package/webdriver) package. For now, only `geckodriver` (aka Firefox) is supported - but `chromedriver` should be easy to implement. If you can't use Firefox for whichever reason, let me know and I'll look into implementing `chromedriver` support. + +This package is strongly inspired by [sandwich-webdriver](https://hackage.haskell.org/package/sandwich-webdriver). My original use-case didn't require the sandwich test suite, though, so I made this package which intends on being simpler and more minimalistic. + +## Extra dependencies +You must have Java installed, since Selenium is distributed as a `.jar` file. I'm running OpenJDK 17 on my machine, and it works perfectly with the selected Selenium version. + +## How to use +There are two functions which are "batteries-included": `wrappedRunSession` and `wrappedRunWD`. Just use them as you would `runSession` and `runWD`. The wrapped functions will handle downloading Selenium and geckodriver (if they were not already downloaded), plus starting and stopping Selenium. If you already have some code with `runSession` or `runWD`, their wrapped counterparts are drop-in replacements. diff --git a/src/Test/WebDriverWrapper.hs b/src/Test/WebDriverWrapper.hs new file mode 100644 --- /dev/null +++ b/src/Test/WebDriverWrapper.hs @@ -0,0 +1,41 @@ +{- | +Module : Core +Description : end-user functions. + +The wrapped functions (`wrappedRunSession` and `wrappedRunWD`) will download Selenium and Firefox's webdriver (geckodriver) if they're not already on the `Test.WebDriverWrapper.Constants.downloadPath`, then start Selenium before running the webdriver equivalent function (`runSession` and `runWD`). They kill the Selenium process at the end of their execution. +-} +module Test.WebDriverWrapper (wrappedRunSession, wrappedRunWD, wrapWebDriverFunction, downloadIfMissing) where + +import System.Process (cleanupProcess) +import Control.Concurrent.Async (concurrently_) +import Test.WebDriverWrapper.Selenium (getSeleniumIfNeeded, startSelenium) +import Test.WebDriverWrapper.GeckoDriver (getGeckoDriverIfNeeded) +import Test.WebDriver (runSession) +import Test.WebDriver.Types (WD, WDSession) +import Test.WebDriver.Config (WebDriverConfig) +import Test.WebDriver.Monad (runWD) +import Control.Exception (bracket) + +-- | Same as `runSession`, but starts Selenium before execution and kills Selenium after execution. +-- Will download Selenium or Firefox's webdriver (geckodriver) if any is missing. +wrappedRunSession :: WebDriverConfig conf => conf -> WD a -> IO a +wrappedRunSession conf wd = wrapWebDriverFunction (conf,wd) (uncurry runSession) + +-- | Same as `runWD`, but starts Selenium before execution and kills Selenium after execution. +-- Will download Selenium or Firefox's webdriver (geckodriver) if any is missing. +wrappedRunWD :: WDSession -> WD a -> IO a +wrappedRunWD session wd = wrapWebDriverFunction (session, wd) (uncurry runWD) + +-- | Runs a function in between starting and killing Selenium. Takes in the arguments and the function, in that order. +-- Will download Selenium or Firefox's webdriver (geckodriver) if any is missing. +wrapWebDriverFunction :: a -> (a -> IO b) -> IO b +wrapWebDriverFunction webdriverArgs webdriverFunction = do + downloadIfMissing + bracket + startSelenium + cleanupProcess + (const $ webdriverFunction webdriverArgs) + +-- | Dowloads Selenium or Firefox's webdriver (geckodriver) if they're missing. +downloadIfMissing :: IO() +downloadIfMissing = concurrently_ getSeleniumIfNeeded getGeckoDriverIfNeeded diff --git a/src/Test/WebDriverWrapper/Constants.hs b/src/Test/WebDriverWrapper/Constants.hs new file mode 100644 --- /dev/null +++ b/src/Test/WebDriverWrapper/Constants.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +{- | +Module : Test.WebDriverWrapper.Constants +Description : Constant values, such as links and paths. + -} + +module Test.WebDriverWrapper.Constants (geckoDriverPath, defaultPath, defaultSeleniumJarUrl, desiredPlatform, getGeckoDriverDownloadUrl, geckoDriverVersionSource, downloadPath, geckoArchivePath, fileFormat, seleniumPath, seleniumLogPath) where + +import Data.String.Interpolate (i) +import qualified System.Info as SI +import System.Directory (getXdgDirectory, XdgDirectory (XdgData)) +import System.FilePath (()) + +-- Paths. Should be platform independent. +-- | @haskell-webdriver-wrapper@ directory, created at `XdgData`. +defaultPath :: IO FilePath +defaultPath = getXdgDirectory XdgData "haskell-webdriver-wrapper" + +-- | Directory named after `desiredPlatform`, created at the `defaultPath`. +downloadPath :: IO FilePath +downloadPath = ( desiredPlatform) <$> defaultPath + +-- | Intermediary path for the compressed version of geckodriver. Inside `downloadPath`. +geckoArchivePath :: IO FilePath +geckoArchivePath = ( archive) <$> downloadPath + where + archive = "geckodriver" <> fileFormat + +-- | Path for geckodriver. Inside `downloadPath`. +geckoDriverPath :: IO FilePath +geckoDriverPath = ( "geckodriver") <$> downloadPath + +-- | Path for selenium.jar. Inside `downloadPath`. +seleniumPath :: IO FilePath +seleniumPath = ( "selenium.jar") <$> downloadPath + +-- | Path for Selenium's log file. Inside `defaultPath`. +seleniumLogPath :: IO FilePath +seleniumLogPath = ( "selenium.log") <$> defaultPath + +-- URLs. Might change at any moment, kinda why I'm putting them all together here. +-- | Url to download Selenium from. +defaultSeleniumJarUrl :: String +defaultSeleniumJarUrl = "https://selenium-release.storage.googleapis.com/3.141/selenium-server-standalone-3.141.59.jar" + +-- | API to get geckodriver's latest version. +geckoDriverVersionSource :: String +geckoDriverVersionSource = "https://api.github.com/repos/mozilla/geckodriver/releases/latest" + +-- | Url to download geckodriver from. Always the latest version provided by `geckoDriverVersionSource`. +getGeckoDriverDownloadUrl :: String -> String +getGeckoDriverDownloadUrl version = [i|https://github.com/mozilla/geckodriver/releases/download/#{version}/geckodriver-#{version}-#{platform}#{format}|] + where + platform = desiredPlatform + format = fileFormat + +-- Platform-dependent variables. +-- | Archive format for geckodriver's download. @.zip@ for Windows, @.tar.gz@ for everyone else. +fileFormat :: String +fileFormat = case SI.os of + "windows" -> ".zip" + "mingw32" -> ".zip" + + "darwrin" -> ".tar.gz" + "linux" -> ".tar.gz" + + _ -> ".tar.gz" + +-- | Platform this code is running at. The options are: +-- +-- * win64 +-- * win-aarch64 +-- * win32 +-- * macos +-- * macos-aarch64 +-- * linux64 +-- * linux-aarch64 +-- * linux32 +-- +-- If the platform is not identified, @linux64@ is used. +desiredPlatform :: String +desiredPlatform = case (SI.os, SI.arch) of + ("windows", "x86_64") -> "win64" + ("windows", "aarch64") -> "win-aarch64" + ("windows", "i386") -> "win32" + ("mingw32", "x86_64") -> "win64" + ("mingw32", "aarch64") -> "win-aarch64" + ("mingw32", "i386") -> "win32" + + ("darwin", "x86_64") -> "macos" + ("darwin", "aarch64") -> "macos-aarch64" + + ("linux", "x86_64") -> "linux64" + ("linux", "aarch64") -> "linux-aarch64" + ("linux", "i386") -> "linux32" + + _ -> "linux64" diff --git a/src/Test/WebDriverWrapper/GeckoDriver.hs b/src/Test/WebDriverWrapper/GeckoDriver.hs new file mode 100644 --- /dev/null +++ b/src/Test/WebDriverWrapper/GeckoDriver.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.WebDriverWrapper.GeckoDriver (getGeckoDriverIfNeeded) where + +import qualified Data.Text as T +import Network.HTTP.Simple (setRequestMethod, httpLBS, parseRequest, setRequestHeader) +import Test.WebDriverWrapper.Helpers (download, decompress) +import Test.WebDriverWrapper.Constants (getGeckoDriverDownloadUrl, geckoDriverVersionSource, geckoArchivePath, geckoDriverPath, downloadPath) +import Network.HTTP.Client.Conduit (Response(responseBody)) +import Data.Aeson (eitherDecode) +import Network.HTTP.Types (hUserAgent) +import qualified Data.Aeson.KeyMap as AKM +import qualified Data.Aeson as A +import System.Directory (createDirectoryIfMissing, removeFile, doesFileExist) +import Control.Monad (unless) + +-- | Checks if @geckodriver@ is in the `downloadPath`. If not, download it. +getGeckoDriverIfNeeded :: IO () +getGeckoDriverIfNeeded = do + geckoPath <- geckoDriverPath + hasGeckoDriver <- doesFileExist geckoPath + unless hasGeckoDriver getGeckoDriver + +getGeckoDriver :: IO() +getGeckoDriver = do + version <- getGeckoDriverVersion + dPath <- downloadPath + tarballPath <- geckoArchivePath + + createDirectoryIfMissing True dPath + + let url = getGeckoDriverDownloadUrl version + download url tarballPath + decompress tarballPath dPath + removeFile tarballPath + +getGeckoDriverVersion :: IO String +getGeckoDriverVersion = do + requestUrl <- parseRequest versionAPI + let + request + = setRequestMethod "GET" + $ setRequestHeader hUserAgent ["cli"] + requestUrl + response <- responseBody <$> httpLBS request + let + version' = eitherDecode response :: Either String A.Object + maybeVersion = case version' of + (Left err) -> error err + (Right version'') -> AKM.lookup "tag_name" version'' + version = case maybeVersion of + Nothing -> error "Couldn't parse response from Test.WebDriverWrapper.GeckoDriver's version API" + (Just (A.String v))-> v + (Just _) -> error "\"tag_name\" key isn't returning a string. Maybe Test.WebDriverWrapper.GeckoDriver's version API changed, consider opening a github issue." + return $ T.unpack version + + where + versionAPI = geckoDriverVersionSource diff --git a/src/Test/WebDriverWrapper/Helpers.hs b/src/Test/WebDriverWrapper/Helpers.hs new file mode 100644 --- /dev/null +++ b/src/Test/WebDriverWrapper/Helpers.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | +Module : Test.WebDriverWrapper.Helpers +Description : Generic functions. +-} +module Test.WebDriverWrapper.Helpers (download, decompress) where + +import Test.WebDriverWrapper.Constants (fileFormat, geckoDriverPath) +import Network.HTTP.Simple (setRequestHeader, setRequestMethod, httpLBS) +import Network.HTTP.Types (hUserAgent) +import Network.HTTP.Conduit (Response(..), parseRequest) +import qualified Data.ByteString.Lazy as BS +import Codec.Archive.Zip (toArchive, fromArchive) +import qualified Codec.Compression.GZip as G +import qualified Codec.Archive.Tar as Tar +import System.Posix ( setFileMode, accessModes ) + +-- | Downloads from @url@ at @output@ filepath. +download :: String -> FilePath -> IO() +download url output = do + requestUrl <- parseRequest url + let + request + = setRequestMethod "GET" + $ setRequestHeader hUserAgent ["cli"] + requestUrl + response <- responseBody <$> httpLBS request + BS.writeFile output response + +-- | Decompresses geckodriver's download, which comes in @.zip@ for Windows or @.tar.gz@ for everyone else. +-- Takes in the archive's filepath and the output filepath. +decompress :: FilePath -> FilePath -> IO() +decompress file outputPath = do + case fileFormat of + ".zip" -> do + archive <- toArchive <$> BS.readFile file + BS.writeFile outputPath $ fromArchive archive + ".tar.gz" -> do + tarball <- G.decompress <$> BS.readFile file + Tar.unpack outputPath $ Tar.read tarball + + geckoDriver <- geckoDriverPath + + setFileMode geckoDriver accessModes + _ -> error "unknown file" diff --git a/src/Test/WebDriverWrapper/Selenium.hs b/src/Test/WebDriverWrapper/Selenium.hs new file mode 100644 --- /dev/null +++ b/src/Test/WebDriverWrapper/Selenium.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} + +module Test.WebDriverWrapper.Selenium (startSelenium, getSeleniumIfNeeded) where + +import Test.WebDriverWrapper.Constants (defaultSeleniumJarUrl, seleniumPath, downloadPath, geckoDriverPath, seleniumLogPath) +import Test.WebDriverWrapper.Helpers (download) +import System.Directory (createDirectoryIfMissing, doesFileExist) +import Control.Monad (unless) +import GHC.IO.Handle ( Handle, hGetLine, hClose ) +import System.Process (ProcessHandle, createProcess) +import Data.String.Interpolate (i) +import System.IO (openFile) +import GHC.IO.IOMode (IOMode(..)) +import Control.Retry (retryOnError, RetryStatus (..)) +import System.IO.Error (isEOFError) +import UnliftIO.Retry ( constantDelay, limitRetries ) +import Data.Foldable.Extra (orM) +import Data.List (isInfixOf) +import System.Process.Run (proc) + +-- | Starts Selenium and waits for its ok message ( "Selenium Server is up and running" ) to show up at the log file. +-- Returns the handles for the Selenium process. +startSelenium :: IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) +startSelenium = do + geckoPath <- geckoDriverPath + selPath <- seleniumPath + logFile <- seleniumLogPath + writeFile logFile "" -- Create file if it doesn't exist, clears it if it does. Needs to happen for "logFileHasReadyMessage" to work correctly. + let + selArgs = [[i|-Dwebdriver.gecko.driver=#{geckoPath}|], "-jar", selPath ,"-log", logFile] + processParams = proc "java" selArgs + processHandles <- createProcess processParams + waitForSeleniumStart + return processHandles + +waitForSeleniumStart :: IO() +waitForSeleniumStart = do + logFile <- seleniumLogPath + fileHandle <- openFile logFile ReadMode + succeeded <- retryOnError retryPolicy' + (\_ e -> return $ isEOFError e) + (\retryStatus -> if rsIterNumber retryStatus < 599 then logFileHasReadyMessage fileHandle else return False) + hClose fileHandle + unless succeeded $ error $ "Couldn't start Selenium successfully. Check " <> logFile <> " for more information." + where + -- waits a minute, retrying every 100ms + retryPolicy' = constantDelay 100000 <> limitRetries 600 + +logFileHasReadyMessage :: Handle -> IO Bool +logFileHasReadyMessage fileHandle = orM remainingLines + where + remainingLines = repeat hasReadyMessage + hasReadyMessage = (readyMessage `isInfixOf`) <$> hGetLine fileHandle + + readyMessage = "Selenium Server is up and running" + +-- | Checks if @selenium@ is in the `downloadPath`. If not, download it. +getSeleniumIfNeeded :: IO () +getSeleniumIfNeeded = do + selPath <- seleniumPath + hasSelenium <- doesFileExist selPath + unless hasSelenium getSelenium + +getSelenium :: IO () +getSelenium = do + downloadPath' <- downloadPath + selPath <- seleniumPath + createDirectoryIfMissing True downloadPath' + download defaultSeleniumJarUrl selPath diff --git a/webdriver-wrapper.cabal b/webdriver-wrapper.cabal new file mode 100644 --- /dev/null +++ b/webdriver-wrapper.cabal @@ -0,0 +1,63 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.36.0. +-- +-- see: https://github.com/sol/hpack + +name: webdriver-wrapper +version: 0.1.0.0 +synopsis: Wrapper around the webdriver package that automatically manages Selenium +description: Please see the README on GitHub at +category: browser, selenium, testing, web, webdriver, geckodriver +homepage: https://github.com/gtollini/webdriver-wrapper#readme +bug-reports: https://github.com/gtollini/webdriver-wrapper/issues +author: Gabriel Tollini +maintainer: gabrieltollini@hotmail.com +copyright: 2024 Gabriel Tollini +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/gtollini/webdriver-wrapper + +library + exposed-modules: + Test.WebDriverWrapper + Test.WebDriverWrapper.Constants + Test.WebDriverWrapper.GeckoDriver + Test.WebDriverWrapper.Helpers + Test.WebDriverWrapper.Selenium + other-modules: + Paths_webdriver_wrapper + autogen-modules: + Paths_webdriver_wrapper + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + aeson >=2.1.2.1 && <2.3 + , async >=2.2.5 && <2.3 + , base >=4.7 && <5 + , bytestring >=0.11.5 && <0.12 + , directory >=1.3.8 && <1.4 + , extra >=1.7.16 && <1.8 + , filepath >=1.4.300 && <1.5 + , http-conduit >=2.3.8 && <2.4 + , http-types >=0.12.4 && <0.13 + , process >=1.6.19 && <1.7 + , process-extras >=0.7.4 && <0.8 + , retry >=0.9.3 && <0.10 + , string-interpolate >=0.3.3 && <0.4 + , tar >=0.5.1.1 && <0.7 + , text >=2.0.2 && <2.1 + , unix >=2.8.4 && <2.9 + , unordered-containers >=0.2.20 && <0.3 + , webdriver >=0.12.0 && <0.13 + , zip-archive >=0.4.3 && <0.5 + , zlib >=0.6.3 && <0.8 + default-language: Haskell2010