@@ -56,14 +56,12 @@ import qualified Network.HTTP.Types as HTTP
5656import Servant.API
5757import Web.HttpApiData
5858
59−data AltJSON = AltJSON deriving (Eq, Ord, Show, Read, Generic, Typeable)
60−data AltMedia = AltMedia deriving (Eq, Ord, Show, Read, Generic, Typeable)
61−
62−instance ToHttpApiData AltJSON where toQueryParam = const "json"
63−instance ToHttpApiData AltMedia where toQueryParam = const "media"
64−
59+data AltJSON = AltJSON deriving (Eq, Ord, Show, Read, Generic, Typeable)
60+data AltMedia = AltMedia deriving (Eq, Ord, Show, Read, Generic, Typeable)
6561data Multipart = Multipart deriving (Eq, Ord, Show, Read, Generic, Typeable)
6662
63+instance ToHttpApiData AltJSON where toQueryParam = const "json"
64+instance ToHttpApiData AltMedia where toQueryParam = const "media"
6765instance ToHttpApiData Multipart where toQueryParam = const "multipart"
6866
6967newtype OAuthScope = OAuthScope Text
@@ -157,7 +155,7 @@ newtype ServiceId = ServiceId Text
157155 )
158156
159157newtype MediaDownload a = MediaDownload a
160−data MediaUpload a = MediaUpload a Part
158+data MediaUpload a = MediaUpload a Body
161159
162160_Coerce :: (Coercible a b, Coercible b a) => Iso' a b
163161_Coerce = iso coerce coerce
@@ -265,28 +263,27 @@ serviceSecure = lens _svcSecure (\s a -> s { _svcSecure = a })
265263serviceTimeout :: Lens' ServiceConfig (Maybe Seconds)
266264serviceTimeout = lens _svcTimeout (\s a -> s { _svcTimeout = a })
267265
268−-- | A single part of a multipart message.
269−data Part = Part MediaType [(HeaderName, ByteString)] RequestBody
266+-- | A single part of a (potentially multipart) request body.
267+data Body = Body !MediaType !RequestBody
270268
271−data Payload
272− = Body !MediaType !RequestBody
273− | Related ![Part]
269+setMIMEType :: MediaType -> Body -> Body
270+setMIMEType m (Body _ b) = Body m b
274271
275272-- | An intermediary request builder.
276273data Request = Request
277274 { _rqPath :: !Builder
278275 , _rqQuery :: !(DList (ByteString, Maybe ByteString))
279276 , _rqHeaders :: !(DList (HeaderName, ByteString))
280− , _rqBody :: !(Maybe Payload)
277+ , _rqBody :: ![Body]
281278 }
282279
283280instance Monoid Request where
284− mempty = Request mempty mempty mempty Nothing
281+ mempty = Request mempty mempty mempty mempty
285282 mappend a b = Request
286− (_rqPath a <> "/" <> _rqPath b)
287− (_rqQuery a <> _rqQuery b)
288− (_rqHeaders a <> _rqHeaders b)
289− (_rqBody b <|> _rqBody a)
283+ (_rqPath a <> "/" <> _rqPath b)
284+ (_rqQuery a <> _rqQuery b)
285+ (_rqHeaders a <> _rqHeaders b)
286+ (_rqBody b <> _rqBody a)
290287
291288appendPath :: Request -> Builder -> Request
292289appendPath rq x = rq { _rqPath = _rqPath rq <> "/" <> x }
@@ -305,11 +302,8 @@ appendHeader rq k (Just v) = rq
305302 { _rqHeaders = DList.snoc (_rqHeaders rq) (k, Text.encodeUtf8 v)
306303 }
307304
308−setBody :: Request -> MediaType -> RequestBody -> Request
309−setBody rq c x = rq { _rqBody = Just (Body c x) }
310−
311−setRelated :: Request -> [Part] -> Request
312−setRelated rq ps = rq { _rqBody = Just (Related ps) }
305+setBody :: Request -> [Body] -> Request
306+setBody rq bs = rq { _rqBody = bs }
313307
314308-- | A materialised 'http-client' request and associated response parser.
315309data Client a = Client
@@ -357,25 +351,22 @@ client f cs m ns rq s = Client
357351 }
358352
359353class Accept c => ToBody c a where
360− toBody :: Proxy c -> a -> RequestBody
361−
362−instance ToBody OctetStream RequestBody where
363− toBody Proxy = id
354+ toBody :: Proxy c -> a -> Body
364355
365356instance ToBody OctetStream ByteString where
366− toBody Proxy = RequestBodyBS
357+ toBody p = Body (contentType p) . RequestBodyBS
367358
368359instance ToBody OctetStream LBS.ByteString where
369− toBody Proxy = RequestBodyLBS
360+ toBody p = Body (contentType p) . RequestBodyLBS
370361
371362instance ToBody PlainText ByteString where
372− toBody Proxy = RequestBodyBS
363+ toBody p = Body (contentType p) . RequestBodyBS
373364
374365instance ToBody PlainText LBS.ByteString where
375− toBody Proxy = RequestBodyLBS
366+ toBody p = Body (contentType p) . RequestBodyLBS
376367
377368instance ToJSON a => ToBody JSON a where
378− toBody Proxy = RequestBodyLBS . encode
369+ toBody p = Body (contentType p) . RequestBodyLBS . encode
379370
380371class Accept c => FromStream c a where
381372 fromStream :: Proxy c
@@ -417,13 +408,18 @@ data MultipartRelated (cs :: [*]) m
417408instance ( ToBody c m
418409 , GoogleClient fn
419410 ) => GoogleClient (MultipartRelated (c ': cs) m :> fn) where
420− type Fn (MultipartRelated (c ': cs) m :> fn) = m -> Part -> Fn fn
411+ type Fn (MultipartRelated (c ': cs) m :> fn) = m -> Body -> Fn fn
421412
422413 buildClient Proxy rq m b =
423414 buildClient (Proxy :: Proxy fn) $
424− setRelated rq [Part (contentType mc) [] (toBody mc m), b]
425− where
426− mc = Proxy :: Proxy c
415+ setBody rq [toBody (Proxy :: Proxy c) m, b]
416+
417+instance GoogleClient fn => GoogleClient (AltMedia :> fn) where
418+ type Fn (AltMedia :> fn) = Body -> Fn fn
419+
420+ buildClient Proxy rq b =
421+ buildClient (Proxy :: Proxy fn) $
422+ setBody rq [b]
427423
428424instance (KnownSymbol s, GoogleClient fn) => GoogleClient (s :> fn) where
429425 type Fn (s :> fn) = Fn fn
@@ -513,11 +509,9 @@ instance ( ToBody c a
513509 ) => GoogleClient (ReqBody (c ': cs) a :> fn) where
514510 type Fn (ReqBody (c ': cs) a :> fn) = a -> Fn fn
515511
516− buildClient Proxy rq = buildClient (Proxy :: Proxy fn)
517− . setBody rq (contentType p)
518− . toBody p
519− where
520− p = Proxy :: Proxy c
512+ buildClient Proxy rq x =
513+ buildClient (Proxy :: Proxy fn) $
514+ setBody rq [toBody (Proxy :: Proxy c) x]
521515
522516instance {-# OVERLAPPABLE #-}
523517 FromStream c a => GoogleClient (Get (c ': cs) a) where