{-# 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.CostExplorer.CreateCostCategoryDefinition
-- 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 new Cost Category with the requested name and rules.
module Amazonka.CostExplorer.CreateCostCategoryDefinition
  ( -- * Creating a Request
    CreateCostCategoryDefinition (..),
    newCreateCostCategoryDefinition,

    -- * Request Lenses
    createCostCategoryDefinition_defaultValue,
    createCostCategoryDefinition_effectiveStart,
    createCostCategoryDefinition_resourceTags,
    createCostCategoryDefinition_splitChargeRules,
    createCostCategoryDefinition_name,
    createCostCategoryDefinition_ruleVersion,
    createCostCategoryDefinition_rules,

    -- * Destructuring the Response
    CreateCostCategoryDefinitionResponse (..),
    newCreateCostCategoryDefinitionResponse,

    -- * Response Lenses
    createCostCategoryDefinitionResponse_costCategoryArn,
    createCostCategoryDefinitionResponse_effectiveStart,
    createCostCategoryDefinitionResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CostExplorer.Types
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:/ 'newCreateCostCategoryDefinition' smart constructor.
data CreateCostCategoryDefinition = CreateCostCategoryDefinition'
  { CreateCostCategoryDefinition -> Maybe Text
defaultValue :: Prelude.Maybe Prelude.Text,
    -- | The Cost Category\'s effective start date. It can only be a billing
    -- start date (first day of the month). If the date isn\'t provided, it\'s
    -- the first day of the current month. Dates can\'t be before the previous
    -- twelve months, or in the future.
    CreateCostCategoryDefinition -> Maybe Text
effectiveStart :: Prelude.Maybe Prelude.Text,
    -- | An optional list of tags to associate with the specified
    -- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategory.html CostCategory>
    -- . You can use resource tags to control access to your @cost category@
    -- using IAM policies.
    --
    -- Each tag consists of a key and a value, and each key must be unique for
    -- the resource. The following restrictions apply to resource tags:
    --
    -- -   Although the maximum number of array members is 200, you can assign
    --     a maximum of 50 user-tags to one resource. The remaining are
    --     reserved for Amazon Web Services use
    --
    -- -   The maximum length of a key is 128 characters
    --
    -- -   The maximum length of a value is 256 characters
    --
    -- -   Keys and values can only contain alphanumeric characters, spaces,
    --     and any of the following: @_.:\/=+\@-@
    --
    -- -   Keys and values are case sensitive
    --
    -- -   Keys and values are trimmed for any leading or trailing whitespaces
    --
    -- -   Don’t use @aws:@ as a prefix for your keys. This prefix is reserved
    --     for Amazon Web Services use
    CreateCostCategoryDefinition -> Maybe [ResourceTag]
resourceTags :: Prelude.Maybe [ResourceTag],
    -- | The split charge rules used to allocate your charges between your Cost
    -- Category values.
    CreateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules :: Prelude.Maybe (Prelude.NonEmpty CostCategorySplitChargeRule),
    CreateCostCategoryDefinition -> Text
name :: Prelude.Text,
    CreateCostCategoryDefinition -> CostCategoryRuleVersion
ruleVersion :: CostCategoryRuleVersion,
    -- | The Cost Category rules used to categorize costs. For more information,
    -- see
    -- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategoryRule.html CostCategoryRule>.
    CreateCostCategoryDefinition -> NonEmpty CostCategoryRule
rules :: Prelude.NonEmpty CostCategoryRule
  }
  deriving (CreateCostCategoryDefinition
-> CreateCostCategoryDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCostCategoryDefinition
-> CreateCostCategoryDefinition -> Bool
$c/= :: CreateCostCategoryDefinition
-> CreateCostCategoryDefinition -> Bool
== :: CreateCostCategoryDefinition
-> CreateCostCategoryDefinition -> Bool
$c== :: CreateCostCategoryDefinition
-> CreateCostCategoryDefinition -> Bool
Prelude.Eq, ReadPrec [CreateCostCategoryDefinition]
ReadPrec CreateCostCategoryDefinition
Int -> ReadS CreateCostCategoryDefinition
ReadS [CreateCostCategoryDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCostCategoryDefinition]
$creadListPrec :: ReadPrec [CreateCostCategoryDefinition]
readPrec :: ReadPrec CreateCostCategoryDefinition
$creadPrec :: ReadPrec CreateCostCategoryDefinition
readList :: ReadS [CreateCostCategoryDefinition]
$creadList :: ReadS [CreateCostCategoryDefinition]
readsPrec :: Int -> ReadS CreateCostCategoryDefinition
$creadsPrec :: Int -> ReadS CreateCostCategoryDefinition
Prelude.Read, Int -> CreateCostCategoryDefinition -> ShowS
[CreateCostCategoryDefinition] -> ShowS
CreateCostCategoryDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCostCategoryDefinition] -> ShowS
$cshowList :: [CreateCostCategoryDefinition] -> ShowS
show :: CreateCostCategoryDefinition -> String
$cshow :: CreateCostCategoryDefinition -> String
showsPrec :: Int -> CreateCostCategoryDefinition -> ShowS
$cshowsPrec :: Int -> CreateCostCategoryDefinition -> ShowS
Prelude.Show, forall x.
Rep CreateCostCategoryDefinition x -> CreateCostCategoryDefinition
forall x.
CreateCostCategoryDefinition -> Rep CreateCostCategoryDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCostCategoryDefinition x -> CreateCostCategoryDefinition
$cfrom :: forall x.
CreateCostCategoryDefinition -> Rep CreateCostCategoryDefinition x
Prelude.Generic)

-- |
-- Create a value of 'CreateCostCategoryDefinition' 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:
--
-- 'defaultValue', 'createCostCategoryDefinition_defaultValue' - Undocumented member.
--
-- 'effectiveStart', 'createCostCategoryDefinition_effectiveStart' - The Cost Category\'s effective start date. It can only be a billing
-- start date (first day of the month). If the date isn\'t provided, it\'s
-- the first day of the current month. Dates can\'t be before the previous
-- twelve months, or in the future.
--
-- 'resourceTags', 'createCostCategoryDefinition_resourceTags' - An optional list of tags to associate with the specified
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategory.html CostCategory>
-- . You can use resource tags to control access to your @cost category@
-- using IAM policies.
--
-- Each tag consists of a key and a value, and each key must be unique for
-- the resource. The following restrictions apply to resource tags:
--
-- -   Although the maximum number of array members is 200, you can assign
--     a maximum of 50 user-tags to one resource. The remaining are
--     reserved for Amazon Web Services use
--
-- -   The maximum length of a key is 128 characters
--
-- -   The maximum length of a value is 256 characters
--
-- -   Keys and values can only contain alphanumeric characters, spaces,
--     and any of the following: @_.:\/=+\@-@
--
-- -   Keys and values are case sensitive
--
-- -   Keys and values are trimmed for any leading or trailing whitespaces
--
-- -   Don’t use @aws:@ as a prefix for your keys. This prefix is reserved
--     for Amazon Web Services use
--
-- 'splitChargeRules', 'createCostCategoryDefinition_splitChargeRules' - The split charge rules used to allocate your charges between your Cost
-- Category values.
--
-- 'name', 'createCostCategoryDefinition_name' - Undocumented member.
--
-- 'ruleVersion', 'createCostCategoryDefinition_ruleVersion' - Undocumented member.
--
-- 'rules', 'createCostCategoryDefinition_rules' - The Cost Category rules used to categorize costs. For more information,
-- see
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategoryRule.html CostCategoryRule>.
newCreateCostCategoryDefinition ::
  -- | 'name'
  Prelude.Text ->
  -- | 'ruleVersion'
  CostCategoryRuleVersion ->
  -- | 'rules'
  Prelude.NonEmpty CostCategoryRule ->
  CreateCostCategoryDefinition
newCreateCostCategoryDefinition :: Text
-> CostCategoryRuleVersion
-> NonEmpty CostCategoryRule
-> CreateCostCategoryDefinition
newCreateCostCategoryDefinition
  Text
pName_
  CostCategoryRuleVersion
pRuleVersion_
  NonEmpty CostCategoryRule
pRules_ =
    CreateCostCategoryDefinition'
      { $sel:defaultValue:CreateCostCategoryDefinition' :: Maybe Text
defaultValue =
          forall a. Maybe a
Prelude.Nothing,
        $sel:effectiveStart:CreateCostCategoryDefinition' :: Maybe Text
effectiveStart = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceTags:CreateCostCategoryDefinition' :: Maybe [ResourceTag]
resourceTags = forall a. Maybe a
Prelude.Nothing,
        $sel:splitChargeRules:CreateCostCategoryDefinition' :: Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateCostCategoryDefinition' :: Text
name = Text
pName_,
        $sel:ruleVersion:CreateCostCategoryDefinition' :: CostCategoryRuleVersion
ruleVersion = CostCategoryRuleVersion
pRuleVersion_,
        $sel:rules:CreateCostCategoryDefinition' :: NonEmpty CostCategoryRule
rules = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty CostCategoryRule
pRules_
      }

-- | Undocumented member.
createCostCategoryDefinition_defaultValue :: Lens.Lens' CreateCostCategoryDefinition (Prelude.Maybe Prelude.Text)
createCostCategoryDefinition_defaultValue :: Lens' CreateCostCategoryDefinition (Maybe Text)
createCostCategoryDefinition_defaultValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinition' {Maybe Text
defaultValue :: Maybe Text
$sel:defaultValue:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
defaultValue} -> Maybe Text
defaultValue) (\s :: CreateCostCategoryDefinition
s@CreateCostCategoryDefinition' {} Maybe Text
a -> CreateCostCategoryDefinition
s {$sel:defaultValue:CreateCostCategoryDefinition' :: Maybe Text
defaultValue = Maybe Text
a} :: CreateCostCategoryDefinition)

