{-# 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.DeleteCostCategoryDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a Cost Category. Expenses from this month going forward will no
-- longer be categorized with this Cost Category.
module Amazonka.CostExplorer.DeleteCostCategoryDefinition
  ( -- * Creating a Request
    DeleteCostCategoryDefinition (..),
    newDeleteCostCategoryDefinition,

    -- * Request Lenses
    deleteCostCategoryDefinition_costCategoryArn,

    -- * Destructuring the Response
    DeleteCostCategoryDefinitionResponse (..),
    newDeleteCostCategoryDefinitionResponse,

    -- * Response Lenses
    deleteCostCategoryDefinitionResponse_costCategoryArn,
    deleteCostCategoryDefinitionResponse_effectiveEnd,
    deleteCostCategoryDefinitionResponse_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:/ 'newDeleteCostCategoryDefinition' smart constructor.
data DeleteCostCategoryDefinition = DeleteCostCategoryDefinition'
  { -- | The unique identifier for your Cost Category.
    DeleteCostCategoryDefinition -> Text
costCategoryArn :: Prelude.Text
  }
  deriving (DeleteCostCategoryDefinition
-> DeleteCostCategoryDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCostCategoryDefinition
-> DeleteCostCategoryDefinition -> Bool
$c/= :: DeleteCostCategoryDefinition
-> DeleteCostCategoryDefinition -> Bool
== :: DeleteCostCategoryDefinition
-> DeleteCostCategoryDefinition -> Bool
$c== :: DeleteCostCategoryDefinition
-> DeleteCostCategoryDefinition -> Bool
Prelude.Eq, ReadPrec [DeleteCostCategoryDefinition]
ReadPrec DeleteCostCategoryDefinition
Int -> ReadS DeleteCostCategoryDefinition
ReadS [DeleteCostCategoryDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCostCategoryDefinition]
$creadListPrec :: ReadPrec [DeleteCostCategoryDefinition]
readPrec :: ReadPrec DeleteCostCategoryDefinition
$creadPrec :: ReadPrec DeleteCostCategoryDefinition
readList :: ReadS [DeleteCostCategoryDefinition]
$creadList :: ReadS [DeleteCostCategoryDefinition]
readsPrec :: Int -> ReadS DeleteCostCategoryDefinition
$creadsPrec :: Int -> ReadS DeleteCostCategoryDefinition
Prelude.Read, Int -> DeleteCostCategoryDefinition -> ShowS
[DeleteCostCategoryDefinition] -> ShowS
DeleteCostCategoryDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCostCategoryDefinition] -> ShowS
$cshowList :: [DeleteCostCategoryDefinition] -> ShowS
show :: DeleteCostCategoryDefinition -> String
$cshow :: DeleteCostCategoryDefinition -> String
showsPrec :: Int -> DeleteCostCategoryDefinition -> ShowS
$cshowsPrec :: Int -> DeleteCostCategoryDefinition -> ShowS
Prelude.Show, forall x.
Rep DeleteCostCategoryDefinition x -> DeleteCostCategoryDefinition
forall x.
DeleteCostCategoryDefinition -> Rep DeleteCostCategoryDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteCostCategoryDefinition x -> DeleteCostCategoryDefinition
$cfrom :: forall x.
DeleteCostCategoryDefinition -> Rep DeleteCostCategoryDefinition x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCostCategoryDefinition' 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', 'deleteCostCategoryDefinition_costCategoryArn' - The unique identifier for your Cost Category.
newDeleteCostCategoryDefinition ::
  -- | 'costCategoryArn'
  Prelude.Text ->
  DeleteCostCategoryDefinition
newDeleteCostCategoryDefinition :: Text -> DeleteCostCategoryDefinition
newDeleteCostCategoryDefinition Text
pCostCategoryArn_ =
  DeleteCostCategoryDefinition'
    { $sel:costCategoryArn:DeleteCostCategoryDefinition' :: Text
costCategoryArn =
        Text
pCostCategoryArn_
    }

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

instance Core.AWSRequest DeleteCostCategoryDefinition where
  type
    AWSResponse DeleteCostCategoryDefinition =
      DeleteCostCategoryDefinitionResponse
  request :: (Service -> Service)
-> DeleteCostCategoryDefinition
-> Request DeleteCostCategoryDefinition
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 DeleteCostCategoryDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteCostCategoryDefinition)))
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 -> DeleteCostCategoryDefinitionResponse
DeleteCostCategoryDefinitionResponse'
            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
