{-# LANGUAGE DeriveGeneric #-}

module Test.WebDriver.Cookies where

import Data.Aeson
import Data.Aeson.Types
import qualified Data.Char as C
import Data.Text (Text)
import GHC.Generics
import Test.WebDriver.JSON

-- | Cookies are delicious delicacies. When sending cookies to the server, a value
-- of Nothing indicates that the server should use a default value. When receiving
-- cookies from the server, a value of Nothing indicates that the server is unable
-- to specify the value.
data Cookie = Cookie {
  Cookie -> Text
cookName   :: Text
  , Cookie -> Text
cookValue  :: Text          -- ^
  , Cookie -> Maybe Text
cookPath   :: Maybe Text    -- ^path of this cookie.
                                -- if Nothing, defaults to /
  , Cookie -> Maybe Text
cookDomain :: Maybe Text    -- ^domain of this cookie.
                                -- if Nothing, the current pages
                                -- domain is used
  , Cookie -> Maybe Bool
cookSecure :: Maybe Bool    -- ^Is this cookie secure?
  , Cookie -> Maybe Double
cookExpiry :: Maybe Double  -- ^Expiry date expressed as
                                -- seconds since the Unix epoch
                                -- Nothing indicates that the
                                -- cookie never expires
  } deriving (Cookie -> Cookie -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c== :: Cookie -> Cookie -> Bool
Eq, Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cookie] -> ShowS
$cshowList :: [Cookie] -> ShowS
show :: Cookie -> String
$cshow :: Cookie -> String
showsPrec :: Int -> Cookie -> ShowS
$cshowsPrec :: Int -> Cookie -> ShowS
Show, forall x. Rep Cookie x -> Cookie
forall x. Cookie -> Rep Cookie x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cookie x -> Cookie
$cfrom :: forall x. Cookie -> Rep Cookie x
Generic)

aesonOptionsCookie :: Options
aesonOptionsCookie :: Options
aesonOptionsCookie = Options
defaultOptions {
  omitNothingFields :: Bool
omitNothingFields = Bool
True
  , fieldLabelModifier :: ShowS
fieldLabelModifier = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
C.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
4
  }

-- |Creates a Cookie with only a name and value specified. All other
-- fields are set to Nothing, which tells the server to use default values.
mkCookie :: Text -> Text -> Cookie
mkCookie :: Text -> Text -> Cookie
mkCookie Text
name Text
value = Cookie { cookName :: Text
cookName = Text
name, cookValue :: Text
cookValue = Text
value,
                               cookPath :: Maybe Text
cookPath = forall a. Maybe a
Nothing, cookDomain :: Maybe Text
cookDomain = forall a. Maybe a
Nothing,
                               cookSecure :: Maybe Bool
cookSecure = forall a. Maybe a
Nothing, cookExpiry :: Maybe Double
cookExpiry = forall a. Maybe a
Nothing
                             }

instance ToJSON Cookie where
  toJSON :: Cookie -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptionsCookie
  toEncoding :: Cookie -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
aesonOptionsCookie
instance FromJSON Cookie where
  parseJSON :: Value -> Parser Cookie
parseJSON (Object Object
o) = Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Double
-> Cookie
Cookie forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Text -> Parser a
req Text
"name"
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Text -> Parser a
req Text
"value"
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Text -> a -> Parser a
opt Text
"path" forall a. Maybe a
Nothing
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Text -> a -> Parser a
opt Text
"domain" forall a. Maybe a
Nothing
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Text -> a -> Parser a
opt Text
"secure" forall a. Maybe a
Nothing
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Text -> a -> Parser a
opt Text
"expiry" forall a. Maybe a
Nothing
    where
      req :: FromJSON a => Text -> Parser a
      req :: forall a. FromJSON a => Text -> Parser a
req = (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Key
fromText
      opt :: FromJSON a => Text -> a -> Parser a
      opt :: forall a. FromJSON a => Text -> a -> Parser a
opt Text
k a
d = Object
o forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?? Text
k forall a. Parser (Maybe a) -> a -> Parser a
.!= a
d
  parseJSON Value
v = forall a. String -> Value -> Parser a
typeMismatch String
"Cookie" Value
v