{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
module Servant.Client.Core.Request (
    Request,
    RequestF (..),
    RequestBody (..),
    defaultRequest,
    -- ** Modifiers
    addHeader,
    appendToPath,
    appendToQueryString,
    encodeQueryParamValue,
    setRequestBody,
    setRequestBodyLBS,
    ) where

import           Prelude ()
import           Prelude.Compat

import           Control.DeepSeq
                 (NFData (..))
import           Data.Bifoldable
                 (Bifoldable (..))
import           Data.Bifunctor
                 (Bifunctor (..))
import           Data.Bitraversable
                 (Bitraversable (..), bifoldMapDefault, bimapDefault)
import qualified Data.ByteString                      as BS
import           Data.ByteString.Builder
                 (Builder)
import qualified Data.ByteString.Builder              as Builder
import qualified Data.ByteString.Lazy                 as LBS
import qualified Data.Sequence                        as Seq
import           Data.Text
                 (Text)
import           Data.Text.Encoding
                 (encodeUtf8)
import           Data.Typeable
                 (Typeable)
import           GHC.Generics
                 (Generic)
import           Network.HTTP.Media
                 (MediaType)
import           Network.HTTP.Types
                 (Header, HeaderName, HttpVersion (..), Method, QueryItem,
                 http11, methodGet, urlEncodeBuilder)
import           Servant.API
                 (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO)

import Servant.Client.Core.Internal (mediaTypeRnf)

data RequestF body path = Request
  { forall body path. RequestF body path -> path
requestPath        :: path
  , forall body path. RequestF body path -> Seq QueryItem
requestQueryString :: Seq.Seq QueryItem
  , forall body path. RequestF body path -> Maybe (body, MediaType)
requestBody        :: Maybe (body, MediaType)
  , forall body path. RequestF body path -> Seq MediaType
requestAccept      :: Seq.Seq MediaType
  , forall body path. RequestF body path -> Seq Header
requestHeaders     :: Seq.Seq Header
  , forall body path. RequestF body path -> HttpVersion
requestHttpVersion :: HttpVersion
  , forall body path. RequestF body path -> Method
requestMethod      :: Method
  } deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall body path x.
Rep (RequestF body path) x -> RequestF body path
forall body path x.
RequestF body path -> Rep (RequestF body path) x
$cto :: forall body path x.
Rep (RequestF body path) x -> RequestF body path
$cfrom :: forall body path x.
RequestF body path -> Rep (RequestF body path) x
Generic, Typeable, RequestF body path -> RequestF body path -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall body path.
(Eq path, Eq body) =>
RequestF body path -> RequestF body path -> Bool
/= :: RequestF body path -> RequestF body path -> Bool
$c/= :: forall body path.
(Eq path, Eq body) =>
RequestF body path -> RequestF body path -> Bool
== :: RequestF body path -> RequestF body path -> Bool
$c== :: forall body path.
(Eq path, Eq body) =>
RequestF body path -> RequestF body path -> Bool
Eq, forall a b. a -> RequestF body b -> RequestF body a
forall a b. (a -> b) -> RequestF body a -> RequestF body b
forall body a b. a -> RequestF body b -> RequestF body a
forall body a b. (a -> b) -> RequestF body a -> RequestF body b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RequestF body b -> RequestF body a
$c<$ :: forall body a b. a -> RequestF body b -> RequestF body a
fmap :: forall a b. (a -> b) -> RequestF body a -> RequestF body b
$cfmap :: forall body a b. (a -> b) -> RequestF body a -> RequestF body b
Functor, forall a. RequestF body a -> Bool
forall body a. Eq a => a -> RequestF body a -> Bool
forall body a. Num a => RequestF body a -> a
forall body a. Ord a => RequestF body a -> a
forall m a. Monoid m => (a -> m) -> RequestF body a -> m
forall body m. Monoid m => RequestF body m -> m
forall body a. RequestF body a -> Bool
forall body a. RequestF body a -> Int
forall body a. RequestF body a -> [a]
forall a b. (a -> b -> b) -> b -> RequestF body a -> b
forall body a. (a -> a -> a) -> RequestF body a -> a
forall body m a. Monoid m => (a -> m) -> RequestF body a -> m
forall body b a. (b -> a -> b) -> b -> RequestF body a -> b
forall body a b. (a -> b -> b) -> b -> RequestF body a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => RequestF body a -> a
$cproduct :: forall body a. Num a => RequestF body a -> a
sum :: forall a. Num a => RequestF body a -> a
$csum :: forall body a. Num a => RequestF body a -> a
minimum :: forall a. Ord a => RequestF body a -> a
$cminimum :: forall body a. Ord a => RequestF body a -> a
maximum :: forall a. Ord a => RequestF body a -> a
$cmaximum :: forall body a. Ord a => RequestF body a -> a
elem :: forall a. Eq a => a -> RequestF body a -> Bool
$celem :: forall body a. Eq a => a -> RequestF body a -> Bool
length :: forall a. RequestF body a -> Int
$clength :: forall body a. RequestF body a -> Int
null :: forall a. RequestF body a -> Bool
$cnull :: forall body a. RequestF body a -> Bool
toList :: forall a. RequestF body a -> [a]
$ctoList :: forall body a. RequestF body a -> [a]
foldl1 :: forall a. (a -> a -> a) -> RequestF body a -> a
$cfoldl1 :: forall body a. (a -> a -> a) -> RequestF body a -> a
foldr1 :: forall a. (a -> a -> a) -> RequestF body a -> a
$cfoldr1 :: forall body a. (a -> a -> a) -> RequestF body a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> RequestF body a -> b
$cfoldl' :: forall body b a. (b -> a -> b) -> b -> RequestF body a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RequestF body a -> b
$cfoldl :: forall body b a. (b -> a -> b) -> b -> RequestF body a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RequestF body a -> b
$cfoldr' :: forall body a b. (a -> b -> b) -> b -> RequestF body a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RequestF body a -> b
$cfoldr :: forall body a b. (a -> b -> b) -> b -> RequestF body a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> RequestF body a -> m
$cfoldMap' :: forall body m a. Monoid m => (a -> m) -> RequestF body a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RequestF body a -> m
$cfoldMap :: forall body m a. Monoid m => (a -> m) -> RequestF body a -> m
fold :: forall m. Monoid m => RequestF body m -> m
$cfold :: forall body m. Monoid m => RequestF body m -> m
Foldable, forall body. Functor (RequestF body)
forall body. Foldable (RequestF body)
forall body (m :: * -> *) a.
Monad m =>
RequestF body (m a) -> m (RequestF body a)
forall body (f :: * -> *) a.
Applicative f =>
RequestF body (f a) -> f (RequestF body a)
forall body (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RequestF body a -> m (RequestF body b)
forall body (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RequestF body a -> f (RequestF body b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RequestF body a -> f (RequestF body b)
sequence :: forall (m :: * -> *) a.
Monad m =>
RequestF body (m a) -> m (RequestF body a)
$csequence :: forall body (m :: * -> *) a.
Monad m =>
RequestF body (m a) -> m (RequestF body a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RequestF body a -> m (RequestF body b)
$cmapM :: forall body (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RequestF body a -> m (RequestF body b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RequestF body (f a) -> f (RequestF body a)
$csequenceA :: forall body (f :: * -> *) a.
Applicative f =>
RequestF body (f a) -> f (RequestF body a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RequestF body a -> f (RequestF body b)
$ctraverse :: forall body (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RequestF body a -> f (RequestF body b)
Traversable)

instance (Show a, Show b) =>
           Show (Servant.Client.Core.Request.RequestF a b) where
    showsPrec :: Int -> RequestF a b -> ShowS
showsPrec Int
p RequestF a b
req
      = Bool -> ShowS -> ShowS
showParen
        (Int
p forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"Request {requestPath = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (forall body path. RequestF body path -> path
requestPath RequestF a b
req)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", requestQueryString = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (forall body path. RequestF body path -> Seq QueryItem
requestQueryString RequestF a b
req)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", requestBody = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (forall body path. RequestF body path -> Maybe (body, MediaType)
requestBody RequestF a b
req)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", requestAccept = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (forall body path. RequestF body path -> Seq MediaType
requestAccept RequestF a b
req)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", requestHeaders = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (Header -> Header
redactSensitiveHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall body path. RequestF body path -> Seq Header
requestHeaders RequestF a b
req)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", requestHttpVersion = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (forall body path. RequestF body path -> HttpVersion
requestHttpVersion RequestF a b
req)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", requestMethod = "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (forall body path. RequestF body path -> Method
requestMethod RequestF a b
req)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"
        )
       where
        redactSensitiveHeader :: Header -> Header
        redactSensitiveHeader :: Header -> Header
redactSensitiveHeader (CI Method
"Authorization", Method
_) = (CI Method
"Authorization", Method
"<REDACTED>")
        redactSensitiveHeader Header
h = Header
h
instance Bifunctor RequestF where bimap :: forall a b c d.
(a -> b) -> (c -> d) -> RequestF a c -> RequestF b d
bimap = forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Bifoldable RequestF where bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> RequestF a b -> m
bifoldMap = forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
instance Bitraversable RequestF where
    bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> RequestF a b -> f (RequestF c d)
bitraverse a -> f c
f b -> f d
g RequestF a b
r = Maybe (c, MediaType) -> d -> RequestF c d
mk
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f forall (f :: * -> *) a. Applicative f => a -> f a
pure) (forall body path. RequestF body path -> Maybe (body, MediaType)
requestBody RequestF a b
r)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g (forall body path. RequestF body path -> path
requestPath RequestF a b
r)
      where
        mk :: Maybe (c, MediaType) -> d -> RequestF c d
mk Maybe (c, MediaType)
b d
p = RequestF a b
r { requestBody :: Maybe (c, MediaType)
requestBody = Maybe (c, MediaType)
b, requestPath :: d
requestPath = d
p }

instance (NFData path, NFData body) => NFData (RequestF body path) where
    rnf :: RequestF body path -> ()
rnf RequestF body path
r =
        forall a. NFData a => a -> ()
rnf (forall body path. RequestF body path -> path
requestPath RequestF body path
r)
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf (forall body path. RequestF body path -> Seq QueryItem
requestQueryString RequestF body path
r)
        seq :: forall a b. a -> b -> b
`seq` forall {a}. NFData a => Maybe (a, MediaType) -> ()
rnfB (forall body path. RequestF body path -> Maybe (body, MediaType)
requestBody RequestF body path
r)
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MediaType -> ()
mediaTypeRnf (forall body path. RequestF body path -> Seq MediaType
requestAccept RequestF body path
r))
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf (forall body path. RequestF body path -> Seq Header
requestHeaders RequestF body path
r)
        seq :: forall a b. a -> b -> b
