{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AppRunner.UpdateService
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update an App Runner service. You can update the source configuration
-- and instance configuration of the service. You can also update the ARN
-- of the auto scaling configuration resource that\'s associated with the
-- service. However, you can\'t change the name or the encryption
-- configuration of the service. These can be set only when you create the
-- service.
--
-- To update the tags applied to your service, use the separate actions
-- TagResource and UntagResource.
--
-- This is an asynchronous operation. On a successful call, you can use the
-- returned @OperationId@ and the ListOperations call to track the
-- operation\'s progress.
module Amazonka.AppRunner.UpdateService
  ( -- * Creating a Request
    UpdateService (..),
    newUpdateService,

    -- * Request Lenses
    updateService_autoScalingConfigurationArn,
    updateService_healthCheckConfiguration,
    updateService_instanceConfiguration,
    updateService_networkConfiguration,
    updateService_observabilityConfiguration,
    updateService_sourceConfiguration,
    updateService_serviceArn,

    -- * Destructuring the Response
    UpdateServiceResponse (..),
    newUpdateServiceResponse,

    -- * Response Lenses
    updateServiceResponse_httpStatus,
    updateServiceResponse_service,
    updateServiceResponse_operationId,
  )
where

import Amazonka.AppRunner.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateService' smart constructor.
data UpdateService = UpdateService'
  { -- | The Amazon Resource Name (ARN) of an App Runner automatic scaling
    -- configuration resource that you want to associate with the App Runner
    -- service.
    UpdateService -> Maybe Text
autoScalingConfigurationArn :: Prelude.Maybe Prelude.Text,
    -- | The settings for the health check that App Runner performs to monitor
    -- the health of the App Runner service.
    UpdateService -> Maybe HealthCheckConfiguration
healthCheckConfiguration :: Prelude.Maybe HealthCheckConfiguration,
    -- | The runtime configuration to apply to instances (scaling units) of your
    -- service.
    UpdateService -> Maybe InstanceConfiguration
instanceConfiguration :: Prelude.Maybe InstanceConfiguration,
    -- | Configuration settings related to network traffic of the web application
    -- that the App Runner service runs.
    UpdateService -> Maybe NetworkConfiguration
networkConfiguration :: Prelude.Maybe NetworkConfiguration,
    -- | The observability configuration of your service.
    UpdateService -> Maybe ServiceObservabilityConfiguration
observabilityConfiguration :: Prelude.Maybe ServiceObservabilityConfiguration,
    -- | The source configuration to apply to the App Runner service.
    --
    -- You can change the configuration of the code or image repository that
    -- the service uses. However, you can\'t switch from code to image or the
    -- other way around. This means that you must provide the same structure
    -- member of @SourceConfiguration@ that you originally included when you
    -- created the service. Specifically, you can include either
    -- @CodeRepository@ or @ImageRepository@. To update the source
    -- configuration, set the values to members of the structure that you
    -- include.
    UpdateService -> Maybe SourceConfiguration
sourceConfiguration :: Prelude.Maybe SourceConfiguration,
    -- | The Amazon Resource Name (ARN) of the App Runner service that you want
    -- to update.
    UpdateService -> Text
serviceArn :: Prelude.Text
  }
  deriving (UpdateService -> UpdateService -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateService -> UpdateService -> Bool
$c/= :: UpdateService -> UpdateService -> Bool
== :: UpdateService -> UpdateService -> Bool
$c== :: UpdateService -> UpdateService -> Bool
Prelude.Eq, Int -> UpdateService -> ShowS
[UpdateService] -> ShowS
UpdateService -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateService] -> ShowS
$cshowList :: [UpdateService] -> ShowS
show :: UpdateService -> String
$cshow :: UpdateService -> String
showsPrec :: Int -> UpdateService -> ShowS
$cshowsPrec :: Int -> UpdateService -> ShowS
Prelude.Show, forall x. Rep UpdateService x -> UpdateService
forall x. UpdateService -> Rep UpdateService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateService x -> UpdateService
$cfrom :: forall x. UpdateService -> Rep UpdateService x
Prelude.Generic)

