{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

-- | A module defining the Payload type. This is used in specifications to
-- represent request body data. Currently JSON and URLEncoded bodies are
-- supported.
--
-- The module provides a FromJSON instance to parse a Payload from a
-- specification.
--
-- Payload is parsed from an object containing two keys: `bodyType` and
-- `content`.
--
-- The value of the `bodyType` field must be either `json` or
-- `urlencoded` and this indicates how the request data should be encoded.
--
-- When `bodyType` is `urlencoded ` the value of the `content` field must be an
-- object with string, numeric or boolean values.
--
-- When `bodyType` is `json` the value of the `content` field will be used as
-- the JSON payload.
--
-- If `bodyType` is not present then the whole object is used as the JSON
-- payload.
--
-- Examples:
-- 1. A URLEncoded request payload:
--
-- >  requestData:
-- >     bodyType: urlencoded
-- >     content:
-- >       key1: value
-- >       key2: true
-- >       key3: 10.22
--
-- 2: A JSON request payload using `bodyType`:
--
-- >  requestData:
-- >     bodyType: json
-- >     content:
-- >       key1: value
-- >       key2: [1,2,3]
--
-- 3: A JSON request payload without using `bodyType`:
--
-- >  requestData:
-- >     key1: value
-- >     key2: [1,2,3]
--
module Testing.CurlRunnings.Internal.Payload
  ( Payload (..)
  ) where

import           Data.Aeson
import qualified Data.Char                                   as C
import qualified Data.Text                                   as T
import           GHC.Generics
import qualified Testing.CurlRunnings.Internal.Aeson         as A
import           Testing.CurlRunnings.Internal.KeyValuePairs

data Payload = JSON Value | URLEncoded KeyValuePairs deriving (forall x. Payload -> Rep Payload x)
-> (forall x. Rep Payload x -> Payload) -> Generic Payload
forall x. Rep Payload x -> Payload
forall x. Payload -> Rep Payload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Payload x -> Payload
$cfrom :: forall x. Payload -> Rep Payload x
Generic

instance Show Payload where
  show :: Payload -> String
show (JSON Value
v) = Value -> String
forall a. Show a => a -> String
show Value
v
  show (URLEncoded (KeyValuePairs [KeyValuePair]
xs)) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"&" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (KeyValuePair -> Text) -> [KeyValuePair] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(KeyValuePair KeyType
k Text
v) -> KeyType -> Text
A.toText KeyType
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v) [KeyValuePair]
xs

payloadTagFieldName :: A.KeyType
payloadTagFieldName :: KeyType
payloadTagFieldName = KeyType
"bodyType"

payloadContentsFieldName :: A.KeyType
payloadContentsFieldName :: KeyType
payloadContentsFieldName = KeyType
"content"

instance FromJSON Payload where
  parseJSON :: Value -> Parser Payload
parseJSON Value
v = String -> (Object -> Parser Payload) -> Value -> Parser Payload
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"payload" Object -> Parser Payload
forall a. KeyMap a -> Parser Payload
parsePayload Value
v where
    parsePayload :: KeyMap a -> Parser Payload
parsePayload KeyMap a
o = if Bool -> Bool
not (KeyType -> KeyMap a -> Bool
forall a. KeyType -> KeyMap a -> Bool
A.member KeyType
payloadTagFieldName KeyMap a
o) then Payload -> Parser Payload
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Payload
JSON Value
v) else Options -> Value -> Parser Payload
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
payloadOptions Value
v
    payloadOptions :: Options
payloadOptions = Options
defaultOptions { sumEncoding :: SumEncoding
sumEncoding = TaggedObject :: String -> String -> SumEncoding
TaggedObject { tagFieldName :: String
tagFieldName = Text -> String
T.unpack (Text -> String) -> (KeyType -> Text) -> KeyType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyType -> Text
A.toText (KeyType -> String) -> KeyType -> String
forall a b. (a -> b) -> a -> b
$ KeyType
payloadTagFieldName
                                                                 , contentsFieldName :: String
contentsFieldName = Text -> String
T.unpack (Text -> String) -> (KeyType -> Text) -> KeyType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyType -> Text
A.toText (KeyType -> String) -> KeyType -> String
forall a b. (a -> b) -> a -> b
$ KeyType
payloadContentsFieldName
                                                                 }
                                    , constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
C.toLower
                                    }

instance ToJSON Payload where
  toJSON :: Payload -> Value
toJSON (JSON Value
v) = [Pair] -> Value
object [(KeyType
payloadTagFieldName, Value
"json"), (KeyType
payloadContentsFieldName, Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
v)]
  toJSON (URLEncoded KeyValuePairs
xs) = [Pair] -> Value
object [(KeyType
payloadTagFieldName, Value
"urlencoded"), (KeyType
payloadContentsFieldName, KeyValuePairs -> Value
forall a. ToJSON a => a -> Value
toJSON KeyValuePairs
xs)]