{-# 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.CodeBuild.ImportSourceCredentials
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports the source repository credentials for an CodeBuild project that
-- has its source code stored in a GitHub, GitHub Enterprise, or Bitbucket
-- repository.
module Amazonka.CodeBuild.ImportSourceCredentials
  ( -- * Creating a Request
    ImportSourceCredentials (..),
    newImportSourceCredentials,

    -- * Request Lenses
    importSourceCredentials_shouldOverwrite,
    importSourceCredentials_username,
    importSourceCredentials_token,
    importSourceCredentials_serverType,
    importSourceCredentials_authType,

    -- * Destructuring the Response
    ImportSourceCredentialsResponse (..),
    newImportSourceCredentialsResponse,

    -- * Response Lenses
    importSourceCredentialsResponse_arn,
    importSourceCredentialsResponse_httpStatus,
  )
where

import Amazonka.CodeBuild.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:/ 'newImportSourceCredentials' smart constructor.
data ImportSourceCredentials = ImportSourceCredentials'
  { -- | Set to @false@ to prevent overwriting the repository source credentials.
    -- Set to @true@ to overwrite the repository source credentials. The
    -- default value is @true@.
    ImportSourceCredentials -> Maybe Bool
shouldOverwrite :: Prelude.Maybe Prelude.Bool,
    -- | The Bitbucket username when the @authType@ is BASIC_AUTH. This parameter
    -- is not valid for other types of source providers or connections.
    ImportSourceCredentials -> Maybe Text
username :: Prelude.Maybe Prelude.Text,
    -- | For GitHub or GitHub Enterprise, this is the personal access token. For
    -- Bitbucket, this is the app password.
    ImportSourceCredentials -> Sensitive Text
token :: Data.Sensitive Prelude.Text,
    -- | The source provider used for this project.
    ImportSourceCredentials -> ServerType
serverType :: ServerType,
    -- | The type of authentication used to connect to a GitHub, GitHub
    -- Enterprise, or Bitbucket repository. An OAUTH connection is not
    -- supported by the API and must be created using the CodeBuild console.
    ImportSourceCredentials -> AuthType
authType :: AuthType
  }
  deriving (ImportSourceCredentials -> ImportSourceCredentials -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSourceCredentials -> ImportSourceCredentials -> Bool
$c/= :: ImportSourceCredentials -> ImportSourceCredentials -> Bool
== :: ImportSourceCredentials -> ImportSourceCredentials -> Bool
$c== :: ImportSourceCredentials -> ImportSourceCredentials -> Bool
Prelude.Eq, Int -> ImportSourceCredentials -> ShowS
[ImportSourceCredentials] -> ShowS
ImportSourceCredentials -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportSourceCredentials] -> ShowS
$cshowList :: [ImportSourceCredentials] -> ShowS
show :: ImportSourceCredentials -> String
$cshow :: ImportSourceCredentials -> String
showsPrec :: Int -> ImportSourceCredentials -> ShowS
$cshowsPrec :: Int -> ImportSourceCredentials -> ShowS
Prelude.Show, forall x. Rep ImportSourceCredentials x -> ImportSourceCredentials
forall x. ImportSourceCredentials -> Rep ImportSourceCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportSourceCredentials x -> ImportSourceCredentials
$cfrom :: forall x. ImportSourceCredentials -> Rep ImportSourceCredentials x
Prelude.Generic)

-- |
-- Create a value of 'ImportSourceCredentials' 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:
--
-- 'shouldOverwrite', 'importSourceCredentials_shouldOverwrite' - Set to @false@ to prevent overwriting the repository source credentials.
-- Set to @true@ to overwrite the repository source credentials. The
-- default value is @true@.
--
-- 'username', 'importSourceCredentials_username' - The Bitbucket username when the @authType@ is BASIC_AUTH. This parameter
-- is not valid for other types of source providers or connections.
--
-- 'token', 'importSourceCredentials_token' - For GitHub or GitHub Enterprise, this is the personal access token. For
-- Bitbucket, this is the app password.
--
-- 'serverType', 'importSourceCredentials_serverType' - The source provider used for this project.
--
-- 'authType', 'importSourceCredentials_authType' - The type of authentication used to connect to a GitHub, GitHub
-- Enterprise, or Bitbucket repository. An OAUTH connection is not
-- supported by the API and must be created using the CodeBuild console.
newImportSourceCredentials ::
  -- | 'token'
  Prelude.Text ->
  -- | 'serverType'
  ServerType ->
  -- | 'authType'
  AuthType ->
  ImportSourceCredentials
