b3418ed · gogol · git.iko.soy

git.iko.soy/gogol

Additional documentation updates

commitb3418ed2927aa85d41d1a59bccf6e7d5fd2141ba authorBrendan Hay <brendan.g.hay@gmail.com> dateMon 20 Jun 2016, 08:57 (10 years ago) parentdf84d6f

9 files changed+156−84

compare with develop

unifiedsplit

core/src/Network/Google/Types.hs+11−3 gogol/src/Network/Google.hs+5−2 gogol/src/Network/Google/Auth.hs+8−6 gogol/src/Network/Google/Auth/InstalledApplication.hs+55−11 gogol/src/Network/Google/Auth/Scope.hs+7−6 gogol/src/Network/Google/Auth/ServiceAccount.hs+17−15 gogol/src/Network/Google/Compute/Metadata.hs+30−27 gogol/src/Network/Google/Env.hs+15−8 gogol/src/Network/Google/Internal/Auth.hs+8−6

core/src/Network/Google/Types.hs+11−3

@@ -64,6 +64,7 @@ instance ToHttpApiData AltJSON where toQueryParam = const "json"

6464instance ToHttpApiData AltMedia where toQueryParam = const "media"

6565instance ToHttpApiData Multipart where toQueryParam = const "multipart"

6666

67+-- | An OAuth2 scope.

6768newtype OAuthScope = OAuthScope Text

6869 deriving

6970 ( Eq

@@ -79,6 +80,7 @@ newtype OAuthScope = OAuthScope Text

7980 , ToJSON

8081 )

8182

83+-- | An OAuth2 access token.

8284newtype AccessToken = AccessToken Text

8385 deriving

8486 ( Eq

@@ -94,6 +96,7 @@ newtype AccessToken = AccessToken Text

9496 , ToJSON

9597 )

9698

99+-- | An OAuth2 refresh token.

97100newtype RefreshToken = RefreshToken Text

98101 deriving

99102 ( Eq

@@ -109,6 +112,7 @@ newtype RefreshToken = RefreshToken Text

109112 , ToJSON

110113 )

111114

115+-- | A client identifier.

112116newtype ClientId = ClientId Text

113117 deriving

114118 ( Eq

@@ -124,7 +128,8 @@ newtype ClientId = ClientId Text

124128 , ToJSON

125129 )

126130

127−newtype Secret = Secret Text

131+-- | A service identifier.

132+newtype ServiceId = ServiceId Text

128133 deriving

129134 ( Eq

130135 , Ord

@@ -139,11 +144,11 @@ newtype Secret = Secret Text

139144 , ToJSON

140145 )

141146

142−newtype ServiceId = ServiceId Text

147+-- | An opaque client secret.

148+newtype Secret = Secret Text

143149 deriving

144150 ( Eq

145151 , Ord

146− , Show

147152 , Read

148153 , IsString

149154 , Generic

@@ -154,6 +159,9 @@ newtype ServiceId = ServiceId Text

154159 , ToJSON

155160 )

156161

162+instance Show Secret where

163+ show = const "*****"

164+

157165newtype MediaDownload a = MediaDownload a

158166data MediaUpload a = MediaUpload a Body

159167

gogol/src/Network/Google.hs+5−2

@@ -140,7 +140,6 @@ import Network.Google.Internal.Logger

140140import Network.Google.Prelude

141141import Network.Google.Types

142142import Network.HTTP.Conduit (newManager, tlsManagerSettings)

143−import Network.HTTP.Media.MediaType (MediaType)

144143

145144-- | The 'Google' monad containing configuration environment and tracks

146145-- resource allocation via 'ResourceT'.

@@ -409,12 +408,16 @@ with 'override':

409408-}

410409