-- | The Cost Category\'s effective start date. It can only be a billing
-- start date (first day of the month). If the date isn\'t provided, it\'s
-- the first day of the current month. Dates can\'t be before the previous
-- twelve months, or in the future.
createCostCategoryDefinition_effectiveStart :: Lens.Lens' CreateCostCategoryDefinition (Prelude.Maybe Prelude.Text)
createCostCategoryDefinition_effectiveStart :: Lens' CreateCostCategoryDefinition (Maybe Text)
createCostCategoryDefinition_effectiveStart = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinition' {Maybe Text
effectiveStart :: Maybe Text
$sel:effectiveStart:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
effectiveStart} -> Maybe Text
effectiveStart) (\s :: CreateCostCategoryDefinition
s@CreateCostCategoryDefinition' {} Maybe Text
a -> CreateCostCategoryDefinition
s {$sel:effectiveStart:CreateCostCategoryDefinition' :: Maybe Text
effectiveStart = Maybe Text
a} :: CreateCostCategoryDefinition)

-- | An optional list of tags to associate with the specified
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategory.html CostCategory>
-- . You can use resource tags to control access to your @cost category@
-- using IAM policies.
--
-- Each tag consists of a key and a value, and each key must be unique for
-- the resource. The following restrictions apply to resource tags:
--
-- -   Although the maximum number of array members is 200, you can assign
--     a maximum of 50 user-tags to one resource. The remaining are
--     reserved for Amazon Web Services use
--
-- -   The maximum length of a key is 128 characters
--
-- -   The maximum length of a value is 256 characters
--
-- -   Keys and values can only contain alphanumeric characters, spaces,
--     and any of the following: @_.:\/=+\@-@
--
-- -   Keys and values are case sensitive
--
-- -   Keys and values are trimmed for any leading or trailing whitespaces
--
-- -   Don’t use @aws:@ as a prefix for your keys. This prefix is reserved
--     for Amazon Web Services use
createCostCategoryDefinition_resourceTags :: Lens.Lens' CreateCostCategoryDefinition (Prelude.Maybe [ResourceTag])
createCostCategoryDefinition_resourceTags :: Lens' CreateCostCategoryDefinition (Maybe [ResourceTag])
createCostCategoryDefinition_resourceTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinition' {Maybe [ResourceTag]
resourceTags :: Maybe [ResourceTag]
$sel:resourceTags:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe [ResourceTag]
resourceTags} -> Maybe [ResourceTag]
resourceTags) (\s :: CreateCostCategoryDefinition
s@CreateCostCategoryDefinition' {} Maybe [ResourceTag]
a -> CreateCostCategoryDefinition
s {$sel:resourceTags:CreateCostCategoryDefinition' :: Maybe [ResourceTag]
resourceTags = Maybe [ResourceTag]
a} :: CreateCostCategoryDefinition) 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 split charge rules used to allocate your charges between your Cost
-- Category values.
createCostCategoryDefinition_splitChargeRules :: Lens.Lens' CreateCostCategoryDefinition (Prelude.Maybe (Prelude.NonEmpty CostCategorySplitChargeRule))
createCostCategoryDefinition_splitChargeRules :: Lens'
  CreateCostCategoryDefinition
  (Maybe (NonEmpty CostCategorySplitChargeRule))
