{-# 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 :: String -> String -> IO ()
download String
url String
output = do
    Request
requestUrl <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
    let
        request :: Request
request
            = ByteString -> Request -> Request
setRequestMethod ByteString
"GET"
            (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> [ByteString] -> Request -> Request
setRequestHeader HeaderName
hUserAgent [ByteString
"cli"]
            Request
requestUrl
    ByteString
response <- Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS Request
request
    String -> ByteString -> IO ()
BS.writeFile String
output ByteString
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 :: String -> String -> IO ()
decompress String
file String
outputPath = do
    case String
fileFormat of
        String
".zip"    -> do
            Archive
archive <- ByteString -> Archive
toArchive (ByteString -> Archive) -> IO ByteString -> IO Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
file
            String -> ByteString -> IO ()
BS.writeFile String
outputPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive
        String
".tar.gz" -> do
            ByteString
tarball <- ByteString -> ByteString
G.decompress (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
file
            String -> Entries FormatError -> IO ()
forall e. Exception e => String -> Entries e -> IO ()
Tar.unpack String
outputPath (Entries FormatError -> IO ()) -> Entries FormatError -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Entries FormatError
Tar.read ByteString
tarball

            String
geckoDriver <- IO String
geckoDriverPath

            String -> FileMode -> IO ()
setFileMode String
geckoDriver FileMode
accessModes
        String
_ -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"unknown file"