{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Testing.CurlRunnings.Internal.Payload
( Payload (..)
) where
import Data.Aeson
import qualified Data.Char as C
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import GHC.Generics
import Testing.CurlRunnings.Internal.KeyValuePairs
data Payload = JSON Value | URLEncoded KeyValuePairs deriving Generic
instance Show Payload where
show (JSON v) = show v
show (URLEncoded (KeyValuePairs xs)) = T.unpack $ T.intercalate "&" $ fmap (\(KeyValuePair k v) -> k <> "=" <> v) xs
payloadTagFieldName :: T.Text
payloadTagFieldName = "bodyType"
payloadContentsFieldName :: T.Text
payloadContentsFieldName = "content"
instance FromJSON Payload where
parseJSON v = withObject "payload" parsePayload v where
parsePayload o = if not (H.member payloadTagFieldName o) then return (JSON v) else genericParseJSON payloadOptions v
payloadOptions = defaultOptions { sumEncoding = TaggedObject { tagFieldName = T.unpack payloadTagFieldName
, contentsFieldName = T.unpack payloadContentsFieldName
}
, constructorTagModifier = fmap C.toLower
}
instance ToJSON Payload where
toJSON (JSON v) = object [(payloadTagFieldName, "json"), (payloadContentsFieldName, toJSON v)]
toJSON (URLEncoded xs) = object [(payloadTagFieldName, "urlencoded"), (payloadContentsFieldName, toJSON xs)]