{-# 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.UpdateCostCategoryDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing Cost Category. Changes made to the Cost Category
-- rules will be used to categorize the current month’s expenses and future
-- expenses. This won’t change categorization for the previous months.
module Amazonka.CostExplorer.UpdateCostCategoryDefinition
  ( -- * Creating a Request
    UpdateCostCategoryDefinition (..),
    newUpdateCostCategoryDefinition,

    -- * Request Lenses
    updateCostCategoryDefinition_defaultValue,
    updateCostCategoryDefinition_effectiveStart,
    updateCostCategoryDefinition_splitChargeRules,
    updateCostCategoryDefinition_costCategoryArn,
    updateCostCategoryDefinition_ruleVersion,
    updateCostCategoryDefinition_rules,

    -- * Destructuring the Response
    UpdateCostCategoryDefinitionResponse (..),
    newUpdateCostCategoryDefinitionResponse,

    -- * Response Lenses
    updateCostCategoryDefinitionResponse_costCategoryArn,
    updateCostCategoryDefinitionResponse_effectiveStart,
    updateCostCategoryDefinitionResponse_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:/ 'newUpdateCostCategoryDefinition' smart constructor.
data UpdateCostCategoryDefinition = UpdateCostCategoryDefinition'
  { UpdateCostCategoryDefinition -> 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.
    UpdateCostCategoryDefinition -> Maybe Text
effectiveStart :: Prelude.Maybe Prelude.Text,
    -- | The split charge rules used to allocate your charges between your Cost
    -- Category values.
    UpdateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules :: Prelude.Maybe (Prelude.NonEmpty CostCategorySplitChargeRule),
    -- | The unique identifier for your Cost Category.
    UpdateCostCategoryDefinition -> Text
costCategoryArn :: Prelude.Text,
    UpdateCostCategoryDefinition -> CostCategoryRuleVersion
ruleVersion :: CostCategoryRuleVersion,
    -- | The @Expression@ object used to categorize costs. For more information,
    -- see
    -- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategoryRule.html CostCategoryRule>
    -- .
    UpdateCostCategoryDefinition -> NonEmpty CostCategoryRule
rules :: Prelude.NonEmpty CostCategoryRule
  }
  deriving (UpdateCostCategoryDefinition
-> UpdateCostCategoryDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCostCategoryDefinition
-> UpdateCostCategoryDefinition -> Bool
$c/= :: UpdateCostCategoryDefinition
-> UpdateCostCategoryDefinition -> Bool
== :: UpdateCostCategoryDefinition
-> UpdateCostCategoryDefinition -> Bool
$c== :: UpdateCostCategoryDefinition
-> UpdateCostCategoryDefinition -> Bool
Prelude.Eq, ReadPrec [UpdateCostCategoryDefinition]
ReadPrec UpdateCostCategoryDefinition
Int -> ReadS UpdateCostCategoryDefinition
ReadS [UpdateCostCategoryDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCostCategoryDefinition]
$creadListPrec :: ReadPrec [UpdateCostCategoryDefinition]
readPrec :: ReadPrec UpdateCostCategoryDefinition
$creadPrec :: ReadPrec UpdateCostCategoryDefinition
readList :: ReadS [UpdateCostCategoryDefinition]
$creadList :: ReadS [UpdateCostCategoryDefinition]
readsPrec :: Int -> ReadS UpdateCostCategoryDefinition
$creadsPrec :: Int -> ReadS UpdateCostCategoryDefinition
Prelude.Read, Int -> UpdateCostCategoryDefinition -> ShowS
[UpdateCostCategoryDefinition] -> ShowS
UpdateCostCategoryDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCostCategoryDefinition] -> ShowS
$cshowList :: [UpdateCostCategoryDefinition] -> ShowS
show :: UpdateCostCategoryDefinition -> String
$cshow :: UpdateCostCategoryDefinition -> String
showsPrec :: Int -> UpdateCostCategoryDefinition -> ShowS
$cshowsPrec :: Int -> UpdateCostCategoryDefinition -> ShowS
Prelude.Show, forall x.
Rep UpdateCostCategoryDefinition x -> UpdateCostCategoryDefinition
forall x.
UpdateCostCategoryDefinition -> Rep UpdateCostCategoryDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCostCategoryDefinition x -> UpdateCostCategoryDefinition
$cfrom :: forall x.
UpdateCostCategoryDefinition -> Rep UpdateCostCategoryDefinition x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCostCategoryDefinition' 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', 'updateCostCategoryDefinition_defaultValue' - Undocumented member.
--
-- 'effectiveStart', 'updateCostCategoryDefinition_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.
--
-- 'splitChargeRules', 'updateCostCategoryDefinition_splitChargeRules' - The split charge rules used to allocate your charges between your Cost
-- Category values.
--
-- 'costCategoryArn', 'updateCostCategoryDefinition_costCategoryArn' - The unique identifier for your Cost Category.
--
-- 'ruleVersion', 'updateCostCategoryDefinition_ruleVersion' - Undocumented member.
--
-- 'rules', 'updateCostCategoryDefinition_rules' - The @Expression@ object used to categorize costs. For more information,
-- see
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategoryRule.html CostCategoryRule>
-- .
newUpdateCostCategoryDefinition ::
  -- | 'costCategoryArn'
  Prelude.Text ->
  -- | 'ruleVersion'
  CostCategoryRuleVersion ->
  -- | 'rules'
  Prelude.NonEmpty CostCategoryRule ->
  UpdateCostCategoryDefinition
newUpdateCostCategoryDefinition :: Text
-> CostCategoryRuleVersion
-> NonEmpty CostCategoryRule
-> UpdateCostCategoryDefinition
newUpdateCostCategoryDefinition
  Text
pCostCategoryArn_
  CostCategoryRuleVersion
pRuleVersion_
  NonEmpty CostCategoryRule
pRules_ =
    UpdateCostCategoryDefinition'
      { $sel:defaultValue:UpdateCostCategoryDefinition' :: Maybe Text
defaultValue =
          forall a. Maybe a
Prelude.Nothing,
        $sel:effectiveStart:UpdateCostCategoryDefinition' :: Maybe Text
effectiveStart = forall a. Maybe a
Prelude.Nothing,
        $sel:splitChargeRules:UpdateCostCategoryDefinition' :: Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules = forall a. Maybe a
Prelude.Nothing,
        $sel:costCategoryArn:UpdateCostCategoryDefinition' :: Text
costCategoryArn = Text
pCostCategoryArn_,
        $sel:ruleVersion:UpdateCostCategoryDefinition' :: CostCategoryRuleVersion
ruleVersion = CostCategoryRuleVersion
pRuleVersion_,
        $sel:rules:UpdateCostCategoryDefinition' :: 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.
updateCostCategoryDefinition_defaultValue :: Lens.Lens' UpdateCostCategoryDefinition (Prelude.Maybe Prelude.Text)
updateCostCategoryDefinition_defaultValue :: Lens' UpdateCostCategoryDefinition (Maybe Text)
updateCostCategoryDefinition_defaultValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostCategoryDefinition' {Maybe Text
defaultValue :: Maybe Text
$sel:defaultValue:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Maybe Text
defaultValue} -> Maybe Text
defaultValue) (\s :: UpdateCostCategoryDefinition
s@UpdateCostCategoryDefinition' {} Maybe Text
a -> UpdateCostCategoryDefinition
s {$sel:defaultValue:UpdateCostCategoryDefinition' :: Maybe Text
defaultValue = Maybe Text
a} :: UpdateCostCategoryDefinition)

-- | 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.
updateCostCategoryDefinition_effectiveStart :: Lens.Lens' UpdateCostCategoryDefinition (Prelude.Maybe Prelude.Text)
updateCostCategoryDefinition_effectiveStart :: Lens' UpdateCostCategoryDefinition (Maybe Text)
updateCostCategoryDefinition_effectiveStart = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostCategoryDefinition' {Maybe Text
effectiveStart :: Maybe Text
$sel:effectiveStart:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Maybe Text
effectiveStart} -> Maybe Text
effectiveStart) (\s :: UpdateCostCategoryDefinition
s@UpdateCostCategoryDefinition' {} Maybe Text
a -> UpdateCostCategoryDefinition
s {$sel:effectiveStart:UpdateCostCategoryDefinition' :: Maybe Text
effectiveStart = Maybe Text
a} :: UpdateCostCategoryDefinition)

