| Copyright | (c) 2015-2016 Brendan Hay |
|---|---|
| License | Mozilla Public License, v. 2.0. |
| Maintainer | Brendan Hay <brendan.g.hay@gmail.com> |
| Stability | provisional |
| Portability | non-portable (GHC extensions) |
| Safe Haskell | None |
| Language | Haskell2010 |
Network.Google.Auth
Contents
Description
Explicitly specify your Google credentials, or retrieve them from the underlying OS.
- data Credentials s
- = FromMetadata !ServiceId
- | FromClient !OAuthClient !(OAuthCode s)
- | FromAccount !ServiceAccount
- | FromUser !AuthorizedUser
- getApplicationDefault :: (MonadIO m, MonadCatch m) => Manager -> m (Credentials s)
- fromWellKnownPath :: (MonadIO m, MonadCatch m) => m (Credentials s)
- fromFilePath :: (MonadIO m, MonadCatch m) => FilePath -> m (Credentials s)
- saveAuthorizedUserToWellKnownPath :: (MonadIO m, MonadCatch m) => Bool -> AuthorizedUser -> m ()
- saveAuthorizedUser :: (MonadIO m, MonadCatch m) => FilePath -> Bool -> AuthorizedUser -> m ()
- installedApplication :: OAuthClient -> OAuthCode s -> Credentials s
- formURL :: AllowScopes (s :: [Symbol]) => OAuthClient -> proxy s -> Text
- authorize :: (MonadIO m, MonadCatch m, AllowScopes s) => Request -> Store s -> Logger -> Manager -> m Request
- data Store s
- initStore :: (MonadIO m, MonadCatch m, AllowScopes s) => Credentials s -> Logger -> Manager -> m (Store s)
- retrieveAuthFromStore :: (MonadIO m, MonadCatch m, AllowScopes s) => Store s -> m (Auth s)
- data Auth s = Auth {
- _credentials :: !(Credentials s)
- _token :: !(OAuthToken s)
- authToAuthorizedUser :: AllowScopes s => Auth s -> Either Text AuthorizedUser
- exchange :: forall m s. (MonadIO m, MonadCatch m, AllowScopes s) => Credentials s -> Logger -> Manager -> m (Auth s)
- refresh :: forall m s. (MonadIO m, MonadCatch m, AllowScopes s) => Auth s -> Logger -> Manager -> m (Auth s)
- checkGCEVar :: String
- cloudSDKConfigDir :: String
- defaultCredentialsFile :: String
- class AsAuthError a where
- data AuthError
- data OAuthClient = OAuthClient {
- _clientId :: !ClientId
- _clientSecret :: !Secret
- data OAuthToken s = OAuthToken {
- _tokenAccess :: !AccessToken
- _tokenRefresh :: !(Maybe RefreshToken)
- _tokenExpiry :: !UTCTime
- newtype OAuthCode s = OAuthCode Text
- newtype OAuthScope :: * = OAuthScope Text
- newtype AccessToken :: * = AccessToken Text
- newtype RefreshToken :: * = RefreshToken Text
- newtype Secret :: * = Secret Text
- newtype ServiceId :: * = ServiceId Text
- newtype ClientId :: * = ClientId Text
- module Network.Google.Auth.Scope
Credentials
data Credentials s Source #
The supported credential mechanisms.
Constructors
| FromMetadata !ServiceId | Obtain and refresh access tokens from the underlying GCE host metadata
at |
| FromClient !OAuthClient !(OAuthCode s) | Obtain and refresh access tokens using the specified client secret and authorization code obtained from. See the OAuth2 Installed Application documentation for more information. |
| FromAccount !ServiceAccount | Use the specified A |
| FromUser !AuthorizedUser | Use the specified An |
Instances
| AllowScopes [Symbol] s => AllowScopes * (Credentials s) Source # | |
Application Default Credentials
getApplicationDefault :: (MonadIO m, MonadCatch m) => Manager -> m (Credentials s) Source #
Performs credentials discovery in the following order:
- Read the default credentials from a file specified by
the environment variable
GOOGLE_APPLICATION_CREDENTIALSif it exists. - Read the platform equivalent of
~/.config/gcloud/application_default_credentials.jsonif it exists. The~/.configcomponent of the path can be overriden by the environment variableCLOUDSDK_CONFIGif it exists. - Retrieve the default service account application credentials if
running on GCE. The environment variable
NO_GCE_CHECKcan be used to skip this check if set to a truthy value such as1ortrue.
The specified Scopes are used to authorize any service_account that is
found with the appropriate OAuth2 scopes, otherwise they are not used. See the
top-level module of each individual gogol-* library for a list of available
scopes, such as Network.Google.Compute.computeScope.
fromWellKnownPath :: (MonadIO m, MonadCatch m) => m (Credentials s) Source #
Attempt to load either a service_account or authorized_user formatted
file to obtain the credentials neccessary to perform a token refresh.
The specified Scopes are used to authorize any service_account that is
found with the appropriate scopes, otherwise they are not used. See the
top-level module of each individual gogol-* library for a list of available
scopes, such as Network.Google.Compute.computeScope.
fromFilePath :: (MonadIO m, MonadCatch m) => FilePath -> m (Credentials s) Source #
Attempt to load either a service_account or authorized_user formatted
file to obtain the credentials neccessary to perform a token refresh from
the specified file.
The specified Scopes are used to authorize any service_account that is
found with the appropriate scopes, otherwise they are not used. See the
top-level module of each individual gogol-* library for a list of available
scopes, such as Network.Google.Compute.computeScope.
saveAuthorizedUserToWellKnownPath Source #
Arguments
| :: (MonadIO m, MonadCatch m) | |
| => Bool | Force to save if True |
| -> AuthorizedUser | |
| -> m () |
Save AuthorizedUser
See: cloudSDKConfigPath, defaultCredentialsPath.
Arguments
| :: (MonadIO m, MonadCatch m) | |
| => FilePath | |
| -> Bool | Force to save if True |
| -> AuthorizedUser | |
| -> m () |
Save AuthorizedUser
Installed Application Credentials
installedApplication :: OAuthClient -> OAuthCode s -> Credentials s Source #
Create new Installed Application credentials.
Since it is intended that the user opens the URL generated by formURL in a browser
and the resulting OAuthCode is then received out-of-band,
you must ensure that the scopes passed to formURL and the type of OAuthCode
correctly match, otherwise an authorization error will occur.
For example, doing this via getLine and copy-paste:
{-# LANGUAGE ScopedTypeVariables #-}import Data.Proxy (Proxy (..)) import Data.Text as T import Data.Text.IO as T import System.Exit (exitFailure) import System.Info (os) import System.Process (rawSystem)
redirectPrompt :: AllowScopes (s :: [Symbol]) => OAuthClient -> proxy s -> IO (OAuthCode s)
redirectPrompt c p = do
let url = formURL c p
T.putStrLn $ "Opening URL " `T.append` url
_ <- case os of
"darwin" -> rawSystem "open" [unpack url]
"linux" -> rawSystem "xdg-open" [unpack url]
_ -> T.putStrLn "Unsupported OS" >> exitFailure
T.putStrLn "Please input the authorisation code: "
OAuthCode <$> T.getLineThis ensures the scopes passed to formURL and the type of OAuthCode s
are correct.
formURL :: AllowScopes (s :: [Symbol]) => OAuthClient -> proxy s -> Text Source #
Given an OAuthClient and a list of scopes to authorize,
construct a URL that can be used to obtain the OAuthCode.
See: Forming the URL.
Authorizing Requests
authorize :: (MonadIO m, MonadCatch m, AllowScopes s) => Request -> Store s -> Logger -> Manager -> m Request Source #
Apply the (by way of possible token refresh) a bearer token to the authentication header of a request.
Thread-safe Storage
initStore :: (MonadIO m, MonadCatch m, AllowScopes s) => Credentials s -> Logger -> Manager -> m (Store s) Source #
Construct storage containing the credentials which have not yet been exchanged or refreshed.
retrieveAuthFromStore :: (MonadIO m, MonadCatch m, AllowScopes s) => Store s -> m (Auth s) Source #
Retrieve auth from storage
An OAuthToken that can potentially be expired, with the original
credentials that can be used to perform a refresh.
Constructors
| Auth | |
Fields
| |
authToAuthorizedUser :: AllowScopes s => Auth s -> Either Text AuthorizedUser Source #
authToAuthorizedUser converts Auth into an AuthorizedUser
by returning Right if there is a FromClient-constructed
Credentials and a refreshed token; otherwise, returning
Left with error message.
exchange :: forall m s. (MonadIO m, MonadCatch m, AllowScopes s) => Credentials s -> Logger -> Manager -> m (Auth s) Source #
Perform the initial credentials exchange to obtain a valid OAuthToken
suitable for authorizing requests.
refresh :: forall m s. (MonadIO m, MonadCatch m, AllowScopes s) => Auth s -> Logger -> Manager -> m (Auth s) Source #
Refresh an existing OAuthToken.
Default Constants
checkGCEVar :: String Source #
The NO_GCE_CHECK environment variable.
cloudSDKConfigDir :: String Source #
The environment variable name which is used to specify the directory
containing the application_default_credentials.json generated by gcloud init.
defaultCredentialsFile :: String Source #
The environment variable pointing the file with local Application Default Credentials.
Handling Errors
class AsAuthError a where Source #
Minimal complete definition
Methods
_AuthError :: Prism' a AuthError Source #
A general authentication error.
_RetrievalError :: Prism' a HttpException Source #
An error occured while communicating over HTTP with either then local metadata or remote accounts.google.com endpoints.
_MissingFileError :: Prism' a FilePath Source #
The specified default credentials file could not be found.
_InvalidFileError :: Prism' a (FilePath, Text) Source #
An error occured parsing the default credentials file.
_TokenRefreshError :: Prism' a (Status, Text, Maybe Text) Source #
An error occured when attempting to refresh a token.
Instances
An error thrown when attempting to readwrite AuthNAuthZ information.
OAuth Types
data OAuthClient Source #
A client identifier and accompanying secret used to obtain/refresh a token.
Constructors
| OAuthClient | |
Fields
| |
Instances
data OAuthToken s Source #
An OAuth bearer type token of the following form:
{
\"token_type\": \"Bearer\",
\"access_token\": \"eyJhbGci...\",
\"refresh_token\": \"1/B3gq9K...\",
\"expires_in\": 3600,
...
}The _tokenAccess field will be inserted verbatim into the
Authorization: Bearer ... header for all HTTP requests.
Constructors
| OAuthToken | |
Fields
| |
Instances
| Eq (OAuthToken s) Source # | |
| Show (OAuthToken s) Source # | |
| FromJSON (UTCTime -> OAuthToken s) Source # | |
An OAuth client authorization code.
Instances
| Eq (OAuthCode s) Source # | |
| Ord (OAuthCode s) Source # | |
| Read (OAuthCode s) Source # | |
| Show (OAuthCode s) Source # | |
| IsString (OAuthCode s) Source # | |
| Generic (OAuthCode s) Source # | |
| ToJSON (OAuthCode s) Source # | |
| FromJSON (OAuthCode s) Source # | |
| ToHttpApiData (OAuthCode s) Source # | |
| type Rep (OAuthCode s) Source # | |
Re-exported Types
An opaque client secret.
A service identifier.
A client identifier.
Re-exported Modules
module Network.Google.Auth.Scope