-- |
-- Create a value of 'UpdateService' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'autoScalingConfigurationArn', 'updateService_autoScalingConfigurationArn' - The Amazon Resource Name (ARN) of an App Runner automatic scaling
-- configuration resource that you want to associate with the App Runner
-- service.
--
-- 'healthCheckConfiguration', 'updateService_healthCheckConfiguration' - The settings for the health check that App Runner performs to monitor
-- the health of the App Runner service.
--
-- 'instanceConfiguration', 'updateService_instanceConfiguration' - The runtime configuration to apply to instances (scaling units) of your
-- service.
--
-- 'networkConfiguration', 'updateService_networkConfiguration' - Configuration settings related to network traffic of the web application
-- that the App Runner service runs.
--
-- 'observabilityConfiguration', 'updateService_observabilityConfiguration' - The observability configuration of your service.
--
-- 'sourceConfiguration', 'updateService_sourceConfiguration' - The source configuration to apply to the App Runner service.
--
-- You can change the configuration of the code or image repository that
-- the service uses. However, you can\'t switch from code to image or the
-- other way around. This means that you must provide the same structure
-- member of @SourceConfiguration@ that you originally included when you
-- created the service. Specifically, you can include either
-- @CodeRepository@ or @ImageRepository@. To update the source
-- configuration, set the values to members of the structure that you
-- include.
--
-- 'serviceArn', 'updateService_serviceArn' - The Amazon Resource Name (ARN) of the App Runner service that you want
-- to update.
newUpdateService ::
  -- | 'serviceArn'
  Prelude.Text ->
  UpdateService
newUpdateService :: Text -> UpdateService
newUpdateService Text
pServiceArn_ =
  UpdateService'
    { $sel:autoScalingConfigurationArn:UpdateService' :: Maybe Text
autoScalingConfigurationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:healthCheckConfiguration:UpdateService' :: Maybe HealthCheckConfiguration
healthCheckConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceConfiguration:UpdateService' :: Maybe InstanceConfiguration
instanceConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:networkConfiguration:UpdateService' :: Maybe NetworkConfiguration
networkConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:observabilityConfiguration:UpdateService' :: Maybe ServiceObservabilityConfiguration
observabilityConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceConfiguration:UpdateService' :: Maybe SourceConfiguration
sourceConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceArn:UpdateService' :: Text
serviceArn = Text
pServiceArn_
    }

-- | The Amazon Resource Name (ARN) of an App Runner automatic scaling
-- configuration resource that you want to associate with the App Runner
-- service.
updateService_autoScalingConfigurationArn :: Lens.Lens' UpdateService (Prelude.Maybe Prelude.Text)
updateService_autoScalingConfigurationArn :: Lens' UpdateService (Maybe Text)
updateService_autoScalingConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateService' {Maybe Text
autoScalingConfigurationArn :: Maybe Text
$sel:autoScalingConfigurationArn:UpdateService' :: UpdateService -> Maybe Text
autoScalingConfigurationArn} -> Maybe Text
autoScalingConfigurationArn) (\s :: UpdateService
s@UpdateService' {} Maybe Text
a -> UpdateService
s {$sel:autoScalingConfigurationArn:UpdateService' :: Maybe Text
autoScalingConfigurationArn = Maybe Text
a} :: UpdateService)

-- | The settings for the health check that App Runner performs to monitor
-- the health of the App Runner service.
updateService_healthCheckConfiguration :: Lens.Lens' UpdateService (Prelude.Maybe HealthCheckConfiguration)
updateService_healthCheckConfiguration :: Lens' UpdateService (Maybe HealthCheckConfiguration)
updateService_healthCheckConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateService' {Maybe HealthCheckConfiguration
healthCheckConfiguration :: Maybe HealthCheckConfiguration
$sel:healthCheckConfiguration:UpdateService' :: UpdateService -> Maybe HealthCheckConfiguration
healthCheckConfiguration} -> Maybe HealthCheckConfiguration
healthCheckConfiguration) (\s :: UpdateService
s@UpdateService' {} Maybe HealthCheckConfiguration
a -> UpdateService
s {$sel:healthCheckConfiguration:UpdateService' :: Maybe HealthCheckConfiguration
healthCheckConfiguration = Maybe HealthCheckConfiguration
a} :: UpdateService)

