{-# 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.Proton.UpdateServiceInstance
-- 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 a service instance.
--
-- There are a few modes for updating a service instance. The
-- @deploymentType@ field defines the mode.
--
-- You can\'t update a service instance while its deployment status, or the
-- deployment status of a component attached to it, is @IN_PROGRESS@.
--
-- For more information about components, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-components.html Proton components>
-- in the /Proton User Guide/.
module Amazonka.Proton.UpdateServiceInstance
  ( -- * Creating a Request
    UpdateServiceInstance (..),
    newUpdateServiceInstance,

    -- * Request Lenses
    updateServiceInstance_spec,
    updateServiceInstance_templateMajorVersion,
    updateServiceInstance_templateMinorVersion,
    updateServiceInstance_deploymentType,
    updateServiceInstance_name,
    updateServiceInstance_serviceName,

    -- * Destructuring the Response
    UpdateServiceInstanceResponse (..),
    newUpdateServiceInstanceResponse,

    -- * Response Lenses
    updateServiceInstanceResponse_httpStatus,
    updateServiceInstanceResponse_serviceInstance,
  )
where

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 Amazonka.Proton.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateServiceInstance' smart constructor.
data UpdateServiceInstance = UpdateServiceInstance'
  { -- | The formatted specification that defines the service instance update.
    UpdateServiceInstance -> Maybe (Sensitive Text)
spec :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The major version of the service template to update.
    UpdateServiceInstance -> Maybe Text
templateMajorVersion :: Prelude.Maybe Prelude.Text,
    -- | The minor version of the service template to update.
    UpdateServiceInstance -> Maybe Text
templateMinorVersion :: Prelude.Maybe Prelude.Text,
    -- | The deployment type. It defines the mode for updating a service
    -- instance, as follows:
    --
    -- []
    --     @NONE@
    --
    --     In this mode, a deployment /doesn\'t/ occur. Only the requested
    --     metadata parameters are updated.
    --
    -- []
    --     @CURRENT_VERSION@
    --
    --     In this mode, the service instance is deployed and updated with the
    --     new spec that you provide. Only requested parameters are updated.
    --     /Don’t/ include major or minor version parameters when you use this
    --     deployment type.
    --
    -- []
    --     @MINOR_VERSION@
    --
    --     In this mode, the service instance is deployed and updated with the
    --     published, recommended (latest) minor version of the current major
    --     version in use, by default. You can also specify a different minor
    --     version of the current major version in use.
    --
    -- []
    --     @MAJOR_VERSION@
    --
    --     In this mode, the service instance is deployed and updated with the
    --     published, recommended (latest) major and minor version of the
    --     current template, by default. You can specify a different major
    --     version that\'s higher than the major version in use and a minor
    --     version.
    UpdateServiceInstance -> DeploymentUpdateType
deploymentType :: DeploymentUpdateType,
    -- | The name of the service instance to update.
    UpdateServiceInstance -> Text
name :: Prelude.Text,
    -- | The name of the service that the service instance belongs to.
    UpdateServiceInstance -> Text
serviceName :: Prelude.Text
  }
  deriving (UpdateServiceInstance -> UpdateServiceInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServiceInstance -> UpdateServiceInstance -> Bool
$c/= :: UpdateServiceInstance -> UpdateServiceInstance -> Bool
== :: UpdateServiceInstance -> UpdateServiceInstance -> Bool
$c== :: UpdateServiceInstance -> UpdateServiceInstance -> Bool
Prelude.Eq, Int -> UpdateServiceInstance -> ShowS
[UpdateServiceInstance] -> ShowS
UpdateServiceInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServiceInstance] -> ShowS
$cshowList :: [UpdateServiceInstance] -> ShowS
show :: UpdateServiceInstance -> String
$cshow :: UpdateServiceInstance -> String
showsPrec :: Int -> UpdateServiceInstance -> ShowS
$cshowsPrec :: Int -> UpdateServiceInstance -> ShowS
Prelude.Show, forall x. Rep UpdateServiceInstance x -> UpdateServiceInstance
forall x. UpdateServiceInstance -> Rep UpdateServiceInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateServiceInstance x -> UpdateServiceInstance
$cfrom :: forall x. UpdateServiceInstance -> Rep UpdateServiceInstance x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServiceInstance' 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:
--
-- 'spec', 'updateServiceInstance_spec' - The formatted specification that defines the service instance update.
--
-- 'templateMajorVersion', 'updateServiceInstance_templateMajorVersion' - The major version of the service template to update.
--
-- 'templateMinorVersion', 'updateServiceInstance_templateMinorVersion' - The minor version of the service template to update.
--
-- 'deploymentType', 'updateServiceInstance_deploymentType' - The deployment type. It defines the mode for updating a service
-- instance, as follows:
--
-- []
--     @NONE@
--
--     In this mode, a deployment /doesn\'t/ occur. Only the requested
--     metadata parameters are updated.
--
-- []
--     @CURRENT_VERSION@
--
--     In this mode, the service instance is deployed and updated with the
--     new spec that you provide. Only requested parameters are updated.
--     /Don’t/ include major or minor version parameters when you use this
--     deployment type.
--
-- []
--     @MINOR_VERSION@
--
--     In this mode, the service instance is deployed and updated with the
--     published, recommended (latest) minor version of the current major
--     version in use, by default. You can also specify a different minor
--     version of the current major version in use.
--
-- []
--     @MAJOR_VERSION@
--
--     In this mode, the service instance is deployed and updated with the
--     published, recommended (latest) major and minor version of the
--     current template, by default. You can specify a different major
--     version that\'s higher than the major version in use and a minor
--     version.
--
-- 'name', 'updateServiceInstance_name' - The name of the service instance to update.
--
-- 'serviceName', 'updateServiceInstance_serviceName' - The name of the service that the service instance belongs to.
newUpdateServiceInstance ::
  -- | 'deploymentType'
  DeploymentUpdateType ->
  -- | 'name'
  Prelude.Text ->
  -- | 'serviceName'
  Prelude.Text ->
  UpdateServiceInstance
newUpdateServiceInstance :: DeploymentUpdateType -> Text -> Text -> UpdateServiceInstance
newUpdateServiceInstance
  DeploymentUpdateType
pDeploymentType_
  Text
pName_
  Text
pServiceName_ =
    UpdateServiceInstance'
      { $sel:spec:UpdateServiceInstance' :: Maybe (Sensitive Text)
spec = forall a. Maybe a
Prelude.Nothing,
        $sel:templateMajorVersion:UpdateServiceInstance' :: Maybe Text
templateMajorVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:templateMinorVersion:UpdateServiceInstance' :: Maybe Text
templateMinorVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:deploymentType:UpdateServiceInstance' :: DeploymentUpdateType
deploymentType = DeploymentUpdateType
pDeploymentType_,
        $sel:name:UpdateServiceInstance' :: Text
name = Text
pName_,
        $sel:serviceName:UpdateServiceInstance' :: Text
serviceName = Text
pServiceName_
      }

-- | The formatted specification that defines the service instance update.
updateServiceInstance_spec :: Lens.Lens' UpdateServiceInstance (Prelude.Maybe Prelude.Text)
updateServiceInstance_spec :: Lens' UpdateServiceInstance (Maybe Text)
updateServiceInstance_spec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceInstance' {Maybe (Sensitive Text)
spec :: Maybe (Sensitive Text)
$sel:spec:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe (Sensitive Text)
spec} -> Maybe (Sensitive Text)
spec) (\s :: UpdateServiceInstance
s@UpdateServiceInstance' {} Maybe (Sensitive Text)
a -> UpdateServiceInstance
s {$sel:spec:UpdateServiceInstance' :: Maybe (Sensitive Text)
spec = Maybe (Sensitive Text)
a} :: UpdateServiceInstance) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The major version of the service template to update.
updateServiceInstance_templateMajorVersion :: Lens.Lens' UpdateServiceInstance (Prelude.Maybe Prelude.Text)
updateServiceInstance_templateMajorVersion :: Lens' UpdateServiceInstance (Maybe Text)
updateServiceInstance_templateMajorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceInstance' {Maybe Text
templateMajorVersion :: Maybe Text
$sel:templateMajorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
templateMajorVersion} -> Maybe Text
templateMajorVersion) (\s :: UpdateServiceInstance
s@UpdateServiceInstance' {} Maybe Text
a -> UpdateServiceInstance
s {$sel:templateMajorVersion:UpdateServiceInstance' :: Maybe Text
templateMajorVersion = Maybe Text
a} :: UpdateServiceInstance)

