@@ -23,35 +23,35 @@
2323module Network.Google.Types where
2424
2525import Control.Applicative
26−import Control.Exception.Lens (exception)
27−import Control.Lens hiding (coerce)
26+import Control.Exception.Lens (exception)
27+import Control.Lens hiding (coerce)
2828import Control.Monad
2929import Control.Monad.Catch
3030import Control.Monad.Trans.Resource
3131import Data.Aeson
32−import Data.ByteString (ByteString)
33−import qualified Data.ByteString.Char8 as BS8
34−import qualified Data.ByteString.Lazy as LBS
35−import qualified Data.CaseInsensitive as CI
32+import Data.ByteString (ByteString)
33+import qualified Data.ByteString.Char8 as BS8
34+import qualified Data.ByteString.Lazy as LBS
35+import qualified Data.CaseInsensitive as CI
3636import Data.Coerce
3737import Data.Conduit
38−import qualified Data.Conduit.List as CL
38+import qualified Data.Conduit.List as CL
3939import Data.Data
40−import Data.DList (DList)
41−import qualified Data.DList as DList
42−import Data.Foldable (foldl')
40+import Data.DList (DList)
41+import qualified Data.DList as DList
42+import Data.Foldable (foldl')
4343import Data.Monoid
4444import Data.String
45−import Data.Text (Text)
46−import qualified Data.Text.Encoding as Text
47−import Data.Text.Lazy.Builder (Builder)
48−import qualified Data.Text.Lazy.Builder as Build
45+import Data.Text (Text)
46+import qualified Data.Text.Encoding as Text
47+import Data.Text.Lazy.Builder (Builder)
48+import qualified Data.Text.Lazy.Builder as Build
4949import GHC.Generics
5050import GHC.TypeLits
51−import Network.HTTP.Client (HttpException)
52−import Network.HTTP.Media hiding (Accept)
53−import Network.HTTP.Types hiding (Header)
54−import qualified Network.HTTP.Types as HTTP
51+import Network.HTTP.Client (HttpException)
52+import Network.HTTP.Media hiding (Accept)
53+import Network.HTTP.Types hiding (Header)
54+import qualified Network.HTTP.Types as HTTP
5555import Servant.API
5656
5757data AltJSON = AltJSON
@@ -199,21 +199,28 @@ serviceSecure = lens _svcSecure (\s a -> s { _svcSecure = a })
199199serviceTimeout :: Lens' Service (Maybe Seconds)
200200serviceTimeout = lens _svcTimeout (\s a -> s { _svcTimeout = a })
201201
202+-- | A single part of a multipart message.
203+data Part = Part MediaType [(HeaderName, ByteString)] Body
204+
205+data Payload
206+ = Body !MediaType !Body
207+ | Related ![Part]
208+
202209-- | An intermediary request builder.
203210data Request = Request
204− { _rqPath :: Builder
205− , _rqQuery :: DList (ByteString, Maybe ByteString)
206− , _rqHeaders :: DList (HeaderName, ByteString)
207− , _rqBody :: Maybe (MediaType, Body)
211+ { _rqPath :: !Builder
212+ , _rqQuery :: !(DList (ByteString, Maybe ByteString))
213+ , _rqHeaders :: !(DList (HeaderName, ByteString))
214+ , _rqBody :: !(Maybe Payload)
208215 }
209216
210217instance Monoid Request where
211218 mempty = Request mempty mempty mempty Nothing
212219 mappend a b = Request
213− (_rqPath a <> "/" <> _rqPath b)
214− (_rqQuery a <> _rqQuery b)
215− (_rqHeaders a <> _rqHeaders b)
216− (_rqBody b <|> _rqBody a)
220+ (_rqPath a <> "/" <> _rqPath b)
221+ (_rqQuery a <> _rqQuery b)
222+ (_rqHeaders a <> _rqHeaders b)
223+ (_rqBody b <|> _rqBody a)
217224
218225appendPath :: Request -> Builder -> Request
219226appendPath rq x = rq { _rqPath = _rqPath rq <> "/" <> x }
@@ -233,16 +240,19 @@ appendHeader rq k (Just v) = rq
233240 }
234241
235242setBody :: Request -> MediaType -> Body -> Request
236−setBody rq c x = rq { _rqBody = Just (c, x) }
243+setBody rq c x = rq { _rqBody = Just (Body c x) }
244+
245+setRelated :: Request -> [Part] -> Request
246+setRelated rq ps = rq { _rqBody = Just (Related ps) }
237247
238248-- | A materialised 'http-client' request and associated response parser.
239249data Client a = Client
240− { _cliAccept :: Maybe MediaType
241− , _cliMethod :: Method
242− , _cliCheck :: Status -> Bool
243− , _cliService :: Service
244− , _cliRequest :: Request
245− , _cliResponse :: Stream -> ResourceT IO (Either String a)
250+ { _cliAccept :: !(Maybe MediaType)
251+ , _cliMethod :: !Method
252+ , _cliCheck :: !(Status -> Bool)
253+ , _cliService :: !Service
254+ , _cliRequest :: !Request
255+ , _cliResponse :: !(Stream -> ResourceT IO (Either String a))
246256 }
247257
248258clientService :: Lens' (Client a) Service
@@ -321,55 +331,20 @@ data CaptureMode (s :: Symbol) (m :: Symbol) a
321331data MultipartRelated (cs :: [*]) m b
322332 deriving (Typeable)
323333
324−instance ( MimeRender c m
334+instance ( ToBody c m
335+ , ToBody OctetStream b
325336 , GoogleClient fn
326337 ) => GoogleClient (MultipartRelated (c ': cs) m b :> fn) where
327338 type Fn (MultipartRelated (c ': cs) m b :> fn) = m -> b -> Fn fn
328339
329− -- requestBuild Proxy rq m b = requestBuild (Proxy :: Proxy fn) $
330− -- mimeRender p m
331− -- mimeRender (Proxy :: Proxy OctetStream) b
332− -- where
333− -- p = Proxy :: Proxy c
334−
335−-- POST /upload/drive/v2/files?uploadType=multipart HTTP/1.1
336−-- Host: www.googleapis.com
337−-- Authorization: Bearer your_auth_token
338−-- Content-Type: multipart/related; boundary="foo_bar_baz"
339−-- Content-Length: number_of_bytes_in_entire_request_body
340−--
341−-- --foo_bar_baz
342−-- Content-Type: application/json; charset=UTF-8
343−-- {
344−-- "title": "My File"
345−-- }
346−-- --foo_bar_baz
347−-- Content-Type: image/jpeg
348−-- JPEG data
349−-- --foo_bar_baz--
350−
351−-- "mediaType" param also comes/calculated from the request body?
352−--
353−-- Resumable endpoints - Not supported to begin with, need to figure
354−-- out how to return session id etc.
355−--
356−-- Assume initially that every service supports multipart upload.
357−--
358−-- When downloading media you must set the alt query parameter
359−-- to media in the request URL.
360−--
361−-- "resumable" or "multipart" needs to go into the "uploadType" param
362−--
363−
364−-- if c.protocol_ == "resumable" {
365−-- if c.mediaType_ == "" {
366−-- c.mediaType_ = googleapi.DetectMediaType(c.resumable_)
367−-- }
368−-- req.Header.Set("X-Upload-Content-Type", c.mediaType_)
369−-- req.Header.Set("Content-Type", "application/json; charset=utf-8")
370−-- } else {
371−-- req.Header.Set("Content-Type", ctype)
372−-- }
340+ buildClient Proxy rq m b = buildClient (Proxy :: Proxy fn) $
341+ setRelated rq
342+ [ Part (contentType mc) [] (toBody mc m)
343+ , Part (contentType mb) [] (toBody mb b)
344+ ]
345+ where
346+ mc = Proxy :: Proxy c
347+ mb = Proxy :: Proxy OctetStream
373348
374349instance (KnownSymbol s, GoogleClient fn) => GoogleClient (s :> fn) where
375350 type Fn (s :> fn) = Fn fn