newImportSourceCredentials :: Text -> ServerType -> AuthType -> ImportSourceCredentials
newImportSourceCredentials
  Text
pToken_
  ServerType
pServerType_
  AuthType
pAuthType_ =
    ImportSourceCredentials'
      { $sel:shouldOverwrite:ImportSourceCredentials' :: Maybe Bool
shouldOverwrite =
          forall a. Maybe a
Prelude.Nothing,
        $sel:username:ImportSourceCredentials' :: Maybe Text
username = forall a. Maybe a
Prelude.Nothing,
        $sel:token:ImportSourceCredentials' :: Sensitive Text
token = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pToken_,
        $sel:serverType:ImportSourceCredentials' :: ServerType
serverType = ServerType
pServerType_,
        $sel:authType:ImportSourceCredentials' :: AuthType
authType = AuthType
pAuthType_
      }

-- | Set to @false@ to prevent overwriting the repository source credentials.
-- Set to @true@ to overwrite the repository source credentials. The
-- default value is @true@.
importSourceCredentials_shouldOverwrite :: Lens.Lens' ImportSourceCredentials (Prelude.Maybe Prelude.Bool)
importSourceCredentials_shouldOverwrite :: Lens' ImportSourceCredentials (Maybe Bool)
importSourceCredentials_shouldOverwrite = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSourceCredentials' {Maybe Bool
shouldOverwrite :: Maybe Bool
$sel:shouldOverwrite:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Bool
shouldOverwrite} -> Maybe Bool
shouldOverwrite) (\s :: ImportSourceCredentials
s@ImportSourceCredentials' {} Maybe Bool
a -> ImportSourceCredentials
s {$sel:shouldOverwrite:ImportSourceCredentials' :: Maybe Bool
shouldOverwrite = Maybe Bool
a} :: ImportSourceCredentials)

-- | The Bitbucket username when the @authType@ is BASIC_AUTH. This parameter
-- is not valid for other types of source providers or connections.
importSourceCredentials_username :: Lens.Lens' ImportSourceCredentials (Prelude.Maybe Prelude.Text)
importSourceCredentials_username :: Lens' ImportSourceCredentials (Maybe Text)
importSourceCredentials_username = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSourceCredentials' {Maybe Text
username :: Maybe Text
$sel:username:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Text
username} -> Maybe Text
username) (\s :: ImportSourceCredentials
s@ImportSourceCredentials' {} Maybe Text
a -> ImportSourceCredentials
s {$sel:username:ImportSourceCredentials' :: Maybe Text
username = Maybe Text
a} :: ImportSourceCredentials)

-- | For GitHub or GitHub Enterprise, this is the personal access token. For
-- Bitbucket, this is the app password.
importSourceCredentials_token :: Lens.Lens' ImportSourceCredentials Prelude.Text
importSourceCredentials_token :: Lens' ImportSourceCredentials Text
importSourceCredentials_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSourceCredentials' {Sensitive Text
token :: Sensitive Text
$sel:token:ImportSourceCredentials' :: ImportSourceCredentials -> Sensitive Text
token} -> Sensitive Text
token) (\s :: ImportSourceCredentials
s@ImportSourceCredentials' {} Sensitive Text
a -> ImportSourceCredentials
s {$sel:token:ImportSourceCredentials' :: Sensitive Text
token = Sensitive Text
a} :: ImportSourceCredentials) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The source provider used for this project.
importSourceCredentials_serverType :: Lens.Lens' ImportSourceCredentials ServerType
importSourceCredentials_serverType :: Lens' ImportSourceCredentials ServerType
importSourceCredentials_serverType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSourceCredentials' {ServerType
serverType :: ServerType
$sel:serverType:ImportSourceCredentials' :: ImportSourceCredentials -> ServerType
serverType} -> ServerType
serverType) (\s :: ImportSourceCredentials
s@ImportSourceCredentials' {} ServerType
a -> ImportSourceCredentials
s {$sel:serverType:ImportSourceCredentials' :: ServerType
serverType = ServerType
a} :: ImportSourceCredentials)