-- | The split charge rules used to allocate your charges between your Cost
-- Category values.
updateCostCategoryDefinition_splitChargeRules :: Lens.Lens' UpdateCostCategoryDefinition (Prelude.Maybe (Prelude.NonEmpty CostCategorySplitChargeRule))
updateCostCategoryDefinition_splitChargeRules :: Lens'
  UpdateCostCategoryDefinition
  (Maybe (NonEmpty CostCategorySplitChargeRule))
updateCostCategoryDefinition_splitChargeRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostCategoryDefinition' {Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:splitChargeRules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules} -> Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules) (\s :: UpdateCostCategoryDefinition
s@UpdateCostCategoryDefinition' {} Maybe (NonEmpty CostCategorySplitChargeRule)
a -> UpdateCostCategoryDefinition
s {$sel:splitChargeRules:UpdateCostCategoryDefinition' :: Maybe (NonEmpty CostCategorySplitChargeRule)
splitChargeRules = Maybe (NonEmpty CostCategorySplitChargeRule)
a} :: UpdateCostCategoryDefinition) 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 identifier for your Cost Category.
updateCostCategoryDefinition_costCategoryArn :: Lens.Lens' UpdateCostCategoryDefinition Prelude.Text
updateCostCategoryDefinition_costCategoryArn :: Lens' UpdateCostCategoryDefinition Text
updateCostCategoryDefinition_costCategoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostCategoryDefinition' {Text
costCategoryArn :: Text
$sel:costCategoryArn:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Text
costCategoryArn} -> Text
costCategoryArn) (\s :: UpdateCostCategoryDefinition
s@UpdateCostCategoryDefinition' {} Text
a -> UpdateCostCategoryDefinition
s {$sel:costCategoryArn:UpdateCostCategoryDefinition' :: Text
costCategoryArn = Text
a} :: UpdateCostCategoryDefinition)

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

