{-# 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.LicenseManager.CreateLicenseManagerReportGenerator
-- 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 generator.
module Amazonka.LicenseManager.CreateLicenseManagerReportGenerator
  ( -- * Creating a Request
    CreateLicenseManagerReportGenerator (..),
    newCreateLicenseManagerReportGenerator,

    -- * Request Lenses
    createLicenseManagerReportGenerator_description,
    createLicenseManagerReportGenerator_tags,
    createLicenseManagerReportGenerator_reportGeneratorName,
    createLicenseManagerReportGenerator_type,
    createLicenseManagerReportGenerator_reportContext,
    createLicenseManagerReportGenerator_reportFrequency,
    createLicenseManagerReportGenerator_clientToken,

    -- * Destructuring the Response
    CreateLicenseManagerReportGeneratorResponse (..),
    newCreateLicenseManagerReportGeneratorResponse,

    -- * Response Lenses
    createLicenseManagerReportGeneratorResponse_licenseManagerReportGeneratorArn,
    createLicenseManagerReportGeneratorResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.LicenseManager.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateLicenseManagerReportGenerator' smart constructor.
data CreateLicenseManagerReportGenerator = CreateLicenseManagerReportGenerator'
  { -- | Description of the report generator.
    CreateLicenseManagerReportGenerator -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Tags to add to the report generator.
    CreateLicenseManagerReportGenerator -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Name of the report generator.
    CreateLicenseManagerReportGenerator -> Text
reportGeneratorName :: Prelude.Text,
    -- | Type of reports to generate. The following report types an be generated:
    --
    -- -   License configuration report - Reports the number and details of
    --     consumed licenses for a license configuration.
    --
    -- -   Resource report - Reports the tracked licenses and resource
    --     consumption for a license configuration.
    CreateLicenseManagerReportGenerator -> [ReportType]
type' :: [ReportType],
    -- | Defines the type of license configuration the report generator tracks.
    CreateLicenseManagerReportGenerator -> ReportContext
reportContext :: ReportContext,
    -- | Frequency by which reports are generated. Reports can be generated
    -- daily, monthly, or weekly.
    CreateLicenseManagerReportGenerator -> ReportFrequency
reportFrequency :: ReportFrequency,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateLicenseManagerReportGenerator -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateLicenseManagerReportGenerator
-> CreateLicenseManagerReportGenerator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLicenseManagerReportGenerator
-> CreateLicenseManagerReportGenerator -> Bool
$c/= :: CreateLicenseManagerReportGenerator
-> CreateLicenseManagerReportGenerator -> Bool
== :: CreateLicenseManagerReportGenerator
-> CreateLicenseManagerReportGenerator -> Bool
$c== :: CreateLicenseManagerReportGenerator
-> CreateLicenseManagerReportGenerator -> Bool
Prelude.Eq, ReadPrec [CreateLicenseManagerReportGenerator]
ReadPrec CreateLicenseManagerReportGenerator
Int -> ReadS CreateLicenseManagerReportGenerator
ReadS [CreateLicenseManagerReportGenerator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLicenseManagerReportGenerator]
$creadListPrec :: ReadPrec [CreateLicenseManagerReportGenerator]
readPrec :: ReadPrec CreateLicenseManagerReportGenerator
$creadPrec :: ReadPrec CreateLicenseManagerReportGenerator
readList :: ReadS [CreateLicenseManagerReportGenerator]
$creadList :: ReadS [CreateLicenseManagerReportGenerator]
readsPrec :: Int -> ReadS CreateLicenseManagerReportGenerator
$creadsPrec :: Int -> ReadS CreateLicenseManagerReportGenerator
Prelude.Read, Int -> CreateLicenseManagerReportGenerator -> ShowS
[CreateLicenseManagerReportGenerator] -> ShowS
CreateLicenseManagerReportGenerator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLicenseManagerReportGenerator] -> ShowS
$cshowList :: [CreateLicenseManagerReportGenerator] -> ShowS
show :: CreateLicenseManagerReportGenerator -> String
$cshow :: CreateLicenseManagerReportGenerator -> String
showsPrec :: Int -> CreateLicenseManagerReportGenerator -> ShowS
$cshowsPrec :: Int -> CreateLicenseManagerReportGenerator -> ShowS
Prelude.Show, forall x.
Rep CreateLicenseManagerReportGenerator x
-> CreateLicenseManagerReportGenerator
forall x.
CreateLicenseManagerReportGenerator
-> Rep CreateLicenseManagerReportGenerator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLicenseManagerReportGenerator x
-> CreateLicenseManagerReportGenerator
$cfrom :: forall x.
CreateLicenseManagerReportGenerator
-> Rep CreateLicenseManagerReportGenerator x
Prelude.Generic)

-- |
-- Create a value of 'CreateLicenseManagerReportGenerator' 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:
--
-- 'description', 'createLicenseManagerReportGenerator_description' - Description of the report generator.
--
-- 'tags', 'createLicenseManagerReportGenerator_tags' - Tags to add to the report generator.
--
-- 'reportGeneratorName', 'createLicenseManagerReportGenerator_reportGeneratorName' - Name of the report generator.
--
-- 'type'', 'createLicenseManagerReportGenerator_type' - Type of reports to generate. The following report types an be generated:
--
-- -   License configuration report - Reports the number and details of
--     consumed licenses for a license configuration.
--
-- -   Resource report - Reports the tracked licenses and resource
--     consumption for a license configuration.
--
-- 'reportContext', 'createLicenseManagerReportGenerator_reportContext' - Defines the type of license configuration the report generator tracks.
--
-- 'reportFrequency', 'createLicenseManagerReportGenerator_reportFrequency' - Frequency by which reports are generated. Reports can be generated
-- daily, monthly, or weekly.
--
-- 'clientToken', 'createLicenseManagerReportGenerator_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
newCreateLicenseManagerReportGenerator ::
  -- | 'reportGeneratorName'
  Prelude.Text ->
  -- | 'reportContext'
  ReportContext ->
  -- | 'reportFrequency'
  ReportFrequency ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateLicenseManagerReportGenerator
newCreateLicenseManagerReportGenerator :: Text
-> ReportContext
-> ReportFrequency
-> Text
-> CreateLicenseManagerReportGenerator
newCreateLicenseManagerReportGenerator
  Text
pReportGeneratorName_
  ReportContext
pReportContext_
  ReportFrequency
pReportFrequency_
  Text
pClientToken_ =
    CreateLicenseManagerReportGenerator'
      { $sel:description:CreateLicenseManagerReportGenerator' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLicenseManagerReportGenerator' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:reportGeneratorName:CreateLicenseManagerReportGenerator' :: Text
reportGeneratorName =
          Text
pReportGeneratorName_,
        $sel:type':CreateLicenseManagerReportGenerator' :: [ReportType]
type' = forall a. Monoid a => a
Prelude.mempty,
        $sel:reportContext:CreateLicenseManagerReportGenerator' :: ReportContext
reportContext = ReportContext
pReportContext_,
        $sel:reportFrequency:CreateLicenseManagerReportGenerator' :: ReportFrequency
reportFrequency = ReportFrequency
pReportFrequency_,
        $sel:clientToken:CreateLicenseManagerReportGenerator' :: Text
clientToken = Text
pClientToken_
      }

-- | Description of the report generator.
createLicenseManagerReportGenerator_description :: Lens.Lens' CreateLicenseManagerReportGenerator (Prelude.Maybe Prelude.Text)
createLicenseManagerReportGenerator_description :: Lens' CreateLicenseManagerReportGenerator (Maybe Text)
createLicenseManagerReportGenerator_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGenerator' {Maybe Text
description :: Maybe Text
$sel:description:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateLicenseManagerReportGenerator
s@CreateLicenseManagerReportGenerator' {} Maybe Text
a -> CreateLicenseManagerReportGenerator
s {$sel:description:CreateLicenseManagerReportGenerator' :: Maybe Text
description = Maybe Text
a} :: CreateLicenseManagerReportGenerator)

