git.iko.soy/gogol
on develop help sign in
Updating naming of overly long module
05f8e7fBrendan Hay
gogol/gogol.cabal+1−1
compare with develop
unifiedsplit
@@ -41,7 +41,7 @@ library
41 exposed-modules:
41 exposed-modules:
42 Network.Google
42 Network.Google
43 , Network.Google.Auth
43 , Network.Google.Auth
44− , Network.Google.Auth.ApplicationDefaultCredentials
44+ , Network.Google.Auth.ApplicationDefault
45 , Network.Google.Auth.Device
45 , Network.Google.Auth.Device
46 , Network.Google.Auth.InstalledApplication
46 , Network.Google.Auth.InstalledApplication
47 , Network.Google.Auth.ServiceAccount
47 , Network.Google.Auth.ServiceAccount
gogol/src/Network/Google.hs+176−143
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -23,71 +24,71 @@
23-- A 'MonadGoogle' typeclass is used as a function constraint to provide automatic
24-- A 'MonadGoogle' typeclass is used as a function constraint to provide automatic
24-- lifting of functions when embedding 'Google' as a layer inside your own
25-- lifting of functions when embedding 'Google' as a layer inside your own
25-- application stack.
26-- application stack.
26−module Network.Google
27+module Network.Google where
27− (
28+ -- (
28− -- * Running Google Actions
29+ -- -- * Running Google Actions
29− Google (..)
30+ -- Google (..)
30− , MonadGoogle (..)
31+ -- , MonadGoogle (..)
31− , runGoogle
32+ -- , runGoogle
32− , runResourceT
33+ -- , runResourceT
33
34
34− -- * Authentication and Environment
35+ -- -- * Authentication and Environment
35− , newEnv
36+ -- , newEnv
36− , Env
37+ -- , Env
37− , HasEnv (..)
38+ -- , HasEnv (..)
38
39
39− -- * Sending Requests
40+ -- -- * Sending Requests
40− , send
41+ -- , send
41
42
42− -- ** Media Downloads
43+ -- -- ** Media Downloads
43− , download
44+ -- , download
44
45
45− -- ** Media Uploads
46+ -- -- ** Media Uploads
46− , upload
47+ -- , upload
47
48
48− , ToBody (..)
49+ -- , ToBody (..)
49− , RequestBody
50+ -- , RequestBody
50− , sourceBody
51+ -- , sourceBody
51
52
52− -- ** Service Configuration
53+ -- -- ** Service Configuration
53− -- ** Overriding Defaults
54+ -- -- ** Overriding Defaults
54− , configure
55+ -- , configure
55− , override
56+ -- , override
56
57
57− -- *** Scoped Actions
58+ -- -- *** Scoped Actions
58− , reconfigure
59+ -- , reconfigure
59− , timeout
60+ -- , timeout
60
61
61− -- * Running Asynchronous Actions
62+ -- -- * Running Asynchronous Actions
62− -- $async
63+ -- -- $async
63
64
64− -- * Handling Errors
65+ -- -- * Handling Errors
65− , AsError (..)
66+ -- , AsError (..)
66− , AsAuthError (..)
67+ -- , AsAuthError (..)
67
68
68− , trying
69+ -- , trying
69− , catching
70+ -- , catching
70
71
71− -- * Logging
72+ -- -- * Logging
72− -- $logging
73+ -- -- $logging
73
74
74− , Logger
75+ -- , Logger
75− , LogLevel (..)
76+ -- , LogLevel (..)
76
77
77− -- ** Constructing a Logger
78+ -- -- ** Constructing a Logger
78− , newLogger
79+ -- , newLogger
79
80
80− -- * Constructing a HTTP Manager
81+ -- -- * Constructing a HTTP Manager
81− , newManager
82+ -- , newManager
82− , tlsManagerSettings
83+ -- , tlsManagerSettings
83
84
84− -- * Re-exported Types
85+ -- -- * Re-exported Types
85− , Proxy (..)
86+ -- , Proxy (..)
86− , OctetStream
87+ -- , OctetStream
87− , PlainText
88+ -- , PlainText
88− , JSON
89+ -- , JSON
89− , module Network.Google.Types
90+ -- , module Network.Google.Types
90− ) where
91+ -- ) where
91
92
92import Control.Applicative
93import Control.Applicative
93import Control.Exception.Lens
94import Control.Exception.Lens
@@ -116,7 +117,7 @@ import Network.Google.Prelude
116import Network.Google.Types
117import Network.Google.Types
117import Network.HTTP.Conduit (newManager, tlsManagerSettings)
118import Network.HTTP.Conduit (newManager, tlsManagerSettings)
118
119
119−newtype Google a = Google { unGoogle :: ReaderT Env (ResourceT IO) a }
120+newtype Google s a = Google { unGoogle :: ReaderT (Env s) (ResourceT IO) a }
120 deriving
121 deriving
121 ( Functor
122 ( Functor
122 , Applicative
123 , Applicative
@@ -128,99 +129,131 @@ newtype Google a = Google { unGoogle :: ReaderT Env (ResourceT IO) a }
128 , MonadCatch
129 , MonadCatch
129 , MonadMask
130 , MonadMask
130 , MonadBase IO
131 , MonadBase IO
131− , MonadReader Env
132+-- , MonadReader (Env s)
132 , MonadResource
133 , MonadResource
133 )
134 )
134
135
135−instance MonadBaseControl IO Google where
136− type StM Google a = StM (ReaderT Env (ResourceT IO)) a
137−
138− liftBaseWith f = Google . liftBaseWith $ \g -> f (g . unGoogle)
139− restoreM = Google . restoreM
140−
141−-- | Monads in which 'Google' actions may be embedded.
142−class ( Functor m
143− , Applicative m
144− , Monad m
145− , MonadIO m
146− , MonadCatch m
147− ) => MonadGoogle m where
148− -- | Lift a computation to the 'Google' monad.
149− liftGoogle :: Google a -> m a
150−
151−instance MonadGoogle Google where
152− liftGoogle = id
153−
154−instance MonadGoogle m => MonadGoogle (IdentityT m) where liftGoogle = lift . liftGoogle
155−instance MonadGoogle m => MonadGoogle (ListT m) where liftGoogle = lift . liftGoogle
156−instance MonadGoogle m => MonadGoogle (MaybeT m) where liftGoogle = lift . liftGoogle
157−instance MonadGoogle m => MonadGoogle (ExceptT e m) where liftGoogle = lift . liftGoogle
158−instance MonadGoogle m => MonadGoogle (ReaderT r m) where liftGoogle = lift . liftGoogle
159−instance MonadGoogle m => MonadGoogle (S.StateT s m) where liftGoogle = lift . liftGoogle
160−instance MonadGoogle m => MonadGoogle (LS.StateT s m) where liftGoogle = lift . liftGoogle
161−
162−instance (Monoid w, MonadGoogle m) => MonadGoogle (W.WriterT w m) where
163− liftGoogle = lift . liftGoogle
164−
165−instance (Monoid w, MonadGoogle m) => MonadGoogle (LW.WriterT w m) where
166− liftGoogle = lift . liftGoogle
167−
168−instance (Monoid w, MonadGoogle m) => MonadGoogle (RW.RWST r w s m) where
169− liftGoogle = lift . liftGoogle
170−
171−instance (Monoid w, MonadGoogle m) => MonadGoogle (LRW.RWST r w s m) where
172− liftGoogle = lift . liftGoogle
173−
174-- | Run a 'Google' aciton using the specified environment.
136-- | Run a 'Google' aciton using the specified environment.
137+-- runGoogle :: (MonadResource m, HasEnv s r) => r -> Google s a -> m a
138+-- runGoogle e m = liftResourceT $ runReaderT (unGoogle m) (e ^. environment)
139+
140+runGoogle :: MonadResource m => Env s -> Google s a -> m a
141+runGoogle e m = liftResourceT $ runReaderT (unGoogle m) e
142+
143+test :: IO ()
144+test = runResourceT $ do
145+ e <- newEnv
146+ runGoogle e $ do
147+ Bar <- send Foo
148+ pure ()
149+
150+send :: (GoogleRequest a, IsSubList s (Ss a)) => a -> Google s (Rs a)
151+send = undefined
152+
153+-- do
154+ -- e <- ask
155+ -- r <- perform e x
156+ -- hoistError r
157+
158+data Foo = Foo
159+data Bar = Bar
160+
161+instance GoogleRequest Foo where
162+ type Rs Foo = Bar
163+ type Ss Foo = '[Foo]
164+
165+ requestClient = undefined
166+
167+
168+-- instance MonadBaseControl IO Google where
169+-- type StM Google a = StM (ReaderT Env (ResourceT IO)) a
170+
171+-- liftBaseWith f = Google . liftBaseWith $ \g -> f (g . unGoogle)
172+-- restoreM = Google . restoreM
173+
174+-- -- | Monads in which 'Google' actions may be embedded.
175+-- class ( Functor m
176+-- , Applicative m
177+-- , Monad m
178+-- , MonadIO m
179+-- , MonadCatch m
180+-- ) => MonadGoogle m where
181+-- -- | Lift a computation to the 'Google' monad.
182+-- liftGoogle :: Google a -> m a
183+
184+-- instance MonadGoogle Google where
185+-- liftGoogle = id
186+
187+-- instance MonadGoogle m => MonadGoogle (IdentityT m) where liftGoogle = lift . liftGoogle
188+-- instance MonadGoogle m => MonadGoogle (ListT m) where liftGoogle = lift . liftGoogle
189+-- instance MonadGoogle m => MonadGoogle (MaybeT m) where liftGoogle = lift . liftGoogle
190+-- instance MonadGoogle m => MonadGoogle (ExceptT e m) where liftGoogle = lift . liftGoogle
191+-- instance MonadGoogle m => MonadGoogle (ReaderT r m) where liftGoogle = lift . liftGoogle
192+-- instance MonadGoogle m => MonadGoogle (S.StateT s m) where liftGoogle = lift . liftGoogle
193+-- instance MonadGoogle m => MonadGoogle (LS.StateT s m) where liftGoogle = lift . liftGoogle
194+
195+-- instance (Monoid w, MonadGoogle m) => MonadGoogle (W.WriterT w m) where
196+-- liftGoogle = lift . liftGoogle
197+
198+-- instance (Monoid w, MonadGoogle m) => MonadGoogle (LW.WriterT w m) where
199+-- liftGoogle = lift . liftGoogle
200+
201+-- instance (Monoid w, MonadGoogle m) => MonadGoogle (RW.RWST r w s m) where
202+-- liftGoogle = lift . liftGoogle
203+
204+-- instance (Monoid w, MonadGoogle m) => MonadGoogle (LRW.RWST r w s m) where
205+-- liftGoogle = lift . liftGoogle
206+
207+-- -- | Run a 'Google' aciton using the specified environment.
175−runGoogle :: (MonadResource m, HasEnv r) => r -> Google a -> m a
208+-- runGoogle :: (MonadResource m, HasEnv r) => r -> Google a -> m a
176−runGoogle e m = liftResourceT $ runReaderT (unGoogle m) (e ^. environment)
209+-- runGoogle e m = liftResourceT $ runReaderT (unGoogle m) (e ^. environment)
177−
210+
178−-- | Send a request, returning the associated response if successful.
211+-- -- | Send a request, returning the associated response if successful.
179−--
212+-- --
180−-- Throws 'Error'.
213+-- -- Throws 'Error'.
181−send :: (MonadGoogle m, GoogleRequest a) => a -> m (Rs a)
214+-- send :: (MonadGoogle m, GoogleRequest a) => a -> m (Rs a)
182−send x = liftGoogle $ do
215+-- send x = liftGoogle $ do
183− e <- ask
216+-- e <- ask
184− r <- perform e x
217+-- r <- perform e x
185− hoistError r
218+-- hoistError r
186−
219+
187−-- | Send a request returning the associated streaming media response if successful.
220+-- -- | Send a request returning the associated streaming media response if successful.
188−--
221+-- --
189−-- Some request data types have two possible responses, the JSON metadata and
222+-- -- Some request data types have two possible responses, the JSON metadata and
190−-- a streaming media response. Use 'send' to retrieve the metadata and 'download'
223+-- -- a streaming media response. Use 'send' to retrieve the metadata and 'download'
191−-- to retrieve the streaming media.
224+-- -- to retrieve the streaming media.
192−--
225+-- --
193−-- Throws 'Error'.
226+-- -- Throws 'Error'.
194−download :: (MonadGoogle m, GoogleRequest (MediaDownload a))
227+-- download :: (MonadGoogle m, GoogleRequest (MediaDownload a))
195− => a
228+-- => a
196− -> m (Rs (MediaDownload a))
229+-- -> m (Rs (MediaDownload a))
197−download = send . MediaDownload
230+-- download = send . MediaDownload
198−
231+
199−-- | Send a request with an attached multipart/related media upload.
232+-- -- | Send a request with an attached multipart/related media upload.
200−--
233+-- --
201−-- Throws 'Error'.
234+-- -- Throws 'Error'.
202−upload :: (MonadGoogle m, GoogleRequest (MediaUpload a))
235+-- upload :: (MonadGoogle m, GoogleRequest (MediaUpload a))
203− => a
236+-- => a
204− -> RequestBody
237+-- -> RequestBody
205− -> m (Rs (MediaUpload a))
238+-- -> m (Rs (MediaUpload a))
206−upload x = send . MediaUpload x
239+-- upload x = send . MediaUpload x
207−
240+
208−hoistError :: MonadThrow m => Either Error a -> m a
241+-- hoistError :: MonadThrow m => Either Error a -> m a
209−hoistError = either (throwingM _Error) return
242+-- hoistError = either (throwingM _Error) return
210−
243+
211−{- $async
244+-- {- $async
212−Requests can be sent asynchronously, but due to guarantees about resource closure
245+-- Requests can be sent asynchronously, but due to guarantees about resource closure
213−require the use of <http://hackage.haskell.org/package/lifted-async lifted-async>.
246+-- require the use of <http://hackage.haskell.org/package/lifted-async lifted-async>.
214−-}
247+-- -}
215−
248+
216−{- $logging
249+-- {- $logging
217−The exposed logging interface is a primitive 'Logger' function which gets
250+-- The exposed logging interface is a primitive 'Logger' function which gets
218−threaded through service calls and serialisation routines. This allows the
251+-- threaded through service calls and serialisation routines. This allows the
219−library to output useful information and diagnostics.
252+-- library to output useful information and diagnostics.
220−
253+
221−The 'newLogger' function can be used to construct a simple logger which writes
254+-- The 'newLogger' function can be used to construct a simple logger which writes
222−output to a 'Handle', but in most production code you should probably consider
255+-- output to a 'Handle', but in most production code you should probably consider
223−using a more robust logging library such as
256+-- using a more robust logging library such as
224−<http://hackage.haskell.org/package/tiny-log tiny-log> or
257+-- <http://hackage.haskell.org/package/tiny-log tiny-log> or
225−<http://hackage.haskell.org/package/fast-logger fast-logger>.
258+-- <http://hackage.haskell.org/package/fast-logger fast-logger>.
226−-}
259+-- -}
gogol/src/Network/Google/Auth.hs+164−150
@@ -1,11 +1,20 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE UndecidableInstances #-}
3+{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE FunctionalDependencies #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10+{-# LANGUAGE KindSignatures #-}
6{-# LANGUAGE LambdaCase #-}
11{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE OverloadedStrings #-}
12{-# LANGUAGE OverloadedStrings #-}
13+{-# LANGUAGE PolyKinds #-}
8{-# LANGUAGE RecordWildCards #-}
14{-# LANGUAGE RecordWildCards #-}
15+{-# LANGUAGE ScopedTypeVariables #-}
16+{-# LANGUAGE TypeFamilies #-}
17+{-# LANGUAGE TypeOperators #-}
9
18
10-- |
19-- |
11-- Module : Network.Google.Auth
20-- Module : Network.Google.Auth
@@ -17,86 +26,86 @@
17--
26--
18-- Explicitly specify your Google credentials, or retrieve them
27-- Explicitly specify your Google credentials, or retrieve them
19-- from the underlying OS.
28-- from the underlying OS.
20−module Network.Google.Auth
29+module Network.Google.Auth where
21− (
30+ -- (
22− -- * Credentials
31+ -- -- * Credentials
23− Credentials (..)
32+ -- Credentials (..)
24−
33+
25− -- ** Application Default Credentials
34+ -- -- ** Application Default Credentials
26− , getApplicationDefault
35+ -- , getApplicationDefault
27− , fromWellKnownPath
36+ -- , fromWellKnownPath
28− , fromFilePath
37+ -- , fromFilePath
29−
38+
30− -- ** Installed Application Credentials
39+ -- -- ** Installed Application Credentials
31− , formURL
40+ -- , formURL
32−
41+
33− -- ** Authorizing Requests
42+ -- -- ** Authorizing Requests
34− , authorize
43+ -- , authorize
35−
44+
36− -- ** Thread-safe Storage
45+ -- -- ** Thread-safe Storage
37− , Store
46+ -- , Store
38− , initStore
47+ -- , initStore
39−
48+
40− , Auth (..)
49+ -- , Auth (..)
41− , exchange
50+ -- , exchange
42− , refresh
51+ -- , refresh
43−
52+
44− -- ** Default Constants
53+ -- -- ** Default Constants
45− , checkGCEVar
54+ -- , checkGCEVar
46− , cloudSDKConfigDir
55+ -- , cloudSDKConfigDir
47− , defaultCredentialsFile
56+ -- , defaultCredentialsFile
48−
57+
49− -- ** Handling Errors
58+ -- -- ** Handling Errors
50− , AsAuthError (..)
59+ -- , AsAuthError (..)
51− , AuthError (..)
60+ -- , AuthError (..)
52−
61+
53− -- * OAuth Types
62+ -- -- * OAuth Types
54− , OAuthClient (..)
63+ -- , OAuthClient (..)
55− , OAuthToken (..)
64+ -- , OAuthToken (..)
56− , OAuthCode (..)
65+ -- , OAuthCode (..)
57− , OAuthScope (..)
66+ -- , OAuthScope (..)
58−
67+
59− -- * Re-exported Types
68+ -- -- * Re-exported Types
60− , AccessToken (..)
69+ -- , AccessToken (..)
61− , RefreshToken (..)
70+ -- , RefreshToken (..)
62− , Secret (..)
71+ -- , Secret (..)
63− , ServiceId (..)
72+ -- , ServiceId (..)
64− , ClientId (..)
73+ -- , ClientId (..)
65− ) where
74+ -- ) where
66
75
67import Control.Applicative
76import Control.Applicative
68import Control.Concurrent
77import Control.Concurrent
69import Control.Exception.Lens
78import Control.Exception.Lens
70−import Control.Lens hiding
79+import Control.Lens hiding (coerce, (.=))
71− (coerce,
72− (.=))
73import Control.Monad
80import Control.Monad
74import Control.Monad.Catch
81import Control.Monad.Catch
75import Control.Monad.IO.Class
82import Control.Monad.IO.Class
76−import Crypto.Hash.Algorithms (SHA256 (..))
83+import Crypto.Hash.Algorithms (SHA256 (..))
77−import Crypto.PubKey.RSA.PKCS15 (signSafer)
84+import Crypto.PubKey.RSA.PKCS15 (signSafer)
78−import Crypto.PubKey.RSA.Types (PrivateKey)
85+import Crypto.PubKey.RSA.Types (PrivateKey)
79import Data.Aeson
86import Data.Aeson
80import Data.Aeson.Types
87import Data.Aeson.Types
81import Data.ByteArray
88import Data.ByteArray
82import Data.ByteArray.Encoding
89import Data.ByteArray.Encoding
83−import Data.ByteString (ByteString)
90+import Data.ByteString (ByteString)
84−import Data.ByteString.Builder (Builder)
91+import Data.ByteString.Builder (Builder)
85−import qualified Data.ByteString.Builder as Build
92+import qualified Data.ByteString.Builder as Build
86−import qualified Data.ByteString.Char8 as BS8
93+import qualified Data.ByteString.Char8 as BS8
87−import qualified Data.ByteString.Lazy as LBS
94+import qualified Data.ByteString.Lazy as LBS
88import Data.Coerce
95import Data.Coerce
89−import Data.Default.Class (def)
96+import Data.Default.Class (def)
90−import Data.List (intersperse)
97+import Data.List
91import Data.String
98import Data.String
92−import qualified Data.Text as Text
99+import qualified Data.Text as Text
93−import qualified Data.Text.Encoding as Text
100+import qualified Data.Text.Encoding as Text
94import Data.Time
101import Data.Time
95import Data.Time.Clock.POSIX
102import Data.Time.Clock.POSIX
96import Data.Typeable
103import Data.Typeable
97import Data.X509
104import Data.X509
98import Data.X509.Memory
105import Data.X509.Memory
99−import Network.Google.Auth.ApplicationDefaultCredentials
106+import GHC.Exts (Constraint)
107+import GHC.TypeLits
108+import Network.Google.Auth.ApplicationDefault
100import Network.Google.Auth.Device
109import Network.Google.Auth.Device
101import Network.Google.Auth.InstalledApplication
110import Network.Google.Auth.InstalledApplication
102import Network.Google.Auth.ServiceAccount
111import Network.Google.Auth.ServiceAccount
@@ -104,105 +113,110 @@ import Network.Google.Compute.Metadata
104import Network.Google.Internal.Auth
113import Network.Google.Internal.Auth
105import Network.Google.Internal.Logger
114import Network.Google.Internal.Logger
106import Network.Google.Prelude
115import Network.Google.Prelude
107−import Network.HTTP.Conduit hiding
116+import Network.HTTP.Conduit hiding (Proxy)
108− (Request)
109−import qualified Network.HTTP.Conduit as Client
117+import qualified Network.HTTP.Conduit as Client
110import Network.HTTP.Types
118import Network.HTTP.Types
111−import System.Directory (doesFileExist, getHomeDirectory)
119+
112−import System.Environment (lookupEnv)
113−import System.FilePath ((</>))
114−import System.Info (os)
115
120
116-- | An 'OAuthToken' that can potentially be expired, with the original
121-- | An 'OAuthToken' that can potentially be expired, with the original
117-- credentials that can be used to perform a refresh.
122-- credentials that can be used to perform a refresh.
118−data Auth = Auth
123+data Auth (s :: [*]) = Auth
119− { _credentials :: !Credentials
124+ { _credentials :: !(Credentials s)
120 , _token :: !OAuthToken
125 , _token :: !OAuthToken
121 }
126 }
122
127
123−-- | Check if the given token is still valid, ie. younger than the projected
128+newtype Store (s :: [*]) = Store { store :: MVar (Auth s) }
124−-- expiry time.
129+
125−--
130+-- type family HasScope s a :: Constraint where
126−-- This deliberately makes no external calls due to the absolute construction of
131+-- HasScope s a = IsSubList s (Ss a)
127−-- the '_tokenExpiry' field, unlike the
132+
128−-- <https://developers.google.com/accounts/docs/OAuth2Login#validatingtoken documented>
133+type family And (a :: Constraint) (b :: Constraint) :: Constraint where
129−-- validation method.
134+ And () () = ()
130−validate :: MonadIO m => Auth -> m Bool
131−validate a = (< _tokenExpiry (_token a)) <$> liftIO getCurrentTime
132
135
136+type family IsSubList a b :: Constraint where
137+ IsSubList '[] b = ()
138+ IsSubList '[x] (x ': xs) = ()
139+ IsSubList '[x] (y ': ys) = IsSubList '[x] ys
140+ IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
141+
142+-- authorize :: (MonadIO m, MonadCatch m)
143+-- => Credentials s
144+-- -> Logger
145+-- -> Manager
133−type Store = MVar Auth
146+-- -> m (Store s)
147+-- authorize = undefined
134
148
135-- | Construct storage containing the credentials which have not yet been
149-- | Construct storage containing the credentials which have not yet been
136-- exchanged or refreshed.
150-- exchanged or refreshed.
137initStore :: (MonadIO m, MonadCatch m)
151initStore :: (MonadIO m, MonadCatch m)
138− => Credentials
152+ => Credentials s
139− -> Logger
140− -> Manager
141− -> m Store
142−initStore c l m = exchange c l m >>= liftIO . newMVar
143−
144−-- | Concurrently read the current token, and if expired, then
145−-- safely perform a single serial refresh.
146−getToken :: (MonadIO m, MonadCatch m)
147− => Store
148− -> Logger
149− -> Manager
150− -> m OAuthToken
151−getToken s l m = do
152− x <- liftIO (readMVar s)
153− mx <- validate x
154− if mx
155− then pure (_token x)
156− else liftIO . modifyMVar s $ \y -> do
157− my <- validate y
158− if my
159− then pure (y, _token y)
160− else do
161− z <- refresh y l m
162− pure (z, _token z)
163−
164−-- | Perform the initial credentials exchange to obtain a valid 'OAuthToken'
165−-- suitable for authorizing requests.
166−exchange :: (MonadIO m, MonadCatch m)
167− => Credentials
168− -> Logger
169− -> Manager
170− -> m Auth
171−exchange c l = fmap (Auth c) . action l
172− where
173− action = case c of
174− FromMetadata s -> metadataToken s
175− FromAccount a ss -> serviceAccountToken a ss
176− FromClient c n -> exchangeCode c n
177− FromUser u -> authorizedUserToken u Nothing
178−
179−-- | Refresh an existing 'OAuthToken' using
180−refresh :: (MonadIO m, MonadCatch m)
181− => Auth
182− -> Logger
183− -> Manager
184− -> m Auth
185−refresh (Auth c t) l = fmap (Auth c) . action l
186− where
187− action = case c of
188− FromMetadata s -> metadataToken s
189− FromAccount a ss -> serviceAccountToken a ss
190− FromClient x _ -> refreshToken x t
191− FromUser u -> authorizedUserToken u (_tokenRefresh t)
192−
193−-- | Apply the (by way of possible token refresh) a bearer token to the
194−-- authentication header of a request.
195−authorize :: (MonadIO m, MonadCatch m)
196− => Client.Request
197− -> Store
198 -> Logger
153 -> Logger
199 -> Manager
154 -> Manager
155+ -> m (Store s)
156+initStore c l m = undefined -- exchange c l m >>= liftIO . newMVar
157+
158+-- -- | Concurrently read the current token, and if expired, then
159+-- -- safely perform a single serial refresh.
160+-- getToken :: (MonadIO m, MonadCatch m)
161+-- => Store
162+-- -> Logger
163+-- -> Manager
164+-- -> m OAuthToken
165+-- getToken s l m = do
166+-- x <- liftIO (readMVar s)
167+-- mx <- validate x
168+-- if mx
169+-- then pure (_token x)
170+-- else liftIO . modifyMVar s $ \y -> do
171+-- my <- validate y
172+-- if my
173+-- then pure (y, _token y)
174+-- else do
175+-- z <- refresh y l m
176+-- pure (z, _token z)
177+
178+-- -- | Perform the initial credentials exchange to obtain a valid 'OAuthToken'
179+-- -- suitable for authorizing requests.
180+-- exchange :: (MonadIO m, MonadCatch m)
181+-- => Credentials
182+-- -> Logger
183+-- -> Manager
184+-- -> m Auth
185+-- exchange c l = fmap (Auth c) . action l
186+-- where
187+-- action = case c of
188+-- FromMetadata s -> metadataToken s
189+-- FromAccount a ss -> serviceAccountToken a ss
190+-- FromClient c n -> exchangeCode c n
191+-- FromUser u -> authorizedUserToken u Nothing
192+
193+-- -- | Refresh an existing 'OAuthToken' using
194+-- refresh :: (MonadIO m, MonadCatch m)
195+-- => Auth
196+-- -> Logger
197+-- -> Manager
198+-- -> m Auth
199+-- refresh (Auth c t) l = fmap (Auth c) . action l
200+-- where
201+-- action = case c of
202+-- FromMetadata s -> metadataToken s
203+-- FromAccount a ss -> serviceAccountToken a ss
204+-- FromClient x _ -> refreshToken x t
205+-- FromUser u -> authorizedUserToken u (_tokenRefresh t)
206+
207+-- -- | Apply the (by way of possible token refresh) a bearer token to the
208+-- -- authentication header of a request.
209+-- authorize :: (MonadIO m, MonadCatch m)
200− -> m Client.Request
210+-- => Client.Request
211+-- -> Store
212+-- -> Logger
213+-- -> Manager
214+-- -> m Client.Request
201−authorize rq s l m = bearer <$> getToken s l m
215+-- authorize rq s l m = bearer <$> getToken s l m
202− where
216+-- where
203− bearer t = rq
217+-- bearer t = rq
204− { Client.requestHeaders =
218+-- { Client.requestHeaders =
205− ( hAuthorization
219+-- ( hAuthorization
206− , "Bearer " <> Text.encodeUtf8 (toText (_tokenAccess t))
220+-- , "Bearer " <> Text.encodeUtf8 (toText (_tokenAccess t))
207− ) : Client.requestHeaders rq
221+-- ) : Client.requestHeaders rq
208− }
222+-- }
gogol/src/Network/Google/Auth/ApplicationDefaultCredentials.hs → gogol/src/Network/Google/Auth/ApplicationDefault.hsrenamed+16−22
@@ -9,7 +9,7 @@
9-- Stability : provisional
9-- Stability : provisional
10-- Portability : non-portable (GHC extensions)
10-- Portability : non-portable (GHC extensions)
11
11
12−module Network.Google.Auth.ApplicationDefaultCredentials where
12+module Network.Google.Auth.ApplicationDefault where
13
13
14import Control.Applicative
14import Control.Applicative
15import Control.Concurrent
15import Control.Concurrent
@@ -102,11 +102,10 @@ defaultCredentialsPath = liftIO (lookupEnv defaultCredentialsFile)
102-- top-level module of each individual @gogol-*@ library for a list of available
102-- top-level module of each individual @gogol-*@ library for a list of available
103-- scopes, such as @Network.Google.Compute.computeScope@.
103-- scopes, such as @Network.Google.Compute.computeScope@.
104getApplicationDefault :: (MonadIO m, MonadCatch m)
104getApplicationDefault :: (MonadIO m, MonadCatch m)
105− => [OAuthScope]
106− -> Manager
105+ => Manager
107− -> m Credentials
106+ -> m (Credentials s)
108−getApplicationDefault ss m =
107+getApplicationDefault m =
109− catching _MissingFileError (fromWellKnownPath ss) $ \f -> do
108+ catching _MissingFileError fromWellKnownPath $ \f -> do
110 p <- isGCE m
109 p <- isGCE m
111 unless p $
110 unless p $
112 throwingM _MissingFileError f
111 throwingM _MissingFileError f
@@ -121,14 +120,14 @@ getApplicationDefault ss m =
121-- scopes, such as @Network.Google.Compute.computeScope@.
120-- scopes, such as @Network.Google.Compute.computeScope@.
122--
121--
123-- /See:/ 'cloudSDKConfigPath', 'defaultCredentialsPath'.
122-- /See:/ 'cloudSDKConfigPath', 'defaultCredentialsPath'.
124−fromWellKnownPath :: (MonadIO m, MonadCatch m) => [OAuthScope] -> m Credentials
123+fromWellKnownPath :: (MonadIO m, MonadCatch m) => m (Credentials s)
125−fromWellKnownPath ss = do
124+fromWellKnownPath = do
126 f <- defaultCredentialsPath
125 f <- defaultCredentialsPath
127 case f of
126 case f of
128− Just x -> fromFilePath ss x
127+ Just x -> fromFilePath x
129 Nothing -> do
128 Nothing -> do
130 x <- cloudSDKConfigPath
129 x <- cloudSDKConfigPath
131− fromFilePath ss x
130+ fromFilePath x
132
131
133-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
132-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
134-- file to obtain the credentials neccessary to perform a token refresh from
133-- file to obtain the credentials neccessary to perform a token refresh from
@@ -138,27 +137,22 @@ fromWellKnownPath ss = do
138-- found with the appropriate scopes, otherwise they are not used. See the
137-- found with the appropriate scopes, otherwise they are not used. See the
139-- top-level module of each individual @gogol-*@ library for a list of available
138-- top-level module of each individual @gogol-*@ library for a list of available
140-- scopes, such as @Network.Google.Compute.computeScope@.
139-- scopes, such as @Network.Google.Compute.computeScope@.
141−fromFilePath :: (MonadIO m, MonadCatch m)
140+fromFilePath :: (MonadIO m, MonadCatch m) => FilePath -> m (Credentials s)
142− => [OAuthScope]
143− -> FilePath
144− -> m Credentials
145−fromFilePath ss f = do
141+fromFilePath f = do
146 p <- liftIO (doesFileExist f)
142 p <- liftIO (doesFileExist f)
147 unless p $
143 unless p $
148 throwM (MissingFileError f)
144 throwM (MissingFileError f)
149 bs <- liftIO (LBS.readFile f)
145 bs <- liftIO (LBS.readFile f)
150 either (throwM . InvalidFileError f . Text.pack) pure
146 either (throwM . InvalidFileError f . Text.pack) pure
151− (fromJSONCredentials ss bs)
147+ (fromJSONCredentials bs)
152
148
153-- | Attempt to parse either a @service_account@ or @authorized_user@ formatted
149-- | Attempt to parse either a @service_account@ or @authorized_user@ formatted
154-- JSON value to obtain credentials.
150-- JSON value to obtain credentials.
155−fromJSONCredentials :: [OAuthScope]
156− -> LBS.ByteString
157− -> Either String Credentials
151+fromJSONCredentials :: LBS.ByteString -> Either String (Credentials s)
158−fromJSONCredentials ss bs = do
152+fromJSONCredentials bs = do
159 v <- eitherDecode' bs
153 v <- eitherDecode' bs
160− let x = (`FromAccount` ss) <$> parseEither parseJSON v
154+ let x = FromAccount <$> parseEither parseJSON v
161− y = FromUser <$> parseEither parseJSON v
155+ y = FromUser <$> parseEither parseJSON v
162 case (x, y) of
156 case (x, y) of
163 (Left xe, Left ye) -> Left $
157 (Left xe, Left ye) -> Left $
164 "Failed parsing service_account: " ++ xe ++
158 "Failed parsing service_account: " ++ xe ++
gogol/src/Network/Google/Env.hs+66−58
@@ -1,3 +1,8 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FunctionalDependencies #-}
4+{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
1-- |
6-- |
2-- Module : Network.Google.Env
7-- Module : Network.Google.Env
3-- Copyright : (c) 2015-2016 Brendan Hay
8-- Copyright : (c) 2015-2016 Brendan Hay
@@ -13,26 +18,29 @@ import Control.Lens
13import Control.Monad.Catch
18import Control.Monad.Catch
14import Control.Monad.IO.Class
19import Control.Monad.IO.Class
15import Control.Monad.Reader
20import Control.Monad.Reader
16−import Data.Function (on)
21+import Data.Function (on)
17import Data.Monoid
22import Data.Monoid
23+import GHC.TypeLits
18import Network.Google.Auth
24import Network.Google.Auth
25+import Network.Google.Auth.ApplicationDefault
26+import Network.Google.Internal.Auth
19import Network.Google.Internal.Logger
27import Network.Google.Internal.Logger
20import Network.Google.Types
28import Network.Google.Types
21import Network.HTTP.Conduit
29import Network.HTTP.Conduit
22
30
23-- | The environment containing the parameters required to make Google requests.
31-- | The environment containing the parameters required to make Google requests.
24−data Env = Env
32+data Env (s :: [*]) = Env
25− { _envOverride :: !(Dual (Endo ServiceConfig))
33+ { _envOverride :: !(Dual (Endo Service))
26 , _envLogger :: !Logger
34 , _envLogger :: !Logger
27 , _envManager :: !Manager
35 , _envManager :: !Manager
28− , _envStore :: !Store
36+ , _envStore :: !(Store s)
29 }
37 }
30
38
31-- Note: The strictness annotations aobe are applied to ensure
39-- Note: The strictness annotations aobe are applied to ensure
32-- total field initialisation.
40-- total field initialisation.
33
41
34−class HasEnv a where
42+class HasEnv s a | a -> s where
35− environment :: Lens' a Env
43+ environment :: Lens' a (Env s)
36 {-# MINIMAL environment #-}
44 {-# MINIMAL environment #-}
37
45
38 -- | The currently applied overrides to all 'Service' configuration.
46 -- | The currently applied overrides to all 'Service' configuration.
@@ -45,61 +53,61 @@ class HasEnv a where
45 envManager :: Lens' a Manager
53 envManager :: Lens' a Manager
46
54
47 -- | The credential store used to sign requests for authentication with Google.
55 -- | The credential store used to sign requests for authentication with Google.
48− envStore :: Lens' a Store
56+ envStore :: Lens' a (Store s)
49
57
50 envOverride = environment . lens _envOverride (\s a -> s { _envOverride = a })
58 envOverride = environment . lens _envOverride (\s a -> s { _envOverride = a })
51 envLogger = environment . lens _envLogger (\s a -> s { _envLogger = a })
59 envLogger = environment . lens _envLogger (\s a -> s { _envLogger = a })
52 envManager = environment . lens _envManager (\s a -> s { _envManager = a })
60 envManager = environment . lens _envManager (\s a -> s { _envManager = a })
53 envStore = environment . lens _envStore (\s a -> s { _envStore = a })
61 envStore = environment . lens _envStore (\s a -> s { _envStore = a })
54
62
55−instance HasEnv Env where
63+instance HasEnv s (Env s) where
56 environment = id
64 environment = id
57
65
58−-- | Provide a function which will be added to the existing stack
66+-- -- | Provide a function which will be added to the existing stack
59−-- of overrides applied to all service configuration.
67+-- -- of overrides applied to all service configuration.
60−--
68+-- --
61−-- To override a specific service, it's suggested you use
69+-- -- To override a specific service, it's suggested you use
62−-- either 'configure' or 'reconfigure' with a modified version of the default
70+-- -- either 'configure' or 'reconfigure' with a modified version of the default
63−-- service, such as @Network.Google.Gmail.gmailService@.
71+-- -- service, such as @Network.Google.Gmail.gmailService@.
64−override :: HasEnv a => (ServiceConfig -> ServiceConfig) -> a -> a
72+-- override :: HasEnv a => (Service -> Service) -> a -> a
65−override f = envOverride <>~ Dual (Endo f)
73+-- override f = envOverride <>~ Dual (Endo f)
66−
74+
67−-- | Configure a specific service. All requests belonging to the
75+-- -- | Configure a specific service. All requests belonging to the
68−-- supplied service will use this configuration instead of the default.
76+-- -- supplied service will use this configuration instead of the default.
69−--
77+-- --
70−-- It's suggested you use a modified version of the default service, such
78+-- -- It's suggested you use a modified version of the default service, such
71−-- as @Network.Google.Gmail.gmailService@.
79+-- -- as @Network.Google.Gmail.gmailService@.
72−--
80+-- --
73−-- /See:/ 'reconfigure'.
81+-- -- /See:/ 'reconfigure'.
74−configure :: HasEnv a => ServiceConfig -> a -> a
82+-- configure :: HasEnv a => Service -> a -> a
75−configure s = override f
83+-- configure s = override f
76− where
84+-- where
77− f x | on (==) _svcId s x = s
85+-- f x | on (==) _svcId s x = s
78− | otherwise = x
86+-- | otherwise = x
79−
87+
80−-- | Scope an action such that all requests belonging to the supplied service
88+-- -- | Scope an action such that all requests belonging to the supplied service
81−-- will use this configuration instead of the default.
89+-- -- will use this configuration instead of the default.
82−--
90+-- --
83−-- It's suggested you use a modified version of the default service, such
91+-- -- It's suggested you use a modified version of the default service, such
84−-- as @Network.Google.Gmail.gmailService@.
92+-- -- as @Network.Google.Gmail.gmailService@.
85−--
93+-- --
86−-- /See:/ 'configure'.
94+-- -- /See:/ 'configure'.
87−reconfigure :: (MonadReader r m, HasEnv r) => ServiceConfig -> m a -> m a
95+-- reconfigure :: (MonadReader r m, HasEnv r) => Service -> m a -> m a
88−reconfigure = local . configure
96+-- reconfigure = local . configure
89−
97+
90−-- | Scope an action such that any HTTP response will use this timeout value.
98+-- -- | Scope an action such that any HTTP response will use this timeout value.
91−--
99+-- --
92−-- Default timeouts are chosen by considering:
100+-- -- Default timeouts are chosen by considering:
93−--
101+-- --
94−-- * This 'timeout', if set.
102+-- -- * This 'timeout', if set.
95−--
103+-- --
96−-- * The related 'Service' timeout for the sent request if set. (Usually 70s)
104+-- -- * The related 'Service' timeout for the sent request if set. (Usually 70s)
97−--
105+-- --
98−-- * The 'envManager' timeout if set.
106+-- -- * The 'envManager' timeout if set.
99−--
107+-- --
100−-- * The default 'ClientRequest' timeout. (Approximately 30s)
108+-- -- * The default 'ClientRequest' timeout. (Approximately 30s)
101−timeout :: (MonadReader r m, HasEnv r) => Seconds -> m a -> m a
109+-- timeout :: (MonadReader r m, HasEnv r) => Seconds -> m a -> m a
102−timeout s = local (override (serviceTimeout ?~ s))
110+-- timeout s = local (override (serviceTimeout ?~ s))
103
111
104-- | Creates a new environment with a new 'Manager', without logging.
112-- | Creates a new environment with a new 'Manager', without logging.
105-- Credentials are determined by calling 'discover'. Use 'newEnvWith' to supply
113-- Credentials are determined by calling 'discover'. Use 'newEnvWith' to supply
@@ -113,10 +121,10 @@ timeout s = local (override (serviceTimeout ?~ s))
113-- Lenses from 'HasEnv' can be used to further configure the resulting 'Env'.
121-- Lenses from 'HasEnv' can be used to further configure the resulting 'Env'.
114--
122--
115-- /See:/ 'newEnvWith', 'getApplicationDefault'.
123-- /See:/ 'newEnvWith', 'getApplicationDefault'.
116−newEnv :: (MonadIO m, MonadCatch m) => [OAuthScope] -> m Env
124+newEnv :: (MonadIO m, MonadCatch m) => m (Env s)
117−newEnv ss = do
125+newEnv = do
118 m <- liftIO (newManager tlsManagerSettings)
126 m <- liftIO (newManager tlsManagerSettings)
119− c <- getApplicationDefault ss m
127+ c <- getApplicationDefault m
120 newEnvWith c (\_ _ -> pure ()) m
128 newEnvWith c (\_ _ -> pure ()) m
121
129
122-- | Creates a new environment without logging, using the supplied 'Manager' and
130-- | Creates a new environment without logging, using the supplied 'Manager' and
@@ -134,8 +142,8 @@ newEnv ss = do
134--
142--
135-- /See:/ 'newEnv'.
143-- /See:/ 'newEnv'.
136newEnvWith :: (MonadIO m, MonadCatch m)
144newEnvWith :: (MonadIO m, MonadCatch m)
137− => Credentials
145+ => Credentials s
138 -> Logger
146 -> Logger
139 -> Manager
147 -> Manager
140− -> m Env
148+ -> m (Env s)
141newEnvWith c l m = Env mempty l m <$> initStore c l m
149newEnvWith c l m = Env mempty l m <$> initStore c l m
gogol/src/Network/Google/Internal/Auth.hs+15−2
@@ -1,8 +1,10 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE KindSignatures #-}
6{-# LANGUAGE LambdaCase #-}
8{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
8
10
@@ -49,6 +51,7 @@ import Data.Time.Clock.POSIX
49import Data.Typeable
51import Data.Typeable
50import Data.X509
52import Data.X509
51import Data.X509.Memory
53import Data.X509.Memory
54+import GHC.TypeLits
52import Network.Google.Compute.Metadata
55import Network.Google.Compute.Metadata
53import Network.Google.Internal.Logger
56import Network.Google.Internal.Logger
54import Network.Google.Prelude hiding (buildText)
57import Network.Google.Prelude hiding (buildText)
@@ -62,7 +65,7 @@ import System.FilePath ((</>))
62import System.Info (os)
65import System.Info (os)
63
66
64-- | The supported credential mechanisms.
67-- | The supported credential mechanisms.
65−data Credentials
68+data Credentials (s :: [*])
66 = FromMetadata !ServiceId
69 = FromMetadata !ServiceId
67 -- ^ Obtain and refresh access tokens from the underlying GCE host metadata
70 -- ^ Obtain and refresh access tokens from the underlying GCE host metadata
68 -- at @http:\/\/169.254.169.254@.
71 -- at @http:\/\/169.254.169.254@.
@@ -74,7 +77,7 @@ data Credentials
74 -- See the <https://developers.google.com/accounts/docs/OAuth2InstalledApp OAuth2 Installed Application>
77 -- See the <https://developers.google.com/accounts/docs/OAuth2InstalledApp OAuth2 Installed Application>
75 -- documentation for more information.
78 -- documentation for more information.
76
79
77− | FromAccount !ServiceAccount ![OAuthScope]
80+ | FromAccount !ServiceAccount
78 -- ^ Use the specified @service_account@ and scopes to sign and request
81 -- ^ Use the specified @service_account@ and scopes to sign and request
79 -- an access token. The 'ServiceAccount' will also be used for subsequent
82 -- an access token. The 'ServiceAccount' will also be used for subsequent
80 -- token refreshes.
83 -- token refreshes.
@@ -189,6 +192,16 @@ instance FromJSON (UTCTime -> OAuthToken) where
189 e <- o .: "expires_in" <&> fromInteger
192 e <- o .: "expires_in" <&> fromInteger
190 pure (OAuthToken t r . addUTCTime e)
193 pure (OAuthToken t r . addUTCTime e)
191
194
195+-- | Check if the given token is still valid, ie. younger than the projected
196+-- expiry time.
197+--
198+-- This deliberately makes no external calls due to the absolute construction of
199+-- the '_tokenExpiry' field, unlike the
200+-- <https://developers.google.com/accounts/docs/OAuth2Login#validatingtoken documented>
201+-- validation method.
202+validate :: MonadIO m => OAuthToken -> m Bool
203+validate t = (< _tokenExpiry t) <$> liftIO getCurrentTime
204+
192newtype OAuthCode = OAuthCode Text
205newtype OAuthCode = OAuthCode Text
193 deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable, ToText, FromJSON, ToJSON)
206 deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable, ToText, FromJSON, ToJSON)
194
207
gogol/src/Network/Google/Internal/HTTP.hs+4−4
@@ -14,7 +14,6 @@
14--
14--
15module Network.Google.Internal.HTTP where
15module Network.Google.Internal.HTTP where
16
16
17−
18import Control.Lens
17import Control.Lens
19import Control.Monad.Catch
18import Control.Monad.Catch
20import Control.Monad.IO.Class
19import Control.Monad.IO.Class
@@ -49,9 +48,10 @@ perform :: (MonadCatch m, MonadResource m, GoogleRequest a)
49 -> m (Either Error (Rs a))
48 -> m (Either Error (Rs a))
50perform Env{..} x = catches go handlers
49perform Env{..} x = catches go handlers
51 where
50 where
52− Request {..} = _cliRequest
51+ Request {..} = _cliRequest
53− ServiceConfig {..} = _cliService
52+ Service {..} = _cliService
53+
54− Client {..} = requestClient x
54+ Client {..} = requestClient x
55 & clientService %~ appEndo (getDual _envOverride)
55 & clientService %~ appEndo (getDual _envOverride)
56
56
57 go = liftResourceT $ do
57 go = liftResourceT $ do