git.iko.soy/gogol
on develop help sign in
Merge branch 'feature/error-context' into develop
b5d64b4Brendan Hay
gogol/gogol.cabal+1
compare with develop
unifiedsplit
@@ -61,6 +61,7 @@ library
61 , base >= 4.7
61 , base >= 4.7
62 , bytestring >= 0.9
62 , bytestring >= 0.9
63 , case-insensitive >= 1.2
63 , case-insensitive >= 1.2
64+ , conduit >= 1.1
64 , conduit-extra >= 1.1
65 , conduit-extra >= 1.1
65 , cryptonite >= 0.6
66 , cryptonite >= 0.6
66 , data-default-class >= 0.0.1
67 , data-default-class >= 0.0.1
gogol/src/Network/Google/Internal/HTTP.hs+16−9
@@ -19,6 +19,9 @@ import Control.Lens ((%~), (&))
19import Control.Monad.Catch
19import Control.Monad.Catch
20import Control.Monad.IO.Class (MonadIO)
20import Control.Monad.IO.Class (MonadIO)
21import Control.Monad.Trans.Resource (MonadResource (..))
21import Control.Monad.Trans.Resource (MonadResource (..))
22+import qualified Data.ByteString.Lazy as LBS
23+import Data.Conduit (($$+-))
24+import qualified Data.Conduit.List as Conduit
22import Data.Default.Class (Default (..))
25import Data.Default.Class (Default (..))
23import Data.Monoid (Dual (..), Endo (..), (<>))
26import Data.Monoid (Dual (..), Endo (..), (<>))
24import qualified Data.Text.Encoding as Text
27import qualified Data.Text.Encoding as Text
@@ -64,6 +67,8 @@ perform Env{..} x = catches go handlers
64
67
65 logDebug _envLogger rs -- debug:ClientResponse
68 logDebug _envLogger rs -- debug:ClientResponse
66
69
70+ statusCheck rs
71+
67 r <- _cliResponse (responseBody rs)
72 r <- _cliResponse (responseBody rs)
68
73
69 pure $! case r of
74 pure $! case r of
@@ -80,7 +85,7 @@ perform Env{..} x = catches go handlers
80 { Client.host = _svcHost
85 { Client.host = _svcHost
81 , Client.port = _svcPort
86 , Client.port = _svcPort
82 , Client.secure = _svcSecure
87 , Client.secure = _svcSecure
83− , Client.checkStatus = status
88+ , Client.checkStatus = \_ _ _ -> Nothing
84 , Client.responseTimeout = timeout
89 , Client.responseTimeout = timeout
85 , Client.method = _cliMethod
90 , Client.method = _cliMethod
86 , Client.path = path
91 , Client.path = path
@@ -97,14 +102,16 @@ perform Env{..} x = catches go handlers
97 . LText.toStrict
102 . LText.toStrict
98 $ Build.toLazyText (_svcPath <> _rqPath)
103 $ Build.toLazyText (_svcPath <> _rqPath)
99
104
100− status s hs _
105+ statusCheck rs
101− | _cliCheck s = Nothing
106+ | _cliCheck (responseStatus rs) = pure ()
107+ | otherwise = do
108+ b <- LBS.fromChunks <$> (responseBody rs $$+- Conduit.consume)
102− | otherwise = Just . toException . ServiceError $ ServiceError'
109+ throwM . toException . ServiceError $ ServiceError'
103− { _serviceId = _svcId
110+ { _serviceId = _svcId
104− , _serviceStatus = s
111+ , _serviceStatus = responseStatus rs
105− , _serviceHeaders = hs
112+ , _serviceHeaders = responseHeaders rs
106− , _serviceBody = Nothing
113+ , _serviceBody = Just b
107− }
114+ }
108
115
109 timeout = microseconds <$> _svcTimeout
116 timeout = microseconds <$> _svcTimeout
110
117