{- |
Module      : Web.Api.WebDriver.Helpers
Description : Higher level WebDriver utilities.
Copyright   : 2018, Automattic, Inc.
License     : GPL-3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX
-}

{-# LANGUAGE OverloadedStrings #-}
module Web.Api.WebDriver.Helpers (
  -- * Data
    writeDataFile
  , readDataFile
  , writeJsonFile
  , readJsonFile

  -- * Secrets
  , stashCookies
  , loadCookies

  -- * Actions
  , press
  , typeString
  ) where

import Control.Monad.Trans.Class
  ( MonadTrans(..) )
import qualified Data.Aeson as Aeson
  ( encode, ToJSON(..), Value )
import Data.ByteString.Lazy
  ( ByteString, fromChunks )
import qualified Data.ByteString.Lazy.Char8 as BS
  ( pack )
import qualified Data.Digest.Pure.SHA as SHA
  ( showDigest, sha1 )
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Web.Api.WebDriver.Endpoints
import Web.Api.WebDriver.Monad
import Web.Api.WebDriver.Types
import Web.Api.WebDriver.Types.Keyboard





-- | Save all cookies for the current domain to a file.
stashCookies
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text -- ^ Passed through SHA1, and the digest is used as the filename.
  -> WebDriverTT t eff ()
stashCookies :: Text -> WebDriverTT t eff ()
stashCookies Text
string =
  let file :: String
file = Digest SHA1State -> String
forall t. Digest t -> String
SHA.showDigest (Digest SHA1State -> String) -> Digest SHA1State -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA1State
SHA.sha1 (ByteString -> Digest SHA1State) -> ByteString -> Digest SHA1State
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
fromChunks [Text -> ByteString
T.encodeUtf8 Text
string] in
  WebDriverTT t eff [Cookie]
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
WebDriverTT t eff [Cookie]
getAllCookies WebDriverTT t eff [Cookie]
-> ([Cookie] -> WebDriverTT t eff ()) -> WebDriverTT t eff ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> [Cookie] -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> [Cookie] -> WebDriverTT t eff ()
writeCookieFile String
file


-- | Load cookies from a file saved with `stashCookies`. Returns `False` if the cookie file is missing or cannot be read.
loadCookies
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text -- ^ Passed through SHA1, and the digest is used as the filename.
  -> WebDriverTT t eff Bool
loadCookies :: Text -> WebDriverTT t eff Bool
loadCookies Text
string = do
  let file :: String
file = Digest SHA1State -> String
forall t. Digest t -> String
SHA.showDigest (Digest SHA1State -> String) -> Digest SHA1State -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA1State
SHA.sha1 (ByteString -> Digest SHA1State) -> ByteString -> Digest SHA1State
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
fromChunks [Text -> ByteString
T.encodeUtf8 Text
string]
  Maybe [Cookie]
contents <- String -> WebDriverTT t eff (Maybe [Cookie])
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> WebDriverTT t eff (Maybe [Cookie])
readCookieFile String
file
  case Maybe [Cookie]
contents of
    Maybe [Cookie]
Nothing -> Bool -> WebDriverTT t eff Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just [Cookie]
cs -> do
      (Cookie -> WebDriverTT t eff ())
-> [Cookie] -> WebDriverTT t eff ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Cookie -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Cookie -> WebDriverTT t eff ()
addCookie [Cookie]
cs
      Bool -> WebDriverTT t eff Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True


-- | Write cookies to a file under the secrets path. 
writeCookieFile
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath -- ^ File path; relative to @$DATA_PATH\/secrets\/cookies\/@
  -> [Cookie]
  -> WebDriverTT t eff ()
writeCookieFile :: String -> [Cookie] -> WebDriverTT t eff ()
writeCookieFile String
file [Cookie]
cookies = do
  String
path <- (R WDError WDLog WDEnv -> String) -> WebDriverTT t eff String
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> String
_dataPath (WDEnv -> String)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
_env)
  let fullpath :: String
fullpath = String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/secrets/cookies/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
  String -> ByteString -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> ByteString -> WebDriverTT t eff ()
writeFilePath String
fullpath ([Cookie] -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode [Cookie]
cookies)


-- | Read cookies from a file stored with `writeCookieFile`. Returns `Nothing` if the file does not exist.
readCookieFile
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath -- ^ File path; relative to @$DATA_PATH\/secrets\/cookies\/@
  -> WebDriverTT t eff (Maybe [Cookie])
readCookieFile :: String -> WebDriverTT t eff (Maybe [Cookie])
readCookieFile String
file = do
  String
path <- (R WDError WDLog WDEnv -> String) -> WebDriverTT t eff String
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> String
_dataPath (WDEnv -> String)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
_env)
  let fullpath :: String
fullpath = String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/secrets/cookies/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
  Bool
cookieFileExists <- String -> WebDriverTT t eff Bool
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> WebDriverTT t eff Bool
fileExists String
fullpath
  if Bool
cookieFileExists
    then String -> WebDriverTT t eff ByteString
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> WebDriverTT t eff ByteString
readFilePath String
fullpath
      WebDriverTT t eff ByteString
-> (ByteString -> WebDriverTT t eff Value)
-> WebDriverTT t eff Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> WebDriverTT t eff Value
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
ByteString -> WebDriverTT t eff Value
parseJson
      WebDriverTT t eff Value