-- | The minor version of the service template to update.
updateServiceInstance_templateMinorVersion :: Lens.Lens' UpdateServiceInstance (Prelude.Maybe Prelude.Text)
updateServiceInstance_templateMinorVersion :: Lens' UpdateServiceInstance (Maybe Text)
updateServiceInstance_templateMinorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceInstance' {Maybe Text
templateMinorVersion :: Maybe Text
$sel:templateMinorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
templateMinorVersion} -> Maybe Text
templateMinorVersion) (\s :: UpdateServiceInstance
s@UpdateServiceInstance' {} Maybe Text
a -> UpdateServiceInstance
s {$sel:templateMinorVersion:UpdateServiceInstance' :: Maybe Text
templateMinorVersion = Maybe Text
a} :: UpdateServiceInstance)

-- | The deployment type. It defines the mode for updating a service
-- instance, as follows:
--
-- []
--     @NONE@
--
--     In this mode, a deployment /doesn\'t/ occur. Only the requested
--     metadata parameters are updated.
--
-- []
--     @CURRENT_VERSION@
--
--     In this mode, the service instance is deployed and updated with the
--     new spec that you provide. Only requested parameters are updated.
--     /Don’t/ include major or minor version parameters when you use this
--     deployment type.
--
-- []
--     @MINOR_VERSION@
--
--     In this mode, the service instance is deployed and updated with the
--     published, recommended (latest) minor version of the current major
--     version in use, by default. You can also specify a different minor
--     version of the current major version in use.
--
-- []
--     @MAJOR_VERSION@
--
--     In this mode, the service instance is deployed and updated with the
--     published, recommended (latest) major and minor version of the
--     current template, by default. You can specify a different major
--     version that\'s higher than the major version in use and a minor
--     version.
updateServiceInstance_deploymentType :: Lens.Lens' UpdateServiceInstance DeploymentUpdateType
updateServiceInstance_deploymentType :: Lens' UpdateServiceInstance DeploymentUpdateType
updateServiceInstance_deploymentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceInstance' {DeploymentUpdateType
deploymentType :: DeploymentUpdateType
$sel:deploymentType:UpdateServiceInstance' :: UpdateServiceInstance -> DeploymentUpdateType
deploymentType} -> DeploymentUpdateType
deploymentType) (\s :: UpdateServiceInstance
s@UpdateServiceInstance' {} DeploymentUpdateType
a -> UpdateServiceInstance
s {$sel:deploymentType:UpdateServiceInstance' :: DeploymentUpdateType
deploymentType = DeploymentUpdateType
a} :: UpdateServiceInstance)