createCostCategoryDefinition_splitChargeRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinition' {Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:splitChargeRules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules} -> Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules) (\s :: CreateCostCategoryDefinition
s@CreateCostCategoryDefinition' {} Maybe (NonEmpty CostCategorySplitChargeRule)
a -> CreateCostCategoryDefinition
s {$sel:splitChargeRules:CreateCostCategoryDefinition' :: Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules = Maybe (NonEmpty CostCategorySplitChargeRule)
a} :: CreateCostCategoryDefinition) 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

-- | Undocumented member.
createCostCategoryDefinition_name :: Lens.Lens' CreateCostCategoryDefinition Prelude.Text
createCostCategoryDefinition_name :: Lens' CreateCostCategoryDefinition Text
createCostCategoryDefinition_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinition' {Text
name :: Text
$sel:name:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Text
name} -> Text
name) (\s :: CreateCostCategoryDefinition
s@CreateCostCategoryDefinition' {} Text
a -> CreateCostCategoryDefinition
s {$sel:name:CreateCostCategoryDefinition' :: Text
name = Text
a} :: CreateCostCategoryDefinition)

-- | Undocumented member.
createCostCategoryDefinition_ruleVersion :: Lens.Lens' CreateCostCategoryDefinition CostCategoryRuleVersion
createCostCategoryDefinition_ruleVersion :: Lens' CreateCostCategoryDefinition CostCategoryRuleVersion
createCostCategoryDefinition_ruleVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinition' {CostCategoryRuleVersion
ruleVersion :: CostCategoryRuleVersion
$sel:ruleVersion:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> CostCategoryRuleVersion
ruleVersion} -> CostCategoryRuleVersion
ruleVersion) (\s :: CreateCostCategoryDefinition
s@CreateCostCategoryDefinition' {} CostCategoryRuleVersion
a -> CreateCostCategoryDefinition
s {$sel:ruleVersion:CreateCostCategoryDefinition' :: CostCategoryRuleVersion
ruleVersion = CostCategoryRuleVersion
a} :: CreateCostCategoryDefinition)

