@@ -128,7 +128,16 @@ module Network.HTTP.Req
128 , parseUrlHttp
128 , parseUrlHttp
129 , parseUrlHttps
129 , parseUrlHttps
130 -- ** Body
130 -- ** Body
131− , HttpBody (..) -- TODO more stuff here
131+ -- $body
135+ , ReqBodyUrlEnc (..)
136+ , FormUrlEncodedParam
137+ , ReqBodyMultipart (..)
132 -- ** Optional parameters
141 -- ** Optional parameters
133 -- $optional-parameters
142 -- $optional-parameters
@@ -168,7 +177,7 @@ import Control.Arrow (first, second)
168import Control.Exception (try)
177import Control.Exception (try)
169import Control.Monad
178import Control.Monad
170import Control.Monad.IO.Class
179import Control.Monad.IO.Class
171−import Data.Aeson
180+import Data.Aeson (FromJSON (..), ToJSON (..), Value)
172import Data.ByteString (ByteString)
181import Data.ByteString (ByteString)
173import Data.Data (Data)
182import Data.Data (Data)
174import Data.Default.Class
183import Data.Default.Class
@@ -183,6 +192,8 @@ import Data.Typeable (Typeable)
183import GHC.Generics
192import GHC.Generics
184import GHC.TypeLits
193import GHC.TypeLits
185import System.IO.Unsafe (unsafePerformIO)
194import System.IO.Unsafe (unsafePerformIO)
195+import qualified Blaze.ByteString.Builder as BB
196+import qualified Data.Aeson as A
186import qualified Data.Binary.Builder as R
197import qualified Data.Binary.Builder as R
187import qualified Data.ByteString as B
198import qualified Data.ByteString as B
188import qualified Data.ByteString.Lazy as BL
199import qualified Data.ByteString.Lazy as BL
@@ -558,17 +569,105 @@ instance RequestComponent (Url scheme) where
558----------------------------------------------------------------------------
569----------------------------------------------------------------------------
559-- Request — Body
570-- Request — Body
574+-- A number of options for request bodies are available, they all are listed
575+-- in this section. The @Content-Type@ header is set for you automatically
576+-- according to body option you use (it's always specified in documentation
577+-- for given body option). To add your own way to represent request body,
561−class HttpBody b where
578+-- see 'HttpBody'.
580+-- | This data type represents empty body of an HTTP request. This is the
581+-- data type to be used with 'HttpMethod's that cannot have a body, as it's
562− type ProvidesBody b :: CanHaveBody
582+-- the only type for which 'ProvidesBody' returns 'NoBody'.
563− getReqestBody :: b -> ByteString -- FIXME should use a conduit here
583+--
584+-- Using of this body option does not set the @Content-Type@ header.
586+data NoReqBody = NoReqBody
588+instance HttpBody NoReqBody where
589+ getRequestBody NoReqBody = L.RequestBodyBS B.empty
591+-- | HTTP request body represented by a strict 'ByteString'.
593+-- Using of this body option does not set the @Content-Type@ header.
595+newtype ReqBodyBs = ReqBodyBs ByteString
597+instance HttpBody ReqBodyBs where
598+ getRequestBody (ReqBodyBs bs) = L.RequestBodyBS bs
600+-- | HTTP request body represented by a lazy 'BL.ByteString'.
602+-- Using of this body option does not set the @Content-Type@ header.
604+newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
606+instance HttpBody ReqBodyLbs where
607+ getRequestBody (ReqBodyLbs bs) = L.RequestBodyLBS bs
609+-- | Form URL-encoded body. This can hold a collection of parameters which
610+-- are encoded similarly to query parameters at the end of query string,
611+-- with the only difference that they are stored in request body. The
612+-- similarity is reflected in API as well, as you can use the same
613+-- combinators you would use to add query parameters: @('=:')@ and
616+-- Here is an example of use:
618+-- > req POST (https "httpbin.org" /: "post") (ReqBodyUrlEnc params) mempty
620+-- > "foo" =: "bar" <>
623+-- This body option sets the @Content-Type@ header to
624+-- @application/x-www-from-urlencoded@ value.
626+newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam
628+instance HttpBody ReqBodyUrlEnc where
629+ getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam params)) =
630+ (L.RequestBodyLBS . BB.toLazyByteString) (Y.renderQueryText False params)
631+ getRequestContentType Proxy = pure "application/x-www-form-urlencoded"
633+-- | An opaque monoidal value that allows to collect URL-encoded parameters
634+-- to be wrapped in 'ReqBodyUrlEnc' (documentation for this type has an
565−data FormUrlEncodedParam = FormUrlEncodedParam Text (Maybe Text)
637+newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
638+ deriving (Semigroup, Monoid)
567instance QueryParam FormUrlEncodedParam where
640instance QueryParam FormUrlEncodedParam where
568− queryParam = FormUrlEncodedParam
641+ queryParam name mvalue = FormUrlEncodedParam [(name, mvalue)]
645+newtype ReqBodyMultipart = ReqBodyMultipart ByteString
647+newtype ReqBodyJSON a = ReqBodyJSON a
649+instance ToJSON a => HttpBody (ReqBodyJSON a) where
650+ getRequestBody (ReqBodyJSON a) = L.RequestBodyLBS (A.encode a)
651+ getRequestContentType Proxy = pure "application/json; charset=utf-8"
653+class HttpBody body where
654+ getRequestBody :: body -> L.RequestBody
655+ getRequestContentType :: Proxy body -> Maybe ByteString
656+ getRequestContentType Proxy = Nothing
658+type family ProvidesBody body :: CanHaveBody where
659+ ProvidesBody NoReqBody = 'NoBody
660+ ProvidesBody body = 'CanHaveBody
570−instance HttpBody b => RequestComponent (Womb "body" b) where
662+instance HttpBody body => RequestComponent (Womb "body" body) where
571− getRequestMod = undefined -- FIXME
663+ getRequestMod (Womb body) = Endo $ \x ->
664+ x { L.requestBody = getRequestBody body
665+ , L.requestHeaders =
666+ let old = L.requestHeaders x in
667+ case getRequestContentType (Proxy :: Proxy body) of
670+ (Y.hContentType, contentType) : old }
573----------------------------------------------------------------------------
672----------------------------------------------------------------------------
574-- Request — Optional parameters
673-- Request — Optional parameters