"EffectiveEnd")
            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
    DeleteCostCategoryDefinition
  where
  hashWithSalt :: Int -> DeleteCostCategoryDefinition -> Int
hashWithSalt Int
_salt DeleteCostCategoryDefinition' {Text
costCategoryArn :: Text
$sel:costCategoryArn:DeleteCostCategoryDefinition' :: DeleteCostCategoryDefinition -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
costCategoryArn

instance Prelude.NFData DeleteCostCategoryDefinition where
  rnf :: DeleteCostCategoryDefinition -> ()
rnf DeleteCostCategoryDefinition' {Text
costCategoryArn :: Text
$sel:costCategoryArn:DeleteCostCategoryDefinition' :: DeleteCostCategoryDefinition -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
costCategoryArn

instance Data.ToHeaders DeleteCostCategoryDefinition where
  toHeaders :: DeleteCostCategoryDefinition -> 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.DeleteCostCategoryDefinition" ::
                          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 DeleteCostCategoryDefinition where
  toJSON :: DeleteCostCategoryDefinition -> Value
toJSON DeleteCostCategoryDefinition' {Text
costCategoryArn :: Text
$sel:costCategoryArn:DeleteCostCategoryDefinition' :: DeleteCostCategoryDefinition -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"CostCategoryArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
costCategoryArn)
          ]
      )

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

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

-- | /See:/ 'newDeleteCostCategoryDefinitionResponse' smart constructor.
data DeleteCostCategoryDefinitionResponse = DeleteCostCategoryDefinitionResponse'
  { -- | The unique identifier for your Cost Category.
    DeleteCostCategoryDefinitionResponse -> Maybe Text
costCategoryArn :: Prelude.Maybe Prelude.Text,
    -- | The effective end date of the Cost Category as a result of deleting it.
    -- No costs after this date is categorized by the deleted Cost Category.
    DeleteCostCategoryDefinitionResponse -> Maybe Text
effectiveEnd :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteCostCategoryDefinitionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteCostCategoryDefinitionResponse
-> DeleteCostCategoryDefinitionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCostCategoryDefinitionResponse
-> DeleteCostCategoryDefinitionResponse -> Bool
$c/= :: DeleteCostCategoryDefinitionResponse
-> DeleteCostCategoryDefinitionResponse -> Bool
== :: DeleteCostCategoryDefinitionResponse
-> DeleteCostCategoryDefinitionResponse -> Bool
$c== :: DeleteCostCategoryDefinitionResponse
-> DeleteCostCategoryDefinitionResponse -> Bool
Prelude.Eq, ReadPrec [DeleteCostCategoryDefinitionResponse]
ReadPrec DeleteCostCategoryDefinitionResponse
Int -> ReadS DeleteCostCategoryDefinitionResponse
ReadS [DeleteCostCategoryDefinitionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCostCategoryDefinitionResponse]
$creadListPrec :: ReadPrec [DeleteCostCategoryDefinitionResponse]
readPrec :: ReadPrec DeleteCostCategoryDefinitionResponse
$creadPrec :: ReadPrec DeleteCostCategoryDefinitionResponse
readList :: ReadS [DeleteCostCategoryDefinitionResponse]
$creadList :: ReadS [DeleteCostCategoryDefinitionResponse]
readsPrec :: Int -> ReadS DeleteCostCategoryDefinitionResponse
$creadsPrec :: Int -> ReadS DeleteCostCategoryDefinitionResponse
Prelude.Read, Int -> DeleteCostCategoryDefinitionResponse -> ShowS
[DeleteCostCategoryDefinitionResponse] -> ShowS
DeleteCostCategoryDefinitionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCostCategoryDefinitionResponse] -> ShowS
$cshowList :: [DeleteCostCategoryDefinitionResponse] -> ShowS
show :: DeleteCostCategoryDefinitionResponse -> String
$cshow :: DeleteCostCategoryDefinitionResponse -> String
showsPrec :: Int -> DeleteCostCategoryDefinitionResponse -> ShowS
$cshowsPrec :: Int -> DeleteCostCategoryDefinitionResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteCostCategoryDefinitionResponse x
-> DeleteCostCategoryDefinitionResponse
forall x.
DeleteCostCategoryDefinitionResponse
-> Rep DeleteCostCategoryDefinitionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteCostCategoryDefinitionResponse x
-> DeleteCostCategoryDefinitionResponse
$cfrom :: forall x.
DeleteCostCategoryDefinitionResponse
-> Rep DeleteCostCategoryDefinitionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCostCategoryDefinitionResponse' 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', 'deleteCostCategoryDefinitionResponse_costCategoryArn' - The unique identifier for your Cost Category.
--
-- 'effectiveEnd', 'deleteCostCategoryDefinitionResponse_effectiveEnd' - The effective end date of the Cost Category as a result of deleting it.
-- No costs after this date is categorized by the deleted Cost Category.
--
-- 'httpStatus', 'deleteCostCategoryDefinitionResponse_httpStatus' - The response's http status code.
newDeleteCostCategoryDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteCostCategoryDefinitionResponse
newDeleteCostCategoryDefinitionResponse :: Int -> DeleteCostCategoryDefinitionResponse
newDeleteCostCategoryDefinitionResponse Int
pHttpStatus_ =
  DeleteCostCategoryDefinitionResponse'
    { $sel:costCategoryArn:DeleteCostCategoryDefinitionResponse' :: Maybe Text
costCategoryArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:effectiveEnd:DeleteCostCategoryDefinitionResponse' :: Maybe Text
effectiveEnd = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteCostCategoryDefinitionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The effective end date of the Cost Category as a result of deleting it.
-- No costs after this date is categorized by the deleted Cost Category.
deleteCostCategoryDefinitionResponse_effectiveEnd :: Lens.Lens' DeleteCostCategoryDefinitionResponse (Prelude.Maybe Prelude.Text)
deleteCostCategoryDefinitionResponse_effectiveEnd :: Lens' DeleteCostCategoryDefinitionResponse (Maybe Text)
deleteCostCategoryDefinitionResponse_effectiveEnd = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCostCategoryDefinitionResponse' {Maybe Text
effectiveEnd :: Maybe Text
$sel:effectiveEnd:DeleteCostCategoryDefinitionResponse' :: DeleteCostCategoryDefinitionResponse -> Maybe Text
effectiveEnd} -> Maybe Text
effectiveEnd) (\s :: DeleteCostCategoryDefinitionResponse
s@DeleteCostCategoryDefinitionResponse' {} Maybe Text
a -> DeleteCostCategoryDefinitionResponse
s {$sel:effectiveEnd:DeleteCostCategoryDefinitionResponse' :: Maybe Text
effectiveEnd = Maybe Text
a} :: DeleteCostCategoryDefinitionResponse)

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

instance
  Prelude.NFData
    DeleteCostCategoryDefinitionResponse
  where
  rnf :: DeleteCostCategoryDefinitionResponse -> ()
rnf DeleteCostCategoryDefinitionResponse' {Int
Maybe Text
httpStatus :: Int
effectiveEnd :: Maybe Text
costCategoryArn :: Maybe Text
$sel:httpStatus:DeleteCostCategoryDefinitionResponse' :: DeleteCostCategoryDefinitionResponse -> Int
$sel:effectiveEnd:DeleteCostCategoryDefinitionResponse' :: DeleteCostCategoryDefinitionResponse -> Maybe Text
$sel:costCategoryArn:DeleteCostCategoryDefinitionResponse' :: DeleteCostCategoryDefinitionResponse -> 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
effectiveEnd
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus