{-# 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.Transfer.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 the signing and encryption certificates that you need to create
-- local (AS2) profiles and partner profiles.
module Amazonka.Transfer.ImportCertificate
  ( -- * Creating a Request
    ImportCertificate (..),
    newImportCertificate,

    -- * Request Lenses
    importCertificate_activeDate,
    importCertificate_certificateChain,
    importCertificate_description,
    importCertificate_inactiveDate,
    importCertificate_privateKey,
    importCertificate_tags,
    importCertificate_usage,
    importCertificate_certificate,

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

    -- * Response Lenses
    importCertificateResponse_httpStatus,
    importCertificateResponse_certificateId,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Transfer.Types

-- | /See:/ 'newImportCertificate' smart constructor.
data ImportCertificate = ImportCertificate'
  { -- | An optional date that specifies when the certificate becomes active.
    ImportCertificate -> Maybe POSIX
activeDate :: Prelude.Maybe Data.POSIX,
    -- | An optional list of certificates that make up the chain for the
    -- certificate that\'s being imported.
    ImportCertificate -> Maybe (Sensitive Text)
certificateChain :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A short description that helps identify the certificate.
    ImportCertificate -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An optional date that specifies when the certificate becomes inactive.
    ImportCertificate -> Maybe POSIX
inactiveDate :: Prelude.Maybe Data.POSIX,
    -- | The file that contains the private key for the certificate that\'s being
    -- imported.
    ImportCertificate -> Maybe (Sensitive Text)
privateKey :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Key-value pairs that can be used to group and search for certificates.
    ImportCertificate -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | Specifies whether this certificate is used for signing or encryption.
    ImportCertificate -> CertificateUsageType
usage :: CertificateUsageType,
    -- | The file that contains the certificate to import.
    ImportCertificate -> Sensitive Text
certificate :: Data.Sensitive Prelude.Text
  }
  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:
--
-- 'activeDate', 'importCertificate_activeDate' - An optional date that specifies when the certificate becomes active.
--
-- 'certificateChain', 'importCertificate_certificateChain' - An optional list of certificates that make up the chain for the
-- certificate that\'s being imported.
--
-- 'description', 'importCertificate_description' - A short description that helps identify the certificate.
--
-- 'inactiveDate', 'importCertificate_inactiveDate' - An optional date that specifies when the certificate becomes inactive.
--
-- 'privateKey', 'importCertificate_privateKey' - The file that contains the private key for the certificate that\'s being
-- imported.
--
-- 'tags', 'importCertificate_tags' - Key-value pairs that can be used to group and search for certificates.
--
-- 'usage', 'importCertificate_usage' - Specifies whether this certificate is used for signing or encryption.
--
-- 'certificate', 'importCertificate_certificate' - The file that contains the certificate to import.
newImportCertificate ::
  -- | 'usage'
  CertificateUsageType ->
  -- | 'certificate'
  Prelude.Text ->
  ImportCertificate
newImportCertificate :: CertificateUsageType -> Text -> ImportCertificate
newImportCertificate CertificateUsageType
pUsage_ Text
pCertificate_ =
  ImportCertificate'
    { $sel:activeDate:ImportCertificate' :: Maybe POSIX
activeDate = forall a. Maybe a
Prelude.Nothing,
      $sel:certificateChain:ImportCertificate' :: Maybe (Sensitive Text)
certificateChain = forall a. Maybe a
Prelude.Nothing,
      $sel:description:ImportCertificate' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:inactiveDate:ImportCertificate' :: Maybe POSIX
inactiveDate = forall a. Maybe a
Prelude.Nothing,
      $sel:privateKey:ImportCertificate' :: Maybe (Sensitive Text)
privateKey = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportCertificate' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:usage:ImportCertificate' :: CertificateUsageType
usage = CertificateUsageType
pUsage_,
      $sel:certificate:ImportCertificate' :: Sensitive Text
certificate = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pCertificate_
    }

-- | An optional date that specifies when the certificate becomes active.
importCertificate_activeDate :: Lens.Lens' ImportCertificate (Prelude.Maybe Prelude.UTCTime)
importCertificate_activeDate :: Lens' ImportCertificate (Maybe UTCTime)
importCertificate_activeDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe POSIX
activeDate :: Maybe POSIX
$sel:activeDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
activeDate} -> Maybe POSIX
activeDate) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe POSIX
a -> ImportCertificate
s {$sel:activeDate:ImportCertificate' :: Maybe POSIX
activeDate = Maybe POSIX
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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | An optional list of certificates that make up the chain for the
-- certificate that\'s being imported.
importCertificate_certificateChain :: Lens.Lens' ImportCertificate (Prelude.Maybe Prelude.Text)
importCertificate_certificateChain :: Lens' ImportCertificate (Maybe Text)
importCertificate_certificateChain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe (Sensitive Text)
certificateChain :: Maybe (Sensitive Text)
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
certificateChain} -> Maybe (Sensitive Text)
certificateChain) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe (Sensitive Text)
a -> ImportCertificate
s {$sel:certificateChain:ImportCertificate' :: Maybe (Sensitive Text)
certificateChain = Maybe (Sensitive Text)
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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | A short description that helps identify the certificate.
importCertificate_description :: Lens.Lens' ImportCertificate (Prelude.Maybe Prelude.Text)
importCertificate_description :: Lens' ImportCertificate (Maybe Text)
importCertificate_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe Text
description :: Maybe Text
$sel:description:ImportCertificate' :: ImportCertificate -> Maybe Text
description} -> Maybe Text
description) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe Text
a -> ImportCertificate
s {$sel:description:ImportCertificate' :: Maybe Text
description = Maybe Text
a} :: ImportCertificate)

-- | An optional date that specifies when the certificate becomes inactive.
importCertificate_inactiveDate :: Lens.Lens' ImportCertificate (Prelude.Maybe Prelude.UTCTime)
importCertificate_inactiveDate :: Lens' ImportCertificate (Maybe UTCTime)
importCertificate_inactiveDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe POSIX
inactiveDate :: Maybe POSIX
$sel:inactiveDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
inactiveDate} -> Maybe POSIX
inactiveDate) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe POSIX
a -> ImportCertificate
s {$sel:inactiveDate:ImportCertificate' :: Maybe POSIX
inactiveDate = Maybe POSIX
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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The file that contains the private key for the certificate that\'s being
-- imported.
importCertificate_privateKey :: Lens.Lens' ImportCertificate (Prelude.Maybe Prelude.Text)
importCertificate_privateKey :: Lens' ImportCertificate (Maybe Text)
importCertificate_privateKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Maybe (Sensitive Text)
privateKey :: Maybe (Sensitive Text)
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
privateKey} -> Maybe (Sensitive Text)
privateKey) (\s :: ImportCertificate
s@ImportCertificate' {} Maybe (Sensitive Text)
a -> ImportCertificate
s {$sel:privateKey:ImportCertificate' :: Maybe (Sensitive Text)
privateKey = Maybe (Sensitive Text)
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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | Key-value pairs that can be used to group and search for certificates.
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

-- | Specifies whether this certificate is used for signing or encryption.
importCertificate_usage :: Lens.Lens' ImportCertificate CertificateUsageType
importCertificate_usage :: Lens' ImportCertificate CertificateUsageType
importCertificate_usage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {CertificateUsageType
usage :: CertificateUsageType
$sel:usage:ImportCertificate' :: ImportCertificate -> CertificateUsageType
usage} -> CertificateUsageType
usage) (\s :: ImportCertificate
s@ImportCertificate' {} CertificateUsageType
a -> ImportCertificate
s {$sel:usage:ImportCertificate' :: CertificateUsageType
usage = CertificateUsageType
a} :: ImportCertificate)

-- | The file that contains the certificate to import.
importCertificate_certificate :: Lens.Lens' ImportCertificate Prelude.Text
importCertificate_certificate :: Lens' ImportCertificate Text
importCertificate_certificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificate' {Sensitive Text
certificate :: Sensitive Text
$sel:certificate:ImportCertificate' :: ImportCertificate -> Sensitive Text
certificate} -> Sensitive Text
certificate) (\s :: ImportCertificate
s@ImportCertificate' {} Sensitive Text
a -> ImportCertificate
s {$sel:certificate:ImportCertificate' :: Sensitive Text
certificate = Sensitive Text
a} :: ImportCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

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 ->
          Int -> Text -> ImportCertificateResponse
ImportCertificateResponse'
            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
"CertificateId")
      )

instance Prelude.Hashable ImportCertificate where
  hashWithSalt :: Int -> ImportCertificate -> Int
hashWithSalt Int
_salt ImportCertificate' {Maybe (NonEmpty Tag)
Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Sensitive Text
CertificateUsageType
certificate :: Sensitive Text
usage :: CertificateUsageType
tags :: Maybe (NonEmpty Tag)
privateKey :: Maybe (Sensitive Text)
inactiveDate :: Maybe POSIX
description :: Maybe Text
certificateChain :: Maybe (Sensitive Text)
activeDate :: Maybe POSIX
$sel:certificate:ImportCertificate' :: ImportCertificate -> Sensitive Text
$sel:usage:ImportCertificate' :: ImportCertificate -> CertificateUsageType
$sel:tags:ImportCertificate' :: ImportCertificate -> Maybe (NonEmpty Tag)
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
$sel:inactiveDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
$sel:description:ImportCertificate' :: ImportCertificate -> Maybe Text
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
$sel:activeDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
activeDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
certificateChain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
inactiveDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
privateKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CertificateUsageType
usage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
certificate

