{-# 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.UpdateEnvironmentAccountConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- In an environment account, update an environment account connection to
-- use a new IAM role.
--
-- For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-env-account-connections.html Environment account connections>
-- in the /Proton User guide/.
module Amazonka.Proton.UpdateEnvironmentAccountConnection
  ( -- * Creating a Request
    UpdateEnvironmentAccountConnection (..),
    newUpdateEnvironmentAccountConnection,

    -- * Request Lenses
    updateEnvironmentAccountConnection_codebuildRoleArn,
    updateEnvironmentAccountConnection_componentRoleArn,
    updateEnvironmentAccountConnection_roleArn,
    updateEnvironmentAccountConnection_id,

    -- * Destructuring the Response
    UpdateEnvironmentAccountConnectionResponse (..),
    newUpdateEnvironmentAccountConnectionResponse,

    -- * Response Lenses
    updateEnvironmentAccountConnectionResponse_httpStatus,
    updateEnvironmentAccountConnectionResponse_environmentAccountConnection,
  )
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:/ 'newUpdateEnvironmentAccountConnection' smart constructor.
data UpdateEnvironmentAccountConnection = UpdateEnvironmentAccountConnection'
  { -- | The Amazon Resource Name (ARN) of an IAM service role in the environment
    -- account. Proton uses this role to provision infrastructure resources
    -- using CodeBuild-based provisioning in the associated environment
    -- account.
    UpdateEnvironmentAccountConnection -> Maybe Text
codebuildRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM service role that Proton uses
    -- when provisioning directly defined components in the associated
    -- environment account. It determines the scope of infrastructure that a
    -- component can provision in the account.
    --
    -- The environment account connection must have a @componentRoleArn@ to
    -- allow directly defined components to be associated with any environments
    -- running in the account.
    --
    -- For more information about components, see
    -- <https://docs.aws.amazon.com/proton/latest/userguide/ag-components.html Proton components>
    -- in the /Proton User Guide/.
    UpdateEnvironmentAccountConnection -> Maybe Text
componentRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM service role that\'s
    -- associated with the environment account connection to update.
    UpdateEnvironmentAccountConnection -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the environment account connection to update.
    UpdateEnvironmentAccountConnection -> Text
id :: Prelude.Text
  }
  deriving (UpdateEnvironmentAccountConnection
-> UpdateEnvironmentAccountConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEnvironmentAccountConnection
-> UpdateEnvironmentAccountConnection -> Bool
$c/= :: UpdateEnvironmentAccountConnection
-> UpdateEnvironmentAccountConnection -> Bool
== :: UpdateEnvironmentAccountConnection
-> UpdateEnvironmentAccountConnection -> Bool
$c== :: UpdateEnvironmentAccountConnection
-> UpdateEnvironmentAccountConnection -> Bool
Prelude.Eq, ReadPrec [UpdateEnvironmentAccountConnection]
ReadPrec UpdateEnvironmentAccountConnection
Int -> ReadS UpdateEnvironmentAccountConnection
ReadS [UpdateEnvironmentAccountConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEnvironmentAccountConnection]
$creadListPrec :: ReadPrec [UpdateEnvironmentAccountConnection]
readPrec :: ReadPrec UpdateEnvironmentAccountConnection
$creadPrec :: ReadPrec UpdateEnvironmentAccountConnection
readList :: ReadS [UpdateEnvironmentAccountConnection]
$creadList :: ReadS [UpdateEnvironmentAccountConnection]
readsPrec :: Int -> ReadS UpdateEnvironmentAccountConnection
$creadsPrec :: Int -> ReadS UpdateEnvironmentAccountConnection
Prelude.Read, Int -> UpdateEnvironmentAccountConnection -> ShowS
[UpdateEnvironmentAccountConnection] -> ShowS
UpdateEnvironmentAccountConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEnvironmentAccountConnection] -> ShowS
$cshowList :: [UpdateEnvironmentAccountConnection] -> ShowS
show :: UpdateEnvironmentAccountConnection -> String
$cshow :: UpdateEnvironmentAccountConnection -> String
showsPrec :: Int -> UpdateEnvironmentAccountConnection -> ShowS
$cshowsPrec :: Int -> UpdateEnvironmentAccountConnection -> ShowS
Prelude.Show, forall x.
Rep UpdateEnvironmentAccountConnection x
-> UpdateEnvironmentAccountConnection
forall x.
UpdateEnvironmentAccountConnection
-> Rep UpdateEnvironmentAccountConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateEnvironmentAccountConnection x
-> UpdateEnvironmentAccountConnection
$cfrom :: forall x.
UpdateEnvironmentAccountConnection
-> Rep UpdateEnvironmentAccountConnection x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEnvironmentAccountConnection' 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:
--
-- 'codebuildRoleArn', 'updateEnvironmentAccountConnection_codebuildRoleArn' - The Amazon Resource Name (ARN) of an IAM service role in the environment
-- account. Proton uses this role to provision infrastructure resources
-- using CodeBuild-based provisioning in the associated environment
-- account.
--
-- 'componentRoleArn', 'updateEnvironmentAccountConnection_componentRoleArn' - The Amazon Resource Name (ARN) of the IAM service role that Proton uses
-- when provisioning directly defined components in the associated
-- environment account. It determines the scope of infrastructure that a
-- component can provision in the account.
--
-- The environment account connection must have a @componentRoleArn@ to
-- allow directly defined components to be associated with any environments
-- running in the account.
--
-- For more information about components, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-components.html Proton components>
-- in the /Proton User Guide/.
--
-- 'roleArn', 'updateEnvironmentAccountConnection_roleArn' - The Amazon Resource Name (ARN) of the IAM service role that\'s
-- associated with the environment account connection to update.
--
-- 'id', 'updateEnvironmentAccountConnection_id' - The ID of the environment account connection to update.
newUpdateEnvironmentAccountConnection ::
  -- | 'id'
  Prelude.Text ->
  UpdateEnvironmentAccountConnection
newUpdateEnvironmentAccountConnection :: Text -> UpdateEnvironmentAccountConnection
newUpdateEnvironmentAccountConnection Text
pId_ =
  UpdateEnvironmentAccountConnection'
    { $sel:codebuildRoleArn:UpdateEnvironmentAccountConnection' :: Maybe Text
codebuildRoleArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:componentRoleArn:UpdateEnvironmentAccountConnection' :: Maybe Text
componentRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateEnvironmentAccountConnection' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateEnvironmentAccountConnection' :: Text
id = Text
pId_
    }

-- | The Amazon Resource Name (ARN) of an IAM service role in the environment
-- account. Proton uses this role to provision infrastructure resources
-- using CodeBuild-based provisioning in the associated environment
-- account.
updateEnvironmentAccountConnection_codebuildRoleArn :: Lens.Lens' UpdateEnvironmentAccountConnection (Prelude.Maybe Prelude.Text)
updateEnvironmentAccountConnection_codebuildRoleArn :: Lens' UpdateEnvironmentAccountConnection (Maybe Text)
updateEnvironmentAccountConnection_codebuildRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEnvironmentAccountConnection' {Maybe Text
codebuildRoleArn :: Maybe Text
$sel:codebuildRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
codebuildRoleArn} -> Maybe Text
codebuildRoleArn) (\s :: UpdateEnvironmentAccountConnection
s@UpdateEnvironmentAccountConnection' {} Maybe Text
a -> UpdateEnvironmentAccountConnection
s {$sel:codebuildRoleArn:UpdateEnvironmentAccountConnection' :: Maybe Text
codebuildRoleArn = Maybe Text
a} :: UpdateEnvironmentAccountConnection)

-- | The Amazon Resource Name (ARN) of the IAM service role that Proton uses
-- when provisioning directly defined components in the associated
-- environment account. It determines the scope of infrastructure that a
-- component can provision in the account.
--
-- The environment account connection must have a @componentRoleArn@ to
-- allow directly defined components to be associated with any environments
-- running in the account.
--
-- For more information about components, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-components.html Proton components>
-- in the /Proton User Guide/.
updateEnvironmentAccountConnection_componentRoleArn :: Lens.Lens' UpdateEnvironmentAccountConnection (Prelude.Maybe Prelude.Text)
updateEnvironmentAccountConnection_componentRoleArn :: Lens' UpdateEnvironmentAccountConnection (Maybe Text)
updateEnvironmentAccountConnection_componentRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEnvironmentAccountConnection' {Maybe Text
componentRoleArn :: Maybe Text
$sel:componentRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
componentRoleArn} -> Maybe Text
componentRoleArn) (\s :: UpdateEnvironmentAccountConnection
s@UpdateEnvironmentAccountConnection' {} Maybe Text
a -> UpdateEnvironmentAccountConnection
s {$sel:componentRoleArn:UpdateEnvironmentAccountConnection' :: Maybe Text
componentRoleArn = Maybe Text
a} :: UpdateEnvironmentAccountConnection)

-- | The Amazon Resource Name (ARN) of the IAM service role that\'s
-- associated with the environment account connection to update.
updateEnvironmentAccountConnection_roleArn :: Lens.Lens' UpdateEnvironmentAccountConnection (Prelude.Maybe Prelude.Text)
updateEnvironmentAccountConnection_roleArn :: Lens' UpdateEnvironmentAccountConnection (Maybe Text)
updateEnvironmentAccountConnection_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEnvironmentAccountConnection' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateEnvironmentAccountConnection
s@UpdateEnvironmentAccountConnection' {} Maybe Text
a -> UpdateEnvironmentAccountConnection
s {$sel:roleArn:UpdateEnvironmentAccountConnection' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateEnvironmentAccountConnection)

-- | The ID of the environment account connection to update.
updateEnvironmentAccountConnection_id :: Lens.Lens' UpdateEnvironmentAccountConnection Prelude.Text
updateEnvironmentAccountConnection_id :: Lens' UpdateEnvironmentAccountConnection Text
updateEnvironmentAccountConnection_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEnvironmentAccountConnection' {Text
id :: Text
$sel:id:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Text
id} -> Text
id) (\s :: UpdateEnvironmentAccountConnection
s@UpdateEnvironmentAccountConnection' {} Text
a -> UpdateEnvironmentAccountConnection
s {$sel:id:UpdateEnvironmentAccountConnection' :: Text
id = Text
a} :: UpdateEnvironmentAccountConnection)

instance
  Core.AWSRequest
    UpdateEnvironmentAccountConnection
  where
  type
    AWSResponse UpdateEnvironmentAccountConnection =
      UpdateEnvironmentAccountConnectionResponse
  request :: (Service -> Service)
-> UpdateEnvironmentAccountConnection
-> Request UpdateEnvironmentAccountConnection
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 UpdateEnvironmentAccountConnection
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateEnvironmentAccountConnection)))
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
-> EnvironmentAccountConnection
-> UpdateEnvironmentAccountConnectionResponse
UpdateEnvironmentAccountConnectionResponse'
            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
"environmentAccountConnection")
      )

instance
  Prelude.Hashable
    UpdateEnvironmentAccountConnection
  where
  hashWithSalt :: Int -> UpdateEnvironmentAccountConnection -> Int
hashWithSalt
    Int
_salt
    UpdateEnvironmentAccountConnection' {Maybe Text
Text
id :: Text
roleArn :: Maybe Text
componentRoleArn :: Maybe Text
codebuildRoleArn :: Maybe Text
$sel:id:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Text
$sel:roleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
$sel:componentRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
$sel:codebuildRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
codebuildRoleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
componentRoleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance
  Prelude.NFData
    UpdateEnvironmentAccountConnection
  where
  rnf :: UpdateEnvironmentAccountConnection -> ()
rnf UpdateEnvironmentAccountConnection' {Maybe Text
Text
id :: Text
roleArn :: Maybe Text
componentRoleArn :: Maybe Text
codebuildRoleArn :: Maybe Text
$sel:id:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Text
$sel:roleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
$sel:componentRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
$sel:codebuildRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
codebuildRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
componentRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance
  Data.ToHeaders
    UpdateEnvironmentAccountConnection
  where
  toHeaders :: UpdateEnvironmentAccountConnection -> 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.UpdateEnvironmentAccountConnection" ::
                          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
    UpdateEnvironmentAccountConnection
  where
  toJSON :: UpdateEnvironmentAccountConnection -> Value
toJSON UpdateEnvironmentAccountConnection' {Maybe Text
Text
id :: Text
roleArn :: Maybe Text
componentRoleArn :: Maybe Text
codebuildRoleArn :: Maybe Text
$sel:id:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Text
$sel:roleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
$sel:componentRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
$sel:codebuildRoleArn:UpdateEnvironmentAccountConnection' :: UpdateEnvironmentAccountConnection -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"codebuildRoleArn" 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
codebuildRoleArn,
            (Key
"componentRoleArn" 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
componentRoleArn,
            (Key
"roleArn" 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
roleArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

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

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

-- | /See:/ 'newUpdateEnvironmentAccountConnectionResponse' smart constructor.
data UpdateEnvironmentAccountConnectionResponse = UpdateEnvironmentAccountConnectionResponse'
  { -- | The response's http status code.
    UpdateEnvironmentAccountConnectionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The environment account connection detail data that\'s returned by
    -- Proton.
    UpdateEnvironmentAccountConnectionResponse
-> EnvironmentAccountConnection
environmentAccountConnection :: EnvironmentAccountConnection
  }
  deriving (UpdateEnvironmentAccountConnectionResponse
-> UpdateEnvironmentAccountConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEnvironmentAccountConnectionResponse
-> UpdateEnvironmentAccountConnectionResponse -> Bool
$c/= :: UpdateEnvironmentAccountConnectionResponse
-> UpdateEnvironmentAccountConnectionResponse -> Bool
== :: UpdateEnvironmentAccountConnectionResponse
-> UpdateEnvironmentAccountConnectionResponse -> Bool
$c== :: UpdateEnvironmentAccountConnectionResponse
-> UpdateEnvironmentAccountConnectionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateEnvironmentAccountConnectionResponse]
ReadPrec UpdateEnvironmentAccountConnectionResponse
Int -> ReadS UpdateEnvironmentAccountConnectionResponse
ReadS [UpdateEnvironmentAccountConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEnvironmentAccountConnectionResponse]
$creadListPrec :: ReadPrec [UpdateEnvironmentAccountConnectionResponse]
readPrec :: ReadPrec UpdateEnvironmentAccountConnectionResponse
$creadPrec :: ReadPrec UpdateEnvironmentAccountConnectionResponse
readList :: ReadS [UpdateEnvironmentAccountConnectionResponse]
$creadList :: ReadS [UpdateEnvironmentAccountConnectionResponse]
readsPrec :: Int -> ReadS UpdateEnvironmentAccountConnectionResponse
$creadsPrec :: Int -> ReadS UpdateEnvironmentAccountConnectionResponse
Prelude.Read, Int -> UpdateEnvironmentAccountConnectionResponse -> ShowS
[UpdateEnvironmentAccountConnectionResponse] -> ShowS
UpdateEnvironmentAccountConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEnvironmentAccountConnectionResponse] -> ShowS
$cshowList :: [UpdateEnvironmentAccountConnectionResponse] -> ShowS
show :: UpdateEnvironmentAccountConnectionResponse -> String
$cshow :: UpdateEnvironmentAccountConnectionResponse -> String
showsPrec :: Int -> UpdateEnvironmentAccountConnectionResponse -> ShowS
$cshowsPrec :: Int -> UpdateEnvironmentAccountConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateEnvironmentAccountConnectionResponse x
-> UpdateEnvironmentAccountConnectionResponse
forall x.
UpdateEnvironmentAccountConnectionResponse
-> Rep UpdateEnvironmentAccountConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateEnvironmentAccountConnectionResponse x
-> UpdateEnvironmentAccountConnectionResponse
$cfrom :: forall x.
UpdateEnvironmentAccountConnectionResponse
-> Rep UpdateEnvironmentAccountConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEnvironmentAccountConnectionResponse' 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', 'updateEnvironmentAccountConnectionResponse_httpStatus' - The response's http status code.
--
-- 'environmentAccountConnection', 'updateEnvironmentAccountConnectionResponse_environmentAccountConnection' - The environment account connection detail data that\'s returned by
-- Proton.
newUpdateEnvironmentAccountConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'environmentAccountConnection'
  EnvironmentAccountConnection ->
  UpdateEnvironmentAccountConnectionResponse
newUpdateEnvironmentAccountConnectionResponse :: Int
-> EnvironmentAccountConnection
-> UpdateEnvironmentAccountConnectionResponse
newUpdateEnvironmentAccountConnectionResponse
  Int
pHttpStatus_
  EnvironmentAccountConnection
pEnvironmentAccountConnection_ =
    UpdateEnvironmentAccountConnectionResponse'
      { $sel:httpStatus:UpdateEnvironmentAccountConnectionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:environmentAccountConnection:UpdateEnvironmentAccountConnectionResponse' :: EnvironmentAccountConnection
environmentAccountConnection =
          EnvironmentAccountConnection
pEnvironmentAccountConnection_
      }

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

-- | The environment account connection detail data that\'s returned by
-- Proton.
updateEnvironmentAccountConnectionResponse_environmentAccountConnection :: Lens.Lens' UpdateEnvironmentAccountConnectionResponse EnvironmentAccountConnection
updateEnvironmentAccountConnectionResponse_environmentAccountConnection :: Lens'
  UpdateEnvironmentAccountConnectionResponse
  EnvironmentAccountConnection
updateEnvironmentAccountConnectionResponse_environmentAccountConnection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEnvironmentAccountConnectionResponse' {EnvironmentAccountConnection
environmentAccountConnection :: EnvironmentAccountConnection
$sel:environmentAccountConnection:UpdateEnvironmentAccountConnectionResponse' :: UpdateEnvironmentAccountConnectionResponse
-> EnvironmentAccountConnection
environmentAccountConnection} -> EnvironmentAccountConnection
environmentAccountConnection) (\s :: UpdateEnvironmentAccountConnectionResponse
s@UpdateEnvironmentAccountConnectionResponse' {} EnvironmentAccountConnection
a -> UpdateEnvironmentAccountConnectionResponse
s {$sel:environmentAccountConnection:UpdateEnvironmentAccountConnectionResponse' :: EnvironmentAccountConnection
environmentAccountConnection = EnvironmentAccountConnection
a} :: UpdateEnvironmentAccountConnectionResponse)

instance
  Prelude.NFData
    UpdateEnvironmentAccountConnectionResponse
  where
  rnf :: UpdateEnvironmentAccountConnectionResponse -> ()
rnf UpdateEnvironmentAccountConnectionResponse' {Int
EnvironmentAccountConnection
environmentAccountConnection :: EnvironmentAccountConnection
httpStatus :: Int
$sel:environmentAccountConnection:UpdateEnvironmentAccountConnectionResponse' :: UpdateEnvironmentAccountConnectionResponse
-> EnvironmentAccountConnection
$sel:httpStatus:UpdateEnvironmentAccountConnectionResponse' :: UpdateEnvironmentAccountConnectionResponse -> 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 EnvironmentAccountConnection
environmentAccountConnection