-- | The @Expression@ object used to categorize costs. For more information,
-- see
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_CostCategoryRule.html CostCategoryRule>
-- .
updateCostCategoryDefinition_rules :: Lens.Lens' UpdateCostCategoryDefinition (Prelude.NonEmpty CostCategoryRule)
updateCostCategoryDefinition_rules :: Lens' UpdateCostCategoryDefinition (NonEmpty CostCategoryRule)
updateCostCategoryDefinition_rules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostCategoryDefinition' {NonEmpty CostCategoryRule
rules :: NonEmpty CostCategoryRule
$sel:rules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> NonEmpty CostCategoryRule
rules} -> NonEmpty CostCategoryRule
rules) (\s :: UpdateCostCategoryDefinition
s@UpdateCostCategoryDefinition' {} NonEmpty CostCategoryRule
a -> UpdateCostCategoryDefinition
s {$sel:rules:UpdateCostCategoryDefinition' :: NonEmpty CostCategoryRule
rules = NonEmpty CostCategoryRule
a} :: UpdateCostCategoryDefinition) 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 UpdateCostCategoryDefinition where
  type
    AWSResponse UpdateCostCategoryDefinition =
      UpdateCostCategoryDefinitionResponse
  request :: (Service -> Service)
-> UpdateCostCategoryDefinition
-> Request UpdateCostCategoryDefinition
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 UpdateCostCategoryDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateCostCategoryDefinition)))
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 -> UpdateCostCategoryDefinitionResponse
UpdateCostCategoryDefinitionResponse'
            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
    UpdateCostCategoryDefinition
  where
  hashWithSalt :: Int -> UpdateCostCategoryDefinition -> Int
hashWithSalt Int
_salt UpdateCostCategoryDefinition' {Maybe (NonEmpty CostCategorySplitChargeRule)
Maybe Text
NonEmpty CostCategoryRule
Text
CostCategoryRuleVersion
rules :: NonEmpty CostCategoryRule
ruleVersion :: CostCategoryRuleVersion
costCategoryArn :: Text
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
effectiveStart :: Maybe Text
defaultValue :: Maybe Text
$sel:rules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> NonEmpty CostCategoryRule
$sel:ruleVersion:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> CostCategoryRuleVersion
$sel:costCategoryArn:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Text
$sel:splitChargeRules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:effectiveStart:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Maybe Text
$sel:defaultValue:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> 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 (NonEmpty CostCategorySplitChargeRule)
splitChargeRules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
costCategoryArn
      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 UpdateCostCategoryDefinition where
  rnf :: UpdateCostCategoryDefinition -> ()
rnf UpdateCostCategoryDefinition' {Maybe (NonEmpty CostCategorySplitChargeRule)
Maybe Text
NonEmpty CostCategoryRule
Text
CostCategoryRuleVersion
rules :: NonEmpty CostCategoryRule
ruleVersion :: CostCategoryRuleVersion
costCategoryArn :: Text
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
effectiveStart :: Maybe Text
defaultValue :: Maybe Text
$sel:rules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> NonEmpty CostCategoryRule
$sel:ruleVersion:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> CostCategoryRuleVersion
$sel:costCategoryArn:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Text
$sel:splitChargeRules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:effectiveStart:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Maybe Text
$sel:defaultValue:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> 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 (NonEmpty CostCategorySplitChargeRule)
splitChargeRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
costCategoryArn
      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 UpdateCostCategoryDefinition where
  toHeaders :: UpdateCostCategoryDefinition -> 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.UpdateCostCategoryDefinition" ::
                          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 UpdateCostCategoryDefinition where
  toJSON :: UpdateCostCategoryDefinition -> Value