-- | The name of the service instance to update.
updateServiceInstance_name :: Lens.Lens' UpdateServiceInstance Prelude.Text
updateServiceInstance_name :: Lens' UpdateServiceInstance Text
updateServiceInstance_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceInstance' {Text
name :: Text
$sel:name:UpdateServiceInstance' :: UpdateServiceInstance -> Text
name} -> Text
name) (\s :: UpdateServiceInstance
s@UpdateServiceInstance' {} Text
a -> UpdateServiceInstance
s {$sel:name:UpdateServiceInstance' :: Text
name = Text
a} :: UpdateServiceInstance)

-- | The name of the service that the service instance belongs to.
updateServiceInstance_serviceName :: Lens.Lens' UpdateServiceInstance Prelude.Text
updateServiceInstance_serviceName :: Lens' UpdateServiceInstance Text
updateServiceInstance_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceInstance' {Text
serviceName :: Text
$sel:serviceName:UpdateServiceInstance' :: UpdateServiceInstance -> Text
serviceName} -> Text
serviceName) (\s :: UpdateServiceInstance
s@UpdateServiceInstance' {} Text
a -> UpdateServiceInstance
s {$sel:serviceName:UpdateServiceInstance' :: Text
serviceName = Text
a} :: UpdateServiceInstance)

