{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}

{-# OPTIONS_GHC -fno-warn-unused-binds   #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

-- |
-- Module      : Network.Google.ServiceConsumerManagement.Types.Product
-- Copyright   : (c) 2015-2016 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
module Network.Google.ServiceConsumerManagement.Types.Product where

import           Network.Google.Prelude
import           Network.Google.ServiceConsumerManagement.Types.Sum

-- | Define a parameter\'s name and location. The parameter may be passed as
-- either an HTTP header or a URL query parameter, and if both are passed
-- the behavior is implementation-dependent.
--
-- /See:/ 'systemParameter' smart constructor.
data SystemParameter =
  SystemParameter'
    { _spHTTPHeader        :: !(Maybe Text)
    , _spURLQueryParameter :: !(Maybe Text)
    , _spName              :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'SystemParameter' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'spHTTPHeader'
--
-- * 'spURLQueryParameter'
--
-- * 'spName'
systemParameter
    :: SystemParameter
systemParameter =
  SystemParameter'
    {_spHTTPHeader = Nothing, _spURLQueryParameter = Nothing, _spName = Nothing}


-- | Define the HTTP header name to use for the parameter. It is case
-- insensitive.
spHTTPHeader :: Lens' SystemParameter (Maybe Text)
spHTTPHeader
  = lens _spHTTPHeader (\ s a -> s{_spHTTPHeader = a})

-- | Define the URL query parameter name to use for the parameter. It is case
-- sensitive.
spURLQueryParameter :: Lens' SystemParameter (Maybe Text)
spURLQueryParameter
  = lens _spURLQueryParameter
      (\ s a -> s{_spURLQueryParameter = a})

-- | Define the name of the parameter, such as \"api_key\" . It is case
-- sensitive.
spName :: Lens' SystemParameter (Maybe Text)
spName = lens _spName (\ s a -> s{_spName = a})

instance FromJSON SystemParameter where
        parseJSON
          = withObject "SystemParameter"
              (\ o ->
                 SystemParameter' <$>
                   (o .:? "httpHeader") <*> (o .:? "urlQueryParameter")
                     <*> (o .:? "name"))

instance ToJSON SystemParameter where
        toJSON SystemParameter'{..}
          = object
              (catMaybes
                 [("httpHeader" .=) <$> _spHTTPHeader,
                  ("urlQueryParameter" .=) <$> _spURLQueryParameter,
                  ("name" .=) <$> _spName])

-- | An object that describes the schema of a MonitoredResource object using
-- a type name and a set of labels. For example, the monitored resource
-- descriptor for Google Compute Engine VM instances has a type of
-- \`\"gce_instance\"\` and specifies the use of the labels
-- \`\"instance_id\"\` and \`\"zone\"\` to identify particular VM
-- instances. Different APIs can support different monitored resource
-- types. APIs generally provide a \`list\` method that returns the
-- monitored resource descriptors used by the API.
--
-- /See:/ 'monitoredResourceDescriptor' smart constructor.
data MonitoredResourceDescriptor =
  MonitoredResourceDescriptor'
    { _mrdName        :: !(Maybe Text)
    , _mrdDisplayName :: !(Maybe Text)
    , _mrdLabels      :: !(Maybe [LabelDescriptor])
    , _mrdType        :: !(Maybe Text)
    , _mrdDescription :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'MonitoredResourceDescriptor' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mrdName'
--
-- * 'mrdDisplayName'
--
-- * 'mrdLabels'
--
-- * 'mrdType'
--
-- * 'mrdDescription'
monitoredResourceDescriptor
    :: MonitoredResourceDescriptor
monitoredResourceDescriptor =
  MonitoredResourceDescriptor'
    { _mrdName = Nothing
    , _mrdDisplayName = Nothing
    , _mrdLabels = Nothing
    , _mrdType = Nothing
    , _mrdDescription = Nothing
    }


-- | Optional. The resource name of the monitored resource descriptor:
-- \`\"projects\/{project_id}\/monitoredResourceDescriptors\/{type}\"\`
-- where {type} is the value of the \`type\` field in this object and
-- {project_id} is a project ID that provides API-specific context for
-- accessing the type. APIs that do not use project information can use the
-- resource name format \`\"monitoredResourceDescriptors\/{type}\"\`.
mrdName :: Lens' MonitoredResourceDescriptor (Maybe Text)
mrdName = lens _mrdName (\ s a -> s{_mrdName = a})

-- | Optional. A concise name for the monitored resource type that might be
-- displayed in user interfaces. It should be a Title Cased Noun Phrase,
-- without any article or other determiners. For example, \`\"Google Cloud
-- SQL Database\"\`.
mrdDisplayName :: Lens' MonitoredResourceDescriptor (Maybe Text)
mrdDisplayName
  = lens _mrdDisplayName
      (\ s a -> s{_mrdDisplayName = a})

-- | Required. A set of labels used to describe instances of this monitored
-- resource type. For example, an individual Google Cloud SQL database is
-- identified by values for the labels \`\"database_id\"\` and
-- \`\"zone\"\`.
mrdLabels :: Lens' MonitoredResourceDescriptor [LabelDescriptor]
mrdLabels
  = lens _mrdLabels (\ s a -> s{_mrdLabels = a}) .
      _Default
      . _Coerce

-- | Required. The monitored resource type. For example, the type
-- \`\"cloudsql_database\"\` represents databases in Google Cloud SQL. The
-- maximum length of this value is 256 characters.
mrdType :: Lens' MonitoredResourceDescriptor (Maybe Text)
mrdType = lens _mrdType (\ s a -> s{_mrdType = a})

-- | Optional. A detailed description of the monitored resource type that
-- might be used in documentation.
mrdDescription :: Lens' MonitoredResourceDescriptor (Maybe Text)
mrdDescription
  = lens _mrdDescription
      (\ s a -> s{_mrdDescription = a})

instance FromJSON MonitoredResourceDescriptor where
        parseJSON
          = withObject "MonitoredResourceDescriptor"
              (\ o ->
                 MonitoredResourceDescriptor' <$>
                   (o .:? "name") <*> (o .:? "displayName") <*>
                     (o .:? "labels" .!= mempty)
                     <*> (o .:? "type")
                     <*> (o .:? "description"))

instance ToJSON MonitoredResourceDescriptor where
        toJSON MonitoredResourceDescriptor'{..}
          = object
              (catMaybes
                 [("name" .=) <$> _mrdName,
                  ("displayName" .=) <$> _mrdDisplayName,
                  ("labels" .=) <$> _mrdLabels,
                  ("type" .=) <$> _mrdType,
                  ("description" .=) <$> _mrdDescription])

-- | Response message for the \`RefreshConsumer\` method. This response
-- message is assigned to the \`response\` field of the returned Operation
-- when that operation is done.
--
-- /See:/ 'v1Beta1RefreshConsumerResponse' smart constructor.
data V1Beta1RefreshConsumerResponse =
  V1Beta1RefreshConsumerResponse'
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1Beta1RefreshConsumerResponse' with the minimum fields required to make a request.
--
v1Beta1RefreshConsumerResponse
    :: V1Beta1RefreshConsumerResponse
v1Beta1RefreshConsumerResponse = V1Beta1RefreshConsumerResponse'


instance FromJSON V1Beta1RefreshConsumerResponse
         where
        parseJSON
          = withObject "V1Beta1RefreshConsumerResponse"
              (\ o -> pure V1Beta1RefreshConsumerResponse')

instance ToJSON V1Beta1RefreshConsumerResponse where
        toJSON = const emptyObject

-- | A documentation rule provides information about individual API elements.
--
-- /See:/ 'documentationRule' smart constructor.
data DocumentationRule =
  DocumentationRule'
    { _drSelector               :: !(Maybe Text)
    , _drDeprecationDescription :: !(Maybe Text)
    , _drDescription            :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'DocumentationRule' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'drSelector'
--
-- * 'drDeprecationDescription'
--
-- * 'drDescription'
documentationRule
    :: DocumentationRule
documentationRule =
  DocumentationRule'
    { _drSelector = Nothing
    , _drDeprecationDescription = Nothing
    , _drDescription = Nothing
    }


-- | The selector is a comma-separated list of patterns. Each pattern is a
-- qualified name of the element which may end in \"*\", indicating a
-- wildcard. Wildcards are only allowed at the end and for a whole
-- component of the qualified name, i.e. \"foo.*\" is ok, but not
-- \"foo.b*\" or \"foo.*.bar\". A wildcard will match one or more
-- components. To specify a default for all applicable elements, the whole
-- pattern \"*\" is used.
drSelector :: Lens' DocumentationRule (Maybe Text)
drSelector
  = lens _drSelector (\ s a -> s{_drSelector = a})

-- | Deprecation description of the selected element(s). It can be provided
-- if an element is marked as \`deprecated\`.
drDeprecationDescription :: Lens' DocumentationRule (Maybe Text)
drDeprecationDescription
  = lens _drDeprecationDescription
      (\ s a -> s{_drDeprecationDescription = a})

-- | Description of the selected API(s).
drDescription :: Lens' DocumentationRule (Maybe Text)
drDescription
  = lens _drDescription
      (\ s a -> s{_drDescription = a})

instance FromJSON DocumentationRule where
        parseJSON
          = withObject "DocumentationRule"
              (\ o ->
                 DocumentationRule' <$>
                   (o .:? "selector") <*>
                     (o .:? "deprecationDescription")
                     <*> (o .:? "description"))

instance ToJSON DocumentationRule where
        toJSON DocumentationRule'{..}
          = object
              (catMaybes
                 [("selector" .=) <$> _drSelector,
                  ("deprecationDescription" .=) <$>
                    _drDeprecationDescription,
                  ("description" .=) <$> _drDescription])

-- | The \`Status\` type defines a logical error model that is suitable for
-- different programming environments, including REST APIs and RPC APIs. It
-- is used by [gRPC](https:\/\/github.com\/grpc). The error model is
-- designed to be: - Simple to use and understand for most users - Flexible
-- enough to meet unexpected needs # Overview The \`Status\` message
-- contains three pieces of data: error code, error message, and error
-- details. The error code should be an enum value of google.rpc.Code, but
-- it may accept additional error codes if needed. The error message should
-- be a developer-facing English message that helps developers *understand*
-- and *resolve* the error. If a localized user-facing error message is
-- needed, put the localized message in the error details or localize it in
-- the client. The optional error details may contain arbitrary information
-- about the error. There is a predefined set of error detail types in the
-- package \`google.rpc\` that can be used for common error conditions. #
-- Language mapping The \`Status\` message is the logical representation of
-- the error model, but it is not necessarily the actual wire format. When
-- the \`Status\` message is exposed in different client libraries and
-- different wire protocols, it can be mapped differently. For example, it
-- will likely be mapped to some exceptions in Java, but more likely mapped
-- to some error codes in C. # Other uses The error model and the
-- \`Status\` message can be used in a variety of environments, either with
-- or without APIs, to provide a consistent developer experience across
-- different environments. Example uses of this error model include: -
-- Partial errors. If a service needs to return partial errors to the
-- client, it may embed the \`Status\` in the normal response to indicate
-- the partial errors. - Workflow errors. A typical workflow has multiple
-- steps. Each step may have a \`Status\` message for error reporting. -
-- Batch operations. If a client uses batch request and batch response, the
-- \`Status\` message should be used directly inside batch response, one
-- for each error sub-response. - Asynchronous operations. If an API call
-- embeds asynchronous operation results in its response, the status of
-- those operations should be represented directly using the \`Status\`
-- message. - Logging. If some API errors are stored in logs, the message
-- \`Status\` could be used directly after any stripping needed for
-- security\/privacy reasons.
--
-- /See:/ 'status' smart constructor.
data Status =
  Status'
    { _sDetails :: !(Maybe [StatusDetailsItem])
    , _sCode    :: !(Maybe (Textual Int32))
    , _sMessage :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Status' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'sDetails'
--
-- * 'sCode'
--
-- * 'sMessage'
status
    :: Status
status = Status' {_sDetails = Nothing, _sCode = Nothing, _sMessage = Nothing}


-- | A list of messages that carry the error details. There is a common set
-- of message types for APIs to use.
sDetails :: Lens' Status [StatusDetailsItem]
sDetails
  = lens _sDetails (\ s a -> s{_sDetails = a}) .
      _Default
      . _Coerce

-- | The status code, which should be an enum value of google.rpc.Code.
sCode :: Lens' Status (Maybe Int32)
sCode
  = lens _sCode (\ s a -> s{_sCode = a}) .
      mapping _Coerce

-- | A developer-facing error message, which should be in English. Any
-- user-facing error message should be localized and sent in the
-- google.rpc.Status.details field, or localized by the client.
sMessage :: Lens' Status (Maybe Text)
sMessage = lens _sMessage (\ s a -> s{_sMessage = a})

instance FromJSON Status where
        parseJSON
          = withObject "Status"
              (\ o ->
                 Status' <$>
                   (o .:? "details" .!= mempty) <*> (o .:? "code") <*>
                     (o .:? "message"))

instance ToJSON Status where
        toJSON Status'{..}
          = object
              (catMaybes
                 [("details" .=) <$> _sDetails,
                  ("code" .=) <$> _sCode,
                  ("message" .=) <$> _sMessage])

-- | Configuration of a specific billing destination (Currently only support
-- bill against consumer project).
--
-- /See:/ 'billingDestination' smart constructor.
data BillingDestination =
  BillingDestination'
    { _bdMetrics           :: !(Maybe [Text])
    , _bdMonitoredResource :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'BillingDestination' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'bdMetrics'
--
-- * 'bdMonitoredResource'
billingDestination
    :: BillingDestination
billingDestination =
  BillingDestination' {_bdMetrics = Nothing, _bdMonitoredResource = Nothing}


-- | Names of the metrics to report to this billing destination. Each name
-- must be defined in Service.metrics section.
bdMetrics :: Lens' BillingDestination [Text]
bdMetrics
  = lens _bdMetrics (\ s a -> s{_bdMetrics = a}) .
      _Default
      . _Coerce

-- | The monitored resource type. The type must be defined in
-- Service.monitored_resources section.
bdMonitoredResource :: Lens' BillingDestination (Maybe Text)
bdMonitoredResource
  = lens _bdMonitoredResource
      (\ s a -> s{_bdMonitoredResource = a})

instance FromJSON BillingDestination where
        parseJSON
          = withObject "BillingDestination"
              (\ o ->
                 BillingDestination' <$>
                   (o .:? "metrics" .!= mempty) <*>
                     (o .:? "monitoredResource"))

instance ToJSON BillingDestination where
        toJSON BillingDestination'{..}
          = object
              (catMaybes
                 [("metrics" .=) <$> _bdMetrics,
                  ("monitoredResource" .=) <$> _bdMonitoredResource])

-- | Selects and configures the service controller used by the service. The
-- service controller handles features like abuse, quota, billing, logging,
-- monitoring, etc.
--
-- /See:/ 'control' smart constructor.
newtype Control =
  Control'
    { _cEnvironment :: Maybe Text
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Control' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'cEnvironment'
control
    :: Control
control = Control' {_cEnvironment = Nothing}


-- | The service control environment to use. If empty, no control plane
-- feature (like quota and billing) will be enabled.
cEnvironment :: Lens' Control (Maybe Text)
cEnvironment
  = lens _cEnvironment (\ s a -> s{_cEnvironment = a})

instance FromJSON Control where
        parseJSON
          = withObject "Control"
              (\ o -> Control' <$> (o .:? "environment"))

instance ToJSON Control where
        toJSON Control'{..}
          = object
              (catMaybes [("environment" .=) <$> _cEnvironment])

-- | User-defined authentication requirements, including support for [JSON
-- Web Token
-- (JWT)](https:\/\/tools.ietf.org\/html\/draft-ietf-oauth-json-web-token-32).
--
-- /See:/ 'authRequirement' smart constructor.
data AuthRequirement =
  AuthRequirement'
    { _arProviderId :: !(Maybe Text)
    , _arAudiences  :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'AuthRequirement' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'arProviderId'
--
-- * 'arAudiences'
authRequirement
    :: AuthRequirement
authRequirement =
  AuthRequirement' {_arProviderId = Nothing, _arAudiences = Nothing}


-- | id from authentication provider. Example: provider_id: bookstore_auth
arProviderId :: Lens' AuthRequirement (Maybe Text)
arProviderId
  = lens _arProviderId (\ s a -> s{_arProviderId = a})

-- | NOTE: This will be deprecated soon, once AuthProvider.audiences is
-- implemented and accepted in all the runtime components. The list of JWT
-- [audiences](https:\/\/tools.ietf.org\/html\/draft-ietf-oauth-json-web-token-32#section-4.1.3).
-- that are allowed to access. A JWT containing any of these audiences will
-- be accepted. When this setting is absent, only JWTs with audience
-- \"https:\/\/Service_name\/API_name\" will be accepted. For example, if
-- no audiences are in the setting, LibraryService API will only accept
-- JWTs with the following audience
-- \"https:\/\/library-example.googleapis.com\/google.example.library.v1.LibraryService\".
-- Example: audiences: bookstore_android.apps.googleusercontent.com,
-- bookstore_web.apps.googleusercontent.com
arAudiences :: Lens' AuthRequirement (Maybe Text)
arAudiences
  = lens _arAudiences (\ s a -> s{_arAudiences = a})

instance FromJSON AuthRequirement where
        parseJSON
          = withObject "AuthRequirement"
              (\ o ->
                 AuthRequirement' <$>
                   (o .:? "providerId") <*> (o .:? "audiences"))

instance ToJSON AuthRequirement where
        toJSON AuthRequirement'{..}
          = object
              (catMaybes
                 [("providerId" .=) <$> _arProviderId,
                  ("audiences" .=) <$> _arAudiences])

-- | \`Context\` defines which contexts an API requests. Example: context:
-- rules: - selector: \"*\" requested: - google.rpc.context.ProjectContext
-- - google.rpc.context.OriginContext The above specifies that all methods
-- in the API request \`google.rpc.context.ProjectContext\` and
-- \`google.rpc.context.OriginContext\`. Available context types are
-- defined in package \`google.rpc.context\`. This also provides mechanism
-- to whitelist any protobuf message extension that can be sent in grpc
-- metadata using “x-goog-ext--bin” and “x-goog-ext--jspb” format. For
-- example, list any service specific protobuf types that can appear in
-- grpc metadata as follows in your yaml file: Example: context: rules: -
-- selector: \"google.example.library.v1.LibraryService.CreateBook\"
-- allowed_request_extensions: - google.foo.v1.NewExtension
-- allowed_response_extensions: - google.foo.v1.NewExtension You can also
-- specify extension ID instead of fully qualified extension name here.
--
-- /See:/ 'context' smart constructor.
newtype Context =
  Context'
    { _cRules :: Maybe [ContextRule]
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Context' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'cRules'
context
    :: Context
context = Context' {_cRules = Nothing}


-- | A list of RPC context rules that apply to individual API methods.
-- **NOTE:** All service configuration rules follow \"last one wins\"
-- order.
cRules :: Lens' Context [ContextRule]
cRules
  = lens _cRules (\ s a -> s{_cRules = a}) . _Default .
      _Coerce

instance FromJSON Context where
        parseJSON
          = withObject "Context"
              (\ o -> Context' <$> (o .:? "rules" .!= mempty))

instance ToJSON Context where
        toJSON Context'{..}
          = object (catMaybes [("rules" .=) <$> _cRules])

-- | Configuration of a specific logging destination (the producer project or
-- the consumer project).
--
-- /See:/ 'loggingDestination' smart constructor.
data LoggingDestination =
  LoggingDestination'
    { _ldMonitoredResource :: !(Maybe Text)
    , _ldLogs              :: !(Maybe [Text])
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'LoggingDestination' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'ldMonitoredResource'
--
-- * 'ldLogs'
loggingDestination
    :: LoggingDestination
loggingDestination =
  LoggingDestination' {_ldMonitoredResource = Nothing, _ldLogs = Nothing}


-- | The monitored resource type. The type must be defined in the
-- Service.monitored_resources section.
ldMonitoredResource :: Lens' LoggingDestination (Maybe Text)
ldMonitoredResource
  = lens _ldMonitoredResource
      (\ s a -> s{_ldMonitoredResource = a})

-- | Names of the logs to be sent to this destination. Each name must be
-- defined in the Service.logs section. If the log name is not a domain
-- scoped name, it will be automatically prefixed with the service name
-- followed by \"\/\".
ldLogs :: Lens' LoggingDestination [Text]
ldLogs
  = lens _ldLogs (\ s a -> s{_ldLogs = a}) . _Default .
      _Coerce

instance FromJSON LoggingDestination where
        parseJSON
          = withObject "LoggingDestination"
              (\ o ->
                 LoggingDestination' <$>
                   (o .:? "monitoredResource") <*>
                     (o .:? "logs" .!= mempty))

instance ToJSON LoggingDestination where
        toJSON LoggingDestination'{..}
          = object
              (catMaybes
                 [("monitoredResource" .=) <$> _ldMonitoredResource,
                  ("logs" .=) <$> _ldLogs])

-- | Defines a metric type and its schema. Once a metric descriptor is
-- created, deleting or altering it stops data collection and makes the
-- metric type\'s existing data unusable.
--
-- /See:/ 'metricDescriptor' smart constructor.
data MetricDescriptor =
  MetricDescriptor'
    { _mdMetricKind  :: !(Maybe MetricDescriptorMetricKind)
    , _mdName        :: !(Maybe Text)
    , _mdMetadata    :: !(Maybe MetricDescriptorMetadata)
    , _mdDisplayName :: !(Maybe Text)
    , _mdLabels      :: !(Maybe [LabelDescriptor])
    , _mdType        :: !(Maybe Text)
    , _mdValueType   :: !(Maybe MetricDescriptorValueType)
    , _mdDescription :: !(Maybe Text)
    , _mdUnit        :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'MetricDescriptor' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mdMetricKind'
--
-- * 'mdName'
--
-- * 'mdMetadata'
--
-- * 'mdDisplayName'
--
-- * 'mdLabels'
--
-- * 'mdType'
--
-- * 'mdValueType'
--
-- * 'mdDescription'
--
-- * 'mdUnit'
metricDescriptor
    :: MetricDescriptor
metricDescriptor =
  MetricDescriptor'
    { _mdMetricKind = Nothing
    , _mdName = Nothing
    , _mdMetadata = Nothing
    , _mdDisplayName = Nothing
    , _mdLabels = Nothing
    , _mdType = Nothing
    , _mdValueType = Nothing
    , _mdDescription = Nothing
    , _mdUnit = Nothing
    }


-- | Whether the metric records instantaneous values, changes to a value,
-- etc. Some combinations of \`metric_kind\` and \`value_type\` might not
-- be supported.
mdMetricKind :: Lens' MetricDescriptor (Maybe MetricDescriptorMetricKind)
mdMetricKind
  = lens _mdMetricKind (\ s a -> s{_mdMetricKind = a})

-- | The resource name of the metric descriptor.
mdName :: Lens' MetricDescriptor (Maybe Text)
mdName = lens _mdName (\ s a -> s{_mdName = a})

-- | Optional. Metadata which can be used to guide usage of the metric.
mdMetadata :: Lens' MetricDescriptor (Maybe MetricDescriptorMetadata)
mdMetadata
  = lens _mdMetadata (\ s a -> s{_mdMetadata = a})

-- | A concise name for the metric, which can be displayed in user
-- interfaces. Use sentence case without an ending period, for example
-- \"Request count\". This field is optional but it is recommended to be
-- set for any metrics associated with user-visible concepts, such as
-- Quota.
mdDisplayName :: Lens' MetricDescriptor (Maybe Text)
mdDisplayName
  = lens _mdDisplayName
      (\ s a -> s{_mdDisplayName = a})

-- | The set of labels that can be used to describe a specific instance of
-- this metric type. For example, the
-- \`appengine.googleapis.com\/http\/server\/response_latencies\` metric
-- type has a label for the HTTP response code, \`response_code\`, so you
-- can look at latencies for successful responses or just for responses
-- that failed.
mdLabels :: Lens' MetricDescriptor [LabelDescriptor]
mdLabels
  = lens _mdLabels (\ s a -> s{_mdLabels = a}) .
      _Default
      . _Coerce

-- | The metric type, including its DNS name prefix. The type is not
-- URL-encoded. All user-defined metric types have the DNS name
-- \`custom.googleapis.com\` or \`external.googleapis.com\`. Metric types
-- should use a natural hierarchical grouping. For example:
-- \"custom.googleapis.com\/invoice\/paid\/amount\"
-- \"external.googleapis.com\/prometheus\/up\"
-- \"appengine.googleapis.com\/http\/server\/response_latencies\"
mdType :: Lens' MetricDescriptor (Maybe Text)
mdType = lens _mdType (\ s a -> s{_mdType = a})

-- | Whether the measurement is an integer, a floating-point number, etc.
-- Some combinations of \`metric_kind\` and \`value_type\` might not be
-- supported.
mdValueType :: Lens' MetricDescriptor (Maybe MetricDescriptorValueType)
mdValueType
  = lens _mdValueType (\ s a -> s{_mdValueType = a})

-- | A detailed description of the metric, which can be used in
-- documentation.
mdDescription :: Lens' MetricDescriptor (Maybe Text)
mdDescription
  = lens _mdDescription
      (\ s a -> s{_mdDescription = a})

-- | The unit in which the metric value is reported. It is only applicable if
-- the \`value_type\` is \`INT64\`, \`DOUBLE\`, or \`DISTRIBUTION\`. The
-- supported units are a subset of [The Unified Code for Units of
-- Measure](http:\/\/unitsofmeasure.org\/ucum.html) standard: **Basic units
-- (UNIT)** * \`bit\` bit * \`By\` byte * \`s\` second * \`min\` minute *
-- \`h\` hour * \`d\` day **Prefixes (PREFIX)** * \`k\` kilo (10**3) *
-- \`M\` mega (10**6) * \`G\` giga (10**9) * \`T\` tera (10**12) * \`P\`
-- peta (10**15) * \`E\` exa (10**18) * \`Z\` zetta (10**21) * \`Y\` yotta
-- (10**24) * \`m\` milli (10**-3) * \`u\` micro (10**-6) * \`n\` nano
-- (10**-9) * \`p\` pico (10**-12) * \`f\` femto (10**-15) * \`a\` atto
-- (10**-18) * \`z\` zepto (10**-21) * \`y\` yocto (10**-24) * \`Ki\` kibi
-- (2**10) * \`Mi\` mebi (2**20) * \`Gi\` gibi (2**30) * \`Ti\` tebi
-- (2**40) **Grammar** The grammar also includes these connectors: * \`\/\`
-- division (as an infix operator, e.g. \`1\/s\`). * \`.\` multiplication
-- (as an infix operator, e.g. \`GBy.d\`) The grammar for a unit is as
-- follows: Expression = Component { \".\" Component } { \"\/\" Component }
-- ; Component = ( [ PREFIX ] UNIT | \"%\" ) [ Annotation ] | Annotation |
-- \"1\" ; Annotation = \"{\" NAME \"}\" ; Notes: * \`Annotation\` is just
-- a comment if it follows a \`UNIT\` and is equivalent to \`1\` if it is
-- used alone. For examples, \`{requests}\/s == 1\/s\`,
-- \`By{transmitted}\/s == By\/s\`. * \`NAME\` is a sequence of non-blank
-- printable ASCII characters not containing \'{\' or \'}\'. * \`1\`
-- represents dimensionless value 1, such as in \`1\/s\`. * \`%\`
-- represents dimensionless value 1\/100, and annotates values giving a
-- percentage.
mdUnit :: Lens' MetricDescriptor (Maybe Text)
mdUnit = lens _mdUnit (\ s a -> s{_mdUnit = a})

instance FromJSON MetricDescriptor where
        parseJSON
          = withObject "MetricDescriptor"
              (\ o ->
                 MetricDescriptor' <$>
                   (o .:? "metricKind") <*> (o .:? "name") <*>
                     (o .:? "metadata")
                     <*> (o .:? "displayName")
                     <*> (o .:? "labels" .!= mempty)
                     <*> (o .:? "type")
                     <*> (o .:? "valueType")
                     <*> (o .:? "description")
                     <*> (o .:? "unit"))

instance ToJSON MetricDescriptor where
        toJSON MetricDescriptor'{..}
          = object
              (catMaybes
                 [("metricKind" .=) <$> _mdMetricKind,
                  ("name" .=) <$> _mdName,
                  ("metadata" .=) <$> _mdMetadata,
                  ("displayName" .=) <$> _mdDisplayName,
                  ("labels" .=) <$> _mdLabels, ("type" .=) <$> _mdType,
                  ("valueType" .=) <$> _mdValueType,
                  ("description" .=) <$> _mdDescription,
                  ("unit" .=) <$> _mdUnit])

-- | The response message for Operations.ListOperations.
--
-- /See:/ 'listOperationsResponse' smart constructor.
data ListOperationsResponse =
  ListOperationsResponse'
    { _lorNextPageToken :: !(Maybe Text)
    , _lorOperations    :: !(Maybe [Operation])
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'ListOperationsResponse' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'lorNextPageToken'
--
-- * 'lorOperations'
listOperationsResponse
    :: ListOperationsResponse
listOperationsResponse =
  ListOperationsResponse'
    {_lorNextPageToken = Nothing, _lorOperations = Nothing}


-- | The standard List next-page token.
lorNextPageToken :: Lens' ListOperationsResponse (Maybe Text)
lorNextPageToken
  = lens _lorNextPageToken
      (\ s a -> s{_lorNextPageToken = a})

-- | A list of operations that matches the specified filter in the request.
lorOperations :: Lens' ListOperationsResponse [Operation]
lorOperations
  = lens _lorOperations
      (\ s a -> s{_lorOperations = a})
      . _Default
      . _Coerce

instance FromJSON ListOperationsResponse where
        parseJSON
          = withObject "ListOperationsResponse"
              (\ o ->
                 ListOperationsResponse' <$>
                   (o .:? "nextPageToken") <*>
                     (o .:? "operations" .!= mempty))

instance ToJSON ListOperationsResponse where
        toJSON ListOperationsResponse'{..}
          = object
              (catMaybes
                 [("nextPageToken" .=) <$> _lorNextPageToken,
                  ("operations" .=) <$> _lorOperations])

-- | The request message for Operations.CancelOperation.
--
-- /See:/ 'cancelOperationRequest' smart constructor.
data CancelOperationRequest =
  CancelOperationRequest'
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'CancelOperationRequest' with the minimum fields required to make a request.
--
cancelOperationRequest
    :: CancelOperationRequest
cancelOperationRequest = CancelOperationRequest'


instance FromJSON CancelOperationRequest where
        parseJSON
          = withObject "CancelOperationRequest"
              (\ o -> pure CancelOperationRequest')

instance ToJSON CancelOperationRequest where
        toJSON = const emptyObject

-- | A backend rule provides configuration for an individual API element.
--
-- /See:/ 'backendRule' smart constructor.
data BackendRule =
  BackendRule'
    { _brJwtAudience       :: !(Maybe Text)
    , _brSelector          :: !(Maybe Text)
    , _brMinDeadline       :: !(Maybe (Textual Double))
    , _brAddress           :: !(Maybe Text)
    , _brOperationDeadline :: !(Maybe (Textual Double))
    , _brDeadline          :: !(Maybe (Textual Double))
    , _brPathTranslation   :: !(Maybe BackendRulePathTranslation)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'BackendRule' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'brJwtAudience'
--
-- * 'brSelector'
--
-- * 'brMinDeadline'
--
-- * 'brAddress'
--
-- * 'brOperationDeadline'
--
-- * 'brDeadline'
--
-- * 'brPathTranslation'
backendRule
    :: BackendRule
backendRule =
  BackendRule'
    { _brJwtAudience = Nothing
    , _brSelector = Nothing
    , _brMinDeadline = Nothing
    , _brAddress = Nothing
    , _brOperationDeadline = Nothing
    , _brDeadline = Nothing
    , _brPathTranslation = Nothing
    }


-- | The JWT audience is used when generating a JWT id token for the backend.
brJwtAudience :: Lens' BackendRule (Maybe Text)
brJwtAudience
  = lens _brJwtAudience
      (\ s a -> s{_brJwtAudience = a})

-- | Selects the methods to which this rule applies. Refer to selector for
-- syntax details.
brSelector :: Lens' BackendRule (Maybe Text)
brSelector
  = lens _brSelector (\ s a -> s{_brSelector = a})

-- | Minimum deadline in seconds needed for this method. Calls having
-- deadline value lower than this will be rejected.
brMinDeadline :: Lens' BackendRule (Maybe Double)
brMinDeadline
  = lens _brMinDeadline
      (\ s a -> s{_brMinDeadline = a})
      . mapping _Coerce

-- | The address of the API backend.
brAddress :: Lens' BackendRule (Maybe Text)
brAddress
  = lens _brAddress (\ s a -> s{_brAddress = a})

-- | The number of seconds to wait for the completion of a long running
-- operation. The default is no deadline.
brOperationDeadline :: Lens' BackendRule (Maybe Double)
brOperationDeadline
  = lens _brOperationDeadline
      (\ s a -> s{_brOperationDeadline = a})
      . mapping _Coerce

-- | The number of seconds to wait for a response from a request. The default
-- deadline for gRPC is infinite (no deadline) and HTTP requests is 5
-- seconds.
brDeadline :: Lens' BackendRule (Maybe Double)
brDeadline
  = lens _brDeadline (\ s a -> s{_brDeadline = a}) .
      mapping _Coerce

brPathTranslation :: Lens' BackendRule (Maybe BackendRulePathTranslation)
brPathTranslation
  = lens _brPathTranslation
      (\ s a -> s{_brPathTranslation = a})

instance FromJSON BackendRule where
        parseJSON
          = withObject "BackendRule"
              (\ o ->
                 BackendRule' <$>
                   (o .:? "jwtAudience") <*> (o .:? "selector") <*>
                     (o .:? "minDeadline")
                     <*> (o .:? "address")
                     <*> (o .:? "operationDeadline")
                     <*> (o .:? "deadline")
                     <*> (o .:? "pathTranslation"))

instance ToJSON BackendRule where
        toJSON BackendRule'{..}
          = object
              (catMaybes
                 [("jwtAudience" .=) <$> _brJwtAudience,
                  ("selector" .=) <$> _brSelector,
                  ("minDeadline" .=) <$> _brMinDeadline,
                  ("address" .=) <$> _brAddress,
                  ("operationDeadline" .=) <$> _brOperationDeadline,
                  ("deadline" .=) <$> _brDeadline,
                  ("pathTranslation" .=) <$> _brPathTranslation])

-- | \`SourceContext\` represents information about the source of a protobuf
-- element, like the file in which it is defined.
--
-- /See:/ 'sourceContext' smart constructor.
newtype SourceContext =
  SourceContext'
    { _scFileName :: Maybe Text
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'SourceContext' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'scFileName'
sourceContext
    :: SourceContext
sourceContext = SourceContext' {_scFileName = Nothing}


-- | The path-qualified name of the .proto file that contained the associated
-- protobuf element. For example:
-- \`\"google\/protobuf\/source_context.proto\"\`.
scFileName :: Lens' SourceContext (Maybe Text)
scFileName
  = lens _scFileName (\ s a -> s{_scFileName = a})

instance FromJSON SourceContext where
        parseJSON
          = withObject "SourceContext"
              (\ o -> SourceContext' <$> (o .:? "fileName"))

instance ToJSON SourceContext where
        toJSON SourceContext'{..}
          = object
              (catMaybes [("fileName" .=) <$> _scFileName])

-- | Response for the search query.
--
-- /See:/ 'searchTenancyUnitsResponse' smart constructor.
data SearchTenancyUnitsResponse =
  SearchTenancyUnitsResponse'
    { _sturTenancyUnits  :: !(Maybe [TenancyUnit])
    , _sturNextPageToken :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'SearchTenancyUnitsResponse' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'sturTenancyUnits'
--
-- * 'sturNextPageToken'
searchTenancyUnitsResponse
    :: SearchTenancyUnitsResponse
searchTenancyUnitsResponse =
  SearchTenancyUnitsResponse'
    {_sturTenancyUnits = Nothing, _sturNextPageToken = Nothing}


-- | Tenancy Units matching the request.
sturTenancyUnits :: Lens' SearchTenancyUnitsResponse [TenancyUnit]
sturTenancyUnits
  = lens _sturTenancyUnits
      (\ s a -> s{_sturTenancyUnits = a})
      . _Default
      . _Coerce

-- | Pagination token for large results.
sturNextPageToken :: Lens' SearchTenancyUnitsResponse (Maybe Text)
sturNextPageToken
  = lens _sturNextPageToken
      (\ s a -> s{_sturNextPageToken = a})

instance FromJSON SearchTenancyUnitsResponse where
        parseJSON
          = withObject "SearchTenancyUnitsResponse"
              (\ o ->
                 SearchTenancyUnitsResponse' <$>
                   (o .:? "tenancyUnits" .!= mempty) <*>
                     (o .:? "nextPageToken"))

instance ToJSON SearchTenancyUnitsResponse where
        toJSON SearchTenancyUnitsResponse'{..}
          = object
              (catMaybes
                 [("tenancyUnits" .=) <$> _sturTenancyUnits,
                  ("nextPageToken" .=) <$> _sturNextPageToken])

-- | A single field of a message type.
--
-- /See:/ 'field' smart constructor.
data Field =
  Field'
    { _fKind         :: !(Maybe FieldKind)
    , _fOneofIndex   :: !(Maybe (Textual Int32))
    , _fName         :: !(Maybe Text)
    , _fJSONName     :: !(Maybe Text)
    , _fCardinality  :: !(Maybe FieldCardinality)
    , _fOptions      :: !(Maybe [Option])
    , _fPacked       :: !(Maybe Bool)
    , _fDefaultValue :: !(Maybe Text)
    , _fNumber       :: !(Maybe (Textual Int32))
    , _fTypeURL      :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Field' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'fKind'
--
-- * 'fOneofIndex'
--
-- * 'fName'
--
-- * 'fJSONName'
--
-- * 'fCardinality'
--
-- * 'fOptions'
--
-- * 'fPacked'
--
-- * 'fDefaultValue'
--
-- * 'fNumber'
--
-- * 'fTypeURL'
field
    :: Field
field =
  Field'
    { _fKind = Nothing
    , _fOneofIndex = Nothing
    , _fName = Nothing
    , _fJSONName = Nothing
    , _fCardinality = Nothing
    , _fOptions = Nothing
    , _fPacked = Nothing
    , _fDefaultValue = Nothing
    , _fNumber = Nothing
    , _fTypeURL = Nothing
    }


-- | The field type.
fKind :: Lens' Field (Maybe FieldKind)
fKind = lens _fKind (\ s a -> s{_fKind = a})

-- | The index of the field type in \`Type.oneofs\`, for message or
-- enumeration types. The first type has index 1; zero means the type is
-- not in the list.
fOneofIndex :: Lens' Field (Maybe Int32)
fOneofIndex
  = lens _fOneofIndex (\ s a -> s{_fOneofIndex = a}) .
      mapping _Coerce

-- | The field name.
fName :: Lens' Field (Maybe Text)
fName = lens _fName (\ s a -> s{_fName = a})

-- | The field JSON name.
fJSONName :: Lens' Field (Maybe Text)
fJSONName
  = lens _fJSONName (\ s a -> s{_fJSONName = a})

-- | The field cardinality.
fCardinality :: Lens' Field (Maybe FieldCardinality)
fCardinality
  = lens _fCardinality (\ s a -> s{_fCardinality = a})

-- | The protocol buffer options.
fOptions :: Lens' Field [Option]
fOptions
  = lens _fOptions (\ s a -> s{_fOptions = a}) .
      _Default
      . _Coerce

-- | Whether to use alternative packed wire representation.
fPacked :: Lens' Field (Maybe Bool)
fPacked = lens _fPacked (\ s a -> s{_fPacked = a})

-- | The string value of the default value of this field. Proto2 syntax only.
fDefaultValue :: Lens' Field (Maybe Text)
fDefaultValue
  = lens _fDefaultValue
      (\ s a -> s{_fDefaultValue = a})

-- | The field number.
fNumber :: Lens' Field (Maybe Int32)
fNumber
  = lens _fNumber (\ s a -> s{_fNumber = a}) .
      mapping _Coerce

-- | The field type URL, without the scheme, for message or enumeration
-- types. Example: \`\"type.googleapis.com\/google.protobuf.Timestamp\"\`.
fTypeURL :: Lens' Field (Maybe Text)
fTypeURL = lens _fTypeURL (\ s a -> s{_fTypeURL = a})

instance FromJSON Field where
        parseJSON
          = withObject "Field"
              (\ o ->
                 Field' <$>
                   (o .:? "kind") <*> (o .:? "oneofIndex") <*>
                     (o .:? "name")
                     <*> (o .:? "jsonName")
                     <*> (o .:? "cardinality")
                     <*> (o .:? "options" .!= mempty)
                     <*> (o .:? "packed")
                     <*> (o .:? "defaultValue")
                     <*> (o .:? "number")
                     <*> (o .:? "typeUrl"))

instance ToJSON Field where
        toJSON Field'{..}
          = object
              (catMaybes
                 [("kind" .=) <$> _fKind,
                  ("oneofIndex" .=) <$> _fOneofIndex,
                  ("name" .=) <$> _fName,
                  ("jsonName" .=) <$> _fJSONName,
                  ("cardinality" .=) <$> _fCardinality,
                  ("options" .=) <$> _fOptions,
                  ("packed" .=) <$> _fPacked,
                  ("defaultValue" .=) <$> _fDefaultValue,
                  ("number" .=) <$> _fNumber,
                  ("typeUrl" .=) <$> _fTypeURL])

-- | Bind API methods to metrics. Binding a method to a metric causes that
-- metric\'s configured quota behaviors to apply to the method call.
--
-- /See:/ 'metricRule' smart constructor.
data MetricRule =
  MetricRule'
    { _mrSelector    :: !(Maybe Text)
    , _mrMetricCosts :: !(Maybe MetricRuleMetricCosts)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'MetricRule' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mrSelector'
--
-- * 'mrMetricCosts'
metricRule
    :: MetricRule
metricRule = MetricRule' {_mrSelector = Nothing, _mrMetricCosts = Nothing}


-- | Selects the methods to which this rule applies. Refer to selector for
-- syntax details.
mrSelector :: Lens' MetricRule (Maybe Text)
mrSelector
  = lens _mrSelector (\ s a -> s{_mrSelector = a})

-- | Metrics to update when the selected methods are called, and the
-- associated cost applied to each metric. The key of the map is the metric
-- name, and the values are the amount increased for the metric against
-- which the quota limits are defined. The value must not be negative.
mrMetricCosts :: Lens' MetricRule (Maybe MetricRuleMetricCosts)
mrMetricCosts
  = lens _mrMetricCosts
      (\ s a -> s{_mrMetricCosts = a})

instance FromJSON MetricRule where
        parseJSON
          = withObject "MetricRule"
              (\ o ->
                 MetricRule' <$>
                   (o .:? "selector") <*> (o .:? "metricCosts"))

instance ToJSON MetricRule where
        toJSON MetricRule'{..}
          = object
              (catMaybes
                 [("selector" .=) <$> _mrSelector,
                  ("metricCosts" .=) <$> _mrMetricCosts])

-- | If this map is nonempty, then this override applies only to specific
-- values for dimensions defined in the limit unit. For example, an
-- override on a limit with the unit 1\/{project}\/{region} could contain
-- an entry with the key \"region\" and the value \"us-east-1\"; the
-- override is only applied to quota consumed in that region. This map has
-- the following restrictions: - Keys that are not defined in the limit\'s
-- unit are not valid keys. Any string appearing in {brackets} in the unit
-- (besides {project} or {user}) is a defined key. - \"project\" is not a
-- valid key; the project is already specified in the parent resource name.
-- - \"user\" is not a valid key; the API does not support quota overrides
-- that apply only to a specific user. - If \"region\" appears as a key,
-- its value must be a valid Cloud region. - If \"zone\" appears as a key,
-- its value must be a valid Cloud zone. - If any valid key other than
-- \"region\" or \"zone\" appears in the map, then all valid keys other
-- than \"region\" or \"zone\" must also appear in the map.
--
-- /See:/ 'v1Beta1QuotaOverrideDimensions' smart constructor.
newtype V1Beta1QuotaOverrideDimensions =
  V1Beta1QuotaOverrideDimensions'
    { _vbqodAddtional :: HashMap Text Text
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1Beta1QuotaOverrideDimensions' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'vbqodAddtional'
v1Beta1QuotaOverrideDimensions
    :: HashMap Text Text -- ^ 'vbqodAddtional'
    -> V1Beta1QuotaOverrideDimensions
v1Beta1QuotaOverrideDimensions pVbqodAddtional_ =
  V1Beta1QuotaOverrideDimensions' {_vbqodAddtional = _Coerce # pVbqodAddtional_}


vbqodAddtional :: Lens' V1Beta1QuotaOverrideDimensions (HashMap Text Text)
vbqodAddtional
  = lens _vbqodAddtional
      (\ s a -> s{_vbqodAddtional = a})
      . _Coerce

instance FromJSON V1Beta1QuotaOverrideDimensions
         where
        parseJSON
          = withObject "V1Beta1QuotaOverrideDimensions"
              (\ o ->
                 V1Beta1QuotaOverrideDimensions' <$>
                   (parseJSONObject o))

instance ToJSON V1Beta1QuotaOverrideDimensions where
        toJSON = toJSON . _vbqodAddtional

-- | \`Service\` is the root object of Google service configuration schema.
-- It describes basic information about a service, such as the name and the
-- title, and delegates other aspects to sub-sections. Each sub-section is
-- either a proto message or a repeated proto message that configures a
-- specific aspect, such as auth. See each proto message definition for
-- details. Example: type: google.api.Service config_version: 3 name:
-- calendar.googleapis.com title: Google Calendar API apis: - name:
-- google.calendar.v3.Calendar authentication: providers: - id:
-- google_calendar_auth jwks_uri:
-- https:\/\/www.googleapis.com\/oauth2\/v1\/certs issuer:
-- https:\/\/securetoken.google.com rules: - selector: \"*\" requirements:
-- provider_id: google_calendar_auth
--
-- /See:/ 'service' smart constructor.
data Service =
  Service'
    { _sControl            :: !(Maybe Control)
    , _sMetrics            :: !(Maybe [MetricDescriptor])
    , _sContext            :: !(Maybe Context)
    , _sAuthentication     :: !(Maybe Authentication)
    , _sAPIs               :: !(Maybe [API])
    , _sTypes              :: !(Maybe [Type])
    , _sSystemTypes        :: !(Maybe [Type])
    , _sExperimental       :: !(Maybe Experimental)
    , _sMonitoredResources :: !(Maybe [MonitoredResourceDescriptor])
    , _sBackend            :: !(Maybe Backend)
    , _sMonitoring         :: !(Maybe Monitoring)
    , _sName               :: !(Maybe Text)
    , _sSystemParameters   :: !(Maybe SystemParameters)
    , _sLogs               :: !(Maybe [LogDescriptor])
    , _sDocumentation      :: !(Maybe Documentation)
    , _sId                 :: !(Maybe Text)
    , _sUsage              :: !(Maybe Usage)
    , _sEndpoints          :: !(Maybe [Endpoint])
    , _sEnums              :: !(Maybe [Enum'])
    , _sConfigVersion      :: !(Maybe (Textual Word32))
    , _sHTTP               :: !(Maybe HTTP)
    , _sTitle              :: !(Maybe Text)
    , _sProducerProjectId  :: !(Maybe Text)
    , _sSourceInfo         :: !(Maybe SourceInfo)
    , _sBilling            :: !(Maybe Billing)
    , _sCustomError        :: !(Maybe CustomError)
    , _sLogging            :: !(Maybe Logging)
    , _sQuota              :: !(Maybe Quota)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Service' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'sControl'
--
-- * 'sMetrics'
--
-- * 'sContext'
--
-- * 'sAuthentication'
--
-- * 'sAPIs'
--
-- * 'sTypes'
--
-- * 'sSystemTypes'
--
-- * 'sExperimental'
--
-- * 'sMonitoredResources'
--
-- * 'sBackend'
--
-- * 'sMonitoring'
--
-- * 'sName'
--
-- * 'sSystemParameters'
--
-- * 'sLogs'
--
-- * 'sDocumentation'
--
-- * 'sId'
--
-- * 'sUsage'
--
-- * 'sEndpoints'
--
-- * 'sEnums'
--
-- * 'sConfigVersion'
--
-- * 'sHTTP'
--
-- * 'sTitle'
--
-- * 'sProducerProjectId'
--
-- * 'sSourceInfo'
--
-- * 'sBilling'
--
-- * 'sCustomError'
--
-- * 'sLogging'
--
-- * 'sQuota'
service
    :: Service
service =
  Service'
    { _sControl = Nothing
    , _sMetrics = Nothing
    , _sContext = Nothing
    , _sAuthentication = Nothing
    , _sAPIs = Nothing
    , _sTypes = Nothing
    , _sSystemTypes = Nothing
    , _sExperimental = Nothing
    , _sMonitoredResources = Nothing
    , _sBackend = Nothing
    , _sMonitoring = Nothing
    , _sName = Nothing
    , _sSystemParameters = Nothing
    , _sLogs = Nothing
    , _sDocumentation = Nothing
    , _sId = Nothing
    , _sUsage = Nothing
    , _sEndpoints = Nothing
    , _sEnums = Nothing
    , _sConfigVersion = Nothing
    , _sHTTP = Nothing
    , _sTitle = Nothing
    , _sProducerProjectId = Nothing
    , _sSourceInfo = Nothing
    , _sBilling = Nothing
    , _sCustomError = Nothing
    , _sLogging = Nothing
    , _sQuota = Nothing
    }


-- | Configuration for the service control plane.
sControl :: Lens' Service (Maybe Control)
sControl = lens _sControl (\ s a -> s{_sControl = a})

-- | Defines the metrics used by this service.
sMetrics :: Lens' Service [MetricDescriptor]
sMetrics
  = lens _sMetrics (\ s a -> s{_sMetrics = a}) .
      _Default
      . _Coerce

-- | Context configuration.
sContext :: Lens' Service (Maybe Context)
sContext = lens _sContext (\ s a -> s{_sContext = a})

-- | Auth configuration.
sAuthentication :: Lens' Service (Maybe Authentication)
sAuthentication
  = lens _sAuthentication
      (\ s a -> s{_sAuthentication = a})

-- | A list of API interfaces exported by this service. Only the \`name\`
-- field of the google.protobuf.Api needs to be provided by the
-- configuration author, as the remaining fields will be derived from the
-- IDL during the normalization process. It is an error to specify an API
-- interface here which cannot be resolved against the associated IDL
-- files.
sAPIs :: Lens' Service [API]
sAPIs
  = lens _sAPIs (\ s a -> s{_sAPIs = a}) . _Default .
      _Coerce

-- | A list of all proto message types included in this API service. Types
-- referenced directly or indirectly by the \`apis\` are automatically
-- included. Messages which are not referenced but shall be included, such
-- as types used by the \`google.protobuf.Any\` type, should be listed here
-- by name. Example: types: - name: google.protobuf.Int32
sTypes :: Lens' Service [Type]
sTypes
  = lens _sTypes (\ s a -> s{_sTypes = a}) . _Default .
      _Coerce

-- | A list of all proto message types included in this API service. It
-- serves similar purpose as [google.api.Service.types], except that these
-- types are not needed by user-defined APIs. Therefore, they will not show
-- up in the generated discovery doc. This field should only be used to
-- define system APIs in ESF.
sSystemTypes :: Lens' Service [Type]
sSystemTypes
  = lens _sSystemTypes (\ s a -> s{_sSystemTypes = a})
      . _Default
      . _Coerce

-- | Experimental configuration.
sExperimental :: Lens' Service (Maybe Experimental)
sExperimental
  = lens _sExperimental
      (\ s a -> s{_sExperimental = a})

-- | Defines the monitored resources used by this service. This is required
-- by the Service.monitoring and Service.logging configurations.
sMonitoredResources :: Lens' Service [MonitoredResourceDescriptor]
sMonitoredResources
  = lens _sMonitoredResources
      (\ s a -> s{_sMonitoredResources = a})
      . _Default
      . _Coerce

-- | API backend configuration.
sBackend :: Lens' Service (Maybe Backend)
sBackend = lens _sBackend (\ s a -> s{_sBackend = a})

-- | Monitoring configuration.
sMonitoring :: Lens' Service (Maybe Monitoring)
sMonitoring
  = lens _sMonitoring (\ s a -> s{_sMonitoring = a})

-- | The service name, which is a DNS-like logical identifier for the
-- service, such as \`calendar.googleapis.com\`. The service name typically
-- goes through DNS verification to make sure the owner of the service also
-- owns the DNS name.
sName :: Lens' Service (Maybe Text)
sName = lens _sName (\ s a -> s{_sName = a})

-- | System parameter configuration.
sSystemParameters :: Lens' Service (Maybe SystemParameters)
sSystemParameters
  = lens _sSystemParameters
      (\ s a -> s{_sSystemParameters = a})

-- | Defines the logs used by this service.
sLogs :: Lens' Service [LogDescriptor]
sLogs
  = lens _sLogs (\ s a -> s{_sLogs = a}) . _Default .
      _Coerce

-- | Additional API documentation.
sDocumentation :: Lens' Service (Maybe Documentation)
sDocumentation
  = lens _sDocumentation
      (\ s a -> s{_sDocumentation = a})

-- | A unique ID for a specific instance of this message, typically assigned
-- by the client for tracking purpose. If empty, the server may choose to
-- generate one instead. Must be no longer than 60 characters.
sId :: Lens' Service (Maybe Text)
sId = lens _sId (\ s a -> s{_sId = a})

-- | Configuration controlling usage of this service.
sUsage :: Lens' Service (Maybe Usage)
sUsage = lens _sUsage (\ s a -> s{_sUsage = a})

-- | Configuration for network endpoints. If this is empty, then an endpoint
-- with the same name as the service is automatically generated to service
-- all defined APIs.
sEndpoints :: Lens' Service [Endpoint]
sEndpoints
  = lens _sEndpoints (\ s a -> s{_sEndpoints = a}) .
      _Default
      . _Coerce

-- | A list of all enum types included in this API service. Enums referenced
-- directly or indirectly by the \`apis\` are automatically included. Enums
-- which are not referenced but shall be included should be listed here by
-- name. Example: enums: - name: google.someapi.v1.SomeEnum
sEnums :: Lens' Service [Enum']
sEnums
  = lens _sEnums (\ s a -> s{_sEnums = a}) . _Default .
      _Coerce

-- | The semantic version of the service configuration. The config version
-- affects the interpretation of the service configuration. For example,
-- certain features are enabled by default for certain config versions. The
-- latest config version is \`3\`.
sConfigVersion :: Lens' Service (Maybe Word32)
sConfigVersion
  = lens _sConfigVersion
      (\ s a -> s{_sConfigVersion = a})
      . mapping _Coerce

-- | HTTP configuration.
sHTTP :: Lens' Service (Maybe HTTP)
sHTTP = lens _sHTTP (\ s a -> s{_sHTTP = a})

-- | The product title for this service.
sTitle :: Lens' Service (Maybe Text)
sTitle = lens _sTitle (\ s a -> s{_sTitle = a})

-- | The Google project that owns this service.
sProducerProjectId :: Lens' Service (Maybe Text)
sProducerProjectId
  = lens _sProducerProjectId
      (\ s a -> s{_sProducerProjectId = a})

-- | Output only. The source information for this configuration if available.
sSourceInfo :: Lens' Service (Maybe SourceInfo)
sSourceInfo
  = lens _sSourceInfo (\ s a -> s{_sSourceInfo = a})

-- | Billing configuration.
sBilling :: Lens' Service (Maybe Billing)
sBilling = lens _sBilling (\ s a -> s{_sBilling = a})

-- | Custom error configuration.
sCustomError :: Lens' Service (Maybe CustomError)
sCustomError
  = lens _sCustomError (\ s a -> s{_sCustomError = a})

-- | Logging configuration.
sLogging :: Lens' Service (Maybe Logging)
sLogging = lens _sLogging (\ s a -> s{_sLogging = a})

-- | Quota configuration.
sQuota :: Lens' Service (Maybe Quota)
sQuota = lens _sQuota (\ s a -> s{_sQuota = a})

instance FromJSON Service where
        parseJSON
          = withObject "Service"
              (\ o ->
                 Service' <$>
                   (o .:? "control") <*> (o .:? "metrics" .!= mempty)
                     <*> (o .:? "context")
                     <*> (o .:? "authentication")
                     <*> (o .:? "apis" .!= mempty)
                     <*> (o .:? "types" .!= mempty)
                     <*> (o .:? "systemTypes" .!= mempty)
                     <*> (o .:? "experimental")
                     <*> (o .:? "monitoredResources" .!= mempty)
                     <*> (o .:? "backend")
                     <*> (o .:? "monitoring")
                     <*> (o .:? "name")
                     <*> (o .:? "systemParameters")
                     <*> (o .:? "logs" .!= mempty)
                     <*> (o .:? "documentation")
                     <*> (o .:? "id")
                     <*> (o .:? "usage")
                     <*> (o .:? "endpoints" .!= mempty)
                     <*> (o .:? "enums" .!= mempty)
                     <*> (o .:? "configVersion")
                     <*> (o .:? "http")
                     <*> (o .:? "title")
                     <*> (o .:? "producerProjectId")
                     <*> (o .:? "sourceInfo")
                     <*> (o .:? "billing")
                     <*> (o .:? "customError")
                     <*> (o .:? "logging")
                     <*> (o .:? "quota"))

instance ToJSON Service where
        toJSON Service'{..}
          = object
              (catMaybes
                 [("control" .=) <$> _sControl,
                  ("metrics" .=) <$> _sMetrics,
                  ("context" .=) <$> _sContext,
                  ("authentication" .=) <$> _sAuthentication,
                  ("apis" .=) <$> _sAPIs, ("types" .=) <$> _sTypes,
                  ("systemTypes" .=) <$> _sSystemTypes,
                  ("experimental" .=) <$> _sExperimental,
                  ("monitoredResources" .=) <$> _sMonitoredResources,
                  ("backend" .=) <$> _sBackend,
                  ("monitoring" .=) <$> _sMonitoring,
                  ("name" .=) <$> _sName,
                  ("systemParameters" .=) <$> _sSystemParameters,
                  ("logs" .=) <$> _sLogs,
                  ("documentation" .=) <$> _sDocumentation,
                  ("id" .=) <$> _sId, ("usage" .=) <$> _sUsage,
                  ("endpoints" .=) <$> _sEndpoints,
                  ("enums" .=) <$> _sEnums,
                  ("configVersion" .=) <$> _sConfigVersion,
                  ("http" .=) <$> _sHTTP, ("title" .=) <$> _sTitle,
                  ("producerProjectId" .=) <$> _sProducerProjectId,
                  ("sourceInfo" .=) <$> _sSourceInfo,
                  ("billing" .=) <$> _sBilling,
                  ("customError" .=) <$> _sCustomError,
                  ("logging" .=) <$> _sLogging,
                  ("quota" .=) <$> _sQuota])

-- | This resource represents a long-running operation that is the result of
-- a network API call.
--
-- /See:/ 'operation' smart constructor.
data Operation =
  Operation'
    { _oDone     :: !(Maybe Bool)
    , _oError    :: !(Maybe Status)
    , _oResponse :: !(Maybe OperationResponse)
    , _oName     :: !(Maybe Text)
    , _oMetadata :: !(Maybe OperationMetadata)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Operation' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'oDone'
--
-- * 'oError'
--
-- * 'oResponse'
--
-- * 'oName'
--
-- * 'oMetadata'
operation
    :: Operation
operation =
  Operation'
    { _oDone = Nothing
    , _oError = Nothing
    , _oResponse = Nothing
    , _oName = Nothing
    , _oMetadata = Nothing
    }


-- | If the value is \`false\`, it means the operation is still in progress.
-- If \`true\`, the operation is completed, and either \`error\` or
-- \`response\` is available.
oDone :: Lens' Operation (Maybe Bool)
oDone = lens _oDone (\ s a -> s{_oDone = a})

-- | The error result of the operation in case of failure or cancellation.
oError :: Lens' Operation (Maybe Status)
oError = lens _oError (\ s a -> s{_oError = a})

-- | The normal response of the operation in case of success. If the original
-- method returns no data on success, such as \`Delete\`, the response is
-- \`google.protobuf.Empty\`. If the original method is standard
-- \`Get\`\/\`Create\`\/\`Update\`, the response should be the resource.
-- For other methods, the response should have the type \`XxxResponse\`,
-- where \`Xxx\` is the original method name. For example, if the original
-- method name is \`TakeSnapshot()\`, the inferred response type is
-- \`TakeSnapshotResponse\`.
oResponse :: Lens' Operation (Maybe OperationResponse)
oResponse
  = lens _oResponse (\ s a -> s{_oResponse = a})

-- | The server-assigned name, which is only unique within the same service
-- that originally returns it. If you use the default HTTP mapping, the
-- \`name\` should have the format of \`operations\/some\/unique\/name\`.
oName :: Lens' Operation (Maybe Text)
oName = lens _oName (\ s a -> s{_oName = a})

-- | Service-specific metadata associated with the operation. It typically
-- contains progress information and common metadata such as create time.
-- Some services might not provide such metadata. Any method that returns a
-- long-running operation should document the metadata type, if any.
oMetadata :: Lens' Operation (Maybe OperationMetadata)
oMetadata
  = lens _oMetadata (\ s a -> s{_oMetadata = a})

instance FromJSON Operation where
        parseJSON
          = withObject "Operation"
              (\ o ->
                 Operation' <$>
                   (o .:? "done") <*> (o .:? "error") <*>
                     (o .:? "response")
                     <*> (o .:? "name")
                     <*> (o .:? "metadata"))

instance ToJSON Operation where
        toJSON Operation'{..}
          = object
              (catMaybes
                 [("done" .=) <$> _oDone, ("error" .=) <$> _oError,
                  ("response" .=) <$> _oResponse,
                  ("name" .=) <$> _oName,
                  ("metadata" .=) <$> _oMetadata])

-- | A generic empty message that you can re-use to avoid defining duplicated
-- empty messages in your APIs. A typical example is to use it as the
-- request or the response type of an API method. For instance: service Foo
-- { rpc Bar(google.protobuf.Empty) returns (google.protobuf.Empty); } The
-- JSON representation for \`Empty\` is empty JSON object \`{}\`.
--
-- /See:/ 'empty' smart constructor.
data Empty =
  Empty'
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Empty' with the minimum fields required to make a request.
--
empty
    :: Empty
empty = Empty'


instance FromJSON Empty where
        parseJSON = withObject "Empty" (\ o -> pure Empty')

instance ToJSON Empty where
        toJSON = const emptyObject

-- | Response message for ImportProducerOverrides
--
-- /See:/ 'v1Beta1ImportProducerOverridesResponse' smart constructor.
newtype V1Beta1ImportProducerOverridesResponse =
  V1Beta1ImportProducerOverridesResponse'
    { _vbiporOverrides :: Maybe [V1Beta1QuotaOverride]
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1Beta1ImportProducerOverridesResponse' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'vbiporOverrides'
v1Beta1ImportProducerOverridesResponse
    :: V1Beta1ImportProducerOverridesResponse
v1Beta1ImportProducerOverridesResponse =
  V1Beta1ImportProducerOverridesResponse' {_vbiporOverrides = Nothing}


-- | The overrides that were created from the imported data.
vbiporOverrides :: Lens' V1Beta1ImportProducerOverridesResponse [V1Beta1QuotaOverride]
vbiporOverrides
  = lens _vbiporOverrides
      (\ s a -> s{_vbiporOverrides = a})
      . _Default
      . _Coerce

instance FromJSON
           V1Beta1ImportProducerOverridesResponse
         where
        parseJSON
          = withObject "V1Beta1ImportProducerOverridesResponse"
              (\ o ->
                 V1Beta1ImportProducerOverridesResponse' <$>
                   (o .:? "overrides" .!= mempty))

instance ToJSON
           V1Beta1ImportProducerOverridesResponse
         where
        toJSON V1Beta1ImportProducerOverridesResponse'{..}
          = object
              (catMaybes [("overrides" .=) <$> _vbiporOverrides])

-- | A custom error rule.
--
-- /See:/ 'customErrorRule' smart constructor.
data CustomErrorRule =
  CustomErrorRule'
    { _cerIsErrorType :: !(Maybe Bool)
    , _cerSelector    :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'CustomErrorRule' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'cerIsErrorType'
--
-- * 'cerSelector'
customErrorRule
    :: CustomErrorRule
customErrorRule =
  CustomErrorRule' {_cerIsErrorType = Nothing, _cerSelector = Nothing}


-- | Mark this message as possible payload in error response. Otherwise,
-- objects of this type will be filtered when they appear in error payload.
cerIsErrorType :: Lens' CustomErrorRule (Maybe Bool)
cerIsErrorType
  = lens _cerIsErrorType
      (\ s a -> s{_cerIsErrorType = a})

-- | Selects messages to which this rule applies. Refer to selector for
-- syntax details.
cerSelector :: Lens' CustomErrorRule (Maybe Text)
cerSelector
  = lens _cerSelector (\ s a -> s{_cerSelector = a})

instance FromJSON CustomErrorRule where
        parseJSON
          = withObject "CustomErrorRule"
              (\ o ->
                 CustomErrorRule' <$>
                   (o .:? "isErrorType") <*> (o .:? "selector"))

instance ToJSON CustomErrorRule where
        toJSON CustomErrorRule'{..}
          = object
              (catMaybes
                 [("isErrorType" .=) <$> _cerIsErrorType,
                  ("selector" .=) <$> _cerSelector])

-- | Response message for the \`EnableConsumer\` method. This response
-- message is assigned to the \`response\` field of the returned Operation
-- when that operation is done.
--
-- /See:/ 'v1Beta1EnableConsumerResponse' smart constructor.
data V1Beta1EnableConsumerResponse =
  V1Beta1EnableConsumerResponse'
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1Beta1EnableConsumerResponse' with the minimum fields required to make a request.
--
v1Beta1EnableConsumerResponse
    :: V1Beta1EnableConsumerResponse
v1Beta1EnableConsumerResponse = V1Beta1EnableConsumerResponse'


instance FromJSON V1Beta1EnableConsumerResponse where
        parseJSON
          = withObject "V1Beta1EnableConsumerResponse"
              (\ o -> pure V1Beta1EnableConsumerResponse')

instance ToJSON V1Beta1EnableConsumerResponse where
        toJSON = const emptyObject

-- | The option\'s value packed in an Any message. If the value is a
-- primitive, the corresponding wrapper type defined in
-- google\/protobuf\/wrappers.proto should be used. If the value is an
-- enum, it should be stored as an int32 value using the
-- google.protobuf.Int32Value type.
--
-- /See:/ 'optionValue' smart constructor.
newtype OptionValue =
  OptionValue'
    { _ovAddtional :: HashMap Text JSONValue
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'OptionValue' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'ovAddtional'
optionValue
    :: HashMap Text JSONValue -- ^ 'ovAddtional'
    -> OptionValue
optionValue pOvAddtional_ =
  OptionValue' {_ovAddtional = _Coerce # pOvAddtional_}


-- | Properties of the object. Contains field \'type with type URL.
ovAddtional :: Lens' OptionValue (HashMap Text JSONValue)
ovAddtional
  = lens _ovAddtional (\ s a -> s{_ovAddtional = a}) .
      _Coerce

instance FromJSON OptionValue where
        parseJSON
          = withObject "OptionValue"
              (\ o -> OptionValue' <$> (parseJSONObject o))

instance ToJSON OptionValue where
        toJSON = toJSON . _ovAddtional

-- | Enum value definition.
--
-- /See:/ 'enumValue' smart constructor.
data EnumValue =
  EnumValue'
    { _evName    :: !(Maybe Text)
    , _evOptions :: !(Maybe [Option])
    , _evNumber  :: !(Maybe (Textual Int32))
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'EnumValue' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'evName'
--
-- * 'evOptions'
--
-- * 'evNumber'
enumValue
    :: EnumValue
enumValue =
  EnumValue' {_evName = Nothing, _evOptions = Nothing, _evNumber = Nothing}


-- | Enum value name.
evName :: Lens' EnumValue (Maybe Text)
evName = lens _evName (\ s a -> s{_evName = a})

-- | Protocol buffer options.
evOptions :: Lens' EnumValue [Option]
evOptions
  = lens _evOptions (\ s a -> s{_evOptions = a}) .
      _Default
      . _Coerce

-- | Enum value number.
evNumber :: Lens' EnumValue (Maybe Int32)
evNumber
  = lens _evNumber (\ s a -> s{_evNumber = a}) .
      mapping _Coerce

instance FromJSON EnumValue where
        parseJSON
          = withObject "EnumValue"
              (\ o ->
                 EnumValue' <$>
                   (o .:? "name") <*> (o .:? "options" .!= mempty) <*>
                     (o .:? "number"))

instance ToJSON EnumValue where
        toJSON EnumValue'{..}
          = object
              (catMaybes
                 [("name" .=) <$> _evName,
                  ("options" .=) <$> _evOptions,
                  ("number" .=) <$> _evNumber])

-- | \`Authentication\` defines the authentication configuration for an API.
-- Example for an API targeted for external use: name:
-- calendar.googleapis.com authentication: providers: - id:
-- google_calendar_auth jwks_uri:
-- https:\/\/www.googleapis.com\/oauth2\/v1\/certs issuer:
-- https:\/\/securetoken.google.com rules: - selector: \"*\" requirements:
-- provider_id: google_calendar_auth
--
-- /See:/ 'authentication' smart constructor.
data Authentication =
  Authentication'
    { _aRules     :: !(Maybe [AuthenticationRule])
    , _aProviders :: !(Maybe [AuthProvider])
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Authentication' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'aRules'
--
-- * 'aProviders'
authentication
    :: Authentication
authentication = Authentication' {_aRules = Nothing, _aProviders = Nothing}


-- | A list of authentication rules that apply to individual API methods.
-- **NOTE:** All service configuration rules follow \"last one wins\"
-- order.
aRules :: Lens' Authentication [AuthenticationRule]
aRules
  = lens _aRules (\ s a -> s{_aRules = a}) . _Default .
      _Coerce

-- | Defines a set of authentication providers that a service supports.
aProviders :: Lens' Authentication [AuthProvider]
aProviders
  = lens _aProviders (\ s a -> s{_aProviders = a}) .
      _Default
      . _Coerce

instance FromJSON Authentication where
        parseJSON
          = withObject "Authentication"
              (\ o ->
                 Authentication' <$>
                   (o .:? "rules" .!= mempty) <*>
                     (o .:? "providers" .!= mempty))

instance ToJSON Authentication where
        toJSON Authentication'{..}
          = object
              (catMaybes
                 [("rules" .=) <$> _aRules,
                  ("providers" .=) <$> _aProviders])

-- | Response message for the \`EnableConsumer\` method. This response
-- message is assigned to the \`response\` field of the returned Operation
-- when that operation is done.
--
-- /See:/ 'v1EnableConsumerResponse' smart constructor.
data V1EnableConsumerResponse =
  V1EnableConsumerResponse'
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1EnableConsumerResponse' with the minimum fields required to make a request.
--
v1EnableConsumerResponse
    :: V1EnableConsumerResponse
v1EnableConsumerResponse = V1EnableConsumerResponse'


instance FromJSON V1EnableConsumerResponse where
        parseJSON
          = withObject "V1EnableConsumerResponse"
              (\ o -> pure V1EnableConsumerResponse')

instance ToJSON V1EnableConsumerResponse where
        toJSON = const emptyObject

-- | Declares an API Interface to be included in this interface. The
-- including interface must redeclare all the methods from the included
-- interface, but documentation and options are inherited as follows: - If
-- after comment and whitespace stripping, the documentation string of the
-- redeclared method is empty, it will be inherited from the original
-- method. - Each annotation belonging to the service config (http,
-- visibility) which is not set in the redeclared method will be inherited.
-- - If an http annotation is inherited, the path pattern will be modified
-- as follows. Any version prefix will be replaced by the version of the
-- including interface plus the root path if specified. Example of a simple
-- mixin: package google.acl.v1; service AccessControl { \/\/ Get the
-- underlying ACL object. rpc GetAcl(GetAclRequest) returns (Acl) { option
-- (google.api.http).get = \"\/v1\/{resource=**}:getAcl\"; } } package
-- google.storage.v2; service Storage { \/\/ rpc GetAcl(GetAclRequest)
-- returns (Acl); \/\/ Get a data record. rpc GetData(GetDataRequest)
-- returns (Data) { option (google.api.http).get = \"\/v2\/{resource=**}\";
-- } } Example of a mixin configuration: apis: - name:
-- google.storage.v2.Storage mixins: - name: google.acl.v1.AccessControl
-- The mixin construct implies that all methods in \`AccessControl\` are
-- also declared with same name and request\/response types in \`Storage\`.
-- A documentation generator or annotation processor will see the effective
-- \`Storage.GetAcl\` method after inherting documentation and annotations
-- as follows: service Storage { \/\/ Get the underlying ACL object. rpc
-- GetAcl(GetAclRequest) returns (Acl) { option (google.api.http).get =
-- \"\/v2\/{resource=**}:getAcl\"; } ... } Note how the version in the path
-- pattern changed from \`v1\` to \`v2\`. If the \`root\` field in the
-- mixin is specified, it should be a relative path under which inherited
-- HTTP paths are placed. Example: apis: - name: google.storage.v2.Storage
-- mixins: - name: google.acl.v1.AccessControl root: acls This implies the
-- following inherited HTTP annotation: service Storage { \/\/ Get the
-- underlying ACL object. rpc GetAcl(GetAclRequest) returns (Acl) { option
-- (google.api.http).get = \"\/v2\/acls\/{resource=**}:getAcl\"; } ... }
--
-- /See:/ 'mixin' smart constructor.
data Mixin =
  Mixin'
    { _mRoot :: !(Maybe Text)
    , _mName :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Mixin' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mRoot'
--
-- * 'mName'
mixin
    :: Mixin
mixin = Mixin' {_mRoot = Nothing, _mName = Nothing}


-- | If non-empty specifies a path under which inherited HTTP paths are
-- rooted.
mRoot :: Lens' Mixin (Maybe Text)
mRoot = lens _mRoot (\ s a -> s{_mRoot = a})

-- | The fully qualified name of the interface which is included.
mName :: Lens' Mixin (Maybe Text)
mName = lens _mName (\ s a -> s{_mName = a})

instance FromJSON Mixin where
        parseJSON
          = withObject "Mixin"
              (\ o -> Mixin' <$> (o .:? "root") <*> (o .:? "name"))

instance ToJSON Mixin where
        toJSON Mixin'{..}
          = object
              (catMaybes
                 [("root" .=) <$> _mRoot, ("name" .=) <$> _mName])

-- | A custom pattern is used for defining custom HTTP verb.
--
-- /See:/ 'customHTTPPattern' smart constructor.
data CustomHTTPPattern =
  CustomHTTPPattern'
    { _chttppPath :: !(Maybe Text)
    , _chttppKind :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'CustomHTTPPattern' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'chttppPath'
--
-- * 'chttppKind'
customHTTPPattern
    :: CustomHTTPPattern
customHTTPPattern =
  CustomHTTPPattern' {_chttppPath = Nothing, _chttppKind = Nothing}


-- | The path matched by this custom verb.
chttppPath :: Lens' CustomHTTPPattern (Maybe Text)
chttppPath
  = lens _chttppPath (\ s a -> s{_chttppPath = a})

-- | The name of this custom HTTP verb.
chttppKind :: Lens' CustomHTTPPattern (Maybe Text)
chttppKind
  = lens _chttppKind (\ s a -> s{_chttppKind = a})

instance FromJSON CustomHTTPPattern where
        parseJSON
          = withObject "CustomHTTPPattern"
              (\ o ->
                 CustomHTTPPattern' <$>
                   (o .:? "path") <*> (o .:? "kind"))

instance ToJSON CustomHTTPPattern where
        toJSON CustomHTTPPattern'{..}
          = object
              (catMaybes
                 [("path" .=) <$> _chttppPath,
                  ("kind" .=) <$> _chttppKind])

-- | Usage configuration rules for the service. NOTE: Under development. Use
-- this rule to configure unregistered calls for the service. Unregistered
-- calls are calls that do not contain consumer project identity. (Example:
-- calls that do not contain an API key). By default, API methods do not
-- allow unregistered calls, and each method call must be identified by a
-- consumer project identity. Use this rule to allow\/disallow unregistered
-- calls. Example of an API that wants to allow unregistered calls for
-- entire service. usage: rules: - selector: \"*\"
-- allow_unregistered_calls: true Example of a method that wants to allow
-- unregistered calls. usage: rules: - selector:
-- \"google.example.library.v1.LibraryService.CreateBook\"
-- allow_unregistered_calls: true
--
-- /See:/ 'usageRule' smart constructor.
data UsageRule =
  UsageRule'
    { _urSelector               :: !(Maybe Text)
    , _urAllowUnregisteredCalls :: !(Maybe Bool)
    , _urSkipServiceControl     :: !(Maybe Bool)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'UsageRule' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'urSelector'
--
-- * 'urAllowUnregisteredCalls'
--
-- * 'urSkipServiceControl'
usageRule
    :: UsageRule
usageRule =
  UsageRule'
    { _urSelector = Nothing
    , _urAllowUnregisteredCalls = Nothing
    , _urSkipServiceControl = Nothing
    }


-- | Selects the methods to which this rule applies. Use \'*\' to indicate
-- all methods in all APIs. Refer to selector for syntax details.
urSelector :: Lens' UsageRule (Maybe Text)
urSelector
  = lens _urSelector (\ s a -> s{_urSelector = a})

-- | If true, the selected method allows unregistered calls, e.g. calls that
-- don\'t identify any user or application.
urAllowUnregisteredCalls :: Lens' UsageRule (Maybe Bool)
urAllowUnregisteredCalls
  = lens _urAllowUnregisteredCalls
      (\ s a -> s{_urAllowUnregisteredCalls = a})

-- | If true, the selected method should skip service control and the control
-- plane features, such as quota and billing, will not be available. This
-- flag is used by Google Cloud Endpoints to bypass checks for internal
-- methods, such as service health check methods.
urSkipServiceControl :: Lens' UsageRule (Maybe Bool)
urSkipServiceControl
  = lens _urSkipServiceControl
      (\ s a -> s{_urSkipServiceControl = a})

instance FromJSON UsageRule where
        parseJSON
          = withObject "UsageRule"
              (\ o ->
                 UsageRule' <$>
                   (o .:? "selector") <*>
                     (o .:? "allowUnregisteredCalls")
                     <*> (o .:? "skipServiceControl"))

instance ToJSON UsageRule where
        toJSON UsageRule'{..}
          = object
              (catMaybes
                 [("selector" .=) <$> _urSelector,
                  ("allowUnregisteredCalls" .=) <$>
                    _urAllowUnregisteredCalls,
                  ("skipServiceControl" .=) <$> _urSkipServiceControl])

--
-- /See:/ 'statusDetailsItem' smart constructor.
newtype StatusDetailsItem =
  StatusDetailsItem'
    { _sdiAddtional :: HashMap Text JSONValue
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'StatusDetailsItem' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'sdiAddtional'
statusDetailsItem
    :: HashMap Text JSONValue -- ^ 'sdiAddtional'
    -> StatusDetailsItem
statusDetailsItem pSdiAddtional_ =
  StatusDetailsItem' {_sdiAddtional = _Coerce # pSdiAddtional_}


-- | Properties of the object. Contains field \'type with type URL.
sdiAddtional :: Lens' StatusDetailsItem (HashMap Text JSONValue)
sdiAddtional
  = lens _sdiAddtional (\ s a -> s{_sdiAddtional = a})
      . _Coerce

instance FromJSON StatusDetailsItem where
        parseJSON
          = withObject "StatusDetailsItem"
              (\ o -> StatusDetailsItem' <$> (parseJSONObject o))

instance ToJSON StatusDetailsItem where
        toJSON = toJSON . _sdiAddtional

-- | Represents a documentation page. A page can contain subpages to
-- represent nested documentation set structure.
--
-- /See:/ 'page' smart constructor.
data Page =
  Page'
    { _pSubpages :: !(Maybe [Page])
    , _pContent  :: !(Maybe Text)
    , _pName     :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Page' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'pSubpages'
--
-- * 'pContent'
--
-- * 'pName'
page
    :: Page
page = Page' {_pSubpages = Nothing, _pContent = Nothing, _pName = Nothing}


-- | Subpages of this page. The order of subpages specified here will be
-- honored in the generated docset.
pSubpages :: Lens' Page [Page]
pSubpages
  = lens _pSubpages (\ s a -> s{_pSubpages = a}) .
      _Default
      . _Coerce

-- | The Markdown content of the page. You can use '(== include {path} ==)'
-- to include content from a Markdown file.
pContent :: Lens' Page (Maybe Text)
pContent = lens _pContent (\ s a -> s{_pContent = a})

-- | The name of the page. It will be used as an identity of the page to
-- generate URI of the page, text of the link to this page in navigation,
-- etc. The full page name (start from the root page name to this page
-- concatenated with \`.\`) can be used as reference to the page in your
-- documentation. For example:
--
-- > pages:
-- > - name: Tutorial
-- >   content: (== include tutorial.md ==)
-- >   subpages:
-- >   - name: Java
-- >     content: (== include tutorial_java.md ==)
--
-- You can reference \`Java\` page using Markdown reference link syntax:
-- \`Java\`.
pName :: Lens' Page (Maybe Text)
pName = lens _pName (\ s a -> s{_pName = a})

instance FromJSON Page where
        parseJSON
          = withObject "Page"
              (\ o ->
                 Page' <$>
                   (o .:? "subpages" .!= mempty) <*> (o .:? "content")
                     <*> (o .:? "name"))

instance ToJSON Page where
        toJSON Page'{..}
          = object
              (catMaybes
                 [("subpages" .=) <$> _pSubpages,
                  ("content" .=) <$> _pContent,
                  ("name" .=) <$> _pName])

-- | Response message for the \`GenerateServiceAccount\` method. This
-- response message is assigned to the \`response\` field of the returned
-- Operation when that operation is done.
--
-- /See:/ 'v1GenerateServiceAccountResponse' smart constructor.
newtype V1GenerateServiceAccountResponse =
  V1GenerateServiceAccountResponse'
    { _vgsarAccount :: Maybe V1ServiceAccount
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1GenerateServiceAccountResponse' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'vgsarAccount'
v1GenerateServiceAccountResponse
    :: V1GenerateServiceAccountResponse
v1GenerateServiceAccountResponse =
  V1GenerateServiceAccountResponse' {_vgsarAccount = Nothing}


-- | ServiceAccount that was created or retrieved.
vgsarAccount :: Lens' V1GenerateServiceAccountResponse (Maybe V1ServiceAccount)
vgsarAccount
  = lens _vgsarAccount (\ s a -> s{_vgsarAccount = a})

instance FromJSON V1GenerateServiceAccountResponse
         where
        parseJSON
          = withObject "V1GenerateServiceAccountResponse"
              (\ o ->
                 V1GenerateServiceAccountResponse' <$>
                   (o .:? "account"))

instance ToJSON V1GenerateServiceAccountResponse
         where
        toJSON V1GenerateServiceAccountResponse'{..}
          = object
              (catMaybes [("account" .=) <$> _vgsarAccount])

-- | Authentication rules for the service. By default, if a method has any
-- authentication requirements, every request must include a valid
-- credential matching one of the requirements. It\'s an error to include
-- more than one kind of credential in a single request. If a method
-- doesn\'t have any auth requirements, request credentials will be
-- ignored.
--
-- /See:/ 'authenticationRule' smart constructor.
data AuthenticationRule =
  AuthenticationRule'
    { _arRequirements           :: !(Maybe [AuthRequirement])
    , _arSelector               :: !(Maybe Text)
    , _arAllowWithoutCredential :: !(Maybe Bool)
    , _arOAuth                  :: !(Maybe OAuthRequirements)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'AuthenticationRule' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'arRequirements'
--
-- * 'arSelector'
--
-- * 'arAllowWithoutCredential'
--
-- * 'arOAuth'
authenticationRule
    :: AuthenticationRule
authenticationRule =
  AuthenticationRule'
    { _arRequirements = Nothing
    , _arSelector = Nothing
    , _arAllowWithoutCredential = Nothing
    , _arOAuth = Nothing
    }


-- | Requirements for additional authentication providers.
arRequirements :: Lens' AuthenticationRule [AuthRequirement]
arRequirements
  = lens _arRequirements
      (\ s a -> s{_arRequirements = a})
      . _Default
      . _Coerce

-- | Selects the methods to which this rule applies. Refer to selector for
-- syntax details.
arSelector :: Lens' AuthenticationRule (Maybe Text)
arSelector
  = lens _arSelector (\ s a -> s{_arSelector = a})

-- | If true, the service accepts API keys without any other credential.
arAllowWithoutCredential :: Lens' AuthenticationRule (Maybe Bool)
arAllowWithoutCredential
  = lens _arAllowWithoutCredential
      (\ s a -> s{_arAllowWithoutCredential = a})

-- | The requirements for OAuth credentials.
arOAuth :: Lens' AuthenticationRule (Maybe OAuthRequirements)
arOAuth = lens _arOAuth (\ s a -> s{_arOAuth = a})

instance FromJSON AuthenticationRule where
        parseJSON
          = withObject "AuthenticationRule"
              (\ o ->
                 AuthenticationRule' <$>
                   (o .:? "requirements" .!= mempty) <*>
                     (o .:? "selector")
                     <*> (o .:? "allowWithoutCredential")
                     <*> (o .:? "oauth"))

instance ToJSON AuthenticationRule where
        toJSON AuthenticationRule'{..}
          = object
              (catMaybes
                 [("requirements" .=) <$> _arRequirements,
                  ("selector" .=) <$> _arSelector,
                  ("allowWithoutCredential" .=) <$>
                    _arAllowWithoutCredential,
                  ("oauth" .=) <$> _arOAuth])

-- | Response message for the \`AddVisibilityLabels\` method. This response
-- message is assigned to the \`response\` field of the returned Operation
-- when that operation is done.
--
-- /See:/ 'v1AddVisibilityLabelsResponse' smart constructor.
newtype V1AddVisibilityLabelsResponse =
  V1AddVisibilityLabelsResponse'
    { _vavlrLabels :: Maybe [Text]
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1AddVisibilityLabelsResponse' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'vavlrLabels'
v1AddVisibilityLabelsResponse
    :: V1AddVisibilityLabelsResponse
v1AddVisibilityLabelsResponse =
  V1AddVisibilityLabelsResponse' {_vavlrLabels = Nothing}


-- | The updated set of visibility labels for this consumer on this service.
vavlrLabels :: Lens' V1AddVisibilityLabelsResponse [Text]
vavlrLabels
  = lens _vavlrLabels (\ s a -> s{_vavlrLabels = a}) .
      _Default
      . _Coerce

instance FromJSON V1AddVisibilityLabelsResponse where
        parseJSON
          = withObject "V1AddVisibilityLabelsResponse"
              (\ o ->
                 V1AddVisibilityLabelsResponse' <$>
                   (o .:? "labels" .!= mempty))

instance ToJSON V1AddVisibilityLabelsResponse where
        toJSON V1AddVisibilityLabelsResponse'{..}
          = object (catMaybes [("labels" .=) <$> _vavlrLabels])

-- | Describes the service account configuration for the tenant project.
--
-- /See:/ 'serviceAccountConfig' smart constructor.
data ServiceAccountConfig =
  ServiceAccountConfig'
    { _sacAccountId          :: !(Maybe Text)
    , _sacTenantProjectRoles :: !(Maybe [Text])
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'ServiceAccountConfig' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'sacAccountId'
--
-- * 'sacTenantProjectRoles'
serviceAccountConfig
    :: ServiceAccountConfig
serviceAccountConfig =
  ServiceAccountConfig'
    {_sacAccountId = Nothing, _sacTenantProjectRoles = Nothing}


-- | ID of the IAM service account to be created in tenant project. The email
-- format of the service account is \"\'.iam.gserviceaccount.com\". This
-- account ID must be unique within tenant project and service producers
-- have to guarantee it. The ID must be 6-30 characters long, and match the
-- following regular expression: \`[a-z]([-a-z0-9]*[a-z0-9])\`.
sacAccountId :: Lens' ServiceAccountConfig (Maybe Text)
sacAccountId
  = lens _sacAccountId (\ s a -> s{_sacAccountId = a})

-- | Roles for the associated service account for the tenant project.
sacTenantProjectRoles :: Lens' ServiceAccountConfig [Text]
sacTenantProjectRoles
  = lens _sacTenantProjectRoles
      (\ s a -> s{_sacTenantProjectRoles = a})
      . _Default
      . _Coerce

instance FromJSON ServiceAccountConfig where
        parseJSON
          = withObject "ServiceAccountConfig"
              (\ o ->
                 ServiceAccountConfig' <$>
                   (o .:? "accountId") <*>
                     (o .:? "tenantProjectRoles" .!= mempty))

instance ToJSON ServiceAccountConfig where
        toJSON ServiceAccountConfig'{..}
          = object
              (catMaybes
                 [("accountId" .=) <$> _sacAccountId,
                  ("tenantProjectRoles" .=) <$>
                    _sacTenantProjectRoles])

-- | A quota override
--
-- /See:/ 'v1Beta1QuotaOverride' smart constructor.
data V1Beta1QuotaOverride =
  V1Beta1QuotaOverride'
    { _vbqoMetric        :: !(Maybe Text)
    , _vbqoOverrideValue :: !(Maybe (Textual Int64))
    , _vbqoName          :: !(Maybe Text)
    , _vbqoDimensions    :: !(Maybe V1Beta1QuotaOverrideDimensions)
    , _vbqoUnit          :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1Beta1QuotaOverride' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'vbqoMetric'
--
-- * 'vbqoOverrideValue'
--
-- * 'vbqoName'
--
-- * 'vbqoDimensions'
--
-- * 'vbqoUnit'
v1Beta1QuotaOverride
    :: V1Beta1QuotaOverride
v1Beta1QuotaOverride =
  V1Beta1QuotaOverride'
    { _vbqoMetric = Nothing
    , _vbqoOverrideValue = Nothing
    , _vbqoName = Nothing
    , _vbqoDimensions = Nothing
    , _vbqoUnit = Nothing
    }


-- | The name of the metric to which this override applies. An example name
-- would be: \`compute.googleapis.com\/cpus\`
vbqoMetric :: Lens' V1Beta1QuotaOverride (Maybe Text)
vbqoMetric
  = lens _vbqoMetric (\ s a -> s{_vbqoMetric = a})

-- | The overriding quota limit value. Can be any nonnegative integer, or -1
-- (unlimited quota).
vbqoOverrideValue :: Lens' V1Beta1QuotaOverride (Maybe Int64)
vbqoOverrideValue
  = lens _vbqoOverrideValue
      (\ s a -> s{_vbqoOverrideValue = a})
      . mapping _Coerce

-- | The resource name of the producer override. An example name would be:
-- \`services\/compute.googleapis.com\/projects\/123\/consumerQuotaMetrics\/compute.googleapis.com%2Fcpus\/limits\/%2Fproject%2Fregion\/producerOverrides\/4a3f2c1d\`
vbqoName :: Lens' V1Beta1QuotaOverride (Maybe Text)
vbqoName = lens _vbqoName (\ s a -> s{_vbqoName = a})

-- | If this map is nonempty, then this override applies only to specific
-- values for dimensions defined in the limit unit. For example, an
-- override on a limit with the unit 1\/{project}\/{region} could contain
-- an entry with the key \"region\" and the value \"us-east-1\"; the
-- override is only applied to quota consumed in that region. This map has
-- the following restrictions: - Keys that are not defined in the limit\'s
-- unit are not valid keys. Any string appearing in {brackets} in the unit
-- (besides {project} or {user}) is a defined key. - \"project\" is not a
-- valid key; the project is already specified in the parent resource name.
-- - \"user\" is not a valid key; the API does not support quota overrides
-- that apply only to a specific user. - If \"region\" appears as a key,
-- its value must be a valid Cloud region. - If \"zone\" appears as a key,
-- its value must be a valid Cloud zone. - If any valid key other than
-- \"region\" or \"zone\" appears in the map, then all valid keys other
-- than \"region\" or \"zone\" must also appear in the map.
vbqoDimensions :: Lens' V1Beta1QuotaOverride (Maybe V1Beta1QuotaOverrideDimensions)
vbqoDimensions
  = lens _vbqoDimensions
      (\ s a -> s{_vbqoDimensions = a})

-- | The limit unit of the limit to which this override applies. An example
-- unit would be: \`1\/{project}\/{region}\` Note that \`{project}\` and
-- \`{region}\` are not placeholders in this example; the literal
-- characters \`{\` and \`}\` occur in the string.
vbqoUnit :: Lens' V1Beta1QuotaOverride (Maybe Text)
vbqoUnit = lens _vbqoUnit (\ s a -> s{_vbqoUnit = a})

instance FromJSON V1Beta1QuotaOverride where
        parseJSON
          = withObject "V1Beta1QuotaOverride"
              (\ o ->
                 V1Beta1QuotaOverride' <$>
                   (o .:? "metric") <*> (o .:? "overrideValue") <*>
                     (o .:? "name")
                     <*> (o .:? "dimensions")
                     <*> (o .:? "unit"))

instance ToJSON V1Beta1QuotaOverride where
        toJSON V1Beta1QuotaOverride'{..}
          = object
              (catMaybes
                 [("metric" .=) <$> _vbqoMetric,
                  ("overrideValue" .=) <$> _vbqoOverrideValue,
                  ("name" .=) <$> _vbqoName,
                  ("dimensions" .=) <$> _vbqoDimensions,
                  ("unit" .=) <$> _vbqoUnit])

-- | Metrics to update when the selected methods are called, and the
-- associated cost applied to each metric. The key of the map is the metric
-- name, and the values are the amount increased for the metric against
-- which the quota limits are defined. The value must not be negative.
--
-- /See:/ 'metricRuleMetricCosts' smart constructor.
newtype MetricRuleMetricCosts =
  MetricRuleMetricCosts'
    { _mrmcAddtional :: HashMap Text (Textual Int64)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'MetricRuleMetricCosts' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mrmcAddtional'
metricRuleMetricCosts
    :: HashMap Text Int64 -- ^ 'mrmcAddtional'
    -> MetricRuleMetricCosts
metricRuleMetricCosts pMrmcAddtional_ =
  MetricRuleMetricCosts' {_mrmcAddtional = _Coerce # pMrmcAddtional_}


mrmcAddtional :: Lens' MetricRuleMetricCosts (HashMap Text Int64)
mrmcAddtional
  = lens _mrmcAddtional
      (\ s a -> s{_mrmcAddtional = a})
      . _Coerce

instance FromJSON MetricRuleMetricCosts where
        parseJSON
          = withObject "MetricRuleMetricCosts"
              (\ o ->
                 MetricRuleMetricCosts' <$> (parseJSONObject o))

instance ToJSON MetricRuleMetricCosts where
        toJSON = toJSON . _mrmcAddtional

-- | Configuration of authorization. This section determines the
-- authorization provider, if unspecified, then no authorization check will
-- be done. Example: experimental: authorization: provider:
-- firebaserules.googleapis.com
--
-- /See:/ 'authorizationConfig' smart constructor.
newtype AuthorizationConfig =
  AuthorizationConfig'
    { _acProvider :: Maybe Text
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'AuthorizationConfig' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'acProvider'
authorizationConfig
    :: AuthorizationConfig
authorizationConfig = AuthorizationConfig' {_acProvider = Nothing}


-- | The name of the authorization provider, such as
-- firebaserules.googleapis.com.
acProvider :: Lens' AuthorizationConfig (Maybe Text)
acProvider
  = lens _acProvider (\ s a -> s{_acProvider = a})

instance FromJSON AuthorizationConfig where
        parseJSON
          = withObject "AuthorizationConfig"
              (\ o -> AuthorizationConfig' <$> (o .:? "provider"))

instance ToJSON AuthorizationConfig where
        toJSON AuthorizationConfig'{..}
          = object
              (catMaybes [("provider" .=) <$> _acProvider])

-- | Request message to delete tenant project resource from the tenancy unit.
--
-- /See:/ 'deleteTenantProjectRequest' smart constructor.
newtype DeleteTenantProjectRequest =
  DeleteTenantProjectRequest'
    { _dtprTag :: Maybe Text
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'DeleteTenantProjectRequest' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'dtprTag'
deleteTenantProjectRequest
    :: DeleteTenantProjectRequest
deleteTenantProjectRequest = DeleteTenantProjectRequest' {_dtprTag = Nothing}


-- | Tag of the resource within the tenancy unit.
dtprTag :: Lens' DeleteTenantProjectRequest (Maybe Text)
dtprTag = lens _dtprTag (\ s a -> s{_dtprTag = a})

instance FromJSON DeleteTenantProjectRequest where
        parseJSON
          = withObject "DeleteTenantProjectRequest"
              (\ o ->
                 DeleteTenantProjectRequest' <$> (o .:? "tag"))

instance ToJSON DeleteTenantProjectRequest where
        toJSON DeleteTenantProjectRequest'{..}
          = object (catMaybes [("tag" .=) <$> _dtprTag])

-- | Describes policy settings that need to be applied to a newly created
-- tenant project.
--
-- /See:/ 'tenantProjectPolicy' smart constructor.
newtype TenantProjectPolicy =
  TenantProjectPolicy'
    { _tppPolicyBindings :: Maybe [PolicyBinding]
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'TenantProjectPolicy' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'tppPolicyBindings'
tenantProjectPolicy
    :: TenantProjectPolicy
tenantProjectPolicy = TenantProjectPolicy' {_tppPolicyBindings = Nothing}


-- | Policy bindings to be applied to the tenant project, in addition to the
-- \'roles\/owner\' role granted to the Service Consumer Management service
-- account. At least one binding must have the role \`roles\/owner\`. Among
-- the list of members for \`roles\/owner\`, at least one of them must be
-- either the \`user\` or \`group\` type.
tppPolicyBindings :: Lens' TenantProjectPolicy [PolicyBinding]
tppPolicyBindings
  = lens _tppPolicyBindings
      (\ s a -> s{_tppPolicyBindings = a})
      . _Default
      . _Coerce

instance FromJSON TenantProjectPolicy where
        parseJSON
          = withObject "TenantProjectPolicy"
              (\ o ->
                 TenantProjectPolicy' <$>
                   (o .:? "policyBindings" .!= mempty))

instance ToJSON TenantProjectPolicy where
        toJSON TenantProjectPolicy'{..}
          = object
              (catMaybes
                 [("policyBindings" .=) <$> _tppPolicyBindings])

-- | Translates to IAM Policy bindings (without auditing at this level)
--
-- /See:/ 'policyBinding' smart constructor.
data PolicyBinding =
  PolicyBinding'
    { _pbMembers :: !(Maybe [Text])
    , _pbRole    :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'PolicyBinding' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'pbMembers'
--
-- * 'pbRole'
policyBinding
    :: PolicyBinding
policyBinding = PolicyBinding' {_pbMembers = Nothing, _pbRole = Nothing}


-- | Uses the same format as in IAM policy. \`member\` must include both a
-- prefix and ID. For example, \`user:{emailId}\`,
-- \`serviceAccount:{emailId}\`, \`group:{emailId}\`.
pbMembers :: Lens' PolicyBinding [Text]
pbMembers
  = lens _pbMembers (\ s a -> s{_pbMembers = a}) .
      _Default
      . _Coerce

-- | Role. (https:\/\/cloud.google.com\/iam\/docs\/understanding-roles) For
-- example, \`roles\/viewer\`, \`roles\/editor\`, or \`roles\/owner\`.
pbRole :: Lens' PolicyBinding (Maybe Text)
pbRole = lens _pbRole (\ s a -> s{_pbRole = a})

instance FromJSON PolicyBinding where
        parseJSON
          = withObject "PolicyBinding"
              (\ o ->
                 PolicyBinding' <$>
                   (o .:? "members" .!= mempty) <*> (o .:? "role"))

instance ToJSON PolicyBinding where
        toJSON PolicyBinding'{..}
          = object
              (catMaybes
                 [("members" .=) <$> _pbMembers,
                  ("role" .=) <$> _pbRole])

-- | Experimental service configuration. These configuration options can only
-- be used by whitelisted users.
--
-- /See:/ 'experimental' smart constructor.
newtype Experimental =
  Experimental'
    { _eAuthorization :: Maybe AuthorizationConfig
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Experimental' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'eAuthorization'
experimental
    :: Experimental
experimental = Experimental' {_eAuthorization = Nothing}


-- | Authorization configuration.
eAuthorization :: Lens' Experimental (Maybe AuthorizationConfig)
eAuthorization
  = lens _eAuthorization
      (\ s a -> s{_eAuthorization = a})

instance FromJSON Experimental where
        parseJSON
          = withObject "Experimental"
              (\ o -> Experimental' <$> (o .:? "authorization"))

instance ToJSON Experimental where
        toJSON Experimental'{..}
          = object
              (catMaybes
                 [("authorization" .=) <$> _eAuthorization])

-- | \`Backend\` defines the backend configuration for a service.
--
-- /See:/ 'backend' smart constructor.
newtype Backend =
  Backend'
    { _bRules :: Maybe [BackendRule]
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Backend' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'bRules'
backend
    :: Backend
backend = Backend' {_bRules = Nothing}


-- | A list of API backend rules that apply to individual API methods.
-- **NOTE:** All service configuration rules follow \"last one wins\"
-- order.
bRules :: Lens' Backend [BackendRule]
bRules
  = lens _bRules (\ s a -> s{_bRules = a}) . _Default .
      _Coerce

instance FromJSON Backend where
        parseJSON
          = withObject "Backend"
              (\ o -> Backend' <$> (o .:? "rules" .!= mempty))

instance ToJSON Backend where
        toJSON Backend'{..}
          = object (catMaybes [("rules" .=) <$> _bRules])

-- | Representation of a tenancy unit.
--
-- /See:/ 'tenancyUnit' smart constructor.
data TenancyUnit =
  TenancyUnit'
    { _tuService         :: !(Maybe Text)
    , _tuName            :: !(Maybe Text)
    , _tuTenantResources :: !(Maybe [TenantResource])
    , _tuConsumer        :: !(Maybe Text)
    , _tuCreateTime      :: !(Maybe DateTime')
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'TenancyUnit' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'tuService'
--
-- * 'tuName'
--
-- * 'tuTenantResources'
--
-- * 'tuConsumer'
--
-- * 'tuCreateTime'
tenancyUnit
    :: TenancyUnit
tenancyUnit =
  TenancyUnit'
    { _tuService = Nothing
    , _tuName = Nothing
    , _tuTenantResources = Nothing
    , _tuConsumer = Nothing
    , _tuCreateTime = Nothing
    }


-- | Output only. Google Cloud API name of the managed service owning this
-- tenancy unit. For example \'serviceconsumermanagement.googleapis.com\'.
tuService :: Lens' TenancyUnit (Maybe Text)
tuService
  = lens _tuService (\ s a -> s{_tuService = a})

-- | Globally unique identifier of this tenancy unit
-- \"services\/{service}\/{collection id}\/{resource
-- id}\/tenancyUnits\/{unit}\"
tuName :: Lens' TenancyUnit (Maybe Text)
tuName = lens _tuName (\ s a -> s{_tuName = a})

-- | Resources constituting the tenancy unit. There can be at most 512 tenant
-- resources in a tenancy unit.
tuTenantResources :: Lens' TenancyUnit [TenantResource]
tuTenantResources
  = lens _tuTenantResources
      (\ s a -> s{_tuTenantResources = a})
      . _Default
      . _Coerce

-- | \'OutputOnly Cloud resource name of the consumer of this service. For
-- example \'projects\/123456\'.
tuConsumer :: Lens' TenancyUnit (Maybe Text)
tuConsumer
  = lens _tuConsumer (\ s a -> s{_tuConsumer = a})

-- | \'OutputOnly The time this tenancy unit was created.
tuCreateTime :: Lens' TenancyUnit (Maybe UTCTime)
tuCreateTime
  = lens _tuCreateTime (\ s a -> s{_tuCreateTime = a})
      . mapping _DateTime

instance FromJSON TenancyUnit where
        parseJSON
          = withObject "TenancyUnit"
              (\ o ->
                 TenancyUnit' <$>
                   (o .:? "service") <*> (o .:? "name") <*>
                     (o .:? "tenantResources" .!= mempty)
                     <*> (o .:? "consumer")
                     <*> (o .:? "createTime"))

instance ToJSON TenancyUnit where
        toJSON TenancyUnit'{..}
          = object
              (catMaybes
                 [("service" .=) <$> _tuService,
                  ("name" .=) <$> _tuName,
                  ("tenantResources" .=) <$> _tuTenantResources,
                  ("consumer" .=) <$> _tuConsumer,
                  ("createTime" .=) <$> _tuCreateTime])

-- | Monitoring configuration of the service. The example below shows how to
-- configure monitored resources and metrics for monitoring. In the
-- example, a monitored resource and two metrics are defined. The
-- \`library.googleapis.com\/book\/returned_count\` metric is sent to both
-- producer and consumer projects, whereas the
-- \`library.googleapis.com\/book\/overdue_count\` metric is only sent to
-- the consumer project. monitored_resources: - type:
-- library.googleapis.com\/branch labels: - key: \/city description: The
-- city where the library branch is located in. - key: \/name description:
-- The name of the branch. metrics: - name:
-- library.googleapis.com\/book\/returned_count metric_kind: DELTA
-- value_type: INT64 labels: - key: \/customer_id - name:
-- library.googleapis.com\/book\/overdue_count metric_kind: GAUGE
-- value_type: INT64 labels: - key: \/customer_id monitoring:
-- producer_destinations: - monitored_resource:
-- library.googleapis.com\/branch metrics: -
-- library.googleapis.com\/book\/returned_count consumer_destinations: -
-- monitored_resource: library.googleapis.com\/branch metrics: -
-- library.googleapis.com\/book\/returned_count -
-- library.googleapis.com\/book\/overdue_count
--
-- /See:/ 'monitoring' smart constructor.
data Monitoring =
  Monitoring'
    { _mProducerDestinations :: !(Maybe [MonitoringDestination])
    , _mConsumerDestinations :: !(Maybe [MonitoringDestination])
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Monitoring' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mProducerDestinations'
--
-- * 'mConsumerDestinations'
monitoring
    :: Monitoring
monitoring =
  Monitoring'
    {_mProducerDestinations = Nothing, _mConsumerDestinations = Nothing}


-- | Monitoring configurations for sending metrics to the producer project.
-- There can be multiple producer destinations. A monitored resouce type
-- may appear in multiple monitoring destinations if different aggregations
-- are needed for different sets of metrics associated with that monitored
-- resource type. A monitored resource and metric pair may only be used
-- once in the Monitoring configuration.
mProducerDestinations :: Lens' Monitoring [MonitoringDestination]
mProducerDestinations
  = lens _mProducerDestinations
      (\ s a -> s{_mProducerDestinations = a})
      . _Default
      . _Coerce

-- | Monitoring configurations for sending metrics to the consumer project.
-- There can be multiple consumer destinations. A monitored resouce type
-- may appear in multiple monitoring destinations if different aggregations
-- are needed for different sets of metrics associated with that monitored
-- resource type. A monitored resource and metric pair may only be used
-- once in the Monitoring configuration.
mConsumerDestinations :: Lens' Monitoring [MonitoringDestination]
mConsumerDestinations
  = lens _mConsumerDestinations
      (\ s a -> s{_mConsumerDestinations = a})
      . _Default
      . _Coerce

instance FromJSON Monitoring where
        parseJSON
          = withObject "Monitoring"
              (\ o ->
                 Monitoring' <$>
                   (o .:? "producerDestinations" .!= mempty) <*>
                     (o .:? "consumerDestinations" .!= mempty))

instance ToJSON Monitoring where
        toJSON Monitoring'{..}
          = object
              (catMaybes
                 [("producerDestinations" .=) <$>
                    _mProducerDestinations,
                  ("consumerDestinations" .=) <$>
                    _mConsumerDestinations])

-- | A description of a log type. Example in YAML format: - name:
-- library.googleapis.com\/activity_history description: The history of
-- borrowing and returning library items. display_name: Activity labels: -
-- key: \/customer_id description: Identifier of a library customer
--
-- /See:/ 'logDescriptor' smart constructor.
data LogDescriptor =
  LogDescriptor'
    { _ldName        :: !(Maybe Text)
    , _ldDisplayName :: !(Maybe Text)
    , _ldLabels      :: !(Maybe [LabelDescriptor])
    , _ldDescription :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'LogDescriptor' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'ldName'
--
-- * 'ldDisplayName'
--
-- * 'ldLabels'
--
-- * 'ldDescription'
logDescriptor
    :: LogDescriptor
logDescriptor =
  LogDescriptor'
    { _ldName = Nothing
    , _ldDisplayName = Nothing
    , _ldLabels = Nothing
    , _ldDescription = Nothing
    }


-- | The name of the log. It must be less than 512 characters long and can
-- include the following characters: upper- and lower-case alphanumeric
-- characters [A-Za-z0-9], and punctuation characters including slash,
-- underscore, hyphen, period [\/_-.].
ldName :: Lens' LogDescriptor (Maybe Text)
ldName = lens _ldName (\ s a -> s{_ldName = a})

-- | The human-readable name for this log. This information appears on the
-- user interface and should be concise.
ldDisplayName :: Lens' LogDescriptor (Maybe Text)
ldDisplayName
  = lens _ldDisplayName
      (\ s a -> s{_ldDisplayName = a})

-- | The set of labels that are available to describe a specific log entry.
-- Runtime requests that contain labels not specified here are considered
-- invalid.
ldLabels :: Lens' LogDescriptor [LabelDescriptor]
ldLabels
  = lens _ldLabels (\ s a -> s{_ldLabels = a}) .
      _Default
      . _Coerce

-- | A human-readable description of this log. This information appears in
-- the documentation and can contain details.
ldDescription :: Lens' LogDescriptor (Maybe Text)
ldDescription
  = lens _ldDescription
      (\ s a -> s{_ldDescription = a})

instance FromJSON LogDescriptor where
        parseJSON
          = withObject "LogDescriptor"
              (\ o ->
                 LogDescriptor' <$>
                   (o .:? "name") <*> (o .:? "displayName") <*>
                     (o .:? "labels" .!= mempty)
                     <*> (o .:? "description"))

instance ToJSON LogDescriptor where
        toJSON LogDescriptor'{..}
          = object
              (catMaybes
                 [("name" .=) <$> _ldName,
                  ("displayName" .=) <$> _ldDisplayName,
                  ("labels" .=) <$> _ldLabels,
                  ("description" .=) <$> _ldDescription])

-- | Method represents a method of an API interface.
--
-- /See:/ 'method' smart constructor.
data Method =
  Method'
    { _metRequestStreaming  :: !(Maybe Bool)
    , _metResponseTypeURL   :: !(Maybe Text)
    , _metName              :: !(Maybe Text)
    , _metResponseStreaming :: !(Maybe Bool)
    , _metRequestTypeURL    :: !(Maybe Text)
    , _metOptions           :: !(Maybe [Option])
    , _metSyntax            :: !(Maybe MethodSyntax)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Method' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'metRequestStreaming'
--
-- * 'metResponseTypeURL'
--
-- * 'metName'
--
-- * 'metResponseStreaming'
--
-- * 'metRequestTypeURL'
--
-- * 'metOptions'
--
-- * 'metSyntax'
method
    :: Method
method =
  Method'
    { _metRequestStreaming = Nothing
    , _metResponseTypeURL = Nothing
    , _metName = Nothing
    , _metResponseStreaming = Nothing
    , _metRequestTypeURL = Nothing
    , _metOptions = Nothing
    , _metSyntax = Nothing
    }


-- | If true, the request is streamed.
metRequestStreaming :: Lens' Method (Maybe Bool)
metRequestStreaming
  = lens _metRequestStreaming
      (\ s a -> s{_metRequestStreaming = a})

-- | The URL of the output message type.
metResponseTypeURL :: Lens' Method (Maybe Text)
metResponseTypeURL
  = lens _metResponseTypeURL
      (\ s a -> s{_metResponseTypeURL = a})

-- | The simple name of this method.
metName :: Lens' Method (Maybe Text)
metName = lens _metName (\ s a -> s{_metName = a})

-- | If true, the response is streamed.
metResponseStreaming :: Lens' Method (Maybe Bool)
metResponseStreaming
  = lens _metResponseStreaming
      (\ s a -> s{_metResponseStreaming = a})

-- | A URL of the input message type.
metRequestTypeURL :: Lens' Method (Maybe Text)
metRequestTypeURL
  = lens _metRequestTypeURL
      (\ s a -> s{_metRequestTypeURL = a})

-- | Any metadata attached to the method.
metOptions :: Lens' Method [Option]
metOptions
  = lens _metOptions (\ s a -> s{_metOptions = a}) .
      _Default
      . _Coerce

-- | The source syntax of this method.
metSyntax :: Lens' Method (Maybe MethodSyntax)
metSyntax
  = lens _metSyntax (\ s a -> s{_metSyntax = a})

instance FromJSON Method where
        parseJSON
          = withObject "Method"
              (\ o ->
                 Method' <$>
                   (o .:? "requestStreaming") <*>
                     (o .:? "responseTypeUrl")
                     <*> (o .:? "name")
                     <*> (o .:? "responseStreaming")
                     <*> (o .:? "requestTypeUrl")
                     <*> (o .:? "options" .!= mempty)
                     <*> (o .:? "syntax"))

instance ToJSON Method where
        toJSON Method'{..}
          = object
              (catMaybes
                 [("requestStreaming" .=) <$> _metRequestStreaming,
                  ("responseTypeUrl" .=) <$> _metResponseTypeURL,
                  ("name" .=) <$> _metName,
                  ("responseStreaming" .=) <$> _metResponseStreaming,
                  ("requestTypeUrl" .=) <$> _metRequestTypeURL,
                  ("options" .=) <$> _metOptions,
                  ("syntax" .=) <$> _metSyntax])

-- | Response message for the \`RefreshConsumer\` method. This response
-- message is assigned to the \`response\` field of the returned Operation
-- when that operation is done.
--
-- /See:/ 'v1RefreshConsumerResponse' smart constructor.
data V1RefreshConsumerResponse =
  V1RefreshConsumerResponse'
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1RefreshConsumerResponse' with the minimum fields required to make a request.
--
v1RefreshConsumerResponse
    :: V1RefreshConsumerResponse
v1RefreshConsumerResponse = V1RefreshConsumerResponse'


instance FromJSON V1RefreshConsumerResponse where
        parseJSON
          = withObject "V1RefreshConsumerResponse"
              (\ o -> pure V1RefreshConsumerResponse')

instance ToJSON V1RefreshConsumerResponse where
        toJSON = const emptyObject

-- | ### System parameter configuration A system parameter is a special kind
-- of parameter defined by the API system, not by an individual API. It is
-- typically mapped to an HTTP header and\/or a URL query parameter. This
-- configuration specifies which methods change the names of the system
-- parameters.
--
-- /See:/ 'systemParameters' smart constructor.
newtype SystemParameters =
  SystemParameters'
    { _spRules :: Maybe [SystemParameterRule]
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'SystemParameters' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'spRules'
systemParameters
    :: SystemParameters
systemParameters = SystemParameters' {_spRules = Nothing}


-- | Define system parameters. The parameters defined here will override the
-- default parameters implemented by the system. If this field is missing
-- from the service config, default system parameters will be used. Default
-- system parameters and names is implementation-dependent. Example: define
-- api key for all methods system_parameters rules: - selector: \"*\"
-- parameters: - name: api_key url_query_parameter: api_key Example: define
-- 2 api key names for a specific method. system_parameters rules: -
-- selector: \"\/ListShelves\" parameters: - name: api_key http_header:
-- Api-Key1 - name: api_key http_header: Api-Key2 **NOTE:** All service
-- configuration rules follow \"last one wins\" order.
spRules :: Lens' SystemParameters [SystemParameterRule]
spRules
  = lens _spRules (\ s a -> s{_spRules = a}) . _Default
      . _Coerce

instance FromJSON SystemParameters where
        parseJSON
          = withObject "SystemParameters"
              (\ o ->
                 SystemParameters' <$> (o .:? "rules" .!= mempty))

instance ToJSON SystemParameters where
        toJSON SystemParameters'{..}
          = object (catMaybes [("rules" .=) <$> _spRules])

-- | \`Documentation\` provides the information for describing a service.
-- Example:
--
-- > documentation:
-- >   summary: >
-- >     The Google Calendar API gives access
-- >     to most calendar features.
-- >   pages:
-- >   - name: Overview
-- >     content: (== include google/foo/overview.md ==)
-- >   - name: Tutorial
-- >     content: (== include google/foo/tutorial.md ==)
-- >     subpages;
-- >     - name: Java
-- >       content: (== include google/foo/tutorial_java.md ==)
-- >   rules:
-- >   - selector: google.calendar.Calendar.Get
-- >     description: >
-- >       ...
-- >   - selector: google.calendar.Calendar.Put
-- >     description: >
-- >       ...
--
-- Documentation is provided in markdown syntax. In addition to standard
-- markdown features, definition lists, tables and fenced code blocks are
-- supported. Section headers can be provided and are interpreted relative
-- to the section nesting of the context where a documentation fragment is
-- embedded. Documentation from the IDL is merged with documentation
-- defined via the config at normalization time, where documentation
-- provided by config rules overrides IDL provided. A number of constructs
-- specific to the API platform are supported in documentation text. In
-- order to reference a proto element, the following notation can be used:
--
-- > [fully.qualified.proto.name][]
--
-- To override the display text used for the link, this can be used:
--
-- > [display text][fully.qualified.proto.name]
--
-- Text can be excluded from doc using the following notation:
--
-- > (-- internal comment --)
--
-- A few directives are available in documentation. Note that directives
-- must appear on a single line to be properly identified. The \`include\`
-- directive includes a markdown file from an external source:
--
-- > (== include path/to/file ==)
--
-- The \`resource_for\` directive marks a message to be the resource of a
-- collection in REST view. If it is not specified, tools attempt to infer
-- the resource from the operations in a collection:
--
-- > (== resource_for v1.shelves.books ==)
--
-- The directive \`suppress_warning\` does not directly affect
-- documentation and is documented together with service config validation.
--
-- /See:/ 'documentation' smart constructor.
data Documentation =
  Documentation'
    { _dSummary              :: !(Maybe Text)
    , _dDocumentationRootURL :: !(Maybe Text)
    , _dRules                :: !(Maybe [DocumentationRule])
    , _dPages                :: !(Maybe [Page])
    , _dOverview             :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Documentation' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'dSummary'
--
-- * 'dDocumentationRootURL'
--
-- * 'dRules'
--
-- * 'dPages'
--
-- * 'dOverview'
documentation
    :: Documentation
documentation =
  Documentation'
    { _dSummary = Nothing
    , _dDocumentationRootURL = Nothing
    , _dRules = Nothing
    , _dPages = Nothing
    , _dOverview = Nothing
    }


-- | A short summary of what the service does. Can only be provided by plain
-- text.
dSummary :: Lens' Documentation (Maybe Text)
dSummary = lens _dSummary (\ s a -> s{_dSummary = a})

-- | The URL to the root of documentation.
dDocumentationRootURL :: Lens' Documentation (Maybe Text)
dDocumentationRootURL
  = lens _dDocumentationRootURL
      (\ s a -> s{_dDocumentationRootURL = a})

-- | A list of documentation rules that apply to individual API elements.
-- **NOTE:** All service configuration rules follow \"last one wins\"
-- order.
dRules :: Lens' Documentation [DocumentationRule]
dRules
  = lens _dRules (\ s a -> s{_dRules = a}) . _Default .
      _Coerce

-- | The top level pages for the documentation set.
dPages :: Lens' Documentation [Page]
dPages
  = lens _dPages (\ s a -> s{_dPages = a}) . _Default .
      _Coerce

-- | Declares a single overview page. For example:
--
-- > documentation:
-- >   summary: ...
-- >   overview: (== include overview.md ==)
--
-- This is a shortcut for the following declaration (using pages style):
--
-- > documentation:
-- >   summary: ...
-- >   pages:
-- >   - name: Overview
-- >     content: (== include overview.md ==)
--
-- Note: you cannot specify both \`overview\` field and \`pages\` field.
dOverview :: Lens' Documentation (Maybe Text)
dOverview
  = lens _dOverview (\ s a -> s{_dOverview = a})

instance FromJSON Documentation where
        parseJSON
          = withObject "Documentation"
              (\ o ->
                 Documentation' <$>
                   (o .:? "summary") <*> (o .:? "documentationRootUrl")
                     <*> (o .:? "rules" .!= mempty)
                     <*> (o .:? "pages" .!= mempty)
                     <*> (o .:? "overview"))

instance ToJSON Documentation where
        toJSON Documentation'{..}
          = object
              (catMaybes
                 [("summary" .=) <$> _dSummary,
                  ("documentationRootUrl" .=) <$>
                    _dDocumentationRootURL,
                  ("rules" .=) <$> _dRules, ("pages" .=) <$> _dPages,
                  ("overview" .=) <$> _dOverview])

-- | Additional annotations that can be used to guide the usage of a metric.
--
-- /See:/ 'metricDescriptorMetadata' smart constructor.
data MetricDescriptorMetadata =
  MetricDescriptorMetadata'
    { _mdmSamplePeriod :: !(Maybe GDuration)
    , _mdmIngestDelay  :: !(Maybe GDuration)
    , _mdmLaunchStage  :: !(Maybe MetricDescriptorMetadataLaunchStage)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'MetricDescriptorMetadata' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'mdmSamplePeriod'
--
-- * 'mdmIngestDelay'
--
-- * 'mdmLaunchStage'
metricDescriptorMetadata
    :: MetricDescriptorMetadata
metricDescriptorMetadata =
  MetricDescriptorMetadata'
    { _mdmSamplePeriod = Nothing
    , _mdmIngestDelay = Nothing
    , _mdmLaunchStage = Nothing
    }


-- | The sampling period of metric data points. For metrics which are written
-- periodically, consecutive data points are stored at this time interval,
-- excluding data loss due to errors. Metrics with a higher granularity
-- have a smaller sampling period.
mdmSamplePeriod :: Lens' MetricDescriptorMetadata (Maybe Scientific)
mdmSamplePeriod
  = lens _mdmSamplePeriod
      (\ s a -> s{_mdmSamplePeriod = a})
      . mapping _GDuration

-- | The delay of data points caused by ingestion. Data points older than
-- this age are guaranteed to be ingested and available to be read,
-- excluding data loss due to errors.
mdmIngestDelay :: Lens' MetricDescriptorMetadata (Maybe Scientific)
mdmIngestDelay
  = lens _mdmIngestDelay
      (\ s a -> s{_mdmIngestDelay = a})
      . mapping _GDuration

-- | The launch stage of the metric definition.
mdmLaunchStage :: Lens' MetricDescriptorMetadata (Maybe MetricDescriptorMetadataLaunchStage)
mdmLaunchStage
  = lens _mdmLaunchStage
      (\ s a -> s{_mdmLaunchStage = a})

instance FromJSON MetricDescriptorMetadata where
        parseJSON
          = withObject "MetricDescriptorMetadata"
              (\ o ->
                 MetricDescriptorMetadata' <$>
                   (o .:? "samplePeriod") <*> (o .:? "ingestDelay") <*>
                     (o .:? "launchStage"))

instance ToJSON MetricDescriptorMetadata where
        toJSON MetricDescriptorMetadata'{..}
          = object
              (catMaybes
                 [("samplePeriod" .=) <$> _mdmSamplePeriod,
                  ("ingestDelay" .=) <$> _mdmIngestDelay,
                  ("launchStage" .=) <$> _mdmLaunchStage])

-- | Request message to undelete tenant project resource previously deleted
-- from the tenancy unit.
--
-- /See:/ 'undeleteTenantProjectRequest' smart constructor.
newtype UndeleteTenantProjectRequest =
  UndeleteTenantProjectRequest'
    { _utprTag :: Maybe Text
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'UndeleteTenantProjectRequest' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'utprTag'
undeleteTenantProjectRequest
    :: UndeleteTenantProjectRequest
undeleteTenantProjectRequest =
  UndeleteTenantProjectRequest' {_utprTag = Nothing}


-- | Tag of the resource within the tenancy unit.
utprTag :: Lens' UndeleteTenantProjectRequest (Maybe Text)
utprTag = lens _utprTag (\ s a -> s{_utprTag = a})

instance FromJSON UndeleteTenantProjectRequest where
        parseJSON
          = withObject "UndeleteTenantProjectRequest"
              (\ o ->
                 UndeleteTenantProjectRequest' <$> (o .:? "tag"))

instance ToJSON UndeleteTenantProjectRequest where
        toJSON UndeleteTenantProjectRequest'{..}
          = object (catMaybes [("tag" .=) <$> _utprTag])

-- | Define a system parameter rule mapping system parameter definitions to
-- methods.
--
-- /See:/ 'systemParameterRule' smart constructor.
data SystemParameterRule =
  SystemParameterRule'
    { _sprSelector   :: !(Maybe Text)
    , _sprParameters :: !(Maybe [SystemParameter])
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'SystemParameterRule' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'sprSelector'
--
-- * 'sprParameters'
systemParameterRule
    :: SystemParameterRule
systemParameterRule =
  SystemParameterRule' {_sprSelector = Nothing, _sprParameters = Nothing}


-- | Selects the methods to which this rule applies. Use \'*\' to indicate
-- all methods in all APIs. Refer to selector for syntax details.
sprSelector :: Lens' SystemParameterRule (Maybe Text)
sprSelector
  = lens _sprSelector (\ s a -> s{_sprSelector = a})

-- | Define parameters. Multiple names may be defined for a parameter. For a
-- given method call, only one of them should be used. If multiple names
-- are used the behavior is implementation-dependent. If none of the
-- specified names are present the behavior is parameter-dependent.
sprParameters :: Lens' SystemParameterRule [SystemParameter]
sprParameters
  = lens _sprParameters
      (\ s a -> s{_sprParameters = a})
      . _Default
      . _Coerce

instance FromJSON SystemParameterRule where
        parseJSON
          = withObject "SystemParameterRule"
              (\ o ->
                 SystemParameterRule' <$>
                   (o .:? "selector") <*>
                     (o .:? "parameters" .!= mempty))

instance ToJSON SystemParameterRule where
        toJSON SystemParameterRule'{..}
          = object
              (catMaybes
                 [("selector" .=) <$> _sprSelector,
                  ("parameters" .=) <$> _sprParameters])

-- | A description of a label.
--
-- /See:/ 'labelDescriptor' smart constructor.
data LabelDescriptor =
  LabelDescriptor'
    { _lKey         :: !(Maybe Text)
    , _lValueType   :: !(Maybe LabelDescriptorValueType)
    , _lDescription :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'LabelDescriptor' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'lKey'
--
-- * 'lValueType'
--
-- * 'lDescription'
labelDescriptor
    :: LabelDescriptor
labelDescriptor =
  LabelDescriptor'
    {_lKey = Nothing, _lValueType = Nothing, _lDescription = Nothing}


-- | The label key.
lKey :: Lens' LabelDescriptor (Maybe Text)
lKey = lens _lKey (\ s a -> s{_lKey = a})

-- | The type of data that can be assigned to the label.
lValueType :: Lens' LabelDescriptor (Maybe LabelDescriptorValueType)
lValueType
  = lens _lValueType (\ s a -> s{_lValueType = a})

-- | A human-readable description for the label.
lDescription :: Lens' LabelDescriptor (Maybe Text)
lDescription
  = lens _lDescription (\ s a -> s{_lDescription = a})

instance FromJSON LabelDescriptor where
        parseJSON
          = withObject "LabelDescriptor"
              (\ o ->
                 LabelDescriptor' <$>
                   (o .:? "key") <*> (o .:? "valueType") <*>
                     (o .:? "description"))

instance ToJSON LabelDescriptor where
        toJSON LabelDescriptor'{..}
          = object
              (catMaybes
                 [("key" .=) <$> _lKey,
                  ("valueType" .=) <$> _lValueType,
                  ("description" .=) <$> _lDescription])

-- | Response message for the \`DisableConsumer\` method. This response
-- message is assigned to the \`response\` field of the returned Operation
-- when that operation is done.
--
-- /See:/ 'v1Beta1DisableConsumerResponse' smart constructor.
data V1Beta1DisableConsumerResponse =
  V1Beta1DisableConsumerResponse'
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1Beta1DisableConsumerResponse' with the minimum fields required to make a request.
--
v1Beta1DisableConsumerResponse
    :: V1Beta1DisableConsumerResponse
v1Beta1DisableConsumerResponse = V1Beta1DisableConsumerResponse'


instance FromJSON V1Beta1DisableConsumerResponse
         where
        parseJSON
          = withObject "V1Beta1DisableConsumerResponse"
              (\ o -> pure V1Beta1DisableConsumerResponse')

instance ToJSON V1Beta1DisableConsumerResponse where
        toJSON = const emptyObject

-- | Configuration controlling usage of a service.
--
-- /See:/ 'usage' smart constructor.
data Usage =
  Usage'
    { _uRequirements                :: !(Maybe [Text])
    , _uRules                       :: !(Maybe [UsageRule])
    , _uProducerNotificationChannel :: !(Maybe Text)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'Usage' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'uRequirements'
--
-- * 'uRules'
--
-- * 'uProducerNotificationChannel'
usage
    :: Usage
usage =
  Usage'
    { _uRequirements = Nothing
    , _uRules = Nothing
    , _uProducerNotificationChannel = Nothing
    }


-- | Requirements that must be satisfied before a consumer project can use
-- the service. Each requirement is of the form \/; for example
-- \'serviceusage.googleapis.com\/billing-enabled\'.
uRequirements :: Lens' Usage [Text]
uRequirements
  = lens _uRequirements
      (\ s a -> s{_uRequirements = a})
      . _Default
      . _Coerce

-- | A list of usage rules that apply to individual API methods. **NOTE:**
-- All service configuration rules follow \"last one wins\" order.
uRules :: Lens' Usage [UsageRule]
uRules
  = lens _uRules (\ s a -> s{_uRules = a}) . _Default .
      _Coerce

-- | The full resource name of a channel used for sending notifications to
-- the service producer. Google Service Management currently only supports
-- [Google Cloud Pub\/Sub](https:\/\/cloud.google.com\/pubsub) as a
-- notification channel. To use Google Cloud Pub\/Sub as the channel, this
-- must be the name of a Cloud Pub\/Sub topic that uses the Cloud Pub\/Sub
-- topic name format documented in
-- https:\/\/cloud.google.com\/pubsub\/docs\/overview.
uProducerNotificationChannel :: Lens' Usage (Maybe Text)
uProducerNotificationChannel
  = lens _uProducerNotificationChannel
      (\ s a -> s{_uProducerNotificationChannel = a})

instance FromJSON Usage where
        parseJSON
          = withObject "Usage"
              (\ o ->
                 Usage' <$>
                   (o .:? "requirements" .!= mempty) <*>
                     (o .:? "rules" .!= mempty)
                     <*> (o .:? "producerNotificationChannel"))

instance ToJSON Usage where
        toJSON Usage'{..}
          = object
              (catMaybes
                 [("requirements" .=) <$> _uRequirements,
                  ("rules" .=) <$> _uRules,
                  ("producerNotificationChannel" .=) <$>
                    _uProducerNotificationChannel])

-- | Response message for BatchCreateProducerOverrides
--
-- /See:/ 'v1Beta1BatchCreateProducerOverridesResponse' smart constructor.
newtype V1Beta1BatchCreateProducerOverridesResponse =
  V1Beta1BatchCreateProducerOverridesResponse'
    { _vbbcporOverrides :: Maybe [V1Beta1QuotaOverride]
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'V1Beta1BatchCreateProducerOverridesResponse' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'vbbcporOverrides'
v1Beta1BatchCreateProducerOverridesResponse
    :: V1Beta1BatchCreateProducerOverridesResponse
v1Beta1BatchCreateProducerOverridesResponse =
  V1Beta1BatchCreateProducerOverridesResponse' {_vbbcporOverrides = Nothing}


-- | The overrides that were created.
vbbcporOverrides :: Lens' V1Beta1BatchCreateProducerOverridesResponse [V1Beta1QuotaOverride]
vbbcporOverrides
  = lens _vbbcporOverrides
      (\ s a -> s{_vbbcporOverrides = a})
      . _Default
      . _Coerce

instance FromJSON
           V1Beta1BatchCreateProducerOverridesResponse
         where
        parseJSON
          = withObject
              "V1Beta1BatchCreateProducerOverridesResponse"
              (\ o ->
                 V1Beta1BatchCreateProducerOverridesResponse' <$>
                   (o .:? "overrides" .!= mempty))

instance ToJSON
           V1Beta1BatchCreateProducerOverridesResponse
         where
        toJSON
          V1Beta1BatchCreateProducerOverridesResponse'{..}
          = object
              (catMaybes [("overrides" .=) <$> _vbbcporOverrides])

-- | Defines the HTTP configuration for an API service. It contains a list of
-- HttpRule, each specifying the mapping of an RPC method to one or more
-- HTTP REST API methods.
--
-- /See:/ 'hTTP' smart constructor.
data HTTP =
  HTTP'
    { _hRules                        :: !(Maybe [HTTPRule])
    , _hFullyDecodeReservedExpansion :: !(Maybe Bool)
    }
  deriving (Eq, Show, Data, Typeable, Generic)


-- | Creates a value of 'HTTP' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'hRules'
--
-- * 'hFullyDecodeReservedExpansion'
hTTP
    :: HTTP
hTTP = HTTP' {_hRules = Nothing, _hFullyDecodeReservedExpansion = Nothing}


-- | A list of HTTP configuration rules that apply to individual API methods.
-- **NOTE:** All service configuration rules follow \"last one wins\"
-- order.
hRules :: Lens' HTTP [HTTPRule]
hRules
  = lens _hRules (\ s a -> s{_hRules = a}) . _Default .
      _Coerce

-- | When set to true, URL path parameters will be fully URI-decoded except
-- in cases of single segment matches in reserved expansion, where \"%2F\"
-- will be left encoded. The default behavior is to not decode RFC 6570
-- reserved characters in multi segment matches.
hFullyDecodeReservedExpansion :: Lens' HTTP (Maybe Bool)
hFullyDecodeReservedExpansion
  = lens _hFullyDecodeReservedExpansion
      (\ s a -> s{_hFullyDecodeReservedExpansion = a})

instance FromJSON HTTP where
        parseJSON
          = withObject "HTTP"
              (\ o ->
                 HTTP' <$>
                   (o .:? "rules" .!= mempty) <*>
                     (o .:? "fullyDecodeReservedExpansion"))

instance ToJSON HTTP where
        toJSON HTTP'{..}
          = object
              (catMaybes
                 [("rules" .=) <$> _hRules,
                  ("fullyDecodeReservedExpansion" .=) <$>