411410{- $credentials #credentials#

412−If you wish to manually specify 'Credentials' via 'newEnvWith' you can use one

411+By default 'newEnv' uses 'getApplicationDefault' to discover credentials

412+from the underlying, following Google's official library behaviour.

413+If you wish to manually specify 'Credentials' via 'newEnvWith', you can use one

413414of the following supported credential mechanisms:

414415

415416* "Network.Google.Auth.InstalledApplication" - Applications installed on devices.

416417* "Network.Google.Auth.ServiceAccount" - Applications deployed to custom environments.

417418* "Network.Google.Auth.ApplicationDefault" - Applications deployed to App Engine (GAE) or Compute Engine (GCE).

419+

420+See "Network.Google.Auth" for more information.

418421-}

419422

420423{- $async

gogol/src/Network/Google/Auth.hs+8−6

@@ -37,6 +37,7 @@ module Network.Google.Auth

3737 , fromFilePath

3838

3939 -- ** Installed Application Credentials

40+ , installedApplication

4041 , formURL

4142

4243 -- ** Authorizing Requests

@@ -97,7 +98,7 @@ import Network.HTTP.Types (hAuthorization)

9798-- credentials that can be used to perform a refresh.

9899data Auth (s :: [Symbol]) = Auth

99100 { _credentials :: !(Credentials s)

100− , _token :: !OAuthToken

101+ , _token :: !(OAuthToken s)

101102 }

102103

103104-- | Check if the given token is still valid, ie. younger than the projected

@@ -110,6 +111,7 @@ data Auth (s :: [Symbol]) = Auth

110111validate :: MonadIO m => Auth s -> m Bool

111112validate a = (< _tokenExpiry (_token a)) <$> liftIO getCurrentTime

112113

114+-- | Data store which ensures thread-safe access of credentials.

113115newtype Store (s :: [Symbol]) = Store (MVar (Auth s))

114116

115117-- | Construct storage containing the credentials which have not yet been

@@ -127,7 +129,7 @@ getToken :: (MonadIO m, MonadCatch m, AllowScopes s)

127129 => Store s

128130 -> Logger

129131 -> Manager

130− -> m OAuthToken

132+ -> m (OAuthToken s)

131133getToken (Store s) l m = do

132134 x <- liftIO (readMVar s)

133135 mx <- validate x

@@ -143,7 +145,7 @@ getToken (Store s) l m = do

143145

144146-- | Perform the initial credentials exchange to obtain a valid 'OAuthToken'

145147-- suitable for authorizing requests.

146−exchange :: (MonadIO m, MonadCatch m, AllowScopes s)

148+exchange :: forall m s. (MonadIO m, MonadCatch m, AllowScopes s)

147149 => Credentials s

148150 -> Logger

149151 -> Manager

@@ -152,12 +154,12 @@ exchange c l = fmap (Auth c) . action l

152154 where

153155 action = case c of

154156 FromMetadata s -> metadataToken s

155− FromAccount a -> serviceAccountToken a (allowScopes c)

157+ FromAccount a -> serviceAccountToken a (Proxy :: Proxy s)

156158 FromClient x n -> exchangeCode x n

157159 FromUser u -> authorizedUserToken u Nothing

158160

159161-- | Refresh an existing 'OAuthToken' using

160−refresh :: (MonadIO m, MonadCatch m, AllowScopes s)

162+refresh :: forall m s. (MonadIO m, MonadCatch m, AllowScopes s)

161163 => Auth s

162164 -> Logger

163165 -> Manager

@@ -166,7 +168,7 @@ refresh (Auth c t) l = fmap (Auth c) . action l

166168 where

167169 action = case c of

168170 FromMetadata s -> metadataToken s

169− FromAccount a -> serviceAccountToken a (allowScopes c)

171+ FromAccount a -> serviceAccountToken a (Proxy :: Proxy s)

170172 FromClient x _ -> refreshToken x t

171173 FromUser u -> authorizedUserToken u (_tokenRefresh t)

172174

gogol/src/Network/Google/Auth/InstalledApplication.hs+55−11

@@ -16,7 +16,18 @@

1616-- application, or when the application is running in the background.

1717--

1818-- /See:/ <https://developers.google.com/identity/protocols/OAuth2InstalledApp Installed Application Documentation>.

19−module Network.Google.Auth.InstalledApplication where

19+module Network.Google.Auth.InstalledApplication

20+ ( installedApplication

21+

22+ -- * Forming the URL

23+ , redirectURI

24+ , formURL

25+ , formURLWith

26+

27+ -- * Internal Exchange and Refresh

28+ , exchangeCode

29+ , refreshToken

30+ ) where

2031

2132import Control.Monad.Catch (MonadCatch)

2233import Control.Monad.IO.Class (MonadIO)

@@ -29,14 +40,47 @@ import Network.Google.Prelude

2940import Network.HTTP.Conduit (Manager)

3041import qualified Network.HTTP.Conduit as Client

3142

32−-- | @urn:ietf:wg:oauth:2.0:oob@.

43+-- | Create new Installed Application credentials.

44+--

45+-- Since it is intended that the user opens the URL generated by 'formURL' in a browser

46+-- and the resulting 'OAuthCode' is then received out-of-band,

47+-- you must ensure that the scopes passed to 'formURL' and the type of 'OAuthCode'

48+-- correctly match, otherwise an authorization error will occur.

49+--

50+-- For example, doing this via 'getLine' and copy-paste:

51+--

52+-- > {-# LANGUAGE ScopedTypeVariables #-}

53+--

54+-- > import Data.Proxy (Proxy (..))

55+-- > import System.Exit (exitFailure)

56+-- > import System.Info (os)

57+-- > import System.Process (rawSystem)

58+--

59+-- > import qualified Data.ByteString as BS

60+-- > import qualified Data.ByteString.Lazy.Char8 as LBS8

61+-- >

62+-- > redirectPrompt :: forall s. OAuthClient -> proxy s -> IO (OAuthCode s)

63+-- > redirectPrompt c p = do

64+-- > let url = LBS8.unpack (formURL c (Proxy :: Proxy s))

65+-- > putStrLn $ "Opening URL " ++ url

66+-- > case os of

67+-- > "darwin" -> rawSystem "open" [url]

68+-- > "linux" -> rawSystem "xdg-open" [url]

69+-- > _ -> putStrLn "Unsupported OS" >> exitFailure

70+-- > putStrLn "Please input the authorisation code: "

71+-- > OAuthCode . LBS.fromStrict <$> BS.getLine

72+--

73+-- This ensures the scopes passed to 'formURL' and the type of 'OAuthCode' 's'

74+-- are correct.

75+installedApplication :: OAuthClient -> OAuthCode s -> Credentials s

76+installedApplication = FromClient

77+

78+-- | The redirection URI used in 'formURL': @urn:ietf:wg:oauth:2.0:oob@.

3379redirectURI :: Text

3480redirectURI = "urn:ietf:wg:oauth:2.0:oob"

3581

3682-- | Given an 'OAuthClient' and a list of scopes to authorize,

37−-- construct a URL that can be used to obtain the 'OAuthCode' required to

38−-- instantiate 'FromClient'-style credentials. The received code can be used

39−-- with 'exchangeCode'.

83+-- construct a URL that can be used to obtain the 'OAuthCode'.

4084--

4185-- /See:/ <https://developers.google.com/accounts/docs/OAuth2InstalledApp#formingtheurl Forming the URL>.

4286formURL :: AllowScopes s => OAuthClient -> proxy s -> Text

@@ -52,16 +96,16 @@ formURLWith c ss = accountsURL

5296 <> "&redirect_uri=" <> redirectURI

5397 <> "&scope=" <> Text.decodeUtf8 (queryEncodeScopes ss)

5498

55−-- | Exchange your 'OAuthClient' details and the 'OAuthCode' you received from

56−-- using 'formURL' with a valid 'OAuthToken'.

99+-- | Exchange 'OAuthClient' details and the received 'OAuthCode' for a new

100+-- 'OAuthToken'.

57101--

58102-- /See:/ <https://developers.google.com/accounts/docs/OAuth2InstalledApp#handlingtheresponse Exchanging the code>.

59103exchangeCode :: (MonadIO m, MonadCatch m)

60104 => OAuthClient

61− -> OAuthCode

105+ -> (OAuthCode s)

62106 -> Logger

63107 -> Manager

64− -> m OAuthToken

108+ -> m (OAuthToken s)

65109exchangeCode c n = refreshRequest $

66110 accountsRequest

67111 { Client.requestBody = textBody $

@@ -77,10 +121,10 @@ exchangeCode c n = refreshRequest $

77121-- /See:/ <https://developers.google.com/accounts/docs/OAuth2InstalledApp#refresh Refreshing tokens>.

78122refreshToken :: (MonadIO m, MonadCatch m)

79123 => OAuthClient

80− -> OAuthToken

124+ -> (OAuthToken s)

81125 -> Logger

82126 -> Manager

83− -> m OAuthToken

127+ -> m (OAuthToken s)

84128refreshToken c t = refreshRequest $

85129 accountsRequest

86130 { Client.requestBody = textBody $

gogol/src/Network/Google/Auth/Scope.hs+7−6

@@ -15,8 +15,7 @@

1515-- Stability : provisional

1616-- Portability : non-portable (GHC extensions)

1717--

18−-- Explicitly specify your Google credentials, or retrieve them

19−-- from the underlying OS.

18+-- Helpers for specifying and using 'Scope's with "Network.Google".

2019module Network.Google.Auth.Scope where

2120

2221import Data.ByteString (ByteString)

@@ -36,11 +35,11 @@ import Network.Google.Prelude (GoogleRequest (..),

3635import Network.HTTP.Types (urlEncode)

3736

3837-- | Annotate credentials with the specified scopes.

39−-- This exists to allow users to choose between using 'getCredentials'

40−-- with a 'Proxy' type constructed via use of '!', or explicitly

41−-- specifying the scopes in a type annotation.

38+-- This exists to allow users to choose between using 'newEnv'

39+-- with a 'Proxy' constructed by '!', or explicitly

40+-- specifying scopes via a type annotation.

4241--

43−-- /See:/ '!' and the scopes available for each service.

42+-- /See:/ '!', 'envScopes', and the scopes available for each service.

4443allow :: proxy s -> k s -> k s

4544allow _ = id

4645

@@ -106,9 +105,11 @@ instance (KnownSymbol x, AllowScopes xs) => AllowScopes (x ': xs) where

106105instance AllowScopes s => AllowScopes (Credentials s) where

107106 allowScopes _ = allowScopes (Proxy :: Proxy s)

108107

108+-- | Concatenate a list of scopes using spaces.

109109concatScopes :: [OAuthScope] -> Text

110110concatScopes = Text.intercalate " " . coerce

111111

112+-- | Encode a list of scopes suitable for embedding in a query string.

112113queryEncodeScopes :: [OAuthScope] -> ByteString

113114queryEncodeScopes =

114115 BS8.intercalate "+"

gogol/src/Network/Google/Auth/ServiceAccount.hs+17−15

@@ -1,4 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE PolyKinds #-}

34-- |

45-- Module : Network.Google.Auth.ServiceAccount

@@ -27,7 +28,8 @@ import qualified Data.ByteString.Char8 as BS8

2728import qualified Data.Text as Text

2829import qualified Data.Text.Encoding as Text

2930import Data.Time.Clock.POSIX

30−import Network.Google.Auth.Scope (concatScopes)

31+import Network.Google.Auth.Scope (AllowScopes (..),

32+ concatScopes)

3133import Network.Google.Compute.Metadata

3234import Network.Google.Internal.Auth

3335import Network.Google.Internal.Logger

@@ -48,7 +50,7 @@ metadataToken :: (MonadIO m, MonadCatch m)

4850 => ServiceId

4951 -> Logger

5052 -> Manager

51− -> m OAuthToken

53+ -> m (OAuthToken s)

5254metadataToken s = refreshRequest $

5355 metadataRequest

5456 { Client.path = "instance/service-accounts/"

@@ -57,14 +59,14 @@ metadataToken s = refreshRequest $

5759 }

5860

5961-- | Use the 'AuthorizedUser' to obtain a new 'OAuthToken'. If the supplied

60−-- 'RefreshToken' is 'Nothing', the original 'RefreshToken' from he user will

62+-- 'RefreshToken' is 'Nothing', the original 'RefreshToken' from the user will

6163-- be used.

6264authorizedUserToken :: (MonadIO m, MonadCatch m)

6365 => AuthorizedUser

6466 -> Maybe RefreshToken

6567 -> Logger

6668 -> Manager

67− -> m OAuthToken

69+ -> m (OAuthToken s)

6870authorizedUserToken u r = refreshRequest $

6971 accountsRequest

7072 { Client.requestBody = textBody $

@@ -75,16 +77,16 @@ authorizedUserToken u r = refreshRequest $

7577 }

7678

7779

78−-- | Obtain an 'OAuthToken' from 'accountsURL' by signing and

79−-- sending a JSON Web Token (JWT) using the supplied 'ServiceAccount'.

80−serviceAccountToken :: (MonadIO m, MonadCatch m)

80+-- | Obtain an 'OAuthToken' from @https://accounts.google.com/o/oauth2/token@

81+-- by signing and sending a JSON Web Token (JWT) using the supplied 'ServiceAccount'.

82+serviceAccountToken :: (MonadIO m, MonadCatch m, AllowScopes s)

8183 => ServiceAccount

82− -> [OAuthScope]

84+ -> proxy s

8385 -> Logger

8486 -> Manager

85− -> m OAuthToken

86−serviceAccountToken s ss l m = do

87− b <- encodeBearerJWT s ss

87+ -> m (OAuthToken s)

88+serviceAccountToken s p l m = do

89+ b <- encodeBearerJWT s p

8890 let rq = accountsRequest

8991 { Client.requestBody = RequestBodyBS $

9092 "grant_type=urn:ietf:params:oauth:grant-type:jwt-bearer"

@@ -95,11 +97,11 @@ serviceAccountToken s ss l m = do

9597

9698-- | Encode the supplied 'ServiceAccount's key id, email, and scopes using the

9799-- private key in the JSON Web Token (JWT) format.

98−encodeBearerJWT :: (MonadIO m, MonadThrow m)

100+encodeBearerJWT :: (MonadIO m, MonadThrow m, AllowScopes s)

99101 => ServiceAccount

100− -> [OAuthScope]

102+ -> proxy s

101103 -> m ByteString

102−encodeBearerJWT s ss = liftIO $ do

104+encodeBearerJWT s p = liftIO $ do

103105 i <- input . truncate <$> getPOSIXTime

104106 r <- signSafer (Just SHA256) (_servicePrivateKey s) i

105107 either failure (pure . concat' i) r

@@ -126,7 +128,7 @@ encodeBearerJWT s ss = liftIO $ do

126128

127129 payload = base64Encode

128130 [ "aud" .= accountsURL

129− , "scope" .= concatScopes ss

131+ , "scope" .= concatScopes (allowScopes p)

130132 , "iat" .= n

131133 , "exp" .= (n + seconds maxTokenLifetime)

132134 , "iss" .= _serviceEmail s

gogol/src/Network/Google/Compute/Metadata.hs+30−27

@@ -12,7 +12,8 @@

1212-- information about your instance or project.

1313--

1414-- This module contains functions for retrieving various Compute metadata from an

15−-- instance's local metadata endpoint using 'MonadIO' and not the Google monad.

15+-- instance\'s local metadata endpoint using 'MonadIO', prior to initialisation

16+-- of the environment used by the "Network.Google" monad.

1617module Network.Google.Compute.Metadata

1718 (

1819 -- * Google Compute Instance Check

@@ -35,8 +36,8 @@ module Network.Google.Compute.Metadata

3536 -- * Raw Metadata Requests

3637 , metadataFlavorHeader

3738 , metadataFlavorDesired

38− , metadata

3939 , metadataRequest

40+ , getMetadata

4041 ) where

4142

4243import Control.Monad.Catch

@@ -55,7 +56,7 @@ import qualified Network.HTTP.Conduit as Client

5556import Network.HTTP.Types (HeaderName)

5657import System.Environment (lookupEnv)

5758

58−-- | @NO_GCE_CHECK@.

59+-- | The @NO_GCE_CHECK@ environment variable.

5960checkGCEVar :: String

6061checkGCEVar = "NO_GCE_CHECK"

6162

@@ -96,14 +97,14 @@ isGCE m = liftIO $ do

9697-- | A directory of custom metadata values that have been set for this project.

9798getProjectAttribute :: MonadIO m => Text -> Manager -> m (Maybe LBS.ByteString)

9899getProjectAttribute k =

99− metadataMaybe ("project/attributes/" <> Text.encodeUtf8 k)

100+ getMetadataMaybe ("project/attributes/" <> Text.encodeUtf8 k)

100101

101102-- | SSH keys that can connect to instances in the project. SSH keys for Compute

102103-- Engine use a specialized format where the keys are prepended with a username,

103104-- like so: @user1:ssh-rsa my-public-ssh-key user1@host.com@

104105getSSHKeys :: MonadIO m => Manager -> m [Text]

105106getSSHKeys m = do

106− mx <- metadataMaybe "project/attributes/sshKeys" m

107+ mx <- getMetadataMaybe "project/attributes/sshKeys" m

107108 case mx of

108109 Nothing -> pure []

109110 Just x -> pure

@@ -116,48 +117,48 @@ getSSHKeys m = do

116117-- the project-id metadata entry value. The project-id value is required for all

117118-- requests to the Compute Engine service.

118119getNumericProjectId :: MonadIO m => Manager -> m Text

119−getNumericProjectId = metadataText "project/numeric-project-id"

120+getNumericProjectId = getMetadataText "project/numeric-project-id"

120121

121122-- | The project ID.

122123getProjectId :: MonadIO m => Manager -> m Text

123−getProjectId = metadataText "project/project-id"

124+getProjectId = getMetadataText "project/project-id"

124125

125126-- | A directory of custom metadata values passed to the instance during startup

126127-- or shutdown.

127128getInstanceAttribute :: MonadIO m => Text -> Manager -> m (Maybe LBS.ByteString)

128129getInstanceAttribute k =

129− metadataMaybe ("instance/attributes/" <> Text.encodeUtf8 k)

130+ getMetadataMaybe ("instance/attributes/" <> Text.encodeUtf8 k)

130131

131132-- | The free-text description of an instance, assigned using the

132133-- @--description@ flag, or set in the API.

133134getDescription :: MonadIO m => Manager -> m Text

134−getDescription = metadataText "instance/description"

135+getDescription = getMetadataText "instance/description"

135136

136137-- | The host name of the instance.

137138getHostname :: MonadIO m => Manager -> m Text

138−getHostname = metadataText "instance/hostname"

139+getHostname = getMetadataText "instance/hostname"

139140

140141-- | The ID of the instance. This is a unique, numerical ID that is generated by

141142-- Google Compute Engine. This is useful for identifying instances if you do not

142143-- want to use instance names.

143144getInstanceId :: MonadIO m => Manager -> m Text

144−getInstanceId = metadataText "instance/id"

145+getInstanceId = getMetadataText "instance/id"

145146

146147-- | The fully-qualified machine type name of the instance's host machine.

147148getMachineType :: MonadIO m => Manager -> m Text

148−getMachineType = metadataText "instance/machine-type"

149+getMachineType = getMetadataText "instance/machine-type"

149150

150151-- | Any tags associated with the instance.

151152getTags :: MonadIO m => Manager -> m [Text]

152153getTags m = do

153− rs <- metadata "instance/tags" [] m

154+ rs <- getMetadata "instance/tags" [] m

154155 case eitherDecode' (Client.responseBody rs) of

155156 Left _ -> pure []

156157 Right xs -> pure xs

157158

158159-- | The instance's zone.

159160getZone :: MonadIO m => Manager -> m Text

160−getZone = metadataText "instance/zone"

161+getZone = getMetadataText "instance/zone"

161162

162163-- -- | A directory of disks attached to this instance.

163164-- getDisk ::

@@ -200,29 +201,29 @@ getZone = metadataText "instance/zone"

200201-- Metadata wait for change

201202-- curl "http://metadata.google.internal/computeMetadata/v1/instance/tags?wait_for_change=true"

202203

203−metadataMaybe :: MonadIO m

204+getMetadataMaybe :: MonadIO m

204205 => ByteString

205206 -> Manager

206207 -> m (Maybe LBS.ByteString)

207−metadataMaybe path m = do

208− rs <- metadata path [404] m

208+getMetadataMaybe path m = do

209+ rs <- getMetadata path [404] m

209210 if fromEnum (Client.responseStatus rs) == 404

210211 then pure Nothing

211212 else pure $ Just (Client.responseBody rs)

212213

213−metadataText :: MonadIO m

214+getMetadataText :: MonadIO m

214215 => ByteString

215216 -> Manager

216217 -> m Text

217−metadataText path m = LText.toStrict . LText.decodeUtf8 . Client.responseBody

218− <$> metadata path [] m

219−

220−metadata :: MonadIO m

221− => ByteString

222− -> [Int]

223− -> Manager

224− -> m (Client.Response LBS.ByteString)

225−metadata path ss m =

218+getMetadataText path m = LText.toStrict . LText.decodeUtf8 . Client.responseBody

219+ <$> getMetadata path [] m

220+

221+getMetadata :: MonadIO m

222+ => ByteString -- ^ The request path.

223+ -> [Int] -- ^ Acceptable status code responses.

224+ -> Manager

225+ -> m (Client.Response LBS.ByteString)

226+getMetadata path ss m =

226227 liftIO . flip Client.httpLbs m $ metadataRequest

227228 { Client.path = "/computeMetadata/v1/" <> path

228229 , Client.checkStatus = \s hs cj ->

@@ -232,6 +233,8 @@ metadata path ss m =

232233 else Just . toException $ StatusCodeException s hs cj

233234 }

234235

236+-- | A default @http-client@ 'Client.Request' with the host, port, and headers

237+-- set appropriately for @metadata.google.internal@ use.

235238metadataRequest :: Client.Request

236239metadataRequest = def

237240 { Client.host = "metadata.google.internal"

gogol/src/Network/Google/Env.hs+15−8

@@ -13,7 +13,7 @@

1313-- Stability : provisional

1414-- Portability : non-portable (GHC extensions)

1515--

16−-- Environment and Google specific configuration for the 'Network.Google' monad.

16+-- Environment and Google specific configuration for the "Network.Google" monad.

1717module Network.Google.Env where

1818

1919import Control.Lens (Lens', lens, (<>~), (?~))

@@ -70,21 +70,28 @@ class HasEnv s a | a -> s where

7070instance HasEnv s (Env s) where

7171 environment = id

7272

73−-- | Provide a function which will be added to the existing stack

74−-- of overrides which are applied to all service configurations.

73+-- | Provide a function which will be added to the stack

74+-- of overrides, which are applied to all service configurations.

75+-- This provides a way to configure any request that is sent using the

76+-- modified 'Env'.

7577--

7678-- /See:/ 'override'.

7779configure :: HasEnv s a => (ServiceConfig -> ServiceConfig) -> a -> a

7880configure f = envOverride <>~ Dual (Endo f)

7981

80−-- | Configure a specific 'Service'. All requests belonging to the

82+-- | Override a specific 'ServiceConfig'. All requests belonging to the

8183-- supplied service will use this configuration instead of the default.

8284--

83−-- It's suggested you use a modified version of the default 'Service', such as:

85+-- Typically you would override a modified version of the default 'ServiceConfig'

86+-- for the desired service:

8487--

85−-- @

86−-- override (Network.Google.Gmail.gmailService & serviceHost .~ "localhost") env

87−-- @

88+-- > override (gmailService & serviceHost .~ "localhost") env

89+--

90+-- Or when using "Network.Google" with "Control.Monad.Reader" or "Control.Lens.Zoom"

91+-- and the 'ServiceConfig' lenses:

92+--

93+-- > local (override (computeService & serviceHost .~ "localhost")) $ do

94+-- > ...

8895--

8996-- /See:/ 'configure'.

9097override :: HasEnv s a => ServiceConfig -> a -> a

gogol/src/Network/Google/Internal/Auth.hs+8−6

@@ -17,6 +17,7 @@

1717-- Stability : provisional

1818-- Portability : non-portable (GHC extensions)

1919--

20+-- Internal types and helpers for constructing OAuth credentials.

2021module Network.Google.Internal.Auth where

2122

2223import Control.Exception.Lens (exception)

@@ -51,7 +52,7 @@ data Credentials (s :: [Symbol])

5152 -- ^ Obtain and refresh access tokens from the underlying GCE host metadata

5253 -- at @http:\/\/169.254.169.254@.

5354

54− | FromClient !OAuthClient !OAuthCode

55+ | FromClient !OAuthClient !(OAuthCode s)

5556 -- ^ Obtain and refresh access tokens using the specified client secret

5657 -- and authorization code obtained from.

5758 --

@@ -154,23 +155,24 @@ data OAuthClient = OAuthClient

154155The '_tokenAccess' field will be inserted verbatim into the

155156@Authorization: Bearer ...@ header for all HTTP requests.

156157-}

157−data OAuthToken = OAuthToken

158+data OAuthToken (s :: [Symbol]) = OAuthToken

158159 { _tokenAccess :: !AccessToken

159160 , _tokenRefresh :: !(Maybe RefreshToken)

160161 , _tokenExpiry :: !UTCTime

161162 } deriving (Eq, Show)

162163

163−instance FromJSON (UTCTime -> OAuthToken) where

164+instance FromJSON (UTCTime -> OAuthToken s) where

164165 parseJSON = withObject "bearer" $ \o -> do

165166 t <- o .: "access_token"

166167 r <- o .:? "refresh_token"

167168 e <- o .: "expires_in" <&> fromInteger

168169 pure (OAuthToken t r . addUTCTime e)

169170

170−newtype OAuthCode = OAuthCode Text

171+-- | An OAuth client authorization code.

172+newtype OAuthCode (s :: [Symbol]) = OAuthCode Text

171173 deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable, FromJSON, ToJSON)

172174

173−instance ToHttpApiData OAuthCode where

175+instance ToHttpApiData (OAuthCode s) where

174176 toQueryParam (OAuthCode c) = c

175177 toHeader (OAuthCode c) = Text.encodeUtf8 c

176178

@@ -264,7 +266,7 @@ refreshRequest :: (MonadIO m, MonadCatch m)

264266 => Client.Request

265267 -> Logger

266268 -> Manager

267− -> m OAuthToken

269+ -> m (OAuthToken s)

268270refreshRequest rq l m = do

269271 logDebug l rq -- debug:ClientRequest

270272