@@ -1,5 +1,6 @@
11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveGeneric #-}
34{-# LANGUAGE FlexibleContexts #-}
45{-# LANGUAGE FlexibleInstances #-}
56{-# LANGUAGE GADTs #-}
@@ -18,57 +19,61 @@
1819--
1920-- Explicitly specify your Google credentials, or retrieve them
2021-- from the underlying OS.
21−module Network.Google.Auth
22− (
23− -- * Authentication
24− -- ** Retrieving Authentication
25− getAuth
26− , Credentials (..)
27− , Auth
28−
29− -- ** Authorising Requests
30− , authorise
31−
32− -- ** Default Constants
33− -- *** Google Compute Engine
34− , checkGCEVar
35−
36− -- *** Cloud SDK
37− , cloudSDKConfigDir
38− , cloudSDKConfigPath
39−
40− -- *** Application Default Credentials
41− , defaultCredentialsFile
42− , defaultCredentialsPath
43−
44− -- ** Credentials
45− , fromMetadata
46− , fromFile
47− , fromFilePath
48−
49− -- *** Authorised User
50− , AuthorisedUser (..)
51− , fromAuthorisedUser
52−
53− -- *** Service Account
54− , ServiceAccount (..)
55− , fromServiceAccount
56−
57− -- ** Handling Errors
58− , AsAuthError (..)
59− , AuthError (..)
60−
61− -- ** Re-exported Types
62− , OAuthScope (..)
63− , OAuthToken (..)
64− , ServiceId (..)
65− , ClientId (..)
66− ) where
22+module Network.Google.Auth where
23+ -- (
24+ -- -- * Authentication
25+ -- -- ** Retrieving Authentication
26+ -- getAuth
27+ -- , Credentials (..)
28+ -- , Auth
29+
30+ -- -- ** Authorising Requests
31+ -- , authorize
32+
33+ -- -- ** Default Constants
34+ -- -- *** Google Compute Engine
35+ -- , checkGCEVar
36+
37+ -- -- *** Cloud SDK
38+ -- , cloudSDKConfigDir
39+ -- , cloudSDKConfigPath
40+
41+ -- -- *** Application Default Credentials
42+ -- , defaultCredentialsFile
43+ -- , defaultCredentialsPath
44+
45+ -- -- ** Credential Styles
46+ -- , fromMetadata
47+ -- , fromFile
48+ -- , fromFilePath
49+
50+ -- -- *** OAuth Token
51+ -- , Bearer (..)
52+ -- , fromToken
53+
54+ -- -- *** Authorized User
55+ -- , AuthorizedUser (..)
56+ -- , fromAuthorizedUser
57+
58+ -- -- *** Service Account
59+ -- , ServiceAccount (..)
60+ -- , fromServiceAccount
61+
62+ -- -- ** Handling Errors
63+ -- , AsAuthError (..)
64+ -- , AuthError (..)
65+
66+ -- -- ** Re-exported Types
67+ -- , Scope (..)
68+ -- , OAuthToken (..)
69+ -- , ServiceId (..)
70+ -- , ClientId (..)
71+ -- ) where
6772
6873import Control.Applicative
6974import Control.Concurrent
7075import Control.Exception.Lens
71−import Control.Lens hiding ((.=))
76+import Control.Lens hiding (coerce, (.=))
7277import Control.Monad
7378import Control.Monad.Catch
7479import Control.Monad.IO.Class
@@ -80,11 +85,19 @@ import Data.Aeson.Types
8085import Data.ByteArray
8186import Data.ByteArray.Encoding
8287import Data.ByteString (ByteString)
88+import Data.ByteString.Builder (Builder)
89+import qualified Data.ByteString.Builder as Build
8390import qualified Data.ByteString.Char8 as BS8
8491import qualified Data.ByteString.Lazy as LBS
92+import Data.Coerce
8593import Data.Default.Class (def)
94+import Data.List (intersperse)
95+import Data.String
8696import qualified Data.Text as Text
8797import qualified Data.Text.Encoding as Text
98+import qualified Data.Text.Lazy as LText
99+import qualified Data.Text.Lazy.Builder as TBuild
100+import qualified Data.Text.Lazy.Encoding as LText
88101import Data.Time
89102import Data.Time.Clock.POSIX
90103import Data.Typeable
@@ -92,7 +105,7 @@ import Data.X509
92105import Data.X509.Memory
93106import Network.Google.Compute.Metadata
94107import Network.Google.Internal.Logger
95−import Network.Google.Prelude
108+import Network.Google.Prelude hiding (buildText)
96109import Network.HTTP.Conduit hiding (Request)
97110import qualified Network.HTTP.Conduit as Client
98111import Network.HTTP.Types
@@ -177,135 +190,6 @@ instance AsAuthError AuthError where
177190 TokenRefreshError s e d -> Right (s, e, d)
178191 x -> Left x)
179192
180−-- | Determines how AuthN/AuthZ information is retrieved.
181−data Credentials
182− = FromToken !OAuthToken
183− -- ^ Supply an explicit access token. See 'fromToken'.
184−
185− | FromFile !FilePath
186− -- ^ Load the Application Default Credentials from a specific file path.
187− -- The file can be formatted as either a @service_account@ or an @authorized_user@.
188−
189− | FromAccount !ServiceId
190− -- ^ Retrieve the Application Default Credentials using the speicfic
191− -- 'ServiceId' from the local metadata endpoint.
192−
193− | Discover
194− -- ^ Attempt credentials discovery via the following steps:
195− --
196− -- * Read the default credentials from a file specified by
197− -- the environment variable @GOOGLE_APPLICATION_CREDENTIALS@ if it exists.
198− --
199− -- * Read the platform equivalent of @~\/.config\/gcloud\/application_default_credentials.json@ if it exists.
200− -- The @~/.config@ component of the path can be overriden by the environment
201− -- variable @CLOUDSDK_CONFIG@ if it exists.
202− --
203− -- * Retrieve the default service account application credentials if
204− -- running on GCE.
205− deriving (Eq, Show)
206−
207−-- | Retrieve authentication information via the specified 'Credentials' mechanism.
208−--
209−-- The specified 'OAuthScope's are used to authorise any @service_account@
210−-- with the appropriate scopes. See the top-level module of each individual
211−-- @gogol-*@ library for a list of available scopes, such as @Network.Google.Compute.computeScope@.
212−--
213−-- Throws 'AuthError' when environment variables or service account information
214−-- cannot be read, and credentials files are invalid or cannot be found.
215−getAuth :: (MonadIO m, MonadCatch m)
216− => Credentials
217− -> [OAuthScope]
218− -> Logger
219− -> Manager
220− -> m Auth
221−getAuth c ss l m = case c of
222− FromToken t -> pure (AuthToken t)
223− FromFile f -> fromFilePath ss f l m
224− FromAccount s -> fromMetadata s l m
225− Discover ->
226− catching _MissingFileError (fromFile ss l m) $ \f -> do
227− p <- isGCE m
228− unless p $
229− throwingM _MissingFileError f
230− fromMetadata "default" l m
231−
232−-- | Refresh a token from the local GCE metadata endpoint for the specified
233−-- 'ServiceId'.
234−fromMetadata :: (MonadIO m, MonadCatch m)
235− => ServiceId
236− -> Logger
237− -> Manager
238− -> m Auth
239−fromMetadata s l = refresh s l >=> fmap AuthMeta . liftIO . newMVar
240−
241−-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
242−-- file to obtain the credentials neccessary to perform a token refresh.
243−fromFile :: (MonadIO m, MonadCatch m) => [OAuthScope] -> Logger -> Manager -> m Auth
244−fromFile ss l m = do
245− f <- defaultCredentialsPath
246− case f of
247− Just x -> fromFilePath ss x l m
248− Nothing -> do
249− x <- cloudSDKConfigPath
250− fromFilePath ss x l m
251−
252−-- | An internal type inhabited by the supported JSON formats
253−-- for Application Default Credentials.
254−data AccountJSON
255− = ParsedService !ServiceAccount
256− | ParsedUser !AuthorisedUser
257−
258−-- The following instance accumulates all error messages if all parsers fail.
259−-- If there is a success, the entire parse succeeds with the single
260−-- successful parse.
261−instance FromJSON AccountJSON where
262− parseJSON o =
263− let x = ParsedService <$> parseEither parseJSON o
264− y = ParsedUser <$> parseEither parseJSON o
265− in either fail pure $
266− case (x, y) of
267− (Left e, Left e') -> Left $
268− "Failed parsing service_account: " ++ e ++
269− ", Failed parsing authorized_user: " ++ e'
270− _ -> x <|> y
271−
272−-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
273−-- file to obtain the credentials neccessary to perform a token refresh from
274−-- the specified file.
275−fromFilePath :: (MonadIO m, MonadCatch m)
276− => [OAuthScope]
277− -> FilePath
278− -> Logger
279− -> Manager
280− -> m Auth
281−fromFilePath ss f l m = do
282− logDebug l $ "Trying to read credentials from " <> build f
283− p <- liftIO (doesFileExist f)
284− unless p $
285− throwM (MissingFileError f)
286− e <- liftIO (LBS.readFile f) >>=
287− either (throwM . InvalidFileError f) pure . parseLBS
288− case e of
289− ParsedUser u -> fromAuthorisedUser u l m
290− ParsedService a -> fromServiceAccount (a { _serviceScope = ss }) l m
291−
292−fromAuthorisedUser :: (MonadIO m, MonadCatch m)
293− => AuthorisedUser
294− -> Logger
295− -> Manager
296− -> m Auth
297−fromAuthorisedUser u l m =
298− refresh u l m >>= fmap AuthUser . liftIO . newMVar
299−
300−fromServiceAccount :: (MonadIO m, MonadCatch m)
301− => ServiceAccount
302− -> Logger
303− -> Manager
304− -> m Auth
305−fromServiceAccount s l m =
306− -- Add a check to ensure scopes aren't empty.
307− refresh s l m >>= fmap AuthSign . liftIO . newMVar
308−
309193-- | Lookup the @GOOGLE_APPLICATION_CREDENTIALS@ environment variable for the
310194-- default application credentials filepath.
311195defaultCredentialsPath :: MonadIO m => m (Maybe FilePath)
@@ -339,160 +223,425 @@ instance FromJSON RefreshError where
339223 <$> o .: "error"
340224 <*> o .:? "error_description"
341225
342−data Expires a = Expires
343− { _expiry :: !UTCTime
344− , _token :: !OAuthToken
345− , _details :: !a
346− }
226+{-| Service Account credentials which are typically generated/download
227+from the Google Developer console of the following form:
228+
229+@
230+{
231+ "type": "service_account",
232+ "private_key_id": "303ad77e5efdf2ce952DFa",
233+ "private_key": "-----BEGIN PRIVATE KEY-----\n...\n",
234+ "client_email": "email@serviceaccount.com",
235+ "client_id": "035-2-310.useraccount.com"
236+}
237+@
238+
239+The private key is used to sign a JSON Web Token (JWT) of the
240+grant_type @urn:ietf:params:oauth:grant-type:jwt-bearer@, which is sent to
241+'accountsURL' to obtain a valid 'OAuthToken'. This process requires explicitly
242+specifying which 'Scope's the resulting 'OAuthToken' is authorized to access.
243+
244+A 'ServiceAccount' is typically generated through the
245+Google Developer Console.
246+-}
247+data ServiceAccount = ServiceAccount
248+ { _serviceId :: !ClientId
249+ , _serviceEmail :: !Text
250+ , _serviceKeyId :: !Text
251+ , _servicePrivateKey :: !PrivateKey
252+ } deriving (Eq, Show)
347253
348−isValid :: MonadIO m => Expires a -> m Bool
349−isValid r = (< _expiry r) <$> liftIO getCurrentTime
254+instance FromJSON ServiceAccount where
255+ parseJSON = withObject "service_account" $ \o -> do
256+ bs <- Text.encodeUtf8 <$> o .: "private_key"
257+ k <- case listToMaybe (readKeyFileFromMemory bs) of
258+ Just (PrivKeyRSA k) -> pure k
259+ _ ->
260+ fail "Unable to parse key contents from \"private_key\""
261+ ServiceAccount
262+ <$> o .: "client_id"
263+ <*> o .: "client_email"
264+ <*> o .: "private_key_id"
265+ <*> pure k
350266
351−data Auth
352− = AuthToken !OAuthToken
353− | AuthSign !(MVar (Expires ServiceAccount))
354− | AuthMeta !(MVar (Expires ServiceId))
355− | AuthUser !(MVar (Expires AuthorisedUser))
267+{-| Authorized User credentials which are typically generated by the Cloud SDK
268+tools such as @gcloud init@, of the following form:
356269
357−authorise :: (MonadIO m, MonadCatch m)
358− => Logger
359− -> Manager
360− -> Client.Request
361− -> Auth
362− -> m Client.Request
363−authorise l m rq = \case
364− AuthToken t -> pure $! authoriseBearer rq t
365− AuthSign r -> authoriseToken l m r rq
366− AuthMeta r -> authoriseToken l m r rq
367− AuthUser r -> authoriseToken l m r rq
368−
369−authoriseBearer :: Client.Request -> OAuthToken -> Client.Request
370−authoriseBearer rq t = rq
371− { Client.requestHeaders = (hAuthorization, "Bearer " <> tokenToBS t)
372− : Client.requestHeaders rq
373− }
270+{
271+ "type": "authorized_user",
272+ "client_id": "32555940559.apps.googleusercontent.com",
273+ "client_secret": "Zms2qjJy2998hD4CTg2ejr2",
274+ "refresh_token": "1/B3gM1x35v.VtqffS1n5w-rSJ"
275+}
374276
375−authoriseToken :: (MonadIO m, MonadCatch m, Refresh a)
376− => Logger
377− -> Manager
378− -> MVar (Expires a)
379− -> Client.Request
380− -> m Client.Request
381−authoriseToken l m r rq = authoriseBearer rq <$> refreshToken l m r
277+The secret and refresh token are used to obtain a valid 'OAuthToken' from
278+'accountsURL' using grant_type @refresh_token@.
382279
383−refreshToken :: (MonadIO m, MonadCatch m, Refresh a)
384− => Logger
385− -> Manager
386− -> MVar (Expires a)
387− -> m OAuthToken
388−refreshToken l m r = do
389− x <- liftIO (readMVar r)
390− xv <- isValid x
391− if xv
392− then pure (_token x)
393− else liftIO . modifyMVar r $ \y -> do
394− yv <- isValid y
395− if yv
396− then pure (y, _token y)
397− else do
398− z <- refresh (_details y) l m
399− pure (z, _token z)
400−
401−-- {
402−-- "access_token": "sadsdasd",
403−-- "expires_in": 3600,
404−-- "id_token": "eyJhbGciOiJSd",
405−-- "refresh_token": "1/B3gq9K",
406−-- "token_type": "Bearer"
407−-- }
408−
409−data Bearer = Bearer
410− { _bearerAccess :: !OAuthToken
411− , _bearerRefresh :: !(Maybe Text)
412− , _bearerExpiry :: !UTCTime
413− }
280+An 'AuthorizedUser' is typically generated by the @gcloud init@ command
281+of the Google CloudSDK Tools.
282+-}
283+data AuthorizedUser = AuthorizedUser
284+ { _userId :: !ClientId
285+ , _userRefresh :: !RefreshToken
286+ , _userSecret :: !Secret
287+ } deriving (Eq, Show)
288+
289+instance FromJSON AuthorizedUser where
290+ parseJSON = withObject "authorized_user" $ \o -> AuthorizedUser
291+ <$> o .: "client_id"
292+ <*> o .: "refresh_token"
293+ <*> o .: "client_secret"
414294
415−instance FromJSON (UTCTime -> Bearer) where
295+-- | A client identifier and accompanying secret used to obtain/refresh a token.
296+data OAuthClient = OAuthClient
297+ { _clientId :: !ClientId
298+ , _clientSecret :: !Secret
299+ } deriving (Eq, Show)
300+
301+{-| An OAuth bearer type token of the following form:
302+
303+@
304+{
305+ "token_type": "Bearer",
306+ "access_token": "eyJhbGci...",
307+ "refresh_token": "1/B3gq9K...",
308+ "expires_in": 3600,
309+ ...
310+}
311+@
312+
313+The '_tokenAccess' field will be inserted verbatim into the
314+@Authorization: Bearer ...@ header for all HTTP requests.
315+-}
316+data OAuthToken = OAuthToken
317+ { _tokenAccess :: !AccessToken
318+ , _tokenRefresh :: !(Maybe RefreshToken)
319+ , _tokenExpiry :: !UTCTime
320+ } deriving (Eq, Show)
321+
322+instance FromJSON (UTCTime -> OAuthToken) where
416323 parseJSON = withObject "bearer" $ \o -> do
417324 t <- o .: "access_token"
418325 r <- o .:? "refresh_token"
419326 e <- o .: "expires_in" <&> fromInteger
420− pure (Bearer t r . addUTCTime e)
327+ pure (OAuthToken t r . addUTCTime e)
421328
422−-- {
423−-- "private_key_id": "303ad77e5efdf2ce952DFa",
424−-- "private_key": "-----BEGIN PRIVATE KEY-----\nMIIE...\n",
425−-- "client_email": "01395191@gserviceaccount.com",
426−-- "client_id": "035-2-310eusercontent.com",
427−-- "type": "service_account"
428−-- }
329+newtype OAuthCode = OAuthCode { codeToText :: Text }
330+ deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable, ToText, FromJSON, ToJSON)
429331
430−data ServiceAccount = ServiceAccount
431− { _serviceId :: !ClientId
432− , _serviceEmail :: !Text
433− , _serviceScope :: ![OAuthScope]
434− , _serviceKeyId :: !Text
435− , _serviceKey :: !PrivateKey
436− }
332+-- | The supported credential mechanisms.
333+data Credentials
334+ = FromMetadata !ServiceId
335+ -- ^ Obtain and refresh access tokens from the underlying GCE host metadata
336+ -- at @http:\/\/169.254.169.254@.
437337
438−instance FromJSON ServiceAccount where
439− parseJSON = withObject "service_account" $ \o -> do
440− bs <- Text.encodeUtf8 <$> o .: "private_key"
441− ServiceAccount
442− <$> o .: "client_id"
443− <*> o .: "client_email"
444− <*> pure mempty
445− <*> o .: "private_key_id"
446− <*> case listToMaybe (readKeyFileFromMemory bs) of
447− Just (PrivKeyRSA k) -> pure k
448− _ ->
449− fail "Unable to parse key contents from \"private_key\""
450−
451−-- {
452−-- "client_id": "32555940559.apps.googleusercontent.com",
453−-- "client_secret": "ZmssLNjJy2998hD4CTg2ejr2",
454−-- "refresh_token": "1/B3gqKM1xzVtqffS1n5w-rSJ",
455−-- "type": "authorized_user"
456−-- }
457−
458−data AuthorisedUser = AuthorisedUser
459− { _userId :: !ClientId
460− , _userSecret :: !Text
461− , _userRefresh :: !Text
462− }
338+ | FromClient !OAuthClient !OAuthCode
339+ -- ^ Obtain and refresh access tokens using the specified client secret
340+ -- and authorization code obtained from.
341+ --
342+ -- See the <https://developers.google.com/accounts/docs/OAuth2InstalledApp OAuth2 Installed Application>
343+ -- documentation for more information.
463344
464−instance FromJSON AuthorisedUser where
465− parseJSON = withObject "authorized_user" $ \o -> AuthorisedUser
466− <$> o .: "client_id"
467− <*> o .: "client_secret"
468− <*> o .: "refresh_token"
345+ | FromAccount !ServiceAccount ![OAuthScope]
346+ -- ^ Use the specified @service_account@ and scopes to sign and request
347+ -- an access token. The 'ServiceAccount' will also be used for subsequent
348+ -- token refreshes.
349+ --
350+ -- A 'ServiceAccount' is typically generated through the
351+ -- Google Developer Console.
352+
353+ | FromUser !AuthorizedUser
354+ -- ^ Use the specified @authorized_user@ to obtain and refresh access tokens.
355+ --
356+ -- An 'AuthorizedUser' is typically created by the @gcloud init@ command
357+ -- of the Google CloudSDK Tools.
358+
359+-- | A credentials value in one of two possible states, pre-exchange and
360+-- containing a valid, but possibly expired access token.
361+data Auth
362+ = Exchange !Credentials
363+ -- ^ Signifies that the initial token refresh has not occured, and the
364+ -- 'Credentials' need to be signed and exchanged for a valid 'OAuthToken'.
365+
366+ | Refresh !Credentials !OAuthToken
367+ -- ^ An 'OAuthToken' that can potentially be expired, with the original
368+ -- credentials that can be used to perform a refresh.
369+
370+type Store = MVar Auth
371+
372+emptyStore :: MonadIO m => Credentials -> m Store
373+emptyStore !c = liftIO . newMVar $ Exchange c
469374
470−class Refresh a where
471− refresh :: (MonadIO m, MonadCatch m)
472− => a
473− -> Logger
474− -> Manager
475− -> m (Expires a)
476−
477−instance Refresh ServiceAccount where
478− refresh s l m = do
479− b <- jwtEncode s
480− let rq = accountsRequest
481− { Client.requestBody = RequestBodyBS $
482− "grant_type=urn:ietf:params:oauth:grant-type:jwt-bearer"
483− <> "&assertion="
484− <> b
485− }
486− refreshRequest s rq l m
487−
488−jwtEncode :: (MonadIO m, MonadThrow m)
489− => ServiceAccount
490− -> m ByteString
491−jwtEncode s = liftIO $ do
375+-- FIXME: support for generating the url using scopes to obtain the OAuthCode.
376+
377+-- FIXME:
378+-- The parameter is include_granted_scopes and the allowed values are true and
379+-- false (the default is false). When the value is true, the effect is that if
380+-- your scope authorization request is granted, the Google authorization server
381+-- will roll this authorization together with all the previous authorizations
382+-- granted to the requesting user from the requesting app.
383+
384+-- FIXME: Get around to replacing the threading of Logger, Manager through
385+-- every exchange/refresh call.
386+
387+-- | Retrieve authentication information via the specified 'Credentials' mechanism.
388+--
389+--
390+-- Throws 'AuthError' when environment variables or service account information
391+-- cannot be read, and credentials files are invalid or cannot be found.
392+-- getAuth :: (MonadIO m, MonadCatch m)
393+-- => Credentials
394+-- -> [Scope]
395+-- -> Logger
396+-- -> Manager
397+-- -> m Auth
398+-- getAuth c ss l m = case c of
399+-- FromToken t -> pure (AuthToken t)
400+-- FromFile f -> fromFilePath ss f l m
401+-- FromAccount s -> fromMetadata s l m
402+-- Discover ->
403+-- catching _MissingFileError (fromFile ss l m) $ \f -> do
404+-- p <- isGCE m
405+-- unless p $
406+-- throwingM _MissingFileError f
407+-- fromMetadata "default" l m
408+
409+-- | Attempt credentials discovery via the following steps:
410+--
411+-- * Read the default credentials from a file specified by
412+-- the environment variable @GOOGLE_APPLICATION_CREDENTIALS@ if it exists.
413+--
414+-- * Read the platform equivalent of @~\/.config\/gcloud\/application_default_credentials.json@ if it exists.
415+-- The @~/.config@ component of the path can be overriden by the environment
416+-- variable @CLOUDSDK_CONFIG@ if it exists.
417+--
418+-- * Retrieve the default service account application credentials if
419+-- running on GCE.
420+--
421+-- The specified 'Scope's are used to authorize any @service_account@ that is
422+-- found with the appropriate scopes, otherwise they are not used. See the
423+-- top-level module of each individual @gogol-*@ library for a list of available
424+-- scopes, such as @Network.Google.Compute.computeScope@.
425+discover :: (MonadIO m, MonadCatch m)
426+ => [OAuthScope]
427+ -> Manager
428+ -> m Credentials
429+discover ss m =
430+ catching _MissingFileError (fromFile ss) $ \f -> do
431+ p <- isGCE m
432+ unless p $
433+ throwingM _MissingFileError f
434+ pure $! FromMetadata "default"
435+
436+-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
437+-- file to obtain the credentials neccessary to perform a token refresh.
438+--
439+-- The specified 'Scope's are used to authorize any @service_account@ that is
440+-- found with the appropriate scopes, otherwise they are not used. See the
441+-- top-level module of each individual @gogol-*@ library for a list of available
442+-- scopes, such as @Network.Google.Compute.computeScope@.
443+--
444+-- /See:/ 'cloudSDKConfigPath', 'defaultCredentialsPath'.
445+fromFile :: (MonadIO m, MonadCatch m) => [OAuthScope] -> m Credentials
446+fromFile ss = do
447+ f <- defaultCredentialsPath
448+ case f of
449+ Just x -> fromFilePath ss x
450+ Nothing -> do
451+ x <- cloudSDKConfigPath
452+ fromFilePath ss x
453+
454+-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
455+-- file to obtain the credentials neccessary to perform a token refresh from
456+-- the specified file.
457+--
458+-- The specified 'Scope's are used to authorize any @service_account@ that is
459+-- found with the appropriate scopes, otherwise they are not used. See the
460+-- top-level module of each individual @gogol-*@ library for a list of available
461+-- scopes, such as @Network.Google.Compute.computeScope@.
462+fromFilePath :: (MonadIO m, MonadCatch m)
463+ => [OAuthScope]
464+ -> FilePath
465+ -> m Credentials
466+fromFilePath ss f = do
467+ p <- liftIO (doesFileExist f)
468+ unless p $
469+ throwM (MissingFileError f)
470+ bs <- liftIO (LBS.readFile f)
471+ either (throwM . InvalidFileError f . Text.pack) pure
472+ (fromJSONCredentials ss bs)
473+
474+fromJSONCredentials :: [OAuthScope]
475+ -> LBS.ByteString
476+ -> Either String Credentials
477+fromJSONCredentials ss bs = do
478+ v <- eitherDecode' bs
479+ let x = (`FromAccount` ss) <$> parseEither parseJSON v
480+ y = FromUser <$> parseEither parseJSON v
481+ case (x, y) of
482+ (Left xe, Left ye) -> Left $
483+ "Failed parsing service_account: " ++ xe ++
484+ ", Failed parsing authorized_user: " ++ ye
485+ _ -> x <|> y
486+
487+authorize :: (MonadIO m, MonadCatch m)
488+ => Client.Request
489+ -> Store
490+ -> Logger
491+ -> Manager
492+ -> m Client.Request
493+authorize rq s l m = bearer <$> getToken s l m
494+ where
495+ bearer t = rq
496+ { Client.requestHeaders =
497+ ( hAuthorization
498+ , "Bearer " <> Text.encodeUtf8 (accessToText (_tokenAccess t))
499+ ) : Client.requestHeaders rq
500+ }
501+
502+getToken :: (MonadIO m, MonadCatch m)
503+ => Store
504+ -> Logger
505+ -> Manager
506+ -> m OAuthToken
507+getToken s l m = do
508+ x <- liftIO (readMVar s)
509+ mx <- validateToken x
510+ case mx of
511+ Just t -> pure t
512+ Nothing -> liftIO . modifyMVar s $ \y -> do
513+ my <- validateToken y
514+ case my of
515+ Just t -> pure (y, t)
516+ Nothing ->
517+ case y of
518+ Exchange c -> do
519+ t <- exchange c l m
520+ pure (Refresh c t, t)
521+ Refresh c t -> do
522+ t' <- refresh c t l m
523+ pure (Refresh c t', t')
524+
525+validateToken :: MonadIO m => Auth -> m (Maybe OAuthToken)
526+validateToken Exchange {} = pure Nothing
527+validateToken (Refresh _ t) = do
528+ ts <- liftIO getCurrentTime
529+ if ts < _tokenExpiry t
530+ then pure (Just t)
531+ else pure Nothing
532+
533+exchange :: (MonadIO m, MonadCatch m)
534+ => Credentials
535+ -> Logger
536+ -> Manager
537+ -> m OAuthToken
538+exchange c l m =
539+ case c of
540+ FromMetadata s -> refreshMetadata s l m
541+ FromAccount a ss -> refreshAssertion a ss l m
542+ FromClient c' n -> exchangeCode c' n l m
543+ FromUser AuthorizedUser{..} ->
544+ refreshToken _userId _userSecret (Just _userRefresh) l m
545+
546+formURL :: OAuthClient -> [OAuthScope] -> Text
547+formURL OAuthClient{..} ss =
548+ LText.toStrict . LText.decodeUtf8 . Build.toLazyByteString $
549+ buildText accountsURL
550+ <> "?response_type=code"
551+ <> "&client_id=" <> buildText _clientId
552+ <> "&redirect_uri=" <> buildText redirectURI
553+ <> "&scope=" <> queryEncodeScopes ss
554+
555+redirectURI :: Text
556+redirectURI = "urn:ietf:wg:oauth:2.0:oob"
557+
558+exchangeCode :: (MonadIO m, MonadCatch m)
559+ => OAuthClient
560+ -> OAuthCode
561+ -> Logger
562+ -> Manager
563+ -> m OAuthToken
564+exchangeCode OAuthClient{..} n = refreshRequest $
565+ accountsRequest
566+ { Client.requestBody = buildBody $
567+ "grant_type=authorization_code"
568+ <> "&client_id=" <> buildText _clientId
569+ <> "&client_secret=" <> buildText _clientSecret
570+ <> "&code=" <> buildText n
571+ <> "&redirect_uri=" <> buildText redirectURI
572+ }
573+
574+refresh :: (MonadIO m, MonadCatch m)
575+ => Credentials
576+ -> OAuthToken
577+ -> Logger
578+ -> Manager
579+ -> m OAuthToken
580+refresh c OAuthToken{..} l m =
581+ case c of
582+ FromMetadata s -> refreshMetadata s l m
583+ FromAccount a ss -> refreshAssertion a ss l m
584+ FromClient OAuthClient{..} _ ->
585+ refreshToken _clientId _clientSecret _tokenRefresh l m
586+ FromUser AuthorizedUser{..} ->
587+ refreshToken _userId _userSecret
588+ (_tokenRefresh <|> Just _userRefresh) l m
589+
590+refreshMetadata :: (MonadIO m, MonadCatch m)
591+ => ServiceId
592+ -> Logger
593+ -> Manager
594+ -> m OAuthToken
595+refreshMetadata s = refreshRequest $
596+ metadataRequest
597+ { Client.path = "instance/service-accounts/"
598+ <> Text.encodeUtf8 (serviceIdToText s)
599+ <> "/token"
600+ }
601+
602+refreshToken :: (MonadIO m, MonadCatch m)
603+ => ClientId
604+ -> Secret
605+ -> Maybe RefreshToken
606+ -> Logger
607+ -> Manager
608+ -> m OAuthToken
609+refreshToken c s r = refreshRequest $
610+ accountsRequest
611+ { Client.requestBody = buildBody $
612+ "grant_type=refresh_token"
613+ <> "&client_id=" <> buildText c
614+ <> "&client_secret=" <> buildText s
615+ <> maybe mempty ("&refresh_token=" <>) (buildText <$> r)
616+ }
617+
618+refreshAssertion :: (MonadIO m, MonadCatch m)
619+ => ServiceAccount
620+ -> [OAuthScope]
621+ -> Logger
622+ -> Manager
623+ -> m OAuthToken
624+refreshAssertion s ss l m = do
625+ b <- encodeJWTBearer s ss
626+ let rq = accountsRequest
627+ { Client.requestBody = buildBody $
628+ "grant_type=urn:ietf:params:oauth:grant-type:jwt-bearer"
629+ <> "&assertion="
630+ <> Build.byteString b
631+ }
632+ refreshRequest rq l m
633+
634+encodeJWTBearer :: (MonadIO m, MonadThrow m)
635+ => ServiceAccount
636+ -> [OAuthScope]
637+ -> m ByteString
638+encodeJWTBearer s ss = liftIO $ do
492639 i <- input . truncate <$> getPOSIXTime
493− r <- signSafer (Just SHA256) (_serviceKey s) i
494− either failure (\x -> pure (i <> "." <> signature (base64 x))) r
640+ r <- signSafer (Just SHA256) (_servicePrivateKey s) i
641+ either failure (pure . concat' i) r
495642 where
643+ concat' i x = i <> "." <> signature (base64 x)
644+
496645 failure e = throwM $
497646 TokenRefreshError (toEnum 400) (Text.pack (show e)) Nothing
498647
@@ -512,30 +661,30 @@ jwtEncode s = liftIO $ do
512661 ]
513662
514663 payload = base64Encode
515− [ "aud" .= Text.pack "https://accounts.google.com/o/oauth2/token"
516− , "scope" .= concatScopes (_serviceScope s)
664+ [ "aud" .= accountsURL
665+ , "scope" .= concatScopes ss
517666 , "iat" .= n
518667 , "exp" .= (n + maxTokenLifetimeSeconds)
519668 , "iss" .= _serviceEmail s
520669 ]
521670
522−instance Refresh AuthorisedUser where
523− refresh u@AuthorisedUser{..} = refreshRequest u $
524− accountsRequest
525− { Client.requestBody = RequestBodyBS . Text.encodeUtf8 $
526− "grant_type=refresh_token"
527− <> "&client_id=" <> clientIdToText _userId
528− <> "&client_secret=" <> _userSecret
529− <> "&refresh_token=" <> _userRefresh
530− }
531−
532−instance Refresh ServiceId where
533− refresh sid = refreshRequest sid $
534− metadataRequest
535− { Client.path = "instance/service-accounts/"
536− <> Text.encodeUtf8 (serviceIdToText sid)
537− <> "/token"
538− }
671+queryEncodeScopes :: [OAuthScope] -> Build.Builder
672+queryEncodeScopes =
673+ mconcat
674+ . intersperse "+"
675+ . map (urlEncodeBuilder True . Text.encodeUtf8)
676+ . coerce
677+
678+concatScopes :: [OAuthScope] -> LText.Text
679+concatScopes =
680+ TBuild.toLazyText
681+ . mconcat
682+ . intersperse " "
683+ . map TBuild.fromText
684+ . coerce
685+
686+accountsURL :: Text
687+accountsURL = "https://accounts.google.com/o/oauth2/token"
539688
540689accountsRequest :: Client.Request
541690accountsRequest = def
@@ -545,16 +694,17 @@ accountsRequest = def
545694 , Client.checkStatus = \_ _ _ -> Nothing
546695 , Client.method = "POST"
547696 , Client.path = "/o/oauth2/token"
548− , Client.requestHeaders = [(hContentType, "application/x-www-form-urlencoded")]
697+ , Client.requestHeaders =
698+ [ (hContentType, "application/x-www-form-urlencoded")
699+ ]
549700 }
550701
551702refreshRequest :: (MonadIO m, MonadCatch m)
552− => a
553− -> Client.Request
703+ => Client.Request
554704 -> Logger
555705 -> Manager
556− -> m (Expires a)
557−refreshRequest r rq l m = do
706+ -> m OAuthToken
707+refreshRequest rq l m = do
558708 logDebug l rq -- debug:ClientRequest
559709
560710 rs <- liftIO (httpLbs rq m) `catch` (throwM . RetrievalError)
@@ -572,8 +722,7 @@ refreshRequest r rq l m = do
572722 success s bs = do
573723 f <- parseErr s bs
574724 ts <- liftIO getCurrentTime
575− let Bearer {..} = f ts
576− pure $! Expires _bearerExpiry _bearerAccess r
725+ pure (f ts)
577726
578727 failure s bs = do
579728 let e = "Failure refreshing token from " <> host <> path
@@ -586,7 +735,8 @@ refreshRequest r rq l m = do
586735 case parseLBS bs of
587736 Right !x -> pure x
588737 Left e -> do
589− logError l $ "[Parse Error] Failure parsing token refresh " <> build e
738+ logError l $
739+ "[Parse Error] Failure parsing token refresh " <> build e
590740 refreshErr s e Nothing
591741
592742 refreshErr :: MonadThrow m => Status -> Text -> Maybe Text -> m a
@@ -603,3 +753,9 @@ base64Encode = base64 . LBS.toStrict . encode . object
603753
604754base64 :: ByteArray a => a -> ByteString
605755base64 = convertToBase Base64URLUnpadded
756+
757+buildBody :: Builder -> RequestBody
758+buildBody = RequestBodyLBS . Build.toLazyByteString
759+
760+buildText :: ToText a => a -> Builder
761+buildText = build . toText