c7ed1f9 · typeable/req

git.iko.soy/typeable/req

on master help sign in

Add support for multipart form data (#6)

c7ed1f9Mark Karpov10 years ago

CHANGELOG.md+9

compare with master

unifiedsplit

@@ -1,3 +1,12 @@

1+## Req 0.2.0

3+* Added support for multipart form data in form of `ReqBodyMultipart` body

4+ option and `reqBodyMultipart` helper function. This also required a change

5+ in type signature of `getRequestContentType`, which now takes `body`, not

6+ `Proxy body` because we need to extract boundary from `body` and put it

7+ into `Content-Type` header. This change, however, shouldn't be too

8+ dangerous for end-users.

1## Req 0.1.0

10## Req 0.1.0

3* Initial release.

12* Initial release.

Network/HTTP/Req.hs+29−5

@@ -149,6 +149,8 @@ module Network.HTTP.Req

149 , ReqBodyLbs (..)

150 , ReqBodyUrlEnc (..)

151 , FormUrlEncodedParam

152+ , ReqBodyMultipart

153+ , reqBodyMultipart

152 , HttpBody (..)

154 , HttpBody (..)

153 , ProvidesBody

155 , ProvidesBody

154 , HttpBodyAllowed

156 , HttpBodyAllowed

@@ -234,6 +236,7 @@ import qualified Data.Text.Encoding as T

234import qualified Network.Connection as NC

236import qualified Network.Connection as NC

235import qualified Network.HTTP.Client as L

237import qualified Network.HTTP.Client as L

236import qualified Network.HTTP.Client.Internal as LI

238import qualified Network.HTTP.Client.Internal as LI

239+import qualified Network.HTTP.Client.MultipartFormData as LM

237import qualified Network.HTTP.Client.TLS as L

240import qualified Network.HTTP.Client.TLS as L

238import qualified Network.HTTP.Types as Y

241import qualified Network.HTTP.Types as Y

239

242

@@ -777,7 +780,7 @@ newtype ReqBodyJson a = ReqBodyJson a

777

780

778instance ToJSON a => HttpBody (ReqBodyJson a) where

781instance ToJSON a => HttpBody (ReqBodyJson a) where

779 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)

782 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)

780− getRequestContentType Proxy = pure "application/json; charset=utf-8"

783+ getRequestContentType _ = pure "application/json; charset=utf-8"

781

784

782-- | This body option streams request body from a file. It is expected that

785-- | This body option streams request body from a file. It is expected that

783-- the file size does not change during the streaming.

786-- the file size does not change during the streaming.

@@ -823,7 +826,7 @@ newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam

823instance HttpBody ReqBodyUrlEnc where

826instance HttpBody ReqBodyUrlEnc where

824 getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam params)) =

827 getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam params)) =

825 (L.RequestBodyLBS . BB.toLazyByteString) (Y.renderQueryText False params)

828 (L.RequestBodyLBS . BB.toLazyByteString) (Y.renderQueryText False params)

826− getRequestContentType Proxy = pure "application/x-www-form-urlencoded"

829+ getRequestContentType _ = pure "application/x-www-form-urlencoded"

827

830

828-- | An opaque monoidal value that allows to collect URL-encoded parameters

831-- | An opaque monoidal value that allows to collect URL-encoded parameters

829-- to be wrapped in 'ReqBodyUrlEnc'.

832-- to be wrapped in 'ReqBodyUrlEnc'.

@@ -835,6 +838,27 @@ instance QueryParam FormUrlEncodedParam where

835 queryParam name mvalue =

838 queryParam name mvalue =

836 FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]

839 FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]

837

840

841+-- | Multipart form data. Please consult the

842+-- "Network.HTTP.Client.MultipartFormData" module for how to construct

843+-- parts, then use 'reqBodyMultipart' to create actual request body from the

844+-- parts. 'reqBodyMultipart' is the only way to get a value of type

845+-- 'ReqBodyMultipart', as its constructor is not exported on purpose.

846+

847+data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody

848+

849+instance HttpBody ReqBodyMultipart where

850+ getRequestBody (ReqBodyMultipart _ body) = body

851+ getRequestContentType (ReqBodyMultipart boundary _) =

852+ pure ("multipart/form-data; boundary=" <> boundary)

853+

854+-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.