toJSON UpdateCostCategoryDefinition' {Maybe (NonEmpty CostCategorySplitChargeRule)
Maybe Text
NonEmpty CostCategoryRule
Text
CostCategoryRuleVersion
rules :: NonEmpty CostCategoryRule
ruleVersion :: CostCategoryRuleVersion
costCategoryArn :: Text
splitChargeRules :: Maybe (NonEmpty CostCategorySplitChargeRule)
effectiveStart :: Maybe Text
defaultValue :: Maybe Text
$sel:rules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> NonEmpty CostCategoryRule
$sel:ruleVersion:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> CostCategoryRuleVersion
$sel:costCategoryArn:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Text
$sel:splitChargeRules:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition
-> Maybe (NonEmpty CostCategorySplitChargeRule)
$sel:effectiveStart:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> Maybe Text
$sel:defaultValue:UpdateCostCategoryDefinition' :: UpdateCostCategoryDefinition -> 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
"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
"CostCategoryArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
costCategoryArn),
            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 UpdateCostCategoryDefinition where
  toPath :: UpdateCostCategoryDefinition -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdateCostCategoryDefinitionResponse' smart constructor.
data UpdateCostCategoryDefinitionResponse = UpdateCostCategoryDefinitionResponse'
  { -- | The unique identifier for your Cost Category.
    UpdateCostCategoryDefinitionResponse -> 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).
    UpdateCostCategoryDefinitionResponse -> Maybe Text
effectiveStart :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateCostCategoryDefinitionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateCostCategoryDefinitionResponse
-> UpdateCostCategoryDefinitionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCostCategoryDefinitionResponse
-> UpdateCostCategoryDefinitionResponse -> Bool
$c/= :: UpdateCostCategoryDefinitionResponse
-> UpdateCostCategoryDefinitionResponse -> Bool
== :: UpdateCostCategoryDefinitionResponse
-> UpdateCostCategoryDefinitionResponse -> Bool
$c== :: UpdateCostCategoryDefinitionResponse
-> UpdateCostCategoryDefinitionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateCostCategoryDefinitionResponse]
ReadPrec UpdateCostCategoryDefinitionResponse
Int -> ReadS UpdateCostCategoryDefinitionResponse
ReadS [UpdateCostCategoryDefinitionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCostCategoryDefinitionResponse]
$creadListPrec :: ReadPrec [UpdateCostCategoryDefinitionResponse]
readPrec :: ReadPrec UpdateCostCategoryDefinitionResponse
$creadPrec :: ReadPrec UpdateCostCategoryDefinitionResponse
readList :: ReadS [UpdateCostCategoryDefinitionResponse]
$creadList :: ReadS [UpdateCostCategoryDefinitionResponse]
readsPrec :: Int -> ReadS UpdateCostCategoryDefinitionResponse
$creadsPrec :: Int -> ReadS UpdateCostCategoryDefinitionResponse
Prelude.Read, Int -> UpdateCostCategoryDefinitionResponse -> ShowS
[UpdateCostCategoryDefinitionResponse] -> ShowS
UpdateCostCategoryDefinitionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCostCategoryDefinitionResponse] -> ShowS
$cshowList :: [UpdateCostCategoryDefinitionResponse] -> ShowS
show :: UpdateCostCategoryDefinitionResponse -> String
$cshow :: UpdateCostCategoryDefinitionResponse -> String
showsPrec :: Int -> UpdateCostCategoryDefinitionResponse -> ShowS
$cshowsPrec :: Int -> UpdateCostCategoryDefinitionResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateCostCategoryDefinitionResponse x
-> UpdateCostCategoryDefinitionResponse
forall x.
UpdateCostCategoryDefinitionResponse
-> Rep UpdateCostCategoryDefinitionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCostCategoryDefinitionResponse x
-> UpdateCostCategoryDefinitionResponse
$cfrom :: forall x.
UpdateCostCategoryDefinitionResponse
-> Rep UpdateCostCategoryDefinitionResponse x
Prelude.Generic)

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

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

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

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

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