@@ -128,7 +128,16 @@ module Network.HTTP.Req
128128 , parseUrlHttp
129129 , parseUrlHttps
130130 -- ** Body
131− , HttpBody (..) -- TODO more stuff here
131+ -- $body
132+ , NoReqBody (..)
133+ , ReqBodyBs (..)
134+ , ReqBodyLbs (..)
135+ , ReqBodyUrlEnc (..)
136+ , FormUrlEncodedParam
137+ , ReqBodyMultipart (..)
138+ , ReqBodyJSON (..)
139+ , HttpBody (..)
140+ , ProvidesBody
132141 -- ** Optional parameters
133142 -- $optional-parameters
134143 , Option
@@ -168,7 +177,7 @@ import Control.Arrow (first, second)
168177import Control.Exception (try)
169178import Control.Monad
170179import Control.Monad.IO.Class
171−import Data.Aeson
180+import Data.Aeson (FromJSON (..), ToJSON (..), Value)
172181import Data.ByteString (ByteString)
173182import Data.Data (Data)
174183import Data.Default.Class
@@ -183,6 +192,8 @@ import Data.Typeable (Typeable)
183192import GHC.Generics
184193import GHC.TypeLits
185194import System.IO.Unsafe (unsafePerformIO)
195+import qualified Blaze.ByteString.Builder as BB
196+import qualified Data.Aeson as A
186197import qualified Data.Binary.Builder as R
187198import qualified Data.ByteString as B
188199import qualified Data.ByteString.Lazy as BL
@@ -558,17 +569,105 @@ instance RequestComponent (Url scheme) where
558569----------------------------------------------------------------------------
559570-- Request — Body
560571
561−class HttpBody b where
562− type ProvidesBody b :: CanHaveBody
563− getReqestBody :: b -> ByteString -- FIXME should use a conduit here
572+-- $body
573+--
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,
578+-- see 'HttpBody'.
579+
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
582+-- the only type for which 'ProvidesBody' returns 'NoBody'.
583+--
584+-- Using of this body option does not set the @Content-Type@ header.
585+
586+data NoReqBody = NoReqBody
587+
588+instance HttpBody NoReqBody where
589+ getRequestBody NoReqBody = L.RequestBodyBS B.empty
590+
591+-- | HTTP request body represented by a strict 'ByteString'.
592+--
593+-- Using of this body option does not set the @Content-Type@ header.
564594
565−data FormUrlEncodedParam = FormUrlEncodedParam Text (Maybe Text)
595+newtype ReqBodyBs = ReqBodyBs ByteString
596+
597+instance HttpBody ReqBodyBs where
598+ getRequestBody (ReqBodyBs bs) = L.RequestBodyBS bs
599+
600+-- | HTTP request body represented by a lazy 'BL.ByteString'.
601+--
602+-- Using of this body option does not set the @Content-Type@ header.
603+
604+newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
605+
606+instance HttpBody ReqBodyLbs where
607+ getRequestBody (ReqBodyLbs bs) = L.RequestBodyLBS bs
608+
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
614+-- 'queryFlag'.
615+--
616+-- Here is an example of use:
617+--
618+-- > req POST (https "httpbin.org" /: "post") (ReqBodyUrlEnc params) mempty
619+-- > where params =
620+-- > "foo" =: "bar" <>
621+-- > queryFlag "baz"
622+--
623+-- This body option sets the @Content-Type@ header to
624+-- @application/x-www-from-urlencoded@ value.
625+
626+newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam
627+
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"
632+
633+-- | An opaque monoidal value that allows to collect URL-encoded parameters
634+-- to be wrapped in 'ReqBodyUrlEnc' (documentation for this type has an
635+-- example of use).
636+
637+newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
638+ deriving (Semigroup, Monoid)
566639
567640instance QueryParam FormUrlEncodedParam where
568− queryParam = FormUrlEncodedParam
641+ queryParam name mvalue = FormUrlEncodedParam [(name, mvalue)]
642+
643+-- |
644+
645+newtype ReqBodyMultipart = ReqBodyMultipart ByteString
646+
647+newtype ReqBodyJSON a = ReqBodyJSON a
648+
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"
652+
653+class HttpBody body where
654+ getRequestBody :: body -> L.RequestBody
655+ getRequestContentType :: Proxy body -> Maybe ByteString
656+ getRequestContentType Proxy = Nothing
657+
658+type family ProvidesBody body :: CanHaveBody where
659+ ProvidesBody NoReqBody = 'NoBody
660+ ProvidesBody body = 'CanHaveBody
569661
570−instance HttpBody b => RequestComponent (Womb "body" b) where
571− getRequestMod = undefined -- FIXME
662+instance HttpBody body => RequestComponent (Womb "body" body) where
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
668+ Nothing -> old
669+ Just contentType ->
670+ (Y.hContentType, contentType) : old }
572671
573672----------------------------------------------------------------------------
574673-- Request — Optional parameters