{-# 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.Backup.CreateReportPlan
-- 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 a report plan. A report plan is a document that contains
-- information about the contents of the report and where Backup will
-- deliver it.
--
-- If you call @CreateReportPlan@ with a plan that already exists, you
-- receive an @AlreadyExistsException@ exception.
module Amazonka.Backup.CreateReportPlan
  ( -- * Creating a Request
    CreateReportPlan (..),
    newCreateReportPlan,

    -- * Request Lenses
    createReportPlan_idempotencyToken,
    createReportPlan_reportPlanDescription,
    createReportPlan_reportPlanTags,
    createReportPlan_reportPlanName,
    createReportPlan_reportDeliveryChannel,
    createReportPlan_reportSetting,

    -- * Destructuring the Response
    CreateReportPlanResponse (..),
    newCreateReportPlanResponse,

    -- * Response Lenses
    createReportPlanResponse_creationTime,
    createReportPlanResponse_reportPlanArn,
    createReportPlanResponse_reportPlanName,
    createReportPlanResponse_httpStatus,
  )
where

import Amazonka.Backup.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:/ 'newCreateReportPlan' smart constructor.
data CreateReportPlan = CreateReportPlan'
  { -- | A customer-chosen string that you can use to distinguish between
    -- otherwise identical calls to @CreateReportPlanInput@. Retrying a
    -- successful request with the same idempotency token results in a success
    -- message with no action taken.
    CreateReportPlan -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    -- | An optional description of the report plan with a maximum of 1,024
    -- characters.
    CreateReportPlan -> Maybe Text
reportPlanDescription :: Prelude.Maybe Prelude.Text,
    -- | Metadata that you can assign to help organize the report plans that you
    -- create. Each tag is a key-value pair.
    CreateReportPlan -> Maybe (HashMap Text Text)
reportPlanTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The unique name of the report plan. The name must be between 1 and 256
    -- characters, starting with a letter, and consisting of letters (a-z,
    -- A-Z), numbers (0-9), and underscores (_).
    CreateReportPlan -> Text
reportPlanName :: Prelude.Text,
    -- | A structure that contains information about where and how to deliver
    -- your reports, specifically your Amazon S3 bucket name, S3 key prefix,
    -- and the formats of your reports.
    CreateReportPlan -> ReportDeliveryChannel
reportDeliveryChannel :: ReportDeliveryChannel,
    -- | Identifies the report template for the report. Reports are built using a
    -- report template. The report templates are:
    --
    -- @RESOURCE_COMPLIANCE_REPORT | CONTROL_COMPLIANCE_REPORT | BACKUP_JOB_REPORT | COPY_JOB_REPORT | RESTORE_JOB_REPORT@
    --
    -- If the report template is @RESOURCE_COMPLIANCE_REPORT@ or
    -- @CONTROL_COMPLIANCE_REPORT@, this API resource also describes the report
    -- coverage by Amazon Web Services Regions and frameworks.
    CreateReportPlan -> ReportSetting
reportSetting :: ReportSetting
  }
  deriving (CreateReportPlan -> CreateReportPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReportPlan -> CreateReportPlan -> Bool
$c/= :: CreateReportPlan -> CreateReportPlan -> Bool
== :: CreateReportPlan -> CreateReportPlan -> Bool
$c== :: CreateReportPlan -> CreateReportPlan -> Bool
Prelude.Eq, ReadPrec [CreateReportPlan]
ReadPrec CreateReportPlan
Int -> ReadS CreateReportPlan
ReadS [CreateReportPlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReportPlan]
$creadListPrec :: ReadPrec [CreateReportPlan]
readPrec :: ReadPrec CreateReportPlan
$creadPrec :: ReadPrec CreateReportPlan
readList :: ReadS [CreateReportPlan]
$creadList :: ReadS [CreateReportPlan]
readsPrec :: Int -> ReadS CreateReportPlan
$creadsPrec :: Int -> ReadS CreateReportPlan
Prelude.Read, Int -> CreateReportPlan -> ShowS
[CreateReportPlan] -> ShowS
CreateReportPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReportPlan] -> ShowS
$cshowList :: [CreateReportPlan] -> ShowS
show :: CreateReportPlan -> String
$cshow :: CreateReportPlan -> String
showsPrec :: Int -> CreateReportPlan -> ShowS
$cshowsPrec :: Int -> CreateReportPlan -> ShowS
Prelude.Show, forall x. Rep CreateReportPlan x -> CreateReportPlan
forall x. CreateReportPlan -> Rep CreateReportPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateReportPlan x -> CreateReportPlan
$cfrom :: forall x. CreateReportPlan -> Rep CreateReportPlan x
Prelude.Generic)

