on develop help sign in
Removing extraneous comments
847dacfBrendan Hay
gogol/gogol.cabal+10−11
@@ -36,22 +36,21 @@ library
36 , Network.Google.Internal.Types
36 , Network.Google.Internal.Types
37
37
38 build-depends:
38 build-depends:
39− base >= 4.7 && < 5
39+ base >= 4.7 && < 5
40+ , bifunctors
41+ , conduit
42+ , data-default-class >= 0.0.1
40 , exceptions
43 , exceptions
41− , gogol-core == 0.0.1.*
44+ , gogol-core == 0.0.1.*
42 , http-conduit
45 , http-conduit
46+ , http-media
47+ , http-types
43 , lens
48 , lens
49+ , mmorph
44 , monad-control
50 , monad-control
45 , mtl
51 , mtl
46 , resourcet
52 , resourcet
47− , retry
53+ , text
48 , time
54 , time
49 , transformers
55 , transformers
50− , data-default-class >= 0.0.1
51− , transformers-base
56+ , transformers-base
52− , http-types
53− , http-media
54− , text
55− , mmorph
56− , conduit
57− , bifunctors
gogol/src/Network/Google/Env.hs+9−27
@@ -15,7 +15,6 @@ import Control.Monad
15import Control.Monad.Catch
15import Control.Monad.Catch
16import Control.Monad.IO.Class
16import Control.Monad.IO.Class
17import Control.Monad.Reader
17import Control.Monad.Reader
18−import Control.Retry
19import Data.Monoid
18import Data.Monoid
20import Network.Google.Auth
19import Network.Google.Auth
21import Network.Google.Internal.Types
20import Network.Google.Internal.Types
@@ -35,48 +34,33 @@ data Env = Env
35-- total field initialisation.
34-- total field initialisation.
36
35
37class HasEnv a where
36class HasEnv a where
38− environment :: Lens' a Env
37+ environment :: Lens' a Env
39 {-# MINIMAL environment #-}
38 {-# MINIMAL environment #-}
40
39
41− -- -- | The function used to determine if an 'HttpException' should be retried.
42− -- envRetryCheck :: Lens' a (Int -> HttpException -> Bool)
43−
44− -- -- | TODO
45− -- envRetryPolicy :: Lens' a RetryPolicy
46−
47 -- | TODO
40 -- | TODO
48− envTimeout :: Lens' a (Maybe Seconds)
41+ envTimeout :: Lens' a (Maybe Seconds)
49
42
50 -- | The 'Manager' used to create and manage open HTTP connections.
43 -- | The 'Manager' used to create and manage open HTTP connections.
51− envManager :: Lens' a Manager
44+ envManager :: Lens' a Manager
52
45
53 -- | The credentials used to sign requests for authentication with Google.
46 -- | The credentials used to sign requests for authentication with Google.
54− envAuth :: Lens' a Auth
47+ envAuth :: Lens' a Auth
55
48
56− -- envRetryCheck = environment . lens _envRetryCheck (\s a -> s { _envRetryCheck = a })
57− -- envRetryPolicy = environment . lens _envRetryPolicy (\s a -> s { _envRetryPolicy = a })
58− envTimeout = environment . lens _envTimeout (\s a -> s { _envTimeout = a })
49+ envTimeout = environment . lens _envTimeout (\s a -> s { _envTimeout = a })
59− envManager = environment . lens _envManager (\s a -> s { _envManager = a })
50+ envManager = environment . lens _envManager (\s a -> s { _envManager = a })
60− envAuth = environment . lens _envAuth (\s a -> s { _envAuth = a })
51+ envAuth = environment . lens _envAuth (\s a -> s { _envAuth = a })
61
52
62instance HasEnv Env where
53instance HasEnv Env where
63 environment = id
54 environment = id
64
55
65−-- -- | Scope an action such that any retry logic for the 'Env' is
66−-- -- ignored and any requests will at most be sent once.
67−-- once :: (MonadReader r m, HasEnv r) => m a -> m a
68−-- once = policy (limitRetries 0)
69−
70−-- -- | TODO
71−-- policy :: (MonadReader r m, HasEnv r) => RetryPolicy -> m a -> m a
72−-- policy r = local (envRetryPolicy <>~ r)
73−
74-- | Scope an action such that any HTTP response will use this timeout value.
56-- | Scope an action such that any HTTP response will use this timeout value.
75--
57--
76-- Default timeouts are chosen by considering:
58-- Default timeouts are chosen by considering:
77--
59--
78-- * This 'timeout', if set.
60-- * This 'timeout', if set.
79--
61--
62+-- * The related 'Service' timeout for the sent request if set. (Usually 70s)
63+--
80-- * The 'envManager' timeout if set.
64-- * The 'envManager' timeout if set.
81--
65--
82-- * The default 'ClientRequest' timeout. (Approximately 30s)
66-- * The default 'ClientRequest' timeout. (Approximately 30s)
@@ -94,5 +78,3 @@ newEnv c = liftIO (newManager conduitManagerSettings) >>= newEnvWith c
94-- | /See:/ 'newEnv'
78-- | /See:/ 'newEnv'
95newEnvWith :: (MonadIO m, MonadCatch m) => Credentials -> Manager -> m Env
79newEnvWith :: (MonadIO m, MonadCatch m) => Credentials -> Manager -> m Env
96newEnvWith c m = Env Nothing m <$> getAuth c
80newEnvWith c m = Env Nothing m <$> getAuth c
97− -- where
98− -- check _ _ = True
gogol/src/Network/Google/Internal/HTTP.hs+1−31
@@ -38,7 +38,6 @@ import qualified Network.HTTP.Conduit as Client
38import Network.HTTP.Media
38import Network.HTTP.Media
39import Network.HTTP.Types
39import Network.HTTP.Types
40
40
41−-- | The 'Service' is configured + unwrapped at this point.
42perform :: (MonadCatch m, MonadResource m, GoogleRequest a)
41perform :: (MonadCatch m, MonadResource m, GoogleRequest a)
43 => Env
42 => Env
44 -> a
43 -> a
@@ -105,33 +104,4 @@ perform Env{..} x = catches go handlers
105 , Handler $ err . TransportError
104 , Handler $ err . TransportError
106 ]
105 ]
107 where
106 where
108− err e = return (Left e) -- logError _envLogger e >>
107+ err e = return (Left 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