instance Core.AWSRequest UpdateServiceInstance where
  type
    AWSResponse UpdateServiceInstance =
      UpdateServiceInstanceResponse
  request :: (Service -> Service)
-> UpdateServiceInstance -> Request UpdateServiceInstance
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 UpdateServiceInstance
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateServiceInstance)))
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 -> ServiceInstance -> UpdateServiceInstanceResponse
UpdateServiceInstanceResponse'
            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
"serviceInstance")
      )

instance Prelude.Hashable UpdateServiceInstance where
  hashWithSalt :: Int -> UpdateServiceInstance -> Int
hashWithSalt Int
_salt UpdateServiceInstance' {Maybe Text
Maybe (Sensitive Text)
Text
DeploymentUpdateType
serviceName :: Text
name :: Text
deploymentType :: DeploymentUpdateType
templateMinorVersion :: Maybe Text
templateMajorVersion :: Maybe Text
spec :: Maybe (Sensitive Text)
$sel:serviceName:UpdateServiceInstance' :: UpdateServiceInstance -> Text
$sel:name:UpdateServiceInstance' :: UpdateServiceInstance -> Text
$sel:deploymentType:UpdateServiceInstance' :: UpdateServiceInstance -> DeploymentUpdateType
$sel:templateMinorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
$sel:templateMajorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
$sel:spec:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
spec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateMajorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateMinorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DeploymentUpdateType
deploymentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceName

instance Prelude.NFData UpdateServiceInstance where
  rnf :: UpdateServiceInstance -> ()
rnf UpdateServiceInstance' {Maybe Text
Maybe (Sensitive Text)
Text
DeploymentUpdateType
serviceName :: Text
name :: Text
deploymentType :: DeploymentUpdateType
templateMinorVersion :: Maybe Text
templateMajorVersion :: Maybe Text
spec :: Maybe (Sensitive Text)
$sel:serviceName:UpdateServiceInstance' :: UpdateServiceInstance -> Text
$sel:name:UpdateServiceInstance' :: UpdateServiceInstance -> Text
$sel:deploymentType:UpdateServiceInstance' :: UpdateServiceInstance -> DeploymentUpdateType
$sel:templateMinorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
$sel:templateMajorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
$sel:spec:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
spec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateMajorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateMinorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeploymentUpdateType
deploymentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceName

instance Data.ToHeaders UpdateServiceInstance where
  toHeaders :: UpdateServiceInstance -> 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
"AwsProton20200720.UpdateServiceInstance" ::
                          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 UpdateServiceInstance where
  toJSON :: UpdateServiceInstance -> Value
toJSON UpdateServiceInstance' {Maybe Text
Maybe (Sensitive Text)
Text
DeploymentUpdateType
serviceName :: Text
name :: Text
deploymentType :: DeploymentUpdateType
templateMinorVersion :: Maybe Text
templateMajorVersion :: Maybe Text
spec :: Maybe (Sensitive Text)
$sel:serviceName:UpdateServiceInstance' :: UpdateServiceInstance -> Text
$sel:name:UpdateServiceInstance' :: UpdateServiceInstance -> Text
$sel:deploymentType:UpdateServiceInstance' :: UpdateServiceInstance -> DeploymentUpdateType
$sel:templateMinorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
$sel:templateMajorVersion:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe Text
$sel:spec:UpdateServiceInstance' :: UpdateServiceInstance -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"spec" 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 (Sensitive Text)
spec,
            (Key
"templateMajorVersion" 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
templateMajorVersion,
            (Key
"templateMinorVersion" 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
templateMinorVersion,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"deploymentType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DeploymentUpdateType
deploymentType),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"serviceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceName)
          ]
      )

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

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

-- | /See:/ 'newUpdateServiceInstanceResponse' smart constructor.
data UpdateServiceInstanceResponse = UpdateServiceInstanceResponse'
  { -- | The response's http status code.
    UpdateServiceInstanceResponse -> Int
httpStatus :: Prelude.Int,
    -- | The service instance summary data that\'s returned by Proton.
    UpdateServiceInstanceResponse -> ServiceInstance
serviceInstance :: ServiceInstance
  }
  deriving (UpdateServiceInstanceResponse
-> UpdateServiceInstanceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServiceInstanceResponse
-> UpdateServiceInstanceResponse -> Bool
$c/= :: UpdateServiceInstanceResponse
-> UpdateServiceInstanceResponse -> Bool
== :: UpdateServiceInstanceResponse
-> UpdateServiceInstanceResponse -> Bool
$c== :: UpdateServiceInstanceResponse
-> UpdateServiceInstanceResponse -> Bool
Prelude.Eq, Int -> UpdateServiceInstanceResponse -> ShowS
[UpdateServiceInstanceResponse] -> ShowS
UpdateServiceInstanceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServiceInstanceResponse] -> ShowS
$cshowList :: [UpdateServiceInstanceResponse] -> ShowS
show :: UpdateServiceInstanceResponse -> String
$cshow :: UpdateServiceInstanceResponse -> String
showsPrec :: Int -> UpdateServiceInstanceResponse -> ShowS
$cshowsPrec :: Int -> UpdateServiceInstanceResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateServiceInstanceResponse x
-> UpdateServiceInstanceResponse
forall x.
UpdateServiceInstanceResponse
-> Rep UpdateServiceInstanceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateServiceInstanceResponse x
-> UpdateServiceInstanceResponse
$cfrom :: forall x.
UpdateServiceInstanceResponse
-> Rep UpdateServiceInstanceResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServiceInstanceResponse' 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', 'updateServiceInstanceResponse_httpStatus' - The response's http status code.
--
-- 'serviceInstance', 'updateServiceInstanceResponse_serviceInstance' - The service instance summary data that\'s returned by Proton.
newUpdateServiceInstanceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'serviceInstance'
  ServiceInstance ->
  UpdateServiceInstanceResponse
newUpdateServiceInstanceResponse :: Int -> ServiceInstance -> UpdateServiceInstanceResponse
newUpdateServiceInstanceResponse
  Int
pHttpStatus_
  ServiceInstance
pServiceInstance_ =
    UpdateServiceInstanceResponse'
      { $sel:httpStatus:UpdateServiceInstanceResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:serviceInstance:UpdateServiceInstanceResponse' :: ServiceInstance
serviceInstance = ServiceInstance
pServiceInstance_
      }

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

-- | The service instance summary data that\'s returned by Proton.
updateServiceInstanceResponse_serviceInstance :: Lens.Lens' UpdateServiceInstanceResponse ServiceInstance
updateServiceInstanceResponse_serviceInstance :: Lens' UpdateServiceInstanceResponse ServiceInstance
updateServiceInstanceResponse_serviceInstance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceInstanceResponse' {ServiceInstance
serviceInstance :: ServiceInstance
$sel:serviceInstance:UpdateServiceInstanceResponse' :: UpdateServiceInstanceResponse -> ServiceInstance
serviceInstance} -> ServiceInstance
serviceInstance) (\s :: UpdateServiceInstanceResponse
s@UpdateServiceInstanceResponse' {} ServiceInstance
a -> UpdateServiceInstanceResponse
s {$sel:serviceInstance:UpdateServiceInstanceResponse' :: ServiceInstance
serviceInstance = ServiceInstance
a} :: UpdateServiceInstanceResponse)

instance Prelude.NFData UpdateServiceInstanceResponse where
  rnf :: UpdateServiceInstanceResponse -> ()
rnf UpdateServiceInstanceResponse' {Int
ServiceInstance
serviceInstance :: ServiceInstance
httpStatus :: Int
$sel:serviceInstance:UpdateServiceInstanceResponse' :: UpdateServiceInstanceResponse -> ServiceInstance
$sel:httpStatus:UpdateServiceInstanceResponse' :: UpdateServiceInstanceResponse -> 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 ServiceInstance
serviceInstance