{-# 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,
addHeader,
appendToPath,
appendToQueryString,
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 qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as LBS
import Data.Semigroup
((<>))
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)
import Servant.API
(ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
import Servant.Client.Core.Internal (mediaTypeRnf)
data RequestF body path = Request
{ RequestF body path -> path
requestPath :: path
, RequestF body path -> Seq QueryItem
requestQueryString :: Seq.Seq QueryItem
, RequestF body path -> Maybe (body, MediaType)
requestBody :: Maybe (body, MediaType)
, RequestF body path -> Seq MediaType
requestAccept :: Seq.Seq MediaType
, :: Seq.Seq Header
, RequestF body path -> HttpVersion
requestHttpVersion :: HttpVersion
, RequestF body path -> Method
requestMethod :: Method
} deriving ((forall x. RequestF body path -> Rep (RequestF body path) x)
-> (forall x. Rep (RequestF body path) x -> RequestF body path)
-> Generic (RequestF body path)
forall x. Rep (RequestF body path) x -> RequestF body path
forall x. RequestF body path -> Rep (RequestF body path) x
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
(RequestF body path -> RequestF body path -> Bool)
-> (RequestF body path -> RequestF body path -> Bool)
-> Eq (RequestF body path)
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, Int -> RequestF body path -> ShowS
[RequestF body path] -> ShowS
RequestF body path -> String
(Int -> RequestF body path -> ShowS)
-> (RequestF body path -> String)
-> ([RequestF body path] -> ShowS)
-> Show (RequestF body path)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall body path.
(Show path, Show body) =>
Int -> RequestF body path -> ShowS
forall body path.
(Show path, Show body) =>
[RequestF body path] -> ShowS
forall body path.
(Show path, Show body) =>
RequestF body path -> String
showList :: [RequestF body path] -> ShowS
$cshowList :: forall body path.
(Show path, Show body) =>
[RequestF body path] -> ShowS
show :: RequestF body path -> String
$cshow :: forall body path.
(Show path, Show body) =>
RequestF body path -> String
showsPrec :: Int -> RequestF body path -> ShowS
$cshowsPrec :: forall body path.
(Show path, Show body) =>
Int -> RequestF body path -> ShowS
Show, a -> RequestF body b -> RequestF body a
(a -> b) -> RequestF body a -> RequestF body b
(forall a b. (a -> b) -> RequestF body a -> RequestF body b)
-> (forall a b. a -> RequestF body b -> RequestF body a)
-> Functor (RequestF body)
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
<$ :: a -> RequestF body b -> RequestF body a
$c<$ :: forall body a b. a -> RequestF body b -> RequestF body a
fmap :: (a -> b) -> RequestF body a -> RequestF body b
$cfmap :: forall body a b. (a -> b) -> RequestF body a -> RequestF body b
Functor, RequestF body a -> Bool
(a -> m) -> RequestF body a -> m
(a -> b -> b) -> b -> RequestF body a -> b
(forall m. Monoid m => RequestF body m -> m)
-> (forall m a. Monoid m => (a -> m) -> RequestF body a -> m)
-> (forall m a. Monoid m => (a -> m) -> RequestF body a -> m)
-> (forall a b. (a -> b -> b) -> b -> RequestF body a -> b)
-> (forall a b. (a -> b -> b) -> b -> RequestF body a -> b)
-> (forall b a. (b -> a -> b) -> b -> RequestF body a -> b)
-> (forall b a. (b -> a -> b) -> b -> RequestF body a -> b)
-> (forall a. (a -> a -> a) -> RequestF body a -> a)
-> (forall a. (a -> a -> a) -> RequestF body a -> a)
-> (forall a. RequestF body a -> [a])
-> (forall a. RequestF body a -> Bool)
-> (forall a. RequestF body a -> Int)
-> (forall a. Eq a => a -> RequestF body a -> Bool)
-> (forall a. Ord a => RequestF body a -> a)
-> (forall a. Ord a => RequestF body a -> a)
-> (forall a. Num a => RequestF body a -> a)
-> (forall a. Num a => RequestF body a -> a)
-> Foldable (RequestF body)
forall a. Eq a => a -> RequestF body a -> Bool
forall a. Num a => RequestF body a -> a
forall a. Ord a => RequestF body a -> a
forall m. Monoid m => RequestF body m -> m
forall a. RequestF body a -> Bool
forall a. RequestF body a -> Int
forall a. RequestF body a -> [a]
forall a. (a -> a -> a) -> RequestF body a -> a
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 b a. (b -> a -> b) -> b -> RequestF body a -> b
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 :: RequestF body a -> a
$cproduct :: forall body a. Num a => RequestF body a -> a
sum :: RequestF body a -> a
$csum :: forall body a. Num a => RequestF body a -> a
minimum :: RequestF body a -> a
$cminimum :: forall body a. Ord a => RequestF body a -> a
maximum :: RequestF body a -> a
$cmaximum :: forall body a. Ord a => RequestF body a -> a
elem :: a -> RequestF body a -> Bool
$celem :: forall body a. Eq a => a -> RequestF body a -> Bool
length :: RequestF body a -> Int
$clength :: forall body a. RequestF body a -> Int
null :: RequestF body a -> Bool
$cnull :: forall body a. RequestF body a -> Bool
toList :: RequestF body a -> [a]
$ctoList :: forall body a. RequestF body a -> [a]
foldl1 :: (a -> a -> a) -> RequestF body a -> a
$cfoldl1 :: forall body a. (a -> a -> a) -> RequestF body a -> a
foldr1 :: (a -> a -> a) -> RequestF body a -> a
$cfoldr1 :: forall body a. (a -> a -> a) -> RequestF body a -> a
foldl' :: (b -> a -> b) -> b -> RequestF body a -> b
$cfoldl' :: forall body b a. (b -> a -> b) -> b -> RequestF body a -> b
foldl :: (b -> a -> b) -> b -> RequestF body a -> b
$cfoldl :: forall body b a. (b -> a -> b) -> b -> RequestF body a -> b
foldr' :: (a -> b -> b) -> b -> RequestF body a -> b
$cfoldr' :: forall body a b. (a -> b -> b) -> b -> RequestF body a -> b
foldr :: (a -> b -> b) -> b -> RequestF body a -> b
$cfoldr :: forall body a b. (a -> b -> b) -> b -> RequestF body a -> b
foldMap' :: (a -> m) -> RequestF body a -> m
$cfoldMap' :: forall body m a. Monoid m => (a -> m) -> RequestF body a -> m
foldMap :: (a -> m) -> RequestF body a -> m
$cfoldMap :: forall body m a. Monoid m => (a -> m) -> RequestF body a -> m
fold :: RequestF body m -> m
$cfold :: forall body m. Monoid m => RequestF body m -> m
Foldable, Functor (RequestF body)
Foldable (RequestF body)
(Functor (RequestF body), Foldable (RequestF body)) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RequestF body a -> f (RequestF body b))
-> (forall (f :: * -> *) a.
Applicative f =>
RequestF body (f a) -> f (RequestF body a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RequestF body a -> m (RequestF body b))
-> (forall (m :: * -> *) a.
Monad m =>
RequestF body (m a) -> m (RequestF body a))
-> Traversable (RequestF body)
(a -> f b) -> RequestF body a -> f (RequestF body b)
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 (m :: * -> *) a.
Monad m =>
RequestF body (m a) -> m (RequestF body a)
forall (f :: * -> *) a.
Applicative f =>
RequestF body (f a) -> f (RequestF body a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RequestF body a -> m (RequestF body b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RequestF body a -> f (RequestF body b)
sequence :: RequestF body (m a) -> m (RequestF body a)
$csequence :: forall body (m :: * -> *) a.
Monad m =>
RequestF body (m a) -> m (RequestF body a)
mapM :: (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 :: RequestF body (f a) -> f (RequestF body a)
$csequenceA :: forall body (f :: * -> *) a.
Applicative f =>
RequestF body (f a) -> f (RequestF body a)
traverse :: (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)
$cp2Traversable :: forall body. Foldable (RequestF body)
$cp1Traversable :: forall body. Functor (RequestF body)
Traversable)
instance Bifunctor RequestF where bimap :: (a -> b) -> (c -> d) -> RequestF a c -> RequestF b d
bimap = (a -> b) -> (c -> d) -> RequestF a c -> RequestF b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Bifoldable RequestF where bifoldMap :: (a -> m) -> (b -> m) -> RequestF a b -> m
bifoldMap = (a -> m) -> (b -> m) -> RequestF a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
instance Bitraversable RequestF where
bitraverse :: (a -> f c) -> (b -> f d) -> RequestF a b -> f (RequestF c d)
bitraverse f :: a -> f c
f g :: b -> f d
g r :: RequestF a b
r = Maybe (c, MediaType) -> d -> RequestF c d
mk
(Maybe (c, MediaType) -> d -> RequestF c d)
-> f (Maybe (c, MediaType)) -> f (d -> RequestF c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, MediaType) -> f (c, MediaType))
-> Maybe (a, MediaType) -> f (Maybe (c, MediaType))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c)
-> (MediaType -> f MediaType) -> (a, MediaType) -> f (c, MediaType)
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 MediaType -> f MediaType
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (RequestF a b -> Maybe (a, MediaType)
forall body path. RequestF body path -> Maybe (body, MediaType)
requestBody RequestF a b
r)
f (d -> RequestF c d) -> f d -> f (RequestF c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g (RequestF a b -> b
forall body path. RequestF body path -> path
requestPath RequestF a b
r)
where
mk :: Maybe (c, MediaType) -> d -> RequestF c d
mk b :: Maybe (c, MediaType)
b p :: 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 r :: RequestF body path
r =
path -> ()
forall a. NFData a => a -> ()
rnf (RequestF body path -> path
forall body path. RequestF body path -> path
requestPath RequestF body path
r)
() -> () -> ()
forall a b. a -> b -> b
`seq` Seq QueryItem -> ()
forall a. NFData a => a -> ()
rnf (RequestF body path -> Seq QueryItem
forall body path. RequestF body path -> Seq QueryItem
requestQueryString RequestF body path
r)
() -> () -> ()
forall a b. a -> b -> b
`seq` Maybe (body, MediaType) -> ()
forall a. NFData a => Maybe (a, MediaType) -> ()
rnfB (RequestF body path -> Maybe (body, MediaType)
forall body path. RequestF body path -> Maybe (body, MediaType)
requestBody RequestF body path
r)
() -> () -> ()
forall a b. a -> b -> b
`seq` Seq () -> ()
forall a. NFData a => a -> ()
rnf ((MediaType -> ()) -> Seq MediaType -> Seq ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MediaType -> ()
mediaTypeRnf (RequestF body path -> Seq MediaType
forall body path. RequestF body path -> Seq MediaType
requestAccept RequestF body path
r))
() -> () -> ()
forall a b. a -> b -> b
`seq` Seq Header -> ()
forall a. NFData a => a -> ()
rnf (RequestF body path -> Seq Header
forall body path. RequestF body path -> Seq Header
requestHeaders RequestF body path
r)
() -> () -> ()
forall a b. a -> b -> b
`seq` RequestF body path -> HttpVersion
forall body path. RequestF body path -> HttpVersion
requestHttpVersion RequestF body path
r
HttpVersion -> () -> ()
forall a b. a -> b -> b
`seq` Method -> ()
forall a. NFData a => a -> ()
rnf (RequestF body path -> Method
forall body path. RequestF body path -> Method
requestMethod RequestF body path
r)
where
rnfB :: Maybe (a, MediaType) -> ()
rnfB Nothing = ()
rnfB (Just (b :: a
b, mt :: MediaType
mt)) = a -> ()
forall a. NFData a => a -> ()
rnf a
b () -> () -> ()
forall a b. a -> b -> b
`seq` MediaType -> ()
mediaTypeRnf MediaType
mt
type Request = RequestF RequestBody Builder.Builder
data RequestBody
= RequestBodyLBS LBS.ByteString
| RequestBodyBS BS.ByteString
| RequestBodySource (SourceIO LBS.ByteString)
deriving ((forall x. RequestBody -> Rep RequestBody x)
-> (forall x. Rep RequestBody x -> RequestBody)
-> Generic RequestBody
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 d :: Int
d (RequestBodyLBS lbs :: ByteString
lbs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "RequestBodyLBS "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 ByteString
lbs
showsPrec d :: Int
d (RequestBodyBS bs :: Method
bs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "RequestBodyBS "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Method -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Method
bs
showsPrec d :: Int
d (RequestBodySource _) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "RequestBodySource <IO>"
defaultRequest :: Request
defaultRequest :: Request
defaultRequest = Request :: forall body path.
path
-> Seq QueryItem
-> Maybe (body, MediaType)
-> Seq MediaType
-> Seq Header
-> HttpVersion
-> Method
-> RequestF body path
Request
{ requestPath :: Builder
requestPath = ""
, requestQueryString :: Seq QueryItem
requestQueryString = Seq QueryItem
forall a. Seq a
Seq.empty
, requestBody :: Maybe (RequestBody, MediaType)
requestBody = Maybe (RequestBody, MediaType)
forall a. Maybe a
Nothing
, requestAccept :: Seq MediaType
requestAccept = Seq MediaType
forall a. Seq a
Seq.empty
, requestHeaders :: Seq Header
requestHeaders = Seq Header
forall a. Seq a
Seq.empty
, requestHttpVersion :: HttpVersion
requestHttpVersion = HttpVersion
http11
, requestMethod :: Method
requestMethod = Method
methodGet
}
appendToPath :: Text -> Request -> Request
appendToPath :: Text -> Request -> Request
appendToPath p :: Text
p req :: Request
req
= Request
req { requestPath :: Builder
requestPath = Request -> Builder
forall body path. RequestF body path -> path
requestPath Request
req Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. ToHttpApiData a => a -> Builder
toEncodedUrlPiece Text
p }
appendToQueryString :: Text
-> Maybe Text
-> Request
-> Request
appendToQueryString :: Text -> Maybe Text -> Request -> Request
appendToQueryString pname :: Text
pname pvalue :: Maybe Text
pvalue req :: Request
req
= Request
req { requestQueryString :: Seq QueryItem
requestQueryString = Request -> Seq QueryItem
forall body path. RequestF body path -> Seq QueryItem
requestQueryString Request
req
Seq QueryItem -> QueryItem -> Seq QueryItem
forall a. Seq a -> a -> Seq a
Seq.|> (Text -> Method
encodeUtf8 Text
pname, Text -> Method
encodeUtf8 (Text -> Method) -> Maybe Text -> Maybe Method
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
pvalue)}
addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
name :: HeaderName
name val :: a
val req :: Request
req
= Request
req { requestHeaders :: Seq Header
requestHeaders = Request -> Seq Header
forall body path. RequestF body path -> Seq Header
requestHeaders Request
req Seq Header -> Header -> Seq Header
forall a. Seq a -> a -> Seq a
Seq.|> (HeaderName
name, a -> Method
forall a. ToHttpApiData a => a -> Method
toHeader a
val)}
setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request
setRequestBodyLBS :: ByteString -> MediaType -> Request -> Request
setRequestBodyLBS b :: ByteString
b t :: MediaType
t req :: Request
req
= Request
req { requestBody :: Maybe (RequestBody, MediaType)
requestBody = (RequestBody, MediaType) -> Maybe (RequestBody, MediaType)
forall a. a -> Maybe a
Just (ByteString -> RequestBody
RequestBodyLBS ByteString
b, MediaType
t) }
setRequestBody :: RequestBody -> MediaType -> Request -> Request
setRequestBody :: RequestBody -> MediaType -> Request -> Request
setRequestBody b :: RequestBody
b t :: MediaType
t req :: Request
req = Request
req { requestBody :: Maybe (RequestBody, MediaType)
requestBody = (RequestBody, MediaType) -> Maybe (RequestBody, MediaType)
forall a. a -> Maybe a
Just (RequestBody
b, MediaType
t) }