-> (Value -> WebDriverTT t eff [Value])
-> WebDriverTT t eff [Value]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> WebDriverTT t eff [Value]
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t, FromJSON a) =>
Value -> WebDriverTT t eff a
constructFromJson
      WebDriverTT t eff [Value]
-> ([Value] -> WebDriverTT t eff [Cookie])
-> WebDriverTT t eff [Cookie]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> WebDriverTT t eff Cookie)
-> [Value] -> WebDriverTT t eff [Cookie]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> WebDriverTT t eff Cookie
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t, FromJSON a) =>
Value -> WebDriverTT t eff a
constructFromJson
      WebDriverTT t eff [Cookie]
-> ([Cookie] -> WebDriverTT t eff (Maybe [Cookie]))
-> WebDriverTT t eff (Maybe [Cookie])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe [Cookie] -> WebDriverTT t eff (Maybe [Cookie])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Cookie] -> WebDriverTT t eff (Maybe [Cookie]))
-> ([Cookie] -> Maybe [Cookie])
-> [Cookie]
-> WebDriverTT t eff (Maybe [Cookie])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cookie] -> Maybe [Cookie]
forall a. a -> Maybe a
Just)
    else Maybe [Cookie] -> WebDriverTT t eff (Maybe [Cookie])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Cookie]
forall a. Maybe a
Nothing



-- | Write a `ByteString` to the data directory
writeDataFile
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash
  -> ByteString
  -> WebDriverTT t eff ()
writeDataFile :: String -> ByteString -> WebDriverTT t eff ()
writeDataFile String
file ByteString
contents = do
  String
path <- (R WDError WDLog WDEnv -> String) -> WebDriverTT t eff String
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> String
_dataPath (WDEnv -> String)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
_env)
  String -> ByteString -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> ByteString -> WebDriverTT t eff ()
writeFilePath (String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) ByteString
contents

-- | Read a `ByteString` from the data directory
readDataFile
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash
  -> WebDriverTT t eff ByteString
readDataFile :: String -> WebDriverTT t eff ByteString
readDataFile String
file = do
  String
path <- (R WDError WDLog WDEnv -> String) -> WebDriverTT t eff String
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> String
_dataPath (WDEnv -> String)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
_env)
  String -> WebDriverTT t eff ByteString
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> WebDriverTT t eff ByteString
readFilePath (String -> WebDriverTT t eff ByteString)
-> String -> WebDriverTT t eff ByteString
forall a b. (a -> b) -> a -> b
$ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file



-- | Write JSON to the data directory
writeJsonFile
  :: (Monad eff, Monad (t eff), MonadTrans t, Aeson.ToJSON a)
  => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash
  -> a
  -> WebDriverTT t eff ()
writeJsonFile :: String -> a -> WebDriverTT t eff ()
writeJsonFile String
file a
a = do
  String
path <- (R WDError WDLog WDEnv -> String) -> WebDriverTT t eff String
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> String
_dataPath (WDEnv -> String)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
_env)
  String -> ByteString -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> ByteString -> WebDriverTT t eff ()
writeFilePath (String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
a)

-- | Read a JSON `Value` from the data directory
readJsonFile
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash
  -> WebDriverTT t eff Aeson.Value
readJsonFile :: String -> WebDriverTT t eff Value
readJsonFile String
file = do
  String
path <- (R WDError WDLog WDEnv -> String) -> WebDriverTT t eff String
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> String
_dataPath (WDEnv -> String)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
_env)
  String -> WebDriverTT t eff ByteString
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
String -> WebDriverTT t eff ByteString
readFilePath (String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) WebDriverTT t eff ByteString
-> (ByteString -> WebDriverTT t eff Value)
-> WebDriverTT t eff Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> WebDriverTT t eff Value
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
ByteString -> WebDriverTT t eff Value
parseJson



-- | `KeyDownAction` with the given `Char`.
keypress :: Char -> ActionItem
keypress :: Char -> ActionItem
keypress Char
x = ActionItem
emptyActionItem
  { _actionType :: Maybe ActionType
_actionType = ActionType -> Maybe ActionType
forall a. a -> Maybe a
Just ActionType
KeyDownAction
  , _actionValue :: Maybe Text
_actionValue = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
x
  }


-- | Simulate pressing a `Key`.
press :: Key -> Action
press :: Key -> Action
press Key
key = Action
emptyAction
  { _inputSourceType :: Maybe InputSource
_inputSourceType = InputSource -> Maybe InputSource
forall a. a -> Maybe a
Just InputSource
KeyInputSource
  , _inputSourceId :: Maybe Text
_inputSourceId = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"kbd"
  , _actionItems :: [ActionItem]
_actionItems = [Char -> ActionItem
keypress (Key -> Char
keyToChar Key
key)]
  }


-- | Simulate typing some text.
typeString :: Text -> Action
typeString :: Text -> Action
typeString Text
x = Action
emptyAction
  { _inputSourceType :: Maybe InputSource
_inputSourceType = InputSource -> Maybe InputSource
forall a. a -> Maybe a
Just InputSource
KeyInputSource
  , _inputSourceId :: Maybe Text
_inputSourceId = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"kbd"
  , _actionItems :: [ActionItem]
_actionItems = (Char -> ActionItem) -> String -> [ActionItem]
forall a b. (a -> b) -> [a] -> [b]
map Char -> ActionItem
keypress (String -> [ActionItem]) -> String -> [ActionItem]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x
  }