`seq` forall body path. RequestF body path -> HttpVersion
requestHttpVersion RequestF body path
r
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf (forall body path. RequestF body path -> Method
requestMethod RequestF body path
r)
      where
        rnfB :: Maybe (a, MediaType) -> ()
rnfB Maybe (a, MediaType)
Nothing        = ()
        rnfB (Just (a
b, MediaType
mt)) = forall a. NFData a => a -> ()
rnf a
b seq :: forall a b. a -> b -> b
`seq` MediaType -> ()
mediaTypeRnf MediaType
mt

type Request = RequestF RequestBody Builder

-- | The request body. R replica of the @http-client@ @RequestBody@.
data RequestBody
  = RequestBodyLBS LBS.ByteString
  | RequestBodyBS BS.ByteString
  | RequestBodySource (SourceIO LBS.ByteString)
  deriving (forall x. Rep RequestBody x -> RequestBody
forall x. RequestBody -> Rep RequestBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestBody x -> RequestBody
$cfrom :: forall x. RequestBody -> Rep RequestBody x
Generic, Typeable)

instance Show RequestBody where
    showsPrec :: Int -> RequestBody -> ShowS
showsPrec Int
d (RequestBodyLBS ByteString
lbs) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
        forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"RequestBodyLBS "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ByteString
lbs
    showsPrec Int
d (RequestBodyBS Method
bs) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
        forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"RequestBodyBS "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Method
bs
    showsPrec Int
d (RequestBodySource SourceIO ByteString
_) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
        forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"RequestBodySource <IO>"

-- A GET request to the top-level path
defaultRequest :: Request
defaultRequest :: Request
defaultRequest = Request
  { requestPath :: Builder
requestPath = Builder
""
  , requestQueryString :: Seq QueryItem
requestQueryString = forall a. Seq a
Seq.empty
  , requestBody :: Maybe (RequestBody, MediaType)
requestBody = forall a. Maybe a
Nothing
  , requestAccept :: Seq MediaType
requestAccept = forall a. Seq a
Seq.empty
  , requestHeaders :: Seq Header
requestHeaders = forall a. Seq a
Seq.empty
  , requestHttpVersion :: HttpVersion
requestHttpVersion = HttpVersion
http11
  , requestMethod :: Method
requestMethod = Method
methodGet
  }

-- | Append extra path to the request being constructed.
--
-- Warning: This function assumes that the path fragment is already URL-encoded.
appendToPath :: Builder -> Request -> Request
appendToPath :: Builder -> Request -> Request
appendToPath Builder
p Request
req
  = Request
req { requestPath :: Builder
requestPath = forall body path. RequestF body path -> path
requestPath Request
req forall a. Semigroup a => a -> a -> a
<> Builder
"/" forall a. Semigroup a => a -> a -> a
<> Builder
p }

-- | Append a query parameter to the request being constructed.
--
appendToQueryString :: Text                -- ^ query param name
                    -> Maybe BS.ByteString -- ^ query param value
                    -> Request
                    -> Request
appendToQueryString :: Text -> Maybe Method -> Request -> Request
appendToQueryString Text
pname Maybe Method
pvalue Request
req
  = Request
req { requestQueryString :: Seq QueryItem
requestQueryString = forall body path. RequestF body path -> Seq QueryItem
requestQueryString Request
req
                        forall a. Seq a -> a -> Seq a
Seq.|> (Text -> Method
encodeUtf8 Text
pname, Maybe Method
pvalue)}

-- | Encode a query parameter value.
--
encodeQueryParamValue :: ToHttpApiData a => a  -> BS.ByteString
encodeQueryParamValue :: forall a. ToHttpApiData a => a -> Method
encodeQueryParamValue = ByteString -> Method
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Method -> Builder
urlEncodeBuilder Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toQueryParam

-- | Add header to the request being constructed.
--
addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader :: forall a. ToHttpApiData a => CI Method -> a -> Request -> Request
addHeader CI Method
name a
val Request
req
  = Request
req { requestHeaders :: Seq Header
requestHeaders = forall body path. RequestF body path -> Seq Header
requestHeaders Request
req forall a. Seq a -> a -> Seq a
Seq.|> (CI Method
name, forall a. ToHttpApiData a => a -> Method
toHeader a
val)}

-- | Set body and media type of the request being constructed.
--
-- The body is set to the given bytestring using the 'RequestBodyLBS'
-- constructor.
--
-- @since 0.12
--
setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request
setRequestBodyLBS :: ByteString -> MediaType -> Request -> Request
setRequestBodyLBS ByteString
b MediaType
t Request
req
  = Request
req { requestBody :: Maybe (RequestBody, MediaType)
requestBody = forall a. a -> Maybe a
Just (ByteString -> RequestBody
RequestBodyLBS ByteString
b, MediaType
t) }

-- | Set body and media type of the request being constructed.
--
-- @since 0.12
--
setRequestBody :: RequestBody -> MediaType -> Request -> Request
setRequestBody :: RequestBody -> MediaType -> Request -> Request
setRequestBody RequestBody
b MediaType
t Request
req = Request
req { requestBody :: Maybe (RequestBody, MediaType)
requestBody = forall a. a -> Maybe a
Just (RequestBody
b, MediaType
t) }