{-# 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.CertificateManagerPCA.CreateCertificateAuthorityAuditReport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an audit report that lists every time that your CA private key
-- is used. The report is saved in the Amazon S3 bucket that you specify on
-- input. The
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_IssueCertificate.html IssueCertificate>
-- and
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_RevokeCertificate.html RevokeCertificate>
-- actions use the private key.
--
-- Both Amazon Web Services Private CA and the IAM principal must have
-- permission to write to the S3 bucket that you specify. If the IAM
-- principal making the call does not have permission to write to the
-- bucket, then an exception is thrown. For more information, see
-- <https://docs.aws.amazon.com/privateca/latest/userguide/crl-planning.html#s3-policies Access policies for CRLs in Amazon S3>.
--
-- Amazon Web Services Private CA assets that are stored in Amazon S3 can
-- be protected with encryption. For more information, see
-- <https://docs.aws.amazon.com/privateca/latest/userguide/PcaAuditReport.html#audit-report-encryption Encrypting Your Audit Reports>.
--
-- You can generate a maximum of one report every 30 minutes.
module Amazonka.CertificateManagerPCA.CreateCertificateAuthorityAuditReport
  ( -- * Creating a Request
    CreateCertificateAuthorityAuditReport (..),
    newCreateCertificateAuthorityAuditReport,

    -- * Request Lenses
    createCertificateAuthorityAuditReport_certificateAuthorityArn,
    createCertificateAuthorityAuditReport_s3BucketName,
    createCertificateAuthorityAuditReport_auditReportResponseFormat,

    -- * Destructuring the Response
    CreateCertificateAuthorityAuditReportResponse (..),
    newCreateCertificateAuthorityAuditReportResponse,

    -- * Response Lenses
    createCertificateAuthorityAuditReportResponse_auditReportId,
    createCertificateAuthorityAuditReportResponse_s3Key,
    createCertificateAuthorityAuditReportResponse_httpStatus,
  )
where

import Amazonka.CertificateManagerPCA.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:/ 'newCreateCertificateAuthorityAuditReport' smart constructor.
data CreateCertificateAuthorityAuditReport = CreateCertificateAuthorityAuditReport'
  { -- | The Amazon Resource Name (ARN) of the CA to be audited. This is of the
    -- form:
    --
    -- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
    CreateCertificateAuthorityAuditReport -> Text
certificateAuthorityArn :: Prelude.Text,
    -- | The name of the S3 bucket that will contain the audit report.
    CreateCertificateAuthorityAuditReport -> Text
s3BucketName :: Prelude.Text,
    -- | The format in which to create the report. This can be either __JSON__ or
    -- __CSV__.
    CreateCertificateAuthorityAuditReport -> AuditReportResponseFormat
auditReportResponseFormat :: AuditReportResponseFormat
  }
  deriving (CreateCertificateAuthorityAuditReport
-> CreateCertificateAuthorityAuditReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCertificateAuthorityAuditReport
-> CreateCertificateAuthorityAuditReport -> Bool
$c/= :: CreateCertificateAuthorityAuditReport
-> CreateCertificateAuthorityAuditReport -> Bool
== :: CreateCertificateAuthorityAuditReport
-> CreateCertificateAuthorityAuditReport -> Bool
$c== :: CreateCertificateAuthorityAuditReport
-> CreateCertificateAuthorityAuditReport -> Bool
Prelude.Eq, ReadPrec [CreateCertificateAuthorityAuditReport]
ReadPrec CreateCertificateAuthorityAuditReport
Int -> ReadS CreateCertificateAuthorityAuditReport
ReadS [CreateCertificateAuthorityAuditReport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCertificateAuthorityAuditReport]
$creadListPrec :: ReadPrec [CreateCertificateAuthorityAuditReport]
readPrec :: ReadPrec CreateCertificateAuthorityAuditReport
$creadPrec :: ReadPrec CreateCertificateAuthorityAuditReport
readList :: ReadS [CreateCertificateAuthorityAuditReport]
$creadList :: ReadS [CreateCertificateAuthorityAuditReport]
readsPrec :: Int -> ReadS CreateCertificateAuthorityAuditReport
$creadsPrec :: Int -> ReadS CreateCertificateAuthorityAuditReport
Prelude.Read, Int -> CreateCertificateAuthorityAuditReport -> ShowS
[CreateCertificateAuthorityAuditReport] -> ShowS
CreateCertificateAuthorityAuditReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCertificateAuthorityAuditReport] -> ShowS
$cshowList :: [CreateCertificateAuthorityAuditReport] -> ShowS
show :: CreateCertificateAuthorityAuditReport -> String
$cshow :: CreateCertificateAuthorityAuditReport -> String
showsPrec :: Int -> CreateCertificateAuthorityAuditReport -> ShowS
$cshowsPrec :: Int -> CreateCertificateAuthorityAuditReport -> ShowS
Prelude.Show, forall x.
Rep CreateCertificateAuthorityAuditReport x
-> CreateCertificateAuthorityAuditReport
forall x.
CreateCertificateAuthorityAuditReport
-> Rep CreateCertificateAuthorityAuditReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCertificateAuthorityAuditReport x
-> CreateCertificateAuthorityAuditReport
$cfrom :: forall x.
CreateCertificateAuthorityAuditReport
-> Rep CreateCertificateAuthorityAuditReport x
Prelude.Generic)

