{-# 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.CertificateManager.ImportCertificate
-- 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 a certificate into Certificate Manager (ACM) to use with
-- services that are integrated with ACM. Note that
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-services.html integrated services>
-- allow only certificate types and keys they support to be associated with
-- their resources. Further, their support differs depending on whether the
-- certificate is imported into IAM or into ACM. For more information, see
-- the documentation for each service. For more information about importing
-- certificates into ACM, see
-- <https://docs.aws.amazon.com/acm/latest/userguide/import-certificate.html Importing Certificates>
-- in the /Certificate Manager User Guide/.
--
-- ACM does not provide
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-renewal.html managed renewal>
-- for certificates that you import.
--
-- Note the following guidelines when importing third party certificates:
--
-- -   You must enter the private key that matches the certificate you are
--     importing.
--
-- -   The private key must be unencrypted. You cannot import a private key
--     that is protected by a password or a passphrase.
--
-- -   The private key must be no larger than 5 KB (5,120 bytes).
--
-- -   If the certificate you are importing is not self-signed, you must
--     enter its certificate chain.
--
-- -   If a certificate chain is included, the issuer must be the subject
--     of one of the certificates in the chain.
--
-- -   The certificate, private key, and certificate chain must be
--     PEM-encoded.
--
-- -   The current time must be between the @Not Before@ and @Not After@
--     certificate fields.
--
-- -   The @Issuer@ field must not be empty.
--
-- -   The OCSP authority URL, if present, must not exceed 1000 characters.
--
-- -   To import a new certificate, omit the @CertificateArn@ argument.
--     Include this argument only when you want to replace a previously
--     imported certificate.
--
-- -   When you import a certificate by using the CLI, you must specify the
--     certificate, the certificate chain, and the private key by their
--     file names preceded by @fileb:\/\/@. For example, you can specify a
--     certificate saved in the @C:\\temp@ folder as
--     @fileb:\/\/C:\\temp\\certificate_to_import.pem@. If you are making
--     an HTTP or HTTPS Query request, include these arguments as BLOBs.
--
-- -   When you import a certificate by using an SDK, you must specify the
--     certificate, the certificate chain, and the private key files in the
--     manner required by the programming language you\'re using.
--
-- -   The cryptographic algorithm of an imported certificate must match
--     the algorithm of the signing CA. For example, if the signing CA key
--     type is RSA, then the certificate key type must also be RSA.
--
-- This operation returns the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Name (ARN)>
-- of the imported certificate.
module Amazonka.CertificateManager.ImportCertificate
  ( -- * Creating a Request
    ImportCertificate (..),
    newImportCertificate,

    -- * Request Lenses
    importCertificate_certificateArn,
    importCertificate_certificateChain,
    importCertificate_tags,
    importCertificate_certificate,
    importCertificate_privateKey,

    -- * Destructuring the Response
    ImportCertificateResponse (..),
    newImportCertificateResponse,

    -- * Response Lenses
    importCertificateResponse_certificateArn,
    importCertificateResponse_httpStatus,
  )
where

import Amazonka.CertificateManager.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:/ 'newImportCertificate' smart constructor.
data ImportCertificate = ImportCertificate'
  { -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Name (ARN)>
    -- of an imported certificate to replace. To import a new certificate, omit
    -- this field.
    ImportCertificate -> Maybe Text
certificateArn :: Prelude.Maybe Prelude.Text,
    -- | The PEM encoded certificate chain.
    ImportCertificate -> Maybe Base64
certificateChain :: Prelude.Maybe Data.Base64,
    -- | One or more resource tags to associate with the imported certificate.
    --
    -- Note: You cannot apply tags when reimporting a certificate.
    ImportCertificate -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The certificate to import.
    ImportCertificate -> Base64
certificate :: Data.Base64,
    -- | The private key that matches the public key in the certificate.
    ImportCertificate -> Sensitive Base64
privateKey :: Data.Sensitive Data.Base64
  }
  deriving (ImportCertificate -> ImportCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportCertificate -> ImportCertificate -> Bool
$c/= :: ImportCertificate -> ImportCertificate -> Bool
== :: ImportCertificate -> ImportCertificate -> Bool
$c== :: ImportCertificate -> ImportCertificate -> Bool
Prelude.Eq, Int -> ImportCertificate -> ShowS
[ImportCertificate] -> ShowS
ImportCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportCertificate] -> ShowS
$cshowList :: [ImportCertificate] -> ShowS
show :: ImportCertificate -> String
$cshow :: ImportCertificate -> String
showsPrec :: Int -> ImportCertificate -> ShowS
$cshowsPrec :: Int -> ImportCertificate -> ShowS
Prelude.Show, forall x. Rep ImportCertificate x -> ImportCertificate
forall x. ImportCertificate -> Rep ImportCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportCertificate x -> ImportCertificate
$cfrom :: forall x. ImportCertificate -> Rep ImportCertificate x
Prelude.Generic)

-- |
-- Create a value of 'ImportCertificate' 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:
--
-- 'certificateArn', 'importCertificate_certificateArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Name (ARN)>
-- of an imported certificate to replace. To import a new certificate, omit
-- this field.
--
-- 'certificateChain', 'importCertificate_certificateChain' - The PEM encoded certificate chain.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'tags', 'importCertificate_tags' - One or more resource tags to associate with the imported certificate.
--
-- Note: You cannot apply tags when reimporting a certificate.
--
-- 'certificate', 'importCertificate_certificate' - The certificate to import.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'privateKey', 'importCertificate_privateKey' - The private key that matches the public key in the certificate.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
newImportCertificate ::
  -- | 'certificate'
  Prelude.ByteString ->
  -- | 'privateKey'
  Prelude.ByteString ->
  ImportCertificate
newImportCertificate :: ByteString -> ByteString -> ImportCertificate
newImportCertificate ByteString
pCertificate_ ByteString
pPrivateKey_ =
  ImportCertificate'
    { $sel:certificateArn:ImportCertificate' :: Maybe Text
certificateArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:certificateChain:ImportCertificate' :: Maybe Base64
certificateChain = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportCertificate' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:certificate:ImportCertificate' :: Base64
certificate = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pCertificate_,
      $sel:privateKey:ImportCertificate' :: Sensitive Base64
privateKey =
        forall a. Iso' (Sensitive a) a
Data._Sensitive
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64
          forall t b. AReview t b -> b -> t
Lens.# ByteString
pPrivateKey_
    }

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Name (ARN)>
-- of an imported certificate to replace. To import a new certificate, omit
-- this field.
importCertificate_certificateArn :: Lens.Lens' ImportCertificate (Prelude.Maybe Prelude.Text)
importCertificate_certificateArn :: Lens' ImportCertificate (Maybe Text)
importCertificate_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe Text
certificateArn :: Maybe Text
$sel:certificateArn:ImportCertificate' :: ImportCertificate -> Maybe Text
certificateArn} -> Maybe Text
certificateArn) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe Text
a -> ImportCertificate
s {$sel:certificateArn:ImportCertificate' :: Maybe Text
certificateArn = Maybe Text
a} :: ImportCertificate)

-- | The PEM encoded certificate chain.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
importCertificate_certificateChain :: Lens.Lens' ImportCertificate (Prelude.Maybe Prelude.ByteString)
importCertificate_certificateChain :: Lens' ImportCertificate (Maybe ByteString)
importCertificate_certificateChain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe Base64
certificateChain :: Maybe Base64
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe Base64
certificateChain} -> Maybe Base64
certificateChain) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe Base64
a -> ImportCertificate
s {$sel:certificateChain:ImportCertificate' :: Maybe Base64
certificateChain = Maybe Base64
a} :: ImportCertificate) 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 Iso' Base64 ByteString
Data._Base64