-- | Tags to add to the report generator.
createLicenseManagerReportGenerator_tags :: Lens.Lens' CreateLicenseManagerReportGenerator (Prelude.Maybe [Tag])
createLicenseManagerReportGenerator_tags :: Lens' CreateLicenseManagerReportGenerator (Maybe [Tag])
createLicenseManagerReportGenerator_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGenerator' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateLicenseManagerReportGenerator
s@CreateLicenseManagerReportGenerator' {} Maybe [Tag]
a -> CreateLicenseManagerReportGenerator
s {$sel:tags:CreateLicenseManagerReportGenerator' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateLicenseManagerReportGenerator) 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

-- | Name of the report generator.
createLicenseManagerReportGenerator_reportGeneratorName :: Lens.Lens' CreateLicenseManagerReportGenerator Prelude.Text
createLicenseManagerReportGenerator_reportGeneratorName :: Lens' CreateLicenseManagerReportGenerator Text
createLicenseManagerReportGenerator_reportGeneratorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGenerator' {Text
reportGeneratorName :: Text
$sel:reportGeneratorName:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
reportGeneratorName} -> Text
reportGeneratorName) (\s :: CreateLicenseManagerReportGenerator
s@CreateLicenseManagerReportGenerator' {} Text
a -> CreateLicenseManagerReportGenerator
s {$sel:reportGeneratorName:CreateLicenseManagerReportGenerator' :: Text
reportGeneratorName = Text
a} :: CreateLicenseManagerReportGenerator)

-- | Type of reports to generate. The following report types an be generated:
--
-- -   License configuration report - Reports the number and details of
--     consumed licenses for a license configuration.
--
-- -   Resource report - Reports the tracked licenses and resource
--     consumption for a license configuration.
createLicenseManagerReportGenerator_type :: Lens.Lens' CreateLicenseManagerReportGenerator [ReportType]
createLicenseManagerReportGenerator_type :: Lens' CreateLicenseManagerReportGenerator [ReportType]
createLicenseManagerReportGenerator_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGenerator' {[ReportType]
type' :: [ReportType]
$sel:type':CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> [ReportType]
type'} -> [ReportType]
type') (\s :: CreateLicenseManagerReportGenerator
s@CreateLicenseManagerReportGenerator' {} [ReportType]
a -> CreateLicenseManagerReportGenerator
s {$sel:type':CreateLicenseManagerReportGenerator' :: [ReportType]
type' = [ReportType]
a} :: CreateLicenseManagerReportGenerator) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Defines the type of license configuration the report generator tracks.
createLicenseManagerReportGenerator_reportContext :: Lens.Lens' CreateLicenseManagerReportGenerator ReportContext
createLicenseManagerReportGenerator_reportContext :: Lens' CreateLicenseManagerReportGenerator ReportContext
createLicenseManagerReportGenerator_reportContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGenerator' {ReportContext
reportContext :: ReportContext
$sel:reportContext:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportContext
reportContext} -> ReportContext
reportContext) (\s :: CreateLicenseManagerReportGenerator
s@CreateLicenseManagerReportGenerator' {} ReportContext
a -> CreateLicenseManagerReportGenerator
s {$sel:reportContext:CreateLicenseManagerReportGenerator' :: ReportContext
reportContext = ReportContext
a} :: CreateLicenseManagerReportGenerator)

-- | Frequency by which reports are generated. Reports can be generated
-- daily, monthly, or weekly.
createLicenseManagerReportGenerator_reportFrequency :: Lens.Lens' CreateLicenseManagerReportGenerator ReportFrequency
createLicenseManagerReportGenerator_reportFrequency :: Lens' CreateLicenseManagerReportGenerator ReportFrequency
createLicenseManagerReportGenerator_reportFrequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGenerator' {ReportFrequency
reportFrequency :: ReportFrequency
$sel:reportFrequency:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportFrequency
reportFrequency} -> ReportFrequency
reportFrequency) (\s :: CreateLicenseManagerReportGenerator
s@CreateLicenseManagerReportGenerator' {} ReportFrequency
a -> CreateLicenseManagerReportGenerator
s {$sel:reportFrequency:CreateLicenseManagerReportGenerator' :: ReportFrequency
reportFrequency = ReportFrequency
a} :: CreateLicenseManagerReportGenerator)

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createLicenseManagerReportGenerator_clientToken :: Lens.Lens' CreateLicenseManagerReportGenerator Prelude.Text
createLicenseManagerReportGenerator_clientToken :: Lens' CreateLicenseManagerReportGenerator Text
createLicenseManagerReportGenerator_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGenerator' {Text
clientToken :: Text
$sel:clientToken:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
clientToken} -> Text
clientToken) (\s :: CreateLicenseManagerReportGenerator
s@CreateLicenseManagerReportGenerator' {} Text
a -> CreateLicenseManagerReportGenerator
s {$sel:clientToken:CreateLicenseManagerReportGenerator' :: Text
clientToken = Text
a} :: CreateLicenseManagerReportGenerator)

instance
  Core.AWSRequest
    CreateLicenseManagerReportGenerator
  where
  type
    AWSResponse CreateLicenseManagerReportGenerator =
      CreateLicenseManagerReportGeneratorResponse
  request :: (Service -> Service)
-> CreateLicenseManagerReportGenerator
-> Request CreateLicenseManagerReportGenerator
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 CreateLicenseManagerReportGenerator
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateLicenseManagerReportGenerator)))
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 -> CreateLicenseManagerReportGeneratorResponse
CreateLicenseManagerReportGeneratorResponse'
            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
"LicenseManagerReportGeneratorArn")
            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
    CreateLicenseManagerReportGenerator
  where
  hashWithSalt :: Int -> CreateLicenseManagerReportGenerator -> Int
hashWithSalt
    Int
_salt
    CreateLicenseManagerReportGenerator' {[ReportType]