-- | The Cost Category rules used to categorize costs. For more information,
-- see
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategoryRule.html CostCategoryRule>.
createCostCategoryDefinition_rules :: Lens.Lens' CreateCostCategoryDefinition (Prelude.NonEmpty CostCategoryRule)
createCostCategoryDefinition_rules :: Lens' CreateCostCategoryDefinition (NonEmpty CostCategoryRule)
createCostCategoryDefinition_rules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinition' {NonEmpty CostCategoryRule
rules :: NonEmpty CostCategoryRule
$sel:rules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> NonEmpty CostCategoryRule
rules} -> NonEmpty CostCategoryRule
rules) (\s :: CreateCostCategoryDefinition
s@CreateCostCategoryDefinition' {} NonEmpty CostCategoryRule
a -> CreateCostCategoryDefinition
s {$sel:rules:CreateCostCategoryDefinition' :: NonEmpty CostCategoryRule
rules = NonEmpty CostCategoryRule
a} :: CreateCostCategoryDefinition) 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

instance Core.AWSRequest CreateCostCategoryDefinition where
  type
    AWSResponse CreateCostCategoryDefinition =
      CreateCostCategoryDefinitionResponse
  request :: (Service -> Service)
-> CreateCostCategoryDefinition
-> Request CreateCostCategoryDefinition
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 CreateCostCategoryDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateCostCategoryDefinition)))
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 -> CreateCostCategoryDefinitionResponse
CreateCostCategoryDefinitionResponse'
            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
"CostCategoryArn")
            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
"EffectiveStart")
            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
    CreateCostCategoryDefinition
  where
  hashWithSalt :: Int -> CreateCostCategoryDefinition -> Int
hashWithSalt Int
_salt CreateCostCategoryDefinition' {Maybe [ResourceTag]
Maybe (NonEmpty CostCategorySplitChargeRule)
Maybe Text
NonEmpty CostCategoryRule
Text
CostCategoryRuleVersion
rules :: NonEmpty CostCategoryRule
ruleVersion :: CostCategoryRuleVersion
name :: Text
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
resourceTags :: Maybe [ResourceTag]
effectiveStart :: Maybe Text
defaultValue :: Maybe Text
$sel:rules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> NonEmpty CostCategoryRule
$sel:ruleVersion:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> CostCategoryRuleVersion
$sel:name:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Text
$sel:splitChargeRules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:resourceTags:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe [ResourceTag]
$sel:effectiveStart:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
$sel:defaultValue:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
effectiveStart
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ResourceTag]
resourceTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CostCategoryRuleVersion
ruleVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty CostCategoryRule
rules

instance Prelude.NFData CreateCostCategoryDefinition where
  rnf :: CreateCostCategoryDefinition -> ()
rnf CreateCostCategoryDefinition' {Maybe [ResourceTag]
Maybe (NonEmpty CostCategorySplitChargeRule)
Maybe Text
NonEmpty CostCategoryRule
Text
CostCategoryRuleVersion
rules :: NonEmpty CostCategoryRule
ruleVersion :: CostCategoryRuleVersion
name :: Text
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
resourceTags :: Maybe [ResourceTag]
effectiveStart :: Maybe Text
defaultValue :: Maybe Text
$sel:rules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> NonEmpty CostCategoryRule
$sel:ruleVersion:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> CostCategoryRuleVersion
$sel:name:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Text
$sel:splitChargeRules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:resourceTags:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe [ResourceTag]
$sel:effectiveStart:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
$sel:defaultValue:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
effectiveStart
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResourceTag]
resourceTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CostCategoryRuleVersion
ruleVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty CostCategoryRule
rules

instance Data.ToHeaders CreateCostCategoryDefinition where
  toHeaders :: CreateCostCategoryDefinition -> 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
"AWSInsightsIndexService.CreateCostCategoryDefinition" ::
                          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 CreateCostCategoryDefinition where
  toJSON :: CreateCostCategoryDefinition -> Value
toJSON CreateCostCategoryDefinition' {Maybe [ResourceTag]
Maybe (NonEmpty CostCategorySplitChargeRule)
Maybe Text
NonEmpty CostCategoryRule
Text
CostCategoryRuleVersion
rules :: NonEmpty CostCategoryRule
ruleVersion :: CostCategoryRuleVersion
name :: Text
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
resourceTags :: Maybe [ResourceTag]
effectiveStart :: Maybe Text
defaultValue :: Maybe Text
$sel:rules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> NonEmpty CostCategoryRule
$sel:ruleVersion:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> CostCategoryRuleVersion
$sel:name:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Text
$sel:splitChargeRules:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:resourceTags:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe [ResourceTag]
$sel:effectiveStart:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
$sel:defaultValue:CreateCostCategoryDefinition' :: CreateCostCategoryDefinition -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DefaultValue" 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
defaultValue,
            (Key
"EffectiveStart" 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
effectiveStart,
            (Key
"ResourceTags" 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 [ResourceTag]
resourceTags,
            (Key
"SplitChargeRules" 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 CostCategorySplitChargeRule)
splitChargeRules,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"RuleVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CostCategoryRuleVersion
ruleVersion),
            forall a. a -> Maybe a
Prelude.Just (Key
"Rules" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty CostCategoryRule
rules)
          ]
      )

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

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

-- | /See:/ 'newCreateCostCategoryDefinitionResponse' smart constructor.
data CreateCostCategoryDefinitionResponse = CreateCostCategoryDefinitionResponse'
  { -- | The unique identifier for your newly created Cost Category.
    CreateCostCategoryDefinitionResponse -> Maybe Text
costCategoryArn :: Prelude.Maybe Prelude.Text,
    -- | The Cost Category\'s effective start date. It can only be a billing
    -- start date (first day of the month).
    CreateCostCategoryDefinitionResponse -> Maybe Text
effectiveStart :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateCostCategoryDefinitionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCostCategoryDefinitionResponse
-> CreateCostCategoryDefinitionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCostCategoryDefinitionResponse
-> CreateCostCategoryDefinitionResponse -> Bool
$c/= :: CreateCostCategoryDefinitionResponse
-> CreateCostCategoryDefinitionResponse -> Bool
== :: CreateCostCategoryDefinitionResponse
-> CreateCostCategoryDefinitionResponse -> Bool
$c== :: CreateCostCategoryDefinitionResponse
-> CreateCostCategoryDefinitionResponse -> Bool
Prelude.Eq, ReadPrec [CreateCostCategoryDefinitionResponse]
ReadPrec CreateCostCategoryDefinitionResponse
Int -> ReadS CreateCostCategoryDefinitionResponse
ReadS [CreateCostCategoryDefinitionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCostCategoryDefinitionResponse]
$creadListPrec :: ReadPrec [CreateCostCategoryDefinitionResponse]
readPrec :: ReadPrec CreateCostCategoryDefinitionResponse
$creadPrec :: ReadPrec CreateCostCategoryDefinitionResponse
readList :: ReadS [CreateCostCategoryDefinitionResponse]
$creadList :: ReadS [CreateCostCategoryDefinitionResponse]
readsPrec :: Int -> ReadS CreateCostCategoryDefinitionResponse
$creadsPrec :: Int -> ReadS CreateCostCategoryDefinitionResponse
Prelude.Read, Int -> CreateCostCategoryDefinitionResponse -> ShowS
[CreateCostCategoryDefinitionResponse] -> ShowS
CreateCostCategoryDefinitionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCostCategoryDefinitionResponse] -> ShowS
$cshowList :: [CreateCostCategoryDefinitionResponse] -> ShowS
show :: CreateCostCategoryDefinitionResponse -> String
$cshow :: CreateCostCategoryDefinitionResponse -> String
showsPrec :: Int -> CreateCostCategoryDefinitionResponse -> ShowS
$cshowsPrec :: Int -> CreateCostCategoryDefinitionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCostCategoryDefinitionResponse x
-> CreateCostCategoryDefinitionResponse
forall x.
CreateCostCategoryDefinitionResponse
-> Rep CreateCostCategoryDefinitionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCostCategoryDefinitionResponse x
-> CreateCostCategoryDefinitionResponse
$cfrom :: forall x.
CreateCostCategoryDefinitionResponse
-> Rep CreateCostCategoryDefinitionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCostCategoryDefinitionResponse' 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:
--
-- 'costCategoryArn', 'createCostCategoryDefinitionResponse_costCategoryArn' - The unique identifier for your newly created Cost Category.
--
-- 'effectiveStart', 'createCostCategoryDefinitionResponse_effectiveStart' - The Cost Category\'s effective start date. It can only be a billing
-- start date (first day of the month).
--
-- 'httpStatus', 'createCostCategoryDefinitionResponse_httpStatus' - The response's http status code.
newCreateCostCategoryDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCostCategoryDefinitionResponse
newCreateCostCategoryDefinitionResponse :: Int -> CreateCostCategoryDefinitionResponse
newCreateCostCategoryDefinitionResponse Int
pHttpStatus_ =
  CreateCostCategoryDefinitionResponse'
    { $sel:costCategoryArn:CreateCostCategoryDefinitionResponse' :: Maybe Text
costCategoryArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:effectiveStart:CreateCostCategoryDefinitionResponse' :: Maybe Text
effectiveStart = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCostCategoryDefinitionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier for your newly created Cost Category.
createCostCategoryDefinitionResponse_costCategoryArn :: Lens.Lens' CreateCostCategoryDefinitionResponse (Prelude.Maybe Prelude.Text)
createCostCategoryDefinitionResponse_costCategoryArn :: Lens' CreateCostCategoryDefinitionResponse (Maybe Text)
createCostCategoryDefinitionResponse_costCategoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinitionResponse' {Maybe Text
costCategoryArn :: Maybe Text
$sel:costCategoryArn:CreateCostCategoryDefinitionResponse' :: CreateCostCategoryDefinitionResponse -> Maybe Text
costCategoryArn} -> Maybe Text
costCategoryArn) (\s :: CreateCostCategoryDefinitionResponse
s@CreateCostCategoryDefinitionResponse' {} Maybe Text
a -> CreateCostCategoryDefinitionResponse
s {$sel:costCategoryArn:CreateCostCategoryDefinitionResponse' :: Maybe Text
costCategoryArn = Maybe Text
a} :: CreateCostCategoryDefinitionResponse)

-- | The Cost Category\'s effective start date. It can only be a billing
-- start date (first day of the month).
createCostCategoryDefinitionResponse_effectiveStart :: Lens.Lens' CreateCostCategoryDefinitionResponse (Prelude.Maybe Prelude.Text)
createCostCategoryDefinitionResponse_effectiveStart :: Lens' CreateCostCategoryDefinitionResponse (Maybe Text)
createCostCategoryDefinitionResponse_effectiveStart = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCostCategoryDefinitionResponse' {Maybe Text
effectiveStart :: Maybe Text
$sel:effectiveStart:CreateCostCategoryDefinitionResponse' :: CreateCostCategoryDefinitionResponse -> Maybe Text
effectiveStart} -> Maybe Text
effectiveStart) (\s :: CreateCostCategoryDefinitionResponse
s@CreateCostCategoryDefinitionResponse' {} Maybe Text
a -> CreateCostCategoryDefinitionResponse
s {$sel:effectiveStart:CreateCostCategoryDefinitionResponse' :: Maybe Text
effectiveStart = Maybe Text
a} :: CreateCostCategoryDefinitionResponse)

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

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