| 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
Contents
Description
This module provides a Google monad and common set of operations which
can be performed against the remote Google Service APIs. Typically you will
import this module along with modules from various gogol-* libraries
for the services you wish to communicate with.
Synopsis
- newtype Google s a = Google {}
- class (Functor m, Applicative m, Monad m, MonadIO m, MonadCatch m, AllowScopes s) => MonadGoogle s m | m -> s where
- liftGoogle :: Google s a -> m a
- runGoogle :: (MonadResource m, HasEnv s r) => r -> Google s a -> m a
- runResourceT :: MonadUnliftIO m => ResourceT m a -> m a
- data Env (s :: [Symbol])
- class HasEnv s a | a -> s where
- environment :: Lens' a (Env s)
- envOverride :: Lens' a (Dual (Endo ServiceConfig))
- envLogger :: Lens' a Logger
- envManager :: Lens' a Manager
- envStore :: Lens' a (Store s)
- envScopes :: Lens' a (Proxy s)
- newEnv :: (MonadIO m, MonadCatch m, AllowScopes s) => m (Env s)
- newEnvWith :: (MonadIO m, MonadCatch m, AllowScopes s) => Credentials s -> Logger -> Manager -> m (Env s)
- getApplicationDefault :: (MonadIO m, MonadCatch m) => Manager -> m (Credentials s)
- (!) :: proxy xs -> proxy ys -> Proxy (Nub (xs ++ ys))
- allow :: proxy s -> k s -> k s
- class AllowScopes a
- type family HasScope (s :: [Symbol]) a :: Constraint where ...
- send :: (MonadGoogle s m, HasScope s a, GoogleRequest a) => a -> m (Rs a)
- download :: (MonadGoogle s m, HasScope s (MediaDownload a), GoogleRequest (MediaDownload a)) => a -> m (Rs (MediaDownload a))
- upload :: (MonadGoogle s m, HasScope s (MediaUpload a), GoogleRequest (MediaUpload a)) => a -> GBody -> m (Rs (MediaUpload a))
- data GBody = GBody !MediaType !RequestBody
- bodyContentType :: Lens' GBody MediaType
- sourceBody :: MonadIO m => FilePath -> m GBody
- getMIMEType :: FilePath -> MediaType
- configure :: HasEnv s a => (ServiceConfig -> ServiceConfig) -> a -> a
- override :: HasEnv s a => ServiceConfig -> a -> a
- timeout :: (MonadReader r m, HasEnv s r) => Seconds -> m a -> m a
- serviceHost :: Lens' ServiceConfig ByteString
- servicePort :: Lens' ServiceConfig Int
- servicePath :: Lens' ServiceConfig Builder
- serviceSecure :: Lens' ServiceConfig Bool
- serviceTimeout :: Lens' ServiceConfig (Maybe Seconds)
- class AsError a where
- class AsAuthError a where
- _AuthError :: Prism' a AuthError
- _RetrievalError :: Prism' a HttpException
- _MissingFileError :: Prism' a FilePath
- _InvalidFileError :: Prism' a (FilePath, Text)
- _TokenRefreshError :: Prism' a (Status, Text, Maybe Text)
- trying :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Either a r)
- catching :: MonadCatch m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
- type Logger = LogLevel -> Builder -> IO ()
- data LogLevel
- newLogger :: MonadIO m => LogLevel -> Handle -> m Logger
- newManager :: ManagerSettings -> IO Manager
- tlsManagerSettings :: ManagerSettings
- module Network.Google.Types
Usage
The request and response types provided by the various gogol-* libraries can
be used with either send, upload, or download, depending upon the
request's purpose. Namely, send is the function you will most commonly use to
send requests, with upload and download as convenience when dealing with
streaming requests and responses respectively.
To get started we will need to specify our Google Service credentials and
create an Env environment containing configuration which will be used by
runGoogle to perform any actions. Your Google Credentials can be supplied
in a number of ways, by having Gogol retrieve
Application Default Credentials
for use on Google App Engine and Google Compute Engine, or by explicitly
supplying your credentials. See the Credentials section for
information about supported credential mechanisms.
The following example demonstrates uploading a file to Google
Cloud Storage using ObjectsInsert from
gogol-storage:
import Control.Lens ((&), (.~), (<&>), (?~))
import Data.Text (Text)
import Network.Google
import Network.Google.Storage
import System.IO (stdout)
import qualified Data.Text as Text
example :: IO Object
example = do
lgr <- newLogger Debug stdout -- (1)
env <- newEnv <&> (envLogger .~ lgr) . (envScopes .~ storageReadWriteScope) -- (2) (3)
body <- sourceBody "/path/to/image.jpg" -- (4)
let key = "image.jpg"
bkt = "my-storage-bucket"
runResourceT . runGoogle env $ -- (5)
upload (objectsInsert bkt object' & oiName ?~ key) bodyBreaking down the above example, we have the following points of interest:
- A new
Loggerto replace the default noop logger is created, set to print debug information and errors tostdout. - The
Envis created usingnewEnv. This creates a new HTTPManagerand retrieves the application defaultCredentials. - The lenses
envLoggerandenvScopesare used to set the newly createdLoggerand authorised OAuth2 scopes, respectively. Explicitly annotating theEnvwith the scopes ensures that any mismatch between the remote operations performed inrunGoogleand the credential scopes are raised as errors at compile time. See the Authorization section for more information. The streaming
bodyfor the object is retrieved from aFilePath, and the MIME type is calculated from the file extension. The MIME type is used as the object'sContent-Typein Cloud Storage, and can be overriden using thebodyContentTypelens as follows:import Network.HTTP.Media ((//)) body <- sourceBody f <&> bodyContentType .~ "application" // "json"
- Finally, we run the
Googlecomputation usingwhich serialises therunResourceT.runGoogleObjectsInserttype to a HTTP request and sets the streamingBody. The resultingObjectmetadata is then parsed from a successful HTTP response. 1 Additional examples can be found can be found in the Gogol project's source control.
The Google Monad
The Google monad containing configuration environment and tracks
resource allocation via ResourceT.
The functions in Network.Google are generalised
Instances
| AllowScopes s => MonadGoogle s (Google s) Source # | |
Defined in Network.Google Methods liftGoogle :: Google s a -> Google s a Source # | |
| Monad (Google s) Source # | |
| Functor (Google s) Source # | |
| Applicative (Google s) Source # | |
| Alternative (Google s) Source # | |
| MonadPlus (Google s) Source # | |
| MonadIO (Google s) Source # | |
Defined in Network.Google | |
| MonadUnliftIO (Google s) Source # | |
Defined in Network.Google | |
| MonadResource (Google s) Source # | |
Defined in Network.Google Methods liftResourceT :: ResourceT IO a -> Google s a # | |
| MonadThrow (Google s) Source # | |
Defined in Network.Google | |
| MonadCatch (Google s) Source # | |
| MonadMask (Google s) Source # | |
Defined in Network.Google | |
| MonadReader (Env s) (Google s) Source # | |
class (Functor m, Applicative m, Monad m, MonadIO m, MonadCatch m, AllowScopes s) => MonadGoogle s m | m -> s where Source #
Monads in which Google actions may be embedded.
The functions in Network.Google have MonadGoogle constraints to provide
automatic lifting when embedding Google as a layer inside your own
application stack.
Instances
runGoogle :: (MonadResource m, HasEnv s r) => r -> Google s a -> m a Source #
Run a Google action using the specified environment and
credentials annotated with sufficient authorization scopes.
runResourceT :: MonadUnliftIO m => ResourceT m a -> m a #
Unwrap a ResourceT transformer, and call all registered release actions.
Note that there is some reference counting involved due to resourceForkIO.
If multiple threads are sharing the same collection of resources, only the
last call to runResourceT will deallocate the resources.
NOTE Since version 1.2.0, this function will throw a
ResourceCleanupException if any of the cleanup functions throw an
exception.
Since: resourcet-0.3.0
Environment
data Env (s :: [Symbol]) Source #
The environment containing the parameters required to make Google requests.
Instances
| HasEnv s (Env s) Source # | |
Defined in Network.Google.Env | |
| MonadReader (Env s) (Google s) Source # | |
class HasEnv s a | a -> s where Source #
Minimal complete definition
Methods
environment :: Lens' a (Env s) Source #
envOverride :: Lens' a (Dual (Endo ServiceConfig)) Source #
The currently applied overrides to all Service configuration.
envLogger :: Lens' a Logger Source #
The function used to output log messages.
envManager :: Lens' a Manager Source #
The Manager used to create and manage open HTTP connections.
envStore :: Lens' a (Store s) Source #
The credential store used to sign requests for authentication with Google.
Instances
| HasEnv s (Env s) Source # | |
Defined in Network.Google.Env | |
newEnv :: (MonadIO m, MonadCatch m, AllowScopes s) => m (Env s) Source #
Creates a new environment with a newly initialized Manager, without logging.
and Credentials that are determined by calling getApplicationDefault.
Use newEnvWith to supply custom credentials such as an OAuthClient
and OAuthCode.
The Allowed OAuthScopes are used to authorize any service_account that is
found with the appropriate scopes. See the top-level module of each individual
gogol-* library for a list of available scopes, such as
Network.Google.Compute.authComputeScope.
Lenses from HasEnv can be used to further configure the resulting Env.
See: newEnvWith, getApplicationDefault.
newEnvWith :: (MonadIO m, MonadCatch m, AllowScopes s) => Credentials s -> Logger -> Manager -> m (Env s) Source #
Create a new environment.
See: newEnv.
Credentials
By default newEnv uses getApplicationDefault to discover credentials
from the underlying, following Google's official library behaviour.
If you wish to manually specify Credentials via newEnvWith, you can use one
of the following supported credential mechanisms:
- Network.Google.Auth.InstalledApplication - Applications installed on devices.
- Network.Google.Auth.ServiceAccount - Applications deployed to custom environments.
- Network.Google.Auth.ApplicationDefault - Applications deployed to App Engine (GAE) or Compute Engine (GCE).
See Network.Google.Auth for more information.
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.
Authorization
Each request within a particular runGoogle context requires specific
OAuth2 scopes to be have been authorized for the given credentials.
For example, the Google Storage ObjectsInsert has the associated scopes of:
type Scopes ObjectsInsert =
'["https://www.googleapis.com/auth/cloud-platform",
"https://www.googleapis.com/auth/devstorage.full_control",
"https://www.googleapis.com/auth/devstorage.read_write"]Multiple differing requests within a given runGoogle context will then require
the credentials to have a minimal set of these associated request scopes.
This authorization information is represented as a type-level set,
the s type parameter of Google and MonadGoogle. A mismatch
of the sent request scopes and the Env credential scopes results in a informative
compile error.
You can use allow or the envScopes lens to specify the Envs set of scopes.
The various gogol-* libraries export their individual scopes from @Network.Google.*"
and you can use the '(!)' combinator to combine these into a larger set.
For example:
import Control.Lens ((<&>), (.~))
import Network.Google
import Network.Google.Monitoring
main :: IO ()
main = do
env <- newEnv <&> envScopes .~ (monitoringReadScope ! monitoringWriteScope ! computeReadOnlyScope)
...>>>:type envEnv '["https://www.googleapis.com/auth/monitoring.read", "https://www.googleapis.com/auth/monitoring.write", "https://www.googleapis.com/auth/compute.readonly"]
class AllowScopes a Source #
Minimal complete definition
Instances
| AllowScopes ([] :: [k]) Source # | |
Defined in Network.Google.Auth.Scope Methods allowScopes :: proxy [] -> [OAuthScope] Source # | |
| AllowScopes s => AllowScopes (Credentials s :: Type) Source # | |
Defined in Network.Google.Auth.Scope Methods allowScopes :: proxy (Credentials s) -> [OAuthScope] Source # | |
| (KnownSymbol x, AllowScopes xs) => AllowScopes (x ': xs :: [Symbol]) Source # | |
Defined in Network.Google.Auth.Scope Methods allowScopes :: proxy (x ': xs) -> [OAuthScope] Source # | |
type family HasScope (s :: [Symbol]) a :: Constraint where ... Source #
Determine if _any_ of the scopes a request requires is listed in the scopes the credentials supports.
For error message/presentation purposes, this wraps the result of
the HasScope membership check to show both lists of scopes before
reduction.
Equations
| HasScope s a = (s `HasScope'` Scopes a) ~ True |
Sending Requests
send :: (MonadGoogle s m, HasScope s a, GoogleRequest a) => a -> m (Rs a) Source #
Send a request, returning the associated response if successful.
Throws LogLevel.
Streaming Media
download :: (MonadGoogle s m, HasScope s (MediaDownload a), GoogleRequest (MediaDownload a)) => a -> m (Rs (MediaDownload a)) Source #
Send a request returning the associated streaming media response if successful.
Some request data types have two possible responses, the JSON metadata and
a streaming media response. Use send to retrieve the metadata and download
to retrieve the streaming media.
Equivalent to:
send.MediaDownload
Throws LogLevel.
upload :: (MonadGoogle s m, HasScope s (MediaUpload a), GoogleRequest (MediaUpload a)) => a -> GBody -> m (Rs (MediaUpload a)) Source #
Send a request with an attached multipart/related media upload.
Equivalent to:
send.MediaUpload
Throws LogLevel.
A single part of a (potentially multipart) request body.
Note: The IsString instance defaults to a text/plain MIME type.
Constructors
| GBody !MediaType !RequestBody |
Instances
| IsString GBody | |
Defined in Network.Google.Types Methods fromString :: String -> GBody # | |
sourceBody :: MonadIO m => FilePath -> m GBody Source #
Construct a GBody from a FilePath.
This uses getMIMEType to calculate the MIME type from the file extension,
you can use bodyContentType to set a MIME type explicitly.
getMIMEType :: FilePath -> MediaType Source #
Attempt to calculate the MIME type based on file extension.
Defaults to application/octet-stream if no file extension is recognised.
Service Configuration
Each service has its own configuration such as host, port, path prefix, and timeout which can be customized independent of other services. It can be desirable to customize this when mocking service endpoints or adjusting HTTP response timeouts for a specific request.
For example, to point all calls to Google Compute to https://localhost instead
of the actual remote endpoint, we can use Control.Monad.Reader.local in conjunction
with override:
import Control.Lens ((&), (.~)) import Control.Monad.Reader (local) import Network.Google import Network.Google.Compute local (override (computeService & serviceHost .~ "localhost")) $ do _ <- send $ instancesGet "project" "zone" "instance-id" ...
Overriding Defaults
configure :: HasEnv s a => (ServiceConfig -> ServiceConfig) -> a -> a Source #
override :: HasEnv s a => ServiceConfig -> a -> a Source #
Override a specific ServiceConfig. All requests belonging to the
supplied service will use this configuration instead of the default.
Typically you would override a modified version of the default ServiceConfig
for the desired service:
override (gmailService & serviceHost .~ "localhost") env
Or when using Network.Google with Control.Monad.Reader or Control.Lens.Zoom
and the ServiceConfig lenses:
local (override (computeService & serviceHost .~ "localhost")) $ do ...
See: configure.
timeout :: (MonadReader r m, HasEnv s r) => Seconds -> m a -> m a Source #
Scope an action such that any HTTP response will use this timeout value.
Default timeouts are chosen by considering:
- This
timeout, if set. - The related
Servicetimeout for the sent request if set. (Default 70s) - The
envManagertimeout, if set. - The
ClientRequesttimeout. (Default 30s)
Lenses
serviceHost :: Lens' ServiceConfig ByteString #
The remote host name, used for both the IP address to connect to and the host request header.
servicePort :: Lens' ServiceConfig Int #
The remote port to connect to.
Defaults to 443.
servicePath :: Lens' ServiceConfig Builder #
A path prefix that is prepended to any sent HTTP request.
Defaults to mempty.
serviceSecure :: Lens' ServiceConfig Bool #
Whether to use HTTPS/SSL.
Defaults to True.
serviceTimeout :: Lens' ServiceConfig (Maybe Seconds) #
Number of seconds to wait for a response.
Handling Errors
Minimal complete definition
Methods
A general Amazonka error.
_TransportError :: Prism' a HttpException #
An error occured while communicating over HTTP with a remote service.
_SerializeError :: Prism' a SerializeError #
A serialisation error occured when attempting to deserialise a response.
_ServiceError :: Prism' a ServiceError #
A service specific error returned by the remote service.
Instances
| AsError SomeException | |
| AsError Error | |
Defined in Network.Google.Types | |
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
trying :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Either a r) #
A variant of try that takes a ReifiedPrism (or any ReifiedFold) to select which
exceptions are caught (c.f. tryJust, catchJust). If the
Exception does not match the predicate, it is re-thrown.
trying::MonadCatchm =>Prism'SomeExceptiona -> m r -> m (Eithera r)trying::MonadCatchm =>Lens'SomeExceptiona -> m r -> m (Eithera r)trying::MonadCatchm =>Traversal'SomeExceptiona -> m r -> m (Eithera r)trying::MonadCatchm =>Iso'SomeExceptiona -> m r -> m (Eithera r)trying::MonadCatchm =>ReifiedGetterSomeExceptiona -> m r -> m (Eithera r)trying::MonadCatchm =>ReifiedFoldSomeExceptiona -> m r -> m (Eithera r)
catching :: MonadCatch m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r #
Catch exceptions that match a given ReifiedPrism (or any ReifiedFold, really).
>>>catching _AssertionFailed (assert False (return "uncaught")) $ \ _ -> return "caught""caught"
catching::MonadCatchm =>Prism'SomeExceptiona -> m r -> (a -> m r) -> m rcatching::MonadCatchm =>Lens'SomeExceptiona -> m r -> (a -> m r) -> m rcatching::MonadCatchm =>Traversal'SomeExceptiona -> m r -> (a -> m r) -> m rcatching::MonadCatchm =>Iso'SomeExceptiona -> m r -> (a -> m r) -> m rcatching::MonadCatchm =>ReifiedGetterSomeExceptiona -> m r -> (a -> m r) -> m rcatching::MonadCatchm =>ReifiedFoldSomeExceptiona -> m r -> (a -> m r) -> m r
Logging
The exposed logging interface is a primitive Logger function which gets
threaded through service calls and serialisation routines. This allows the
consuming library to output useful information and diagnostics.
The newLogger function can be used to construct a simple logger which writes
output to a Handle, but in most production code you should probably consider
using a more robust logging library such as
tinylog or
fast-logger.
type Logger = LogLevel -> Builder -> IO () Source #
A function threaded through various request and serialisation routines to log informational and debug messages.
Constructors
| Info | Info messages supplied by the user - this level is not emitted by the library. |
| Error | Error messages only. |
| Debug | Useful debug information + info + error levels. |
| Trace | Includes potentially credentials metadata, and non-streaming response bodies. |
Instances
| Enum LogLevel Source # | |
Defined in Network.Google.Internal.Logger | |
| Eq LogLevel Source # | |
| Data LogLevel Source # | |
Defined in Network.Google.Internal.Logger Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> LogLevel -> c LogLevel # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c LogLevel # toConstr :: LogLevel -> Constr # dataTypeOf :: LogLevel -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c LogLevel) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LogLevel) # gmapT :: (forall b. Data b => b -> b) -> LogLevel -> LogLevel # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LogLevel -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LogLevel -> r # gmapQ :: (forall d. Data d => d -> u) -> LogLevel -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> LogLevel -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> LogLevel -> m LogLevel # | |
| Ord LogLevel Source # | |
Defined in Network.Google.Internal.Logger | |
| Show LogLevel Source # | |
Constructing a Logger
newLogger :: MonadIO m => LogLevel -> Handle -> m Logger Source #
This is a primitive logger which can be used to log builds to a Handle.
Note: A more sophisticated logging library such as tinylog or fast-logger should be used in production code.
Constructing a HTTP Manager
newManager :: ManagerSettings -> IO Manager #
Create a Manager. The Manager will be shut down automatically via
garbage collection.
Creating a new Manager is a relatively expensive operation, you are
advised to share a single Manager between requests instead.
The first argument to this function is often defaultManagerSettings,
though add-on libraries may provide a recommended replacement.
Since 0.1.0
tlsManagerSettings :: ManagerSettings #
Default TLS-enabled manager settings
Running Asynchronous Actions
Requests can be sent asynchronously, but due to guarantees about resource closure require the use of lifted-async.
Compute Metadata
Google Compute metadata can be retrieve when running on GCE instances. See the documentation in Network.Google.Compute.Metadata for the available functions.
Re-exported Types
module Network.Google.Types