-- | The type of authentication used to connect to a GitHub, GitHub
-- Enterprise, or Bitbucket repository. An OAUTH connection is not
-- supported by the API and must be created using the CodeBuild console.
importSourceCredentials_authType :: Lens.Lens' ImportSourceCredentials AuthType
importSourceCredentials_authType :: Lens' ImportSourceCredentials AuthType
importSourceCredentials_authType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSourceCredentials' {AuthType
authType :: AuthType
$sel:authType:ImportSourceCredentials' :: ImportSourceCredentials -> AuthType
authType} -> AuthType
authType) (\s :: ImportSourceCredentials
s@ImportSourceCredentials' {} AuthType
a -> ImportSourceCredentials
s {$sel:authType:ImportSourceCredentials' :: AuthType
authType = AuthType
a} :: ImportSourceCredentials)

instance Core.AWSRequest ImportSourceCredentials where
  type
    AWSResponse ImportSourceCredentials =
      ImportSourceCredentialsResponse
  request :: (Service -> Service)
-> ImportSourceCredentials -> Request ImportSourceCredentials
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 ImportSourceCredentials
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportSourceCredentials)))
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 ->
          Maybe Text -> Int -> ImportSourceCredentialsResponse
ImportSourceCredentialsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"arn")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable ImportSourceCredentials where
  hashWithSalt :: Int -> ImportSourceCredentials -> Int
hashWithSalt Int
_salt ImportSourceCredentials' {Maybe Bool
Maybe Text
Sensitive Text
AuthType
ServerType
authType :: AuthType
serverType :: ServerType
token :: Sensitive Text
username :: Maybe Text
shouldOverwrite :: Maybe Bool
$sel:authType:ImportSourceCredentials' :: ImportSourceCredentials -> AuthType
$sel:serverType:ImportSourceCredentials' :: ImportSourceCredentials -> ServerType
$sel:token:ImportSourceCredentials' :: ImportSourceCredentials -> Sensitive Text
$sel:username:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Text
$sel:shouldOverwrite:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
shouldOverwrite
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
username
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
token
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ServerType
serverType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AuthType
authType

instance Prelude.NFData ImportSourceCredentials where
  rnf :: ImportSourceCredentials -> ()
rnf ImportSourceCredentials' {Maybe Bool
Maybe Text
Sensitive Text
AuthType
ServerType
authType :: AuthType
serverType :: ServerType
token :: Sensitive Text
username :: Maybe Text
shouldOverwrite :: Maybe Bool
$sel:authType:ImportSourceCredentials' :: ImportSourceCredentials -> AuthType
$sel:serverType:ImportSourceCredentials' :: ImportSourceCredentials -> ServerType
$sel:token:ImportSourceCredentials' :: ImportSourceCredentials -> Sensitive Text
$sel:username:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Text
$sel:shouldOverwrite:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
shouldOverwrite
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
username
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
token
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ServerType
serverType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AuthType
authType

instance Data.ToHeaders ImportSourceCredentials where
  toHeaders :: ImportSourceCredentials -> 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
"CodeBuild_20161006.ImportSourceCredentials" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ImportSourceCredentials where
  toJSON :: ImportSourceCredentials -> Value
toJSON ImportSourceCredentials' {Maybe Bool
Maybe Text
Sensitive Text
AuthType
ServerType
authType :: AuthType
serverType :: ServerType
token :: Sensitive Text
username :: Maybe Text
shouldOverwrite :: Maybe Bool
$sel:authType:ImportSourceCredentials' :: ImportSourceCredentials -> AuthType
$sel:serverType:ImportSourceCredentials' :: ImportSourceCredentials -> ServerType
$sel:token:ImportSourceCredentials' :: ImportSourceCredentials -> Sensitive Text
$sel:username:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Text
$sel:shouldOverwrite:ImportSourceCredentials' :: ImportSourceCredentials -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"shouldOverwrite" 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 Bool
shouldOverwrite,
            (Key
"username" 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
username,
            forall a. a -> Maybe a
Prelude.Just (Key
"token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
token),
            forall a. a -> Maybe a
Prelude.Just (Key
"serverType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ServerType
serverType),
            forall a. a -> Maybe a
Prelude.Just (Key
"authType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AuthType
authType)
          ]
      )

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

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