-- | One or more resource tags to associate with the imported certificate.
--
-- Note: You cannot apply tags when reimporting a certificate.
importCertificate_tags :: Lens.Lens' ImportCertificate (Prelude.Maybe (Prelude.NonEmpty Tag))
importCertificate_tags :: Lens' ImportCertificate (Maybe (NonEmpty Tag))
importCertificate_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:ImportCertificate' :: ImportCertificate -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe (NonEmpty Tag)
a -> ImportCertificate
s {$sel:tags:ImportCertificate' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: ImportCertificate) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The certificate to import.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
importCertificate_certificate :: Lens.Lens' ImportCertificate Prelude.ByteString
importCertificate_certificate :: Lens' ImportCertificate ByteString
importCertificate_certificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Base64
certificate :: Base64
$sel:certificate:ImportCertificate' :: ImportCertificate -> Base64
certificate} -> Base64
certificate) (\s :: ImportCertificate
s@ImportCertificate' {} Base64
a -> ImportCertificate
s {$sel:certificate:ImportCertificate' :: Base64
certificate = Base64
a} :: ImportCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The private key that matches the public key in the certificate.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
importCertificate_privateKey :: Lens.Lens' ImportCertificate Prelude.ByteString
importCertificate_privateKey :: Lens' ImportCertificate ByteString
importCertificate_privateKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Sensitive Base64
privateKey :: Sensitive Base64
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Sensitive Base64
privateKey} -> Sensitive Base64
privateKey) (\s :: ImportCertificate
s@ImportCertificate' {} Sensitive Base64
a -> ImportCertificate
s {$sel:privateKey:ImportCertificate' :: Sensitive Base64
privateKey = Sensitive Base64
a} :: ImportCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

instance Core.AWSRequest ImportCertificate where
  type
    AWSResponse ImportCertificate =
      ImportCertificateResponse
  request :: (Service -> Service)
-> ImportCertificate -> Request ImportCertificate
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 ImportCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportCertificate)))
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 -> ImportCertificateResponse
ImportCertificateResponse'
            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
"CertificateArn")
            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 ImportCertificate where
  hashWithSalt :: Int -> ImportCertificate -> Int
hashWithSalt Int
_salt ImportCertificate' {Maybe (NonEmpty Tag)
Maybe Text
Maybe Base64
Base64
Sensitive Base64
privateKey :: Sensitive Base64
certificate :: Base64
tags :: Maybe (NonEmpty Tag)
certificateChain :: Maybe Base64
certificateArn :: Maybe Text
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Sensitive Base64
$sel:certificate:ImportCertificate' :: ImportCertificate -> Base64
$sel:tags:ImportCertificate' :: ImportCertificate -> Maybe (NonEmpty Tag)
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe Base64
$sel:certificateArn:ImportCertificate' :: ImportCertificate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
certificateChain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
certificate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Base64
privateKey

instance Prelude.NFData ImportCertificate where
  rnf :: ImportCertificate -> ()
rnf ImportCertificate' {Maybe (NonEmpty Tag)
Maybe Text
Maybe Base64
Base64
Sensitive Base64
privateKey :: Sensitive Base64
certificate :: Base64
tags :: Maybe (NonEmpty Tag)
certificateChain :: Maybe Base64
certificateArn :: Maybe Text
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Sensitive Base64
$sel:certificate:ImportCertificate' :: ImportCertificate -> Base64
$sel:tags:ImportCertificate' :: ImportCertificate -> Maybe (NonEmpty Tag)
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe Base64
$sel:certificateArn:ImportCertificate' :: ImportCertificate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
certificateChain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
certificate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Base64
privateKey

instance Data.ToHeaders ImportCertificate where
  toHeaders :: ImportCertificate -> 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
"CertificateManager.ImportCertificate" ::
                          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 ImportCertificate where
  toJSON :: ImportCertificate -> Value
toJSON ImportCertificate' {Maybe (NonEmpty Tag)
Maybe Text
Maybe Base64
Base64
Sensitive Base64
privateKey :: Sensitive Base64
certificate :: Base64
tags :: Maybe (NonEmpty Tag)
certificateChain :: Maybe Base64
certificateArn :: Maybe Text
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Sensitive Base64
$sel:certificate:ImportCertificate' :: ImportCertificate -> Base64
$sel:tags:ImportCertificate' :: ImportCertificate -> Maybe (NonEmpty Tag)
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe Base64
$sel:certificateArn:ImportCertificate' :: ImportCertificate -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CertificateArn" 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
certificateArn,
            (Key
"CertificateChain" 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 Base64
certificateChain,
            (Key
"Tags" 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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Certificate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
certificate),
            forall a. a -> Maybe a
Prelude.Just (Key
"PrivateKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Base64
privateKey)
          ]
      )

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

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

-- | /See:/ 'newImportCertificateResponse' smart constructor.
data ImportCertificateResponse = ImportCertificateResponse'
  { -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Name (ARN)>
    -- of the imported certificate.
    ImportCertificateResponse -> Maybe Text
certificateArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ImportCertificateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportCertificateResponse -> ImportCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportCertificateResponse -> ImportCertificateResponse -> Bool
$c/= :: ImportCertificateResponse -> ImportCertificateResponse -> Bool
== :: ImportCertificateResponse -> ImportCertificateResponse -> Bool
$c== :: ImportCertificateResponse -> ImportCertificateResponse -> Bool
Prelude.Eq, ReadPrec [ImportCertificateResponse]
ReadPrec ImportCertificateResponse
Int -> ReadS ImportCertificateResponse
ReadS [ImportCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportCertificateResponse]
$creadListPrec :: ReadPrec [ImportCertificateResponse]
readPrec :: ReadPrec ImportCertificateResponse
$creadPrec :: ReadPrec ImportCertificateResponse
readList :: ReadS [ImportCertificateResponse]
$creadList :: ReadS [ImportCertificateResponse]
readsPrec :: Int -> ReadS ImportCertificateResponse
$creadsPrec :: Int -> ReadS ImportCertificateResponse
Prelude.Read, Int -> ImportCertificateResponse -> ShowS
[ImportCertificateResponse] -> ShowS
ImportCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportCertificateResponse] -> ShowS
$cshowList :: [ImportCertificateResponse] -> ShowS
show :: ImportCertificateResponse -> String
$cshow :: ImportCertificateResponse -> String
showsPrec :: Int -> ImportCertificateResponse -> ShowS
$cshowsPrec :: Int -> ImportCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep ImportCertificateResponse x -> ImportCertificateResponse
forall x.
ImportCertificateResponse -> Rep ImportCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ImportCertificateResponse x -> ImportCertificateResponse
$cfrom :: forall x.
ImportCertificateResponse -> Rep ImportCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportCertificateResponse' 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:
--
-- 'certificateArn', 'importCertificateResponse_certificateArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Name (ARN)>
-- of the imported certificate.
--
-- 'httpStatus', 'importCertificateResponse_httpStatus' - The response's http status code.
newImportCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportCertificateResponse
newImportCertificateResponse :: Int -> ImportCertificateResponse
newImportCertificateResponse Int
pHttpStatus_ =
  ImportCertificateResponse'
    { $sel:certificateArn:ImportCertificateResponse' :: Maybe Text
certificateArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportCertificateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Name (ARN)>
-- of the imported certificate.
importCertificateResponse_certificateArn :: Lens.Lens' ImportCertificateResponse (Prelude.Maybe Prelude.Text)
importCertificateResponse_certificateArn :: Lens' ImportCertificateResponse (Maybe Text)
importCertificateResponse_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificateResponse' {Maybe Text
certificateArn :: Maybe Text
$sel:certificateArn:ImportCertificateResponse' :: ImportCertificateResponse -> Maybe Text
certificateArn} -> Maybe Text
certificateArn) (\s :: ImportCertificateResponse
s@ImportCertificateResponse' {} Maybe Text
a -> ImportCertificateResponse
s {$sel:certificateArn:ImportCertificateResponse' :: Maybe Text
certificateArn = Maybe Text
a} :: ImportCertificateResponse)

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

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