855+

856+reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart

857+reqBodyMultipart parts = liftIO $ do

858+ boundary <- LM.webkitBoundary

859+ body <- LM.renderParts boundary parts

860+ return (ReqBodyMultipart boundary body)

861+

838-- | A type class for things that can be interpreted as HTTP

862-- | A type class for things that can be interpreted as HTTP

839-- 'L.RequestBody'.

863-- 'L.RequestBody'.

840

864

@@ -850,8 +874,8 @@ class HttpBody body where

850 -- header that should be used with particular body option. By default it

874 -- header that should be used with particular body option. By default it

851 -- returns 'Nothing' and so @Content-Type@ is not set.

875 -- returns 'Nothing' and so @Content-Type@ is not set.

852

876

853− getRequestContentType :: Proxy body -> Maybe ByteString

877+ getRequestContentType :: body -> Maybe ByteString

854− getRequestContentType Proxy = Nothing

878+ getRequestContentType = const Nothing

855

879

856-- | The type function recognizes 'NoReqBody' as having 'NoBody', while any

880-- | The type function recognizes 'NoReqBody' as having 'NoBody', while any

857-- other body option 'CanHaveBody'. This forces user to use 'NoReqBody' with

881-- other body option 'CanHaveBody'. This forces user to use 'NoReqBody' with

@@ -883,7 +907,7 @@ instance HttpBody body => RequestComponent (Womb "body" body) where

883 x { L.requestBody = getRequestBody body

907 x { L.requestBody = getRequestBody body

884 , L.requestHeaders =

908 , L.requestHeaders =

885 let old = L.requestHeaders x in

909 let old = L.requestHeaders x in

886− case getRequestContentType (Proxy :: Proxy body) of

910+ case getRequestContentType body of

887 Nothing -> old

911 Nothing -> old

888 Just contentType ->

912 Just contentType ->

889 (Y.hContentType, contentType) : old }

913 (Y.hContentType, contentType) : old }

httpbin-tests/Network/HTTP/ReqSpec.hs+28

@@ -60,6 +60,7 @@ import qualified Data.Text as T

60import qualified Data.Text.Encoding as T

61import qualified Data.Text.IO as TIO

62import qualified Network.HTTP.Client as L

63+import qualified Network.HTTP.Client.MultipartFormData as LM

63import qualified Network.HTTP.Types as Y

64import qualified Network.HTTP.Types as Y

65#if !MIN_VERSION_base(4,8,0)

66#if !MIN_VERSION_base(4,8,0)

@@ -143,6 +144,33 @@ spec = do

143 responseStatusCode r `shouldBe` 200

144 responseStatusCode r `shouldBe` 200

144 responseStatusMessage r `shouldBe` "OK"

145 responseStatusMessage r `shouldBe` "OK"

145

146

147+ describe "receiving POST data back (multipart form data)" $

148+ it "works" $ do

149+ body <- reqBodyMultipart

150+ [ LM.partBS "foo" "foo data!"

151+ , LM.partBS "bar" "bar data!" ]

152+ r <- req POST (httpbin /: "post") body jsonResponse mempty

153+ let Just contentType = getRequestContentType body

154+ stripOrigin (responseBody r) `shouldBe` object

155+ [ "args" .= emptyObject

156+ , "json" .= Null

157+ , "data" .= ("" :: Text)

158+ , "url" .= ("https://httpbin.org/post" :: Text)

159+ , "headers" .= object

160+ [ "Content-Type" .= T.decodeUtf8 contentType

161+ , "Accept-Encoding" .= ("gzip" :: Text)

162+ , "Host" .= ("httpbin.org" :: Text)

163+ , "Content-Length" .= ("242" :: Text)

164+ ]

165+ , "files" .= emptyObject

166+ , "form" .= object

167+ [ "foo" .= ("foo data!" :: Text)

168+ , "bar" .= ("bar data!" :: Text) ]

169+ ]

170+ responseHeader r "Content-Type" `shouldBe` return "application/json"

171+ responseStatusCode r `shouldBe` 200

172+ responseStatusMessage r `shouldBe` "OK"

173+

146 describe "receiving PATCHed file back" $

174 describe "receiving PATCHed file back" $

147 it "works" $ do

175 it "works" $ do

148 let file :: FilePath

176 let file :: FilePath