-- |
-- Create a value of 'CreateCertificateAuthorityAuditReport' 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:
--
-- 'certificateAuthorityArn', 'createCertificateAuthorityAuditReport_certificateAuthorityArn' - The Amazon Resource Name (ARN) of the CA to be audited. This is of the
-- form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
--
-- 's3BucketName', 'createCertificateAuthorityAuditReport_s3BucketName' - The name of the S3 bucket that will contain the audit report.
--
-- 'auditReportResponseFormat', 'createCertificateAuthorityAuditReport_auditReportResponseFormat' - The format in which to create the report. This can be either __JSON__ or
-- __CSV__.
newCreateCertificateAuthorityAuditReport ::
  -- | 'certificateAuthorityArn'
  Prelude.Text ->
  -- | 's3BucketName'
  Prelude.Text ->
  -- | 'auditReportResponseFormat'
  AuditReportResponseFormat ->
  CreateCertificateAuthorityAuditReport
newCreateCertificateAuthorityAuditReport :: Text
-> Text
-> AuditReportResponseFormat
-> CreateCertificateAuthorityAuditReport
newCreateCertificateAuthorityAuditReport
  Text
pCertificateAuthorityArn_
  Text
pS3BucketName_
  AuditReportResponseFormat
pAuditReportResponseFormat_ =
    CreateCertificateAuthorityAuditReport'
      { $sel:certificateAuthorityArn:CreateCertificateAuthorityAuditReport' :: Text
certificateAuthorityArn =
          Text
pCertificateAuthorityArn_,
        $sel:s3BucketName:CreateCertificateAuthorityAuditReport' :: Text
s3BucketName = Text
pS3BucketName_,
        $sel:auditReportResponseFormat:CreateCertificateAuthorityAuditReport' :: AuditReportResponseFormat
auditReportResponseFormat =
          AuditReportResponseFormat
pAuditReportResponseFormat_
      }

-- | The Amazon Resource Name (ARN) of the CA to be audited. This is of the
-- form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
createCertificateAuthorityAuditReport_certificateAuthorityArn :: Lens.Lens' CreateCertificateAuthorityAuditReport Prelude.Text
createCertificateAuthorityAuditReport_certificateAuthorityArn :: Lens' CreateCertificateAuthorityAuditReport Text
createCertificateAuthorityAuditReport_certificateAuthorityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCertificateAuthorityAuditReport' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
certificateAuthorityArn} -> Text
certificateAuthorityArn) (\s :: CreateCertificateAuthorityAuditReport
s@CreateCertificateAuthorityAuditReport' {} Text
a -> CreateCertificateAuthorityAuditReport
s {$sel:certificateAuthorityArn:CreateCertificateAuthorityAuditReport' :: Text
certificateAuthorityArn = Text
a} :: CreateCertificateAuthorityAuditReport)