-- | The runtime configuration to apply to instances (scaling units) of your
-- service.
updateService_instanceConfiguration :: Lens.Lens' UpdateService (Prelude.Maybe InstanceConfiguration)
updateService_instanceConfiguration :: Lens' UpdateService (Maybe InstanceConfiguration)
updateService_instanceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateService' {Maybe InstanceConfiguration
instanceConfiguration :: Maybe InstanceConfiguration
$sel:instanceConfiguration:UpdateService' :: UpdateService -> Maybe InstanceConfiguration
instanceConfiguration} -> Maybe InstanceConfiguration
instanceConfiguration) (\s :: UpdateService
s@UpdateService' {} Maybe InstanceConfiguration
a -> UpdateService
s {$sel:instanceConfiguration:UpdateService' :: Maybe InstanceConfiguration
instanceConfiguration = Maybe InstanceConfiguration
a} :: UpdateService)

-- | Configuration settings related to network traffic of the web application
-- that the App Runner service runs.
updateService_networkConfiguration :: Lens.Lens' UpdateService (Prelude.Maybe NetworkConfiguration)
updateService_networkConfiguration :: Lens' UpdateService (Maybe NetworkConfiguration)
updateService_networkConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateService' {Maybe NetworkConfiguration
networkConfiguration :: Maybe NetworkConfiguration
$sel:networkConfiguration:UpdateService' :: UpdateService -> Maybe NetworkConfiguration
networkConfiguration} -> Maybe NetworkConfiguration
networkConfiguration) (\s :: UpdateService
s@UpdateService' {} Maybe NetworkConfiguration
a -> UpdateService
s {$sel:networkConfiguration:UpdateService' :: Maybe NetworkConfiguration
networkConfiguration = Maybe NetworkConfiguration
a} :: UpdateService)

-- | The observability configuration of your service.
updateService_observabilityConfiguration :: Lens.Lens' UpdateService (Prelude.Maybe ServiceObservabilityConfiguration)
updateService_observabilityConfiguration :: Lens' UpdateService (Maybe ServiceObservabilityConfiguration)
updateService_observabilityConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateService' {Maybe ServiceObservabilityConfiguration
observabilityConfiguration :: Maybe ServiceObservabilityConfiguration
$sel:observabilityConfiguration:UpdateService' :: UpdateService -> Maybe ServiceObservabilityConfiguration
observabilityConfiguration} -> Maybe ServiceObservabilityConfiguration
observabilityConfiguration) (\s :: UpdateService
s@UpdateService' {} Maybe ServiceObservabilityConfiguration
a -> UpdateService
s {$sel:observabilityConfiguration:UpdateService' :: Maybe ServiceObservabilityConfiguration
observabilityConfiguration = Maybe ServiceObservabilityConfiguration
a} :: UpdateService)

-- | The source configuration to apply to the App Runner service.
--
-- You can change the configuration of the code or image repository that
-- the service uses. However, you can\'t switch from code to image or the
-- other way around. This means that you must provide the same structure
-- member of @SourceConfiguration@ that you originally included when you
-- created the service. Specifically, you can include either
-- @CodeRepository@ or @ImageRepository@. To update the source
-- configuration, set the values to members of the structure that you
-- include.
updateService_sourceConfiguration :: Lens.Lens' UpdateService (Prelude.Maybe SourceConfiguration)
updateService_sourceConfiguration :: Lens' UpdateService (Maybe SourceConfiguration)
updateService_sourceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateService' {Maybe SourceConfiguration
sourceConfiguration :: Maybe SourceConfiguration
$sel:sourceConfiguration:UpdateService' :: UpdateService -> Maybe SourceConfiguration
sourceConfiguration} -> Maybe SourceConfiguration
sourceConfiguration) (\s :: UpdateService
s@UpdateService' {} Maybe SourceConfiguration
a -> UpdateService
s {$sel:sourceConfiguration:UpdateService' :: Maybe SourceConfiguration
sourceConfiguration = Maybe SourceConfiguration
a} :: UpdateService)