Maybe [Tag]
Maybe Text
Text
ReportContext
ReportFrequency
clientToken :: Text
reportFrequency :: ReportFrequency
reportContext :: ReportContext
type' :: [ReportType]
reportGeneratorName :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:clientToken:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
$sel:reportFrequency:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportFrequency
$sel:reportContext:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportContext
$sel:type':CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> [ReportType]
$sel:reportGeneratorName:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
$sel:tags:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe [Tag]
$sel:description:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reportGeneratorName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ReportType]
type'
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReportContext
reportContext
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReportFrequency
reportFrequency
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance
  Prelude.NFData
    CreateLicenseManagerReportGenerator
  where
  rnf :: CreateLicenseManagerReportGenerator -> ()
rnf CreateLicenseManagerReportGenerator' {[ReportType]
Maybe [Tag]
Maybe Text
Text
ReportContext
ReportFrequency
clientToken :: Text
reportFrequency :: ReportFrequency
reportContext :: ReportContext
type' :: [ReportType]
reportGeneratorName :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:clientToken:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
$sel:reportFrequency:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportFrequency
$sel:reportContext:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportContext
$sel:type':CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> [ReportType]
$sel:reportGeneratorName:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
$sel:tags:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe [Tag]
$sel:description:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe Text
..} =
    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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reportGeneratorName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ReportType]
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReportContext
reportContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReportFrequency
reportFrequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance
  Data.ToHeaders
    CreateLicenseManagerReportGenerator
  where
  toHeaders :: CreateLicenseManagerReportGenerator -> 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
"AWSLicenseManager.CreateLicenseManagerReportGenerator" ::
                          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
    CreateLicenseManagerReportGenerator
  where
  toJSON :: CreateLicenseManagerReportGenerator -> Value
toJSON CreateLicenseManagerReportGenerator' {[ReportType]
Maybe [Tag]
Maybe Text
Text
ReportContext
ReportFrequency
clientToken :: Text
reportFrequency :: ReportFrequency
reportContext :: ReportContext
type' :: [ReportType]
reportGeneratorName :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:clientToken:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
$sel:reportFrequency:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportFrequency
$sel:reportContext:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> ReportContext
$sel:type':CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> [ReportType]
$sel:reportGeneratorName:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Text
$sel:tags:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe [Tag]
$sel:description:CreateLicenseManagerReportGenerator' :: CreateLicenseManagerReportGenerator -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReportGeneratorName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
reportGeneratorName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [ReportType]
type'),
            forall a. a -> Maybe a
Prelude.Just (Key
"ReportContext" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ReportContext
reportContext),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReportFrequency" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ReportFrequency
reportFrequency),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateLicenseManagerReportGeneratorResponse' 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:
--
-- 'licenseManagerReportGeneratorArn', 'createLicenseManagerReportGeneratorResponse_licenseManagerReportGeneratorArn' - The Amazon Resource Name (ARN) of the new report generator.
--
-- 'httpStatus', 'createLicenseManagerReportGeneratorResponse_httpStatus' - The response's http status code.
newCreateLicenseManagerReportGeneratorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLicenseManagerReportGeneratorResponse
newCreateLicenseManagerReportGeneratorResponse :: Int -> CreateLicenseManagerReportGeneratorResponse
newCreateLicenseManagerReportGeneratorResponse
  Int
pHttpStatus_ =
    CreateLicenseManagerReportGeneratorResponse'
      { $sel:licenseManagerReportGeneratorArn:CreateLicenseManagerReportGeneratorResponse' :: Maybe Text
licenseManagerReportGeneratorArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateLicenseManagerReportGeneratorResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The Amazon Resource Name (ARN) of the new report generator.
createLicenseManagerReportGeneratorResponse_licenseManagerReportGeneratorArn :: Lens.Lens' CreateLicenseManagerReportGeneratorResponse (Prelude.Maybe Prelude.Text)
createLicenseManagerReportGeneratorResponse_licenseManagerReportGeneratorArn :: Lens' CreateLicenseManagerReportGeneratorResponse (Maybe Text)
createLicenseManagerReportGeneratorResponse_licenseManagerReportGeneratorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLicenseManagerReportGeneratorResponse' {Maybe Text
licenseManagerReportGeneratorArn :: Maybe Text
$sel:licenseManagerReportGeneratorArn:CreateLicenseManagerReportGeneratorResponse' :: CreateLicenseManagerReportGeneratorResponse -> Maybe Text
licenseManagerReportGeneratorArn} -> Maybe Text
licenseManagerReportGeneratorArn) (\s :: CreateLicenseManagerReportGeneratorResponse
s@CreateLicenseManagerReportGeneratorResponse' {} Maybe Text
a -> CreateLicenseManagerReportGeneratorResponse
s {$sel:licenseManagerReportGeneratorArn:CreateLicenseManagerReportGeneratorResponse' :: Maybe Text
licenseManagerReportGeneratorArn = Maybe Text
a} :: CreateLicenseManagerReportGeneratorResponse)

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

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