-- | /See:/ 'newImportSourceCredentialsResponse' smart constructor.
data ImportSourceCredentialsResponse = ImportSourceCredentialsResponse'
  { -- | The Amazon Resource Name (ARN) of the token.
    ImportSourceCredentialsResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ImportSourceCredentialsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportSourceCredentialsResponse
-> ImportSourceCredentialsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSourceCredentialsResponse
-> ImportSourceCredentialsResponse -> Bool
$c/= :: ImportSourceCredentialsResponse
-> ImportSourceCredentialsResponse -> Bool
== :: ImportSourceCredentialsResponse
-> ImportSourceCredentialsResponse -> Bool
$c== :: ImportSourceCredentialsResponse
-> ImportSourceCredentialsResponse -> Bool
Prelude.Eq, ReadPrec [ImportSourceCredentialsResponse]
ReadPrec ImportSourceCredentialsResponse
Int -> ReadS ImportSourceCredentialsResponse
ReadS [ImportSourceCredentialsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportSourceCredentialsResponse]
$creadListPrec :: ReadPrec [ImportSourceCredentialsResponse]
readPrec :: ReadPrec ImportSourceCredentialsResponse
$creadPrec :: ReadPrec ImportSourceCredentialsResponse
readList :: ReadS [ImportSourceCredentialsResponse]
$creadList :: ReadS [ImportSourceCredentialsResponse]
readsPrec :: Int -> ReadS ImportSourceCredentialsResponse
$creadsPrec :: Int -> ReadS ImportSourceCredentialsResponse
Prelude.Read, Int -> ImportSourceCredentialsResponse -> ShowS
[ImportSourceCredentialsResponse] -> ShowS
ImportSourceCredentialsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportSourceCredentialsResponse] -> ShowS
$cshowList :: [ImportSourceCredentialsResponse] -> ShowS
show :: ImportSourceCredentialsResponse -> String
$cshow :: ImportSourceCredentialsResponse -> String
showsPrec :: Int -> ImportSourceCredentialsResponse -> ShowS
$cshowsPrec :: Int -> ImportSourceCredentialsResponse -> ShowS
Prelude.Show, forall x.
Rep ImportSourceCredentialsResponse x
-> ImportSourceCredentialsResponse
forall x.
ImportSourceCredentialsResponse
-> Rep ImportSourceCredentialsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ImportSourceCredentialsResponse x
-> ImportSourceCredentialsResponse
$cfrom :: forall x.
ImportSourceCredentialsResponse
-> Rep ImportSourceCredentialsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportSourceCredentialsResponse' 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:
--
-- 'arn', 'importSourceCredentialsResponse_arn' - The Amazon Resource Name (ARN) of the token.
--
-- 'httpStatus', 'importSourceCredentialsResponse_httpStatus' - The response's http status code.
newImportSourceCredentialsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportSourceCredentialsResponse
newImportSourceCredentialsResponse :: Int -> ImportSourceCredentialsResponse
newImportSourceCredentialsResponse Int
pHttpStatus_ =
  ImportSourceCredentialsResponse'
    { $sel:arn:ImportSourceCredentialsResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportSourceCredentialsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the token.
importSourceCredentialsResponse_arn :: Lens.Lens' ImportSourceCredentialsResponse (Prelude.Maybe Prelude.Text)
importSourceCredentialsResponse_arn :: Lens' ImportSourceCredentialsResponse (Maybe Text)
importSourceCredentialsResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSourceCredentialsResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:ImportSourceCredentialsResponse' :: ImportSourceCredentialsResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: ImportSourceCredentialsResponse
s@ImportSourceCredentialsResponse' {} Maybe Text
a -> ImportSourceCredentialsResponse
s {$sel:arn:ImportSourceCredentialsResponse' :: Maybe Text
arn = Maybe Text
a} :: ImportSourceCredentialsResponse)

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

instance
  Prelude.NFData
    ImportSourceCredentialsResponse
  where
  rnf :: ImportSourceCredentialsResponse -> ()
rnf ImportSourceCredentialsResponse' {Int
Maybe Text
httpStatus :: Int
arn :: Maybe Text
$sel:httpStatus:ImportSourceCredentialsResponse' :: ImportSourceCredentialsResponse -> Int
$sel:arn:ImportSourceCredentialsResponse' :: ImportSourceCredentialsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus