git.iko.soy/gogol
on develop help sign in
Adding serialisation errors
commit1535b357a2f2fa024b030255fe1e95a8086d395b authorBrendan Hay <brendan.g.hay@gmail.com> dateMon 12 Oct 2015, 13:12 (11 years ago) parent33c8c76
2 files changed+45−65
compare with develop
unifiedsplit
core/src/Network/Google/Types.hs+7−64 gogol/src/Network/Google/Internal/HTTP.hs+38−1
core/src/Network/Google/Types.hs+7−64
@@ -23,6 +23,7 @@
2323module Network.Google.Types where
2424
2525import Control.Lens hiding (coerce)
26+import Control.Monad
2627import Control.Monad.Catch
2728import Control.Monad.Trans.Resource
2829import Data.Aeson
@@ -200,26 +201,16 @@ data Client a = Client
200201 , _cliCheck :: Status -> Bool
201202 , _cliService :: Service
202203 , _cliRequest :: Request
203− , _cliResponse :: Stream -> ResourceT IO (Either SerializeError a)
204+ , _cliResponse :: Stream -> ResourceT IO (Either String a)
204205 }
205206
206−mime :: FromStream c a
207− => Proxy c
208− -> Method
209− -> [Int]
210− -> Request
211− -> Service
212− -> Client a
207+mime :: FromStream c a => Proxy c -> Method -> [Int] -> Request -> Service -> Client a
213208mime p = client (fromStream p) (Just (contentType p))
214209
215−discard :: Method
216− -> [Int]
217− -> Request
218− -> Service
219− -> Client ()
210+discard :: Method -> [Int] -> Request -> Service -> Client ()
220211discard = client (\b -> closeResumableSource b >> pure (Right ())) Nothing
221212
222−client :: (Stream -> ResourceT IO (Either SerializeError a))
213+client :: (Stream -> ResourceT IO (Either String a))
223214 -> Maybe MediaType
224215 -> Method
225216 -> [Int]
@@ -253,19 +244,13 @@ instance ToBody JSON Value where
253244 toBody Proxy = RequestBodyLBS . encode
254245
255246class Accept c => FromStream c a where
256− fromStream :: Proxy c
257− -> Stream
258− -> ResourceT IO (Either SerializeError a)
247+ fromStream :: Proxy c -> Stream -> ResourceT IO (Either String a)
259248
260249instance FromStream OctetStream Stream where
261250 fromStream Proxy = pure . Right
262251
263252instance FromJSON a => FromStream JSON a where
264− fromStream Proxy b = do
265− lbs <- sinkLBS b
266− case eitherDecode lbs of
267− Left e -> undefined
268− Right x -> pure (Right x)
253+ fromStream Proxy = sinkLBS >=> pure . eitherDecode
269254
270255class GoogleAuth a where
271256 _AuthKey :: Traversal' a AuthKey
@@ -496,48 +481,6 @@ instance {-# OVERLAPPING #-}
496481
497482 buildClient Proxy = discard methodDelete [204]
498483
499−-- perform :: Accept
500−-- -> (Stream -> Client (Either SerializeError a))
501−-- -> Method
502−-- -> [Int]
503−-- -> Request
504−-- -> Client a
505−-- perform a meth ns f rq = undefined -- do
506− -- m <- ask
507− -- x <- lift . try $ Client.http m (client meth a rq)
508− -- either (failure . TransportError) success x
509− -- where
510− -- failure = pure . Left
511−
512− -- success rs = do
513− -- let s = Client.responseStatus rs
514− -- b = Client.responseBody rs
515− -- hs = Client.responseHeaders rs
516− -- case content hs of
517− -- unless (matches respCT (acceptCT)) $
518− -- left $ UnsupportedContentType respCT respBody
519−
520− -- Nothing -> failure (SerializeError' (SerializeError hs))
521−
522− -- Just _ | statusInvalid s -> do
523− -- lbs <- sinkLBS b
524− -- failure (ServiceError' (ServiceError s c hs lbs))
525−
526− -- Just c | contentInvalid c -> do
527− -- lbs <- sinkLBS b
528− -- failure (SerializeError' (SerializeError s c hs lbs))
529−
530−
531− -- Just c -> first SerializeError' <$> f b
532−
533− -- content :: [Header] -> Maybe c
534− -- content = parseAccept
535− -- . fromMaybe "application/octet-stream"
536− -- . lookup hContentType
537−
538− -- statusCheck s = fromEnum s `elem` ns
539− -- contentCheck = matches a
540−
541484sinkLBS :: Stream -> ResourceT IO LBS.ByteString
542485sinkLBS = fmap LBS.fromChunks . ($$+- CL.consume)
543486
gogol/src/Network/Google/Internal/HTTP.hs+38−1
@@ -47,7 +47,15 @@ perform Env{..} x = catches go handlers
4747 where
4848 go = liftResourceT $ do
4949 rs <- http rq _envManager
50− first SerializeError <$> _cliResponse (responseBody rs)
50+ r <- _cliResponse (responseBody rs)
51+ pure $! case r of
52+ Right y -> Right y
53+ Left e -> Left . SerializeError $ SerializeError'
54+ { _serializeId = _svcId
55+ , _serializeHeaders = responseHeaders rs
56+ , _serializeStatus = responseStatus rs
57+ , _serializeMessage = e
58+ }
5159
5260 rq = def
5361 { Client.host = _svcHost
@@ -98,3 +106,32 @@ perform Env{..} x = catches go handlers
98106 ]
99107 where
100108 err e = return (Left e) -- logError _envLogger e >>
109+
110+ -- success rs = do
111+ -- let s = Client.responseStatus rs
112+ -- b = Client.responseBody rs
113+ -- hs = Client.responseHeaders rs
114+ -- case content hs of
115+ -- unless (matches respCT (acceptCT)) $
116+ -- left $ UnsupportedContentType respCT respBody
117+
118+ -- Nothing -> failure (SerializeError' (SerializeError hs))
119+
120+ -- Just _ | statusInvalid s -> do
121+ -- lbs <- sinkLBS b
122+ -- failure (ServiceError' (ServiceError s c hs lbs))
123+
124+ -- Just c | contentInvalid c -> do
125+ -- lbs <- sinkLBS b
126+ -- failure (SerializeError' (SerializeError s c hs lbs))
127+
128+
129+ -- Just c -> first SerializeError' <$> f b
130+
131+ -- content :: [Header] -> Maybe c
132+ -- content = parseAccept
133+ -- . fromMaybe "application/octet-stream"
134+ -- . lookup hContentType
135+
136+ -- statusCheck s = fromEnum s `elem` ns
137+ -- contentCheck = matches a