instance Prelude.NFData ImportCertificate where
  rnf :: ImportCertificate -> ()
rnf ImportCertificate' {Maybe (NonEmpty Tag)
Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Sensitive Text
CertificateUsageType
certificate :: Sensitive Text
usage :: CertificateUsageType
tags :: Maybe (NonEmpty Tag)
privateKey :: Maybe (Sensitive Text)
inactiveDate :: Maybe POSIX
description :: Maybe Text
certificateChain :: Maybe (Sensitive Text)
activeDate :: Maybe POSIX
$sel:certificate:ImportCertificate' :: ImportCertificate -> Sensitive Text
$sel:usage:ImportCertificate' :: ImportCertificate -> CertificateUsageType
$sel:tags:ImportCertificate' :: ImportCertificate -> Maybe (NonEmpty Tag)
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
$sel:inactiveDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
$sel:description:ImportCertificate' :: ImportCertificate -> Maybe Text
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
$sel:activeDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
activeDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
certificateChain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
inactiveDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
privateKey
      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 CertificateUsageType
usage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
certificate

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
"TransferService.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 (Sensitive Text)
Maybe POSIX
Sensitive Text
CertificateUsageType
certificate :: Sensitive Text
usage :: CertificateUsageType
tags :: Maybe (NonEmpty Tag)
privateKey :: Maybe (Sensitive Text)
inactiveDate :: Maybe POSIX
description :: Maybe Text
certificateChain :: Maybe (Sensitive Text)
activeDate :: Maybe POSIX
$sel:certificate:ImportCertificate' :: ImportCertificate -> Sensitive Text
$sel:usage:ImportCertificate' :: ImportCertificate -> CertificateUsageType
$sel:tags:ImportCertificate' :: ImportCertificate -> Maybe (NonEmpty Tag)
$sel:privateKey:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
$sel:inactiveDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
$sel:description:ImportCertificate' :: ImportCertificate -> Maybe Text
$sel:certificateChain:ImportCertificate' :: ImportCertificate -> Maybe (Sensitive Text)
$sel:activeDate:ImportCertificate' :: ImportCertificate -> Maybe POSIX
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ActiveDate" 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 POSIX
activeDate,
            (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 (Sensitive Text)
certificateChain,
            (Key
"Description" 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
description,
            (Key
"InactiveDate" 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 POSIX
inactiveDate,
            (Key
"PrivateKey" 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)
privateKey,
            (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
"Usage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CertificateUsageType
usage),
            forall a. a -> Maybe a
Prelude.Just (Key
"Certificate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
certificate)
          ]
      )

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 response's http status code.
    ImportCertificateResponse -> Int
httpStatus :: Prelude.Int,
    -- | An array of identifiers for the imported certificates. You use this
    -- identifier for working with profiles and partner profiles.
    ImportCertificateResponse -> Text
certificateId :: Prelude.Text
  }
  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:
--
-- 'httpStatus', 'importCertificateResponse_httpStatus' - The response's http status code.
--
-- 'certificateId', 'importCertificateResponse_certificateId' - An array of identifiers for the imported certificates. You use this
-- identifier for working with profiles and partner profiles.
newImportCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'certificateId'
  Prelude.Text ->
  ImportCertificateResponse
newImportCertificateResponse :: Int -> Text -> ImportCertificateResponse
newImportCertificateResponse
  Int
pHttpStatus_
  Text
pCertificateId_ =
    ImportCertificateResponse'
      { $sel:httpStatus:ImportCertificateResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:certificateId:ImportCertificateResponse' :: Text
certificateId = Text
pCertificateId_
      }

-- | 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)

-- | An array of identifiers for the imported certificates. You use this
-- identifier for working with profiles and partner profiles.
importCertificateResponse_certificateId :: Lens.Lens' ImportCertificateResponse Prelude.Text
importCertificateResponse_certificateId :: Lens' ImportCertificateResponse Text
importCertificateResponse_certificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportCertificateResponse' {Text
certificateId :: Text
$sel:certificateId:ImportCertificateResponse' :: ImportCertificateResponse -> Text
certificateId} -> Text
certificateId) (\s :: ImportCertificateResponse
s@ImportCertificateResponse' {} Text
a -> ImportCertificateResponse
s {$sel:certificateId:ImportCertificateResponse' :: Text
certificateId = Text
a} :: ImportCertificateResponse)

instance Prelude.NFData ImportCertificateResponse where
  rnf :: ImportCertificateResponse -> ()
rnf ImportCertificateResponse' {Int
Text
certificateId :: Text
httpStatus :: Int
$sel:certificateId:ImportCertificateResponse' :: ImportCertificateResponse -> Text
$sel:httpStatus:ImportCertificateResponse' :: ImportCertificateResponse -> 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 Text
certificateId