-- | The Amazon Resource Name (ARN) of the App Runner service that you want
-- to update.
updateService_serviceArn :: Lens.Lens' UpdateService Prelude.Text
updateService_serviceArn :: Lens' UpdateService Text
updateService_serviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateService' {Text
serviceArn :: Text
$sel:serviceArn:UpdateService' :: UpdateService -> Text
serviceArn} -> Text
serviceArn) (\s :: UpdateService
s@UpdateService' {} Text
a -> UpdateService
s {$sel:serviceArn:UpdateService' :: Text
serviceArn = Text
a} :: UpdateService)

instance Core.AWSRequest UpdateService where
  type
    AWSResponse UpdateService =
      UpdateServiceResponse
  request :: (Service -> Service) -> UpdateService -> Request UpdateService
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateService
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateService)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Service -> Text -> UpdateServiceResponse
UpdateServiceResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Service")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"OperationId")
      )

instance Prelude.Hashable UpdateService where
  hashWithSalt :: Int -> UpdateService -> Int
hashWithSalt Int
_salt UpdateService' {Maybe Text
Maybe HealthCheckConfiguration
Maybe InstanceConfiguration
Maybe NetworkConfiguration
Maybe ServiceObservabilityConfiguration
Maybe SourceConfiguration
Text
serviceArn :: Text
sourceConfiguration :: Maybe SourceConfiguration
observabilityConfiguration :: Maybe ServiceObservabilityConfiguration
networkConfiguration :: Maybe NetworkConfiguration
instanceConfiguration :: Maybe InstanceConfiguration
healthCheckConfiguration :: Maybe HealthCheckConfiguration
autoScalingConfigurationArn :: Maybe Text
$sel:serviceArn:UpdateService' :: UpdateService -> Text
$sel:sourceConfiguration:UpdateService' :: UpdateService -> Maybe SourceConfiguration
$sel:observabilityConfiguration:UpdateService' :: UpdateService -> Maybe ServiceObservabilityConfiguration
$sel:networkConfiguration:UpdateService' :: UpdateService -> Maybe NetworkConfiguration
$sel:instanceConfiguration:UpdateService' :: UpdateService -> Maybe InstanceConfiguration
$sel:healthCheckConfiguration:UpdateService' :: UpdateService -> Maybe HealthCheckConfiguration
$sel:autoScalingConfigurationArn:UpdateService' :: UpdateService -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
autoScalingConfigurationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HealthCheckConfiguration
healthCheckConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceConfiguration
instanceConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkConfiguration
networkConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServiceObservabilityConfiguration
observabilityConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceConfiguration
sourceConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceArn

instance Prelude.NFData UpdateService where
  rnf :: UpdateService -> ()
rnf UpdateService' {Maybe Text
Maybe HealthCheckConfiguration
Maybe InstanceConfiguration
Maybe NetworkConfiguration
Maybe ServiceObservabilityConfiguration
Maybe SourceConfiguration
Text
serviceArn :: Text
sourceConfiguration :: Maybe SourceConfiguration
observabilityConfiguration :: Maybe ServiceObservabilityConfiguration
networkConfiguration :: Maybe NetworkConfiguration
instanceConfiguration :: Maybe InstanceConfiguration
healthCheckConfiguration :: Maybe HealthCheckConfiguration
autoScalingConfigurationArn :: Maybe Text
$sel:serviceArn:UpdateService' :: UpdateService -> Text
$sel:sourceConfiguration:UpdateService' :: UpdateService -> Maybe SourceConfiguration
$sel:observabilityConfiguration:UpdateService' :: UpdateService -> Maybe ServiceObservabilityConfiguration
$sel:networkConfiguration:UpdateService' :: UpdateService -> Maybe NetworkConfiguration
$sel:instanceConfiguration:UpdateService' :: UpdateService -> Maybe InstanceConfiguration
$sel:healthCheckConfiguration:UpdateService' :: UpdateService -> Maybe HealthCheckConfiguration
$sel:autoScalingConfigurationArn:UpdateService' :: UpdateService -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
autoScalingConfigurationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HealthCheckConfiguration
healthCheckConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceConfiguration
instanceConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkConfiguration
networkConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceObservabilityConfiguration
observabilityConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceConfiguration
sourceConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceArn

instance Data.ToHeaders UpdateService where
  toHeaders :: UpdateService -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"AppRunner.UpdateService" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateService where
  toJSON :: UpdateService -> Value
toJSON UpdateService' {Maybe Text
Maybe HealthCheckConfiguration
Maybe InstanceConfiguration
Maybe NetworkConfiguration
Maybe ServiceObservabilityConfiguration
Maybe SourceConfiguration
Text
serviceArn :: Text
sourceConfiguration :: Maybe SourceConfiguration
observabilityConfiguration :: Maybe ServiceObservabilityConfiguration
networkConfiguration :: Maybe NetworkConfiguration
instanceConfiguration :: Maybe InstanceConfiguration
healthCheckConfiguration :: Maybe HealthCheckConfiguration
autoScalingConfigurationArn :: Maybe Text
$sel:serviceArn:UpdateService' :: UpdateService -> Text
$sel:sourceConfiguration:UpdateService' :: UpdateService -> Maybe SourceConfiguration
$sel:observabilityConfiguration:UpdateService' :: UpdateService -> Maybe ServiceObservabilityConfiguration
$sel:networkConfiguration:UpdateService' :: UpdateService -> Maybe NetworkConfiguration
$sel:instanceConfiguration:UpdateService' :: UpdateService -> Maybe InstanceConfiguration
$sel:healthCheckConfiguration:UpdateService' :: UpdateService -> Maybe HealthCheckConfiguration
$sel:autoScalingConfigurationArn:UpdateService' :: UpdateService -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AutoScalingConfigurationArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
autoScalingConfigurationArn,
            (Key
"HealthCheckConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HealthCheckConfiguration
healthCheckConfiguration,
            (Key
"InstanceConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe InstanceConfiguration
instanceConfiguration,
            (Key
"NetworkConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe NetworkConfiguration
networkConfiguration,
            (Key
"ObservabilityConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ServiceObservabilityConfiguration
observabilityConfiguration,
            (Key
"SourceConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SourceConfiguration
sourceConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"ServiceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceArn)
          ]
      )

instance Data.ToPath UpdateService where
  toPath :: UpdateService -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery UpdateService where
  toQuery :: UpdateService -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateServiceResponse' smart constructor.
data UpdateServiceResponse = UpdateServiceResponse'
  { -- | The response's http status code.
    UpdateServiceResponse -> Int
httpStatus :: Prelude.Int,
    -- | A description of the App Runner service updated by this request. All
    -- configuration values in the returned @Service@ structure reflect
    -- configuration changes that are being applied by this request.
    UpdateServiceResponse -> Service
service :: Service,
    -- | The unique ID of the asynchronous operation that this request started.
    -- You can use it combined with the ListOperations call to track the
    -- operation\'s progress.
    UpdateServiceResponse -> Text
operationId :: Prelude.Text
  }
  deriving (UpdateServiceResponse -> UpdateServiceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServiceResponse -> UpdateServiceResponse -> Bool
$c/= :: UpdateServiceResponse -> UpdateServiceResponse -> Bool
== :: UpdateServiceResponse -> UpdateServiceResponse -> Bool
$c== :: UpdateServiceResponse -> UpdateServiceResponse -> Bool
Prelude.Eq, Int -> UpdateServiceResponse -> ShowS
[UpdateServiceResponse] -> ShowS
UpdateServiceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServiceResponse] -> ShowS
$cshowList :: [UpdateServiceResponse] -> ShowS
show :: UpdateServiceResponse -> String
$cshow :: UpdateServiceResponse -> String
showsPrec :: Int -> UpdateServiceResponse -> ShowS
$cshowsPrec :: Int -> UpdateServiceResponse -> ShowS
Prelude.Show, forall x. Rep UpdateServiceResponse x -> UpdateServiceResponse
forall x. UpdateServiceResponse -> Rep UpdateServiceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateServiceResponse x -> UpdateServiceResponse
$cfrom :: forall x. UpdateServiceResponse -> Rep UpdateServiceResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServiceResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'updateServiceResponse_httpStatus' - The response's http status code.
--
-- 'service', 'updateServiceResponse_service' - A description of the App Runner service updated by this request. All
-- configuration values in the returned @Service@ structure reflect
-- configuration changes that are being applied by this request.
--
-- 'operationId', 'updateServiceResponse_operationId' - The unique ID of the asynchronous operation that this request started.
-- You can use it combined with the ListOperations call to track the
-- operation\'s progress.
newUpdateServiceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'service'
  Service ->
  -- | 'operationId'
  Prelude.Text ->
  UpdateServiceResponse
newUpdateServiceResponse :: Int -> Service -> Text -> UpdateServiceResponse
newUpdateServiceResponse
  Int
pHttpStatus_
  Service
pService_
  Text
pOperationId_ =
    UpdateServiceResponse'
      { $sel:httpStatus:UpdateServiceResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:service:UpdateServiceResponse' :: Service
service = Service
pService_,
        $sel:operationId:UpdateServiceResponse' :: Text
operationId = Text
pOperationId_
      }

-- | The response's http status code.
updateServiceResponse_httpStatus :: Lens.Lens' UpdateServiceResponse Prelude.Int
updateServiceResponse_httpStatus :: Lens' UpdateServiceResponse Int
updateServiceResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateServiceResponse' :: UpdateServiceResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateServiceResponse
s@UpdateServiceResponse' {} Int
a -> UpdateServiceResponse
s {$sel:httpStatus:UpdateServiceResponse' :: Int
httpStatus = Int
a} :: UpdateServiceResponse)

-- | A description of the App Runner service updated by this request. All
-- configuration values in the returned @Service@ structure reflect
-- configuration changes that are being applied by this request.
updateServiceResponse_service :: Lens.Lens' UpdateServiceResponse Service
updateServiceResponse_service :: Lens' UpdateServiceResponse Service
updateServiceResponse_service = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceResponse' {Service
service :: Service
$sel:service:UpdateServiceResponse' :: UpdateServiceResponse -> Service
service} -> Service
service) (\s :: UpdateServiceResponse
s@UpdateServiceResponse' {} Service
a -> UpdateServiceResponse
s {$sel:service:UpdateServiceResponse' :: Service
service = Service
a} :: UpdateServiceResponse)

-- | The unique ID of the asynchronous operation that this request started.
-- You can use it combined with the ListOperations call to track the
-- operation\'s progress.
updateServiceResponse_operationId :: Lens.Lens' UpdateServiceResponse Prelude.Text
updateServiceResponse_operationId :: Lens' UpdateServiceResponse Text
updateServiceResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceResponse' {Text
operationId :: Text
$sel:operationId:UpdateServiceResponse' :: UpdateServiceResponse -> Text
operationId} -> Text
operationId) (\s :: UpdateServiceResponse
s@UpdateServiceResponse' {} Text
a -> UpdateServiceResponse
s {$sel:operationId:UpdateServiceResponse' :: Text
operationId = Text
a} :: UpdateServiceResponse)

instance Prelude.NFData UpdateServiceResponse where
  rnf :: UpdateServiceResponse -> ()
rnf UpdateServiceResponse' {Int
Text
Service
operationId :: Text
service :: Service
httpStatus :: Int
$sel:operationId:UpdateServiceResponse' :: UpdateServiceResponse -> Text
$sel:service:UpdateServiceResponse' :: UpdateServiceResponse -> Service
$sel:httpStatus:UpdateServiceResponse' :: UpdateServiceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Service
service
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
operationId