-- |
-- Create a value of 'CreateReportPlan' 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:
--
-- 'idempotencyToken', 'createReportPlan_idempotencyToken' - A customer-chosen string that you can use to distinguish between
-- otherwise identical calls to @CreateReportPlanInput@. Retrying a
-- successful request with the same idempotency token results in a success
-- message with no action taken.
--
-- 'reportPlanDescription', 'createReportPlan_reportPlanDescription' - An optional description of the report plan with a maximum of 1,024
-- characters.
--
-- 'reportPlanTags', 'createReportPlan_reportPlanTags' - Metadata that you can assign to help organize the report plans that you
-- create. Each tag is a key-value pair.
--
-- 'reportPlanName', 'createReportPlan_reportPlanName' - The unique name of the report plan. The name must be between 1 and 256
-- characters, starting with a letter, and consisting of letters (a-z,
-- A-Z), numbers (0-9), and underscores (_).
--
-- 'reportDeliveryChannel', 'createReportPlan_reportDeliveryChannel' - A structure that contains information about where and how to deliver
-- your reports, specifically your Amazon S3 bucket name, S3 key prefix,
-- and the formats of your reports.
--
-- 'reportSetting', 'createReportPlan_reportSetting' - Identifies the report template for the report. Reports are built using a
-- report template. The report templates are:
--
-- @RESOURCE_COMPLIANCE_REPORT | CONTROL_COMPLIANCE_REPORT | BACKUP_JOB_REPORT | COPY_JOB_REPORT | RESTORE_JOB_REPORT@
--
-- If the report template is @RESOURCE_COMPLIANCE_REPORT@ or
-- @CONTROL_COMPLIANCE_REPORT@, this API resource also describes the report
-- coverage by Amazon Web Services Regions and frameworks.
newCreateReportPlan ::
  -- | 'reportPlanName'
  Prelude.Text ->
  -- | 'reportDeliveryChannel'
  ReportDeliveryChannel ->
  -- | 'reportSetting'
  ReportSetting ->
  CreateReportPlan
newCreateReportPlan :: Text -> ReportDeliveryChannel -> ReportSetting -> CreateReportPlan
newCreateReportPlan
  Text
pReportPlanName_
  ReportDeliveryChannel
pReportDeliveryChannel_
  ReportSetting
pReportSetting_ =
    CreateReportPlan'
      { $sel:idempotencyToken:CreateReportPlan' :: Maybe Text
idempotencyToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:reportPlanDescription:CreateReportPlan' :: Maybe Text
reportPlanDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:reportPlanTags:CreateReportPlan' :: Maybe (HashMap Text Text)
reportPlanTags = forall a. Maybe a
Prelude.Nothing,
        $sel:reportPlanName:CreateReportPlan' :: Text
reportPlanName = Text
pReportPlanName_,
        $sel:reportDeliveryChannel:CreateReportPlan' :: ReportDeliveryChannel
reportDeliveryChannel = ReportDeliveryChannel
pReportDeliveryChannel_,
        $sel:reportSetting:CreateReportPlan' :: ReportSetting
reportSetting = ReportSetting
pReportSetting_
      }

-- | A customer-chosen string that you can use to distinguish between
-- otherwise identical calls to @CreateReportPlanInput@. Retrying a
-- successful request with the same idempotency token results in a success
-- message with no action taken.
createReportPlan_idempotencyToken :: Lens.Lens' CreateReportPlan (Prelude.Maybe Prelude.Text)
createReportPlan_idempotencyToken :: Lens' CreateReportPlan (Maybe Text)
createReportPlan_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlan' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:CreateReportPlan' :: CreateReportPlan -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: CreateReportPlan
s@CreateReportPlan' {} Maybe Text
a -> CreateReportPlan
s {$sel:idempotencyToken:CreateReportPlan' :: Maybe Text
idempotencyToken = Maybe Text
a} :: CreateReportPlan)