-- | The name of the S3 bucket that will contain the audit report.
createCertificateAuthorityAuditReport_s3BucketName :: Lens.Lens' CreateCertificateAuthorityAuditReport Prelude.Text
createCertificateAuthorityAuditReport_s3BucketName :: Lens' CreateCertificateAuthorityAuditReport Text
createCertificateAuthorityAuditReport_s3BucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCertificateAuthorityAuditReport' {Text
s3BucketName :: Text
$sel:s3BucketName:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
s3BucketName} -> Text
s3BucketName) (\s :: CreateCertificateAuthorityAuditReport
s@CreateCertificateAuthorityAuditReport' {} Text
a -> CreateCertificateAuthorityAuditReport
s {$sel:s3BucketName:CreateCertificateAuthorityAuditReport' :: Text
s3BucketName = Text
a} :: CreateCertificateAuthorityAuditReport)

-- | The format in which to create the report. This can be either __JSON__ or
-- __CSV__.
createCertificateAuthorityAuditReport_auditReportResponseFormat :: Lens.Lens' CreateCertificateAuthorityAuditReport AuditReportResponseFormat
createCertificateAuthorityAuditReport_auditReportResponseFormat :: Lens'
  CreateCertificateAuthorityAuditReport AuditReportResponseFormat
createCertificateAuthorityAuditReport_auditReportResponseFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCertificateAuthorityAuditReport' {AuditReportResponseFormat
auditReportResponseFormat :: AuditReportResponseFormat
$sel:auditReportResponseFormat:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> AuditReportResponseFormat
auditReportResponseFormat} -> AuditReportResponseFormat
auditReportResponseFormat) (\s :: CreateCertificateAuthorityAuditReport
s@CreateCertificateAuthorityAuditReport' {} AuditReportResponseFormat
a -> CreateCertificateAuthorityAuditReport
s {$sel:auditReportResponseFormat:CreateCertificateAuthorityAuditReport' :: AuditReportResponseFormat
auditReportResponseFormat = AuditReportResponseFormat
a} :: CreateCertificateAuthorityAuditReport)

instance
  Core.AWSRequest
    CreateCertificateAuthorityAuditReport
  where
  type
    AWSResponse
      CreateCertificateAuthorityAuditReport =
      CreateCertificateAuthorityAuditReportResponse
  request :: (Service -> Service)
-> CreateCertificateAuthorityAuditReport
-> Request CreateCertificateAuthorityAuditReport
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 CreateCertificateAuthorityAuditReport
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse CreateCertificateAuthorityAuditReport)))
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
-> Maybe Text
-> Int
-> CreateCertificateAuthorityAuditReportResponse
CreateCertificateAuthorityAuditReportResponse'
            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
"AuditReportId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"S3Key")
            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
    CreateCertificateAuthorityAuditReport
  where
  hashWithSalt :: Int -> CreateCertificateAuthorityAuditReport -> Int
hashWithSalt
    Int
_salt
    CreateCertificateAuthorityAuditReport' {Text
AuditReportResponseFormat
auditReportResponseFormat :: AuditReportResponseFormat
s3BucketName :: Text
certificateAuthorityArn :: Text
$sel:auditReportResponseFormat:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> AuditReportResponseFormat
$sel:s3BucketName:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
$sel:certificateAuthorityArn:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateAuthorityArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
s3BucketName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AuditReportResponseFormat
auditReportResponseFormat

instance
  Prelude.NFData
    CreateCertificateAuthorityAuditReport
  where
  rnf :: CreateCertificateAuthorityAuditReport -> ()
rnf CreateCertificateAuthorityAuditReport' {Text
AuditReportResponseFormat
auditReportResponseFormat :: AuditReportResponseFormat
s3BucketName :: Text
certificateAuthorityArn :: Text
$sel:auditReportResponseFormat:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> AuditReportResponseFormat
$sel:s3BucketName:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
$sel:certificateAuthorityArn:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
certificateAuthorityArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
s3BucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AuditReportResponseFormat
auditReportResponseFormat

instance
  Data.ToHeaders
    CreateCertificateAuthorityAuditReport
  where
  toHeaders :: CreateCertificateAuthorityAuditReport -> 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
"ACMPrivateCA.CreateCertificateAuthorityAuditReport" ::
                          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
    CreateCertificateAuthorityAuditReport
  where
  toJSON :: CreateCertificateAuthorityAuditReport -> Value
toJSON CreateCertificateAuthorityAuditReport' {Text
AuditReportResponseFormat
auditReportResponseFormat :: AuditReportResponseFormat
s3BucketName :: Text
certificateAuthorityArn :: Text
$sel:auditReportResponseFormat:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> AuditReportResponseFormat
$sel:s3BucketName:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
$sel:certificateAuthorityArn:CreateCertificateAuthorityAuditReport' :: CreateCertificateAuthorityAuditReport -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"CertificateAuthorityArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateAuthorityArn
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"S3BucketName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
s3BucketName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"AuditReportResponseFormat"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AuditReportResponseFormat
auditReportResponseFormat
              )
          ]
      )

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

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

-- | /See:/ 'newCreateCertificateAuthorityAuditReportResponse' smart constructor.
data CreateCertificateAuthorityAuditReportResponse = CreateCertificateAuthorityAuditReportResponse'
  { -- | An alphanumeric string that contains a report identifier.
    CreateCertificateAuthorityAuditReportResponse -> Maybe Text
auditReportId :: Prelude.Maybe Prelude.Text,
    -- | The __key__ that uniquely identifies the report file in your S3 bucket.
    CreateCertificateAuthorityAuditReportResponse -> Maybe Text
s3Key :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateCertificateAuthorityAuditReportResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCertificateAuthorityAuditReportResponse
-> CreateCertificateAuthorityAuditReportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCertificateAuthorityAuditReportResponse
-> CreateCertificateAuthorityAuditReportResponse -> Bool
$c/= :: CreateCertificateAuthorityAuditReportResponse
-> CreateCertificateAuthorityAuditReportResponse -> Bool
== :: CreateCertificateAuthorityAuditReportResponse
-> CreateCertificateAuthorityAuditReportResponse -> Bool
$c== :: CreateCertificateAuthorityAuditReportResponse
-> CreateCertificateAuthorityAuditReportResponse -> Bool
Prelude.Eq, ReadPrec [CreateCertificateAuthorityAuditReportResponse]
ReadPrec CreateCertificateAuthorityAuditReportResponse
Int -> ReadS CreateCertificateAuthorityAuditReportResponse
ReadS [CreateCertificateAuthorityAuditReportResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCertificateAuthorityAuditReportResponse]
$creadListPrec :: ReadPrec [CreateCertificateAuthorityAuditReportResponse]
readPrec :: ReadPrec CreateCertificateAuthorityAuditReportResponse
$creadPrec :: ReadPrec CreateCertificateAuthorityAuditReportResponse
readList :: ReadS [CreateCertificateAuthorityAuditReportResponse]
$creadList :: ReadS [CreateCertificateAuthorityAuditReportResponse]
readsPrec :: Int -> ReadS CreateCertificateAuthorityAuditReportResponse
$creadsPrec :: Int -> ReadS CreateCertificateAuthorityAuditReportResponse
Prelude.Read, Int -> CreateCertificateAuthorityAuditReportResponse -> ShowS
[CreateCertificateAuthorityAuditReportResponse] -> ShowS
CreateCertificateAuthorityAuditReportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCertificateAuthorityAuditReportResponse] -> ShowS
$cshowList :: [CreateCertificateAuthorityAuditReportResponse] -> ShowS
show :: CreateCertificateAuthorityAuditReportResponse -> String
$cshow :: CreateCertificateAuthorityAuditReportResponse -> String
showsPrec :: Int -> CreateCertificateAuthorityAuditReportResponse -> ShowS
$cshowsPrec :: Int -> CreateCertificateAuthorityAuditReportResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCertificateAuthorityAuditReportResponse x
-> CreateCertificateAuthorityAuditReportResponse
forall x.
CreateCertificateAuthorityAuditReportResponse
-> Rep CreateCertificateAuthorityAuditReportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCertificateAuthorityAuditReportResponse x
-> CreateCertificateAuthorityAuditReportResponse
$cfrom :: forall x.
CreateCertificateAuthorityAuditReportResponse
-> Rep CreateCertificateAuthorityAuditReportResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCertificateAuthorityAuditReportResponse' 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:
--
-- 'auditReportId', 'createCertificateAuthorityAuditReportResponse_auditReportId' - An alphanumeric string that contains a report identifier.
--
-- 's3Key', 'createCertificateAuthorityAuditReportResponse_s3Key' - The __key__ that uniquely identifies the report file in your S3 bucket.
--
-- 'httpStatus', 'createCertificateAuthorityAuditReportResponse_httpStatus' - The response's http status code.
newCreateCertificateAuthorityAuditReportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCertificateAuthorityAuditReportResponse
newCreateCertificateAuthorityAuditReportResponse :: Int -> CreateCertificateAuthorityAuditReportResponse
newCreateCertificateAuthorityAuditReportResponse
  Int
pHttpStatus_ =
    CreateCertificateAuthorityAuditReportResponse'
      { $sel:auditReportId:CreateCertificateAuthorityAuditReportResponse' :: Maybe Text
auditReportId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:s3Key:CreateCertificateAuthorityAuditReportResponse' :: Maybe Text
s3Key = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateCertificateAuthorityAuditReportResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | An alphanumeric string that contains a report identifier.
createCertificateAuthorityAuditReportResponse_auditReportId :: Lens.Lens' CreateCertificateAuthorityAuditReportResponse (Prelude.Maybe Prelude.Text)
createCertificateAuthorityAuditReportResponse_auditReportId :: Lens' CreateCertificateAuthorityAuditReportResponse (Maybe Text)
createCertificateAuthorityAuditReportResponse_auditReportId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCertificateAuthorityAuditReportResponse' {Maybe Text
auditReportId :: Maybe Text
$sel:auditReportId:CreateCertificateAuthorityAuditReportResponse' :: CreateCertificateAuthorityAuditReportResponse -> Maybe Text
auditReportId} -> Maybe Text
auditReportId) (\s :: CreateCertificateAuthorityAuditReportResponse
s@CreateCertificateAuthorityAuditReportResponse' {} Maybe Text
a -> CreateCertificateAuthorityAuditReportResponse
s {$sel:auditReportId:CreateCertificateAuthorityAuditReportResponse' :: Maybe Text
auditReportId = Maybe Text
a} :: CreateCertificateAuthorityAuditReportResponse)

-- | The __key__ that uniquely identifies the report file in your S3 bucket.
createCertificateAuthorityAuditReportResponse_s3Key :: Lens.Lens' CreateCertificateAuthorityAuditReportResponse (Prelude.Maybe Prelude.Text)
createCertificateAuthorityAuditReportResponse_s3Key :: Lens' CreateCertificateAuthorityAuditReportResponse (Maybe Text)
createCertificateAuthorityAuditReportResponse_s3Key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCertificateAuthorityAuditReportResponse' {Maybe Text
s3Key :: Maybe Text
$sel:s3Key:CreateCertificateAuthorityAuditReportResponse' :: CreateCertificateAuthorityAuditReportResponse -> Maybe Text
s3Key} -> Maybe Text
s3Key) (\s :: CreateCertificateAuthorityAuditReportResponse
s@CreateCertificateAuthorityAuditReportResponse' {} Maybe Text
a -> CreateCertificateAuthorityAuditReportResponse
s {$sel:s3Key:CreateCertificateAuthorityAuditReportResponse' :: Maybe Text
s3Key = Maybe Text
a} :: CreateCertificateAuthorityAuditReportResponse)

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

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