module Test.WebDriver.Commands.SeleniumSpecific.Uploads (
  seleniumUploadFile
  , seleniumUploadRawFile
  , seleniumUploadZipEntry
  ) where

import Codec.Archive.Zip
import Control.Monad.IO.Class
import Data.ByteString.Base64.Lazy as B64
import Data.ByteString.Lazy as LBS (ByteString)
import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Text.Lazy.Encoding as TL
import GHC.Stack
import Test.WebDriver.JSON
import Test.WebDriver.Types
import Test.WebDriver.Util.Commands


-- | Uploads a file from the local filesystem by its file path. Returns the
-- remote filepath of the file.
seleniumUploadFile :: (HasCallStack, WebDriver wd) => FilePath -> wd Text
seleniumUploadFile :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
FilePath -> wd Text
seleniumUploadFile FilePath
path = Entry -> wd Text
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Entry -> wd Text
seleniumUploadZipEntry (Entry -> wd Text) -> wd Entry -> wd Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Entry -> wd Entry
forall a. IO a -> wd a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([ZipOption] -> FilePath -> IO Entry
readEntry [] FilePath
path)

-- | Uploads a raw 'LBS.ByteString' with associated file info. Returns the
-- remote filepath of the file.
seleniumUploadRawFile :: (
  HasCallStack, WebDriver wd
  )
  -- | File path to use with this bytestring.
  => FilePath
  -- | Modification time (in seconds since Unix epoch).
  -> Integer
  -- | The file contents as a lazy ByteString.
  -> LBS.ByteString
  -> wd Text
seleniumUploadRawFile :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
FilePath -> Integer -> ByteString -> wd Text
seleniumUploadRawFile FilePath
path Integer
t ByteString
str = Entry -> wd Text
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Entry -> wd Text
seleniumUploadZipEntry (FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
path Integer
t ByteString
str)

-- | Lowest level interface to the file uploading mechanism. This allows you to
-- specify the exact details of the zip entry sent across network. Returns the
-- remote filepath of the extracted file
seleniumUploadZipEntry :: (HasCallStack, WebDriver wd) => Entry -> wd Text
seleniumUploadZipEntry :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Entry -> wd Text
seleniumUploadZipEntry Entry
entry = Method -> Text -> Value -> wd Text
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/se/file" (Value -> wd Text) -> Value -> wd Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"file" Text
file
  where
    file :: Text
file = Entry
entry
         Entry -> (Entry -> Archive) -> Archive
forall a b. a -> (a -> b) -> b
& (Entry -> Archive -> Archive
`addEntryToArchive` Archive
emptyArchive)
         Archive -> (Archive -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& Archive -> ByteString
fromArchive
         ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> ByteString
B64.encode
         ByteString -> (ByteString -> Text) -> Text
forall a b. a -> (a -> b) -> b
& ByteString -> Text
TL.decodeUtf8