-- | An optional description of the report plan with a maximum of 1,024
-- characters.
createReportPlan_reportPlanDescription :: Lens.Lens' CreateReportPlan (Prelude.Maybe Prelude.Text)
createReportPlan_reportPlanDescription :: Lens' CreateReportPlan (Maybe Text)
createReportPlan_reportPlanDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlan' {Maybe Text
reportPlanDescription :: Maybe Text
$sel:reportPlanDescription:CreateReportPlan' :: CreateReportPlan -> Maybe Text
reportPlanDescription} -> Maybe Text
reportPlanDescription) (\s :: CreateReportPlan
s@CreateReportPlan' {} Maybe Text
a -> CreateReportPlan
s {$sel:reportPlanDescription:CreateReportPlan' :: Maybe Text
reportPlanDescription = Maybe Text
a} :: CreateReportPlan)

-- | Metadata that you can assign to help organize the report plans that you
-- create. Each tag is a key-value pair.
createReportPlan_reportPlanTags :: Lens.Lens' CreateReportPlan (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createReportPlan_reportPlanTags :: Lens' CreateReportPlan (Maybe (HashMap Text Text))
createReportPlan_reportPlanTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlan' {Maybe (HashMap Text Text)
reportPlanTags :: Maybe (HashMap Text Text)
$sel:reportPlanTags:CreateReportPlan' :: CreateReportPlan -> Maybe (HashMap Text Text)
reportPlanTags} -> Maybe (HashMap Text Text)
reportPlanTags) (\s :: CreateReportPlan
s@CreateReportPlan' {} Maybe (HashMap Text Text)
a -> CreateReportPlan
s {$sel:reportPlanTags:CreateReportPlan' :: Maybe (HashMap Text Text)
reportPlanTags = Maybe (HashMap Text Text)
a} :: CreateReportPlan) 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 unique name of the report plan. The name must be between 1 and 256
-- characters, starting with a letter, and consisting of letters (a-z,
-- A-Z), numbers (0-9), and underscores (_).
createReportPlan_reportPlanName :: Lens.Lens' CreateReportPlan Prelude.Text
createReportPlan_reportPlanName :: Lens' CreateReportPlan Text
createReportPlan_reportPlanName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlan' {Text
reportPlanName :: Text
$sel:reportPlanName:CreateReportPlan' :: CreateReportPlan -> Text
reportPlanName} -> Text
reportPlanName) (\s :: CreateReportPlan
s@CreateReportPlan' {} Text
a -> CreateReportPlan
s {$sel:reportPlanName:CreateReportPlan' :: Text
reportPlanName = Text
a} :: CreateReportPlan)

-- | A structure that contains information about where and how to deliver
-- your reports, specifically your Amazon S3 bucket name, S3 key prefix,
-- and the formats of your reports.
createReportPlan_reportDeliveryChannel :: Lens.Lens' CreateReportPlan ReportDeliveryChannel
createReportPlan_reportDeliveryChannel :: Lens' CreateReportPlan ReportDeliveryChannel
createReportPlan_reportDeliveryChannel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlan' {ReportDeliveryChannel
reportDeliveryChannel :: ReportDeliveryChannel
$sel:reportDeliveryChannel:CreateReportPlan' :: CreateReportPlan -> ReportDeliveryChannel
reportDeliveryChannel} -> ReportDeliveryChannel
reportDeliveryChannel) (\s :: CreateReportPlan
s@CreateReportPlan' {} ReportDeliveryChannel
a -> CreateReportPlan
s {$sel:reportDeliveryChannel:CreateReportPlan' :: ReportDeliveryChannel
reportDeliveryChannel = ReportDeliveryChannel
a} :: CreateReportPlan)

-- | Identifies the report template for the report. Reports are built using a
-- report template. The report templates are:
--
-- @RESOURCE_COMPLIANCE_REPORT | CONTROL_COMPLIANCE_REPORT | BACKUP_JOB_REPORT | COPY_JOB_REPORT | RESTORE_JOB_REPORT@
--
-- If the report template is @RESOURCE_COMPLIANCE_REPORT@ or
-- @CONTROL_COMPLIANCE_REPORT@, this API resource also describes the report
-- coverage by Amazon Web Services Regions and frameworks.
createReportPlan_reportSetting :: Lens.Lens' CreateReportPlan ReportSetting
createReportPlan_reportSetting :: Lens' CreateReportPlan ReportSetting
createReportPlan_reportSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlan' {ReportSetting
reportSetting :: ReportSetting
$sel:reportSetting:CreateReportPlan' :: CreateReportPlan -> ReportSetting
reportSetting} -> ReportSetting
reportSetting) (\s :: CreateReportPlan
s@CreateReportPlan' {} ReportSetting
a -> CreateReportPlan
s {$sel:reportSetting:CreateReportPlan' :: ReportSetting
reportSetting = ReportSetting
a} :: CreateReportPlan)

instance Core.AWSRequest CreateReportPlan where
  type
    AWSResponse CreateReportPlan =
      CreateReportPlanResponse
  request :: (Service -> Service)
-> CreateReportPlan -> Request CreateReportPlan
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 CreateReportPlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateReportPlan)))
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 POSIX
-> Maybe Text -> Maybe Text -> Int -> CreateReportPlanResponse
CreateReportPlanResponse'
            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
"CreationTime")
            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
"ReportPlanArn")
            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
"ReportPlanName")
            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 CreateReportPlan where
  hashWithSalt :: Int -> CreateReportPlan -> Int
hashWithSalt Int
_salt CreateReportPlan' {Maybe Text
Maybe (HashMap Text Text)
Text
ReportDeliveryChannel
ReportSetting
reportSetting :: ReportSetting
reportDeliveryChannel :: ReportDeliveryChannel
reportPlanName :: Text
reportPlanTags :: Maybe (HashMap Text Text)
reportPlanDescription :: Maybe Text
idempotencyToken :: Maybe Text
$sel:reportSetting:CreateReportPlan' :: CreateReportPlan -> ReportSetting
$sel:reportDeliveryChannel:CreateReportPlan' :: CreateReportPlan -> ReportDeliveryChannel
$sel:reportPlanName:CreateReportPlan' :: CreateReportPlan -> Text
$sel:reportPlanTags:CreateReportPlan' :: CreateReportPlan -> Maybe (HashMap Text Text)
$sel:reportPlanDescription:CreateReportPlan' :: CreateReportPlan -> Maybe Text
$sel:idempotencyToken:CreateReportPlan' :: CreateReportPlan -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reportPlanDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
reportPlanTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reportPlanName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReportDeliveryChannel
reportDeliveryChannel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReportSetting
reportSetting

instance Prelude.NFData CreateReportPlan where
  rnf :: CreateReportPlan -> ()
rnf CreateReportPlan' {Maybe Text
Maybe (HashMap Text Text)
Text
ReportDeliveryChannel
ReportSetting
reportSetting :: ReportSetting
reportDeliveryChannel :: ReportDeliveryChannel
reportPlanName :: Text
reportPlanTags :: Maybe (HashMap Text Text)
reportPlanDescription :: Maybe Text
idempotencyToken :: Maybe Text
$sel:reportSetting:CreateReportPlan' :: CreateReportPlan -> ReportSetting
$sel:reportDeliveryChannel:CreateReportPlan' :: CreateReportPlan -> ReportDeliveryChannel
$sel:reportPlanName:CreateReportPlan' :: CreateReportPlan -> Text
$sel:reportPlanTags:CreateReportPlan' :: CreateReportPlan -> Maybe (HashMap Text Text)
$sel:reportPlanDescription:CreateReportPlan' :: CreateReportPlan -> Maybe Text
$sel:idempotencyToken:CreateReportPlan' :: CreateReportPlan -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idempotencyToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reportPlanDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
reportPlanTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reportPlanName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReportDeliveryChannel
reportDeliveryChannel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReportSetting
reportSetting

instance Data.ToHeaders CreateReportPlan where
  toHeaders :: CreateReportPlan -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateReportPlan where
  toJSON :: CreateReportPlan -> Value
