@@ -13,15 +13,17 @@ import Control.Lens
1313import Control.Monad.Catch
1414import Control.Monad.IO.Class
1515import Control.Monad.Reader
16+import Data.Function (on)
17+import Data.Monoid
1618import Network.Google.Auth
1719import Network.Google.Types
1820import Network.HTTP.Conduit
1921
2022-- | The environment containing the parameters required to make Google requests.
2123data Env = Env
22− { _envTimeout :: !(Maybe Seconds)
23− , _envManager :: !Manager
24− , _envAuth :: !Auth
24+ { _envOverride :: !(Dual (Endo Service))
25+ , _envManager :: !Manager
26+ , _envAuth :: !Auth
2527 }
2628
2729-- Note: The strictness annotations aobe are applied to ensure
@@ -31,8 +33,8 @@ class HasEnv a where
3133 environment :: Lens' a Env
3234 {-# MINIMAL environment #-}
3335
34− -- | TODO
35− envTimeout :: Lens' a (Maybe Seconds)
36+ -- | The currently applied overrides to all 'Service' configuration.
37+ envOverride :: Lens' a (Dual (Endo Service))
3638
3739 -- | The 'Manager' used to create and manage open HTTP connections.
3840 envManager :: Lens' a Manager
@@ -40,13 +42,45 @@ class HasEnv a where
4042 -- | The credentials used to sign requests for authentication with Google.
4143 envAuth :: Lens' a Auth
4244
43− envTimeout = environment . lens _envTimeout (\s a -> s { _envTimeout = a })
44− envManager = environment . lens _envManager (\s a -> s { _envManager = a })
45− envAuth = environment . lens _envAuth (\s a -> s { _envAuth = a })
45+ envOverride = environment . lens _envOverride (\s a -> s { _envOverride = a })
46+ envManager = environment . lens _envManager (\s a -> s { _envManager = a })
47+ envAuth = environment . lens _envAuth (\s a -> s { _envAuth = a })
4648
4749instance HasEnv Env where
4850 environment = id
4951
52+-- | Provide a function which will be added to the existing stack
53+-- of overrides applied to all service configuration.
54+--
55+-- To override a specific service, it's suggested you use
56+-- either 'configure' or 'reconfigure' with a modified version of the default
57+-- service, such as @Network.Google.Gmail.gmail@.
58+override :: HasEnv a => (Service -> Service) -> a -> a
59+override f = envOverride <>~ Dual (Endo f)
60+
61+-- | Configure a specific service. All requests belonging to the
62+-- supplied service will use this configuration instead of the default.
63+--
64+-- It's suggested you use a modified version of the default service, such
65+-- as @Network.Google.Gmail.gmail@.
66+--
67+-- /See:/ 'reconfigure'.
68+configure :: HasEnv a => Service -> a -> a
69+configure s = override f
70+ where
71+ f x | on (==) _svcId s x = s
72+ | otherwise = x
73+
74+-- | Scope an action such that all requests belonging to the supplied service
75+-- will use this configuration instead of the default.
76+--
77+-- It's suggested you use a modified version of the default service, such
78+-- as @Network.Google.Gmail.gmail@.
79+--
80+-- /See:/ 'configure'.
81+reconfigure :: (MonadReader r m, HasEnv r) => Service -> m a -> m a
82+reconfigure = local . configure
83+
5084-- | Scope an action such that any HTTP response will use this timeout value.
5185--
5286-- Default timeouts are chosen by considering:
@@ -59,7 +93,7 @@ instance HasEnv Env where
5993--
6094-- * The default 'ClientRequest' timeout. (Approximately 30s)
6195timeout :: (MonadReader r m, HasEnv r) => Seconds -> m a -> m a
62−timeout s = local (envTimeout ?~ s)
96+timeout s = local (override (serviceTimeout ?~ s))
6397
6498-- | Creates a new environment with a new 'Manager' without debug logging
6599-- and uses 'getAuth' to expand/discover the supplied 'Credentials'.
@@ -71,4 +105,4 @@ newEnv c = liftIO (newManager tlsManagerSettings) >>= newEnvWith c
71105
72106-- | /See:/ 'newEnv'
73107newEnvWith :: (MonadIO m, MonadCatch m) => Credentials -> Manager -> m Env
74−newEnvWith c m = Env Nothing m <$> getAuth m c
108+newEnvWith c m = Env mempty m <$> getAuth m c