toJSON CreateReportPlan' {Maybe Text
Maybe (HashMap Text Text)
Text
ReportDeliveryChannel
ReportSetting
reportSetting :: ReportSetting
reportDeliveryChannel :: ReportDeliveryChannel
reportPlanName :: Text
reportPlanTags :: Maybe (HashMap Text Text)
reportPlanDescription :: Maybe Text
idempotencyToken :: Maybe Text
$sel:reportSetting:CreateReportPlan' :: CreateReportPlan -> ReportSetting
$sel:reportDeliveryChannel:CreateReportPlan' :: CreateReportPlan -> ReportDeliveryChannel
$sel:reportPlanName:CreateReportPlan' :: CreateReportPlan -> Text
$sel:reportPlanTags:CreateReportPlan' :: CreateReportPlan -> Maybe (HashMap Text Text)
$sel:reportPlanDescription:CreateReportPlan' :: CreateReportPlan -> Maybe Text
$sel:idempotencyToken:CreateReportPlan' :: CreateReportPlan -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IdempotencyToken" 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
idempotencyToken,
            (Key
"ReportPlanDescription" 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
reportPlanDescription,
            (Key
"ReportPlanTags" 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 (HashMap Text Text)
reportPlanTags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReportPlanName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
reportPlanName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ReportDeliveryChannel"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ReportDeliveryChannel
reportDeliveryChannel
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReportSetting" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ReportSetting
reportSetting)
          ]
      )

instance Data.ToPath CreateReportPlan where
  toPath :: CreateReportPlan -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/audit/report-plans"

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

-- | /See:/ 'newCreateReportPlanResponse' smart constructor.
data CreateReportPlanResponse = CreateReportPlanResponse'
  { -- | The date and time a backup vault is created, in Unix format and
    -- Coordinated Universal Time (UTC). The value of @CreationTime@ is
    -- accurate to milliseconds. For example, the value 1516925490.087
    -- represents Friday, January 26, 2018 12:11:30.087 AM.
    CreateReportPlanResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | An Amazon Resource Name (ARN) that uniquely identifies a resource. The
    -- format of the ARN depends on the resource type.
    CreateReportPlanResponse -> Maybe Text
reportPlanArn :: Prelude.Maybe Prelude.Text,
    -- | The unique name of the report plan.
    CreateReportPlanResponse -> Maybe Text
reportPlanName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateReportPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateReportPlanResponse -> CreateReportPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReportPlanResponse -> CreateReportPlanResponse -> Bool
$c/= :: CreateReportPlanResponse -> CreateReportPlanResponse -> Bool
== :: CreateReportPlanResponse -> CreateReportPlanResponse -> Bool
$c== :: CreateReportPlanResponse -> CreateReportPlanResponse -> Bool
Prelude.Eq, ReadPrec [CreateReportPlanResponse]
ReadPrec CreateReportPlanResponse
Int -> ReadS CreateReportPlanResponse
ReadS [CreateReportPlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReportPlanResponse]
$creadListPrec :: ReadPrec [CreateReportPlanResponse]
readPrec :: ReadPrec CreateReportPlanResponse
$creadPrec :: ReadPrec CreateReportPlanResponse
readList :: ReadS [CreateReportPlanResponse]
$creadList :: ReadS [CreateReportPlanResponse]
readsPrec :: Int -> ReadS CreateReportPlanResponse
$creadsPrec :: Int -> ReadS CreateReportPlanResponse
Prelude.Read, Int -> CreateReportPlanResponse -> ShowS
[CreateReportPlanResponse] -> ShowS
CreateReportPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReportPlanResponse] -> ShowS
$cshowList :: [CreateReportPlanResponse] -> ShowS
show :: CreateReportPlanResponse -> String
$cshow :: CreateReportPlanResponse -> String
showsPrec :: Int -> CreateReportPlanResponse -> ShowS
$cshowsPrec :: Int -> CreateReportPlanResponse -> ShowS
Prelude.Show, forall x.
Rep CreateReportPlanResponse x -> CreateReportPlanResponse
forall x.
CreateReportPlanResponse -> Rep CreateReportPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateReportPlanResponse x -> CreateReportPlanResponse
$cfrom :: forall x.
CreateReportPlanResponse -> Rep CreateReportPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateReportPlanResponse' 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:
--
-- 'creationTime', 'createReportPlanResponse_creationTime' - The date and time a backup vault is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationTime@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'reportPlanArn', 'createReportPlanResponse_reportPlanArn' - An Amazon Resource Name (ARN) that uniquely identifies a resource. The
-- format of the ARN depends on the resource type.
--
-- 'reportPlanName', 'createReportPlanResponse_reportPlanName' - The unique name of the report plan.
--
-- 'httpStatus', 'createReportPlanResponse_httpStatus' - The response's http status code.
newCreateReportPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateReportPlanResponse
newCreateReportPlanResponse :: Int -> CreateReportPlanResponse
newCreateReportPlanResponse Int
pHttpStatus_ =
  CreateReportPlanResponse'
    { $sel:creationTime:CreateReportPlanResponse' :: Maybe POSIX
creationTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:reportPlanArn:CreateReportPlanResponse' :: Maybe Text
reportPlanArn = forall a. Maybe a
Prelude.Nothing,
      $sel:reportPlanName:CreateReportPlanResponse' :: Maybe Text
reportPlanName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateReportPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time a backup vault is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationTime@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
createReportPlanResponse_creationTime :: Lens.Lens' CreateReportPlanResponse (Prelude.Maybe Prelude.UTCTime)
createReportPlanResponse_creationTime :: Lens' CreateReportPlanResponse (Maybe UTCTime)
createReportPlanResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlanResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:CreateReportPlanResponse' :: CreateReportPlanResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: CreateReportPlanResponse
s@CreateReportPlanResponse' {} Maybe POSIX
a -> CreateReportPlanResponse
s {$sel:creationTime:CreateReportPlanResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: CreateReportPlanResponse) 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 Amazon Resource Name (ARN) that uniquely identifies a resource. The
-- format of the ARN depends on the resource type.
createReportPlanResponse_reportPlanArn :: Lens.Lens' CreateReportPlanResponse (Prelude.Maybe Prelude.Text)
createReportPlanResponse_reportPlanArn :: Lens' CreateReportPlanResponse (Maybe Text)
createReportPlanResponse_reportPlanArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlanResponse' {Maybe Text
reportPlanArn :: Maybe Text
$sel:reportPlanArn:CreateReportPlanResponse' :: CreateReportPlanResponse -> Maybe Text
reportPlanArn} -> Maybe Text
reportPlanArn) (\s :: CreateReportPlanResponse
s@CreateReportPlanResponse' {} Maybe Text
a -> CreateReportPlanResponse
s {$sel:reportPlanArn:CreateReportPlanResponse' :: Maybe Text
reportPlanArn = Maybe Text
a} :: CreateReportPlanResponse)

-- | The unique name of the report plan.
createReportPlanResponse_reportPlanName :: Lens.Lens' CreateReportPlanResponse (Prelude.Maybe Prelude.Text)
createReportPlanResponse_reportPlanName :: Lens' CreateReportPlanResponse (Maybe Text)
createReportPlanResponse_reportPlanName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReportPlanResponse' {Maybe Text
reportPlanName :: Maybe Text
$sel:reportPlanName:CreateReportPlanResponse' :: CreateReportPlanResponse -> Maybe Text
reportPlanName} -> Maybe Text
reportPlanName) (\s :: CreateReportPlanResponse
s@CreateReportPlanResponse' {} Maybe Text
a -> CreateReportPlanResponse
s {$sel:reportPlanName:CreateReportPlanResponse' :: Maybe Text
reportPlanName = Maybe Text
a} :: CreateReportPlanResponse)

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

instance Prelude.NFData CreateReportPlanResponse where
  rnf :: CreateReportPlanResponse -> ()
rnf CreateReportPlanResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
reportPlanName :: Maybe Text
reportPlanArn :: Maybe Text
creationTime :: Maybe POSIX
$sel:httpStatus:CreateReportPlanResponse' :: CreateReportPlanResponse -> Int
$sel:reportPlanName:CreateReportPlanResponse' :: CreateReportPlanResponse -> Maybe Text
$sel:reportPlanArn:CreateReportPlanResponse' :: CreateReportPlanResponse -> Maybe Text
$sel:creationTime:CreateReportPlanResponse' :: CreateReportPlanResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reportPlanArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reportPlanName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus