{-# 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.BillingConductor.CreateBillingGroup
-- 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 billing group that resembles a consolidated billing family
-- that Amazon Web Services charges, based off of the predefined pricing
-- plan computation.
module Amazonka.BillingConductor.CreateBillingGroup
  ( -- * Creating a Request
    CreateBillingGroup (..),
    newCreateBillingGroup,

    -- * Request Lenses
    createBillingGroup_clientToken,
    createBillingGroup_description,
    createBillingGroup_primaryAccountId,
    createBillingGroup_tags,
    createBillingGroup_name,
    createBillingGroup_accountGrouping,
    createBillingGroup_computationPreference,

    -- * Destructuring the Response
    CreateBillingGroupResponse (..),
    newCreateBillingGroupResponse,

    -- * Response Lenses
    createBillingGroupResponse_arn,
    createBillingGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateBillingGroup' smart constructor.
data CreateBillingGroup = CreateBillingGroup'
  { -- | The token that is needed to support idempotency. Idempotency isn\'t
    -- currently supported, but will be implemented in a future update.
    CreateBillingGroup -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The description of the billing group.
    CreateBillingGroup -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The account ID that serves as the main account in a billing group.
    CreateBillingGroup -> Maybe Text
primaryAccountId :: Prelude.Maybe Prelude.Text,
    -- | A map that contains tag keys and tag values that are attached to a
    -- billing group. This feature isn\'t available during the beta.
    CreateBillingGroup -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The billing group name. The names must be unique.
    CreateBillingGroup -> Sensitive Text
name :: Data.Sensitive Prelude.Text,
    -- | The set of accounts that will be under the billing group. The set of
    -- accounts resemble the linked accounts in a consolidated family.
    CreateBillingGroup -> AccountGrouping
accountGrouping :: AccountGrouping,
    -- | The preferences and settings that will be used to compute the Amazon Web
    -- Services charges for a billing group.
    CreateBillingGroup -> ComputationPreference
computationPreference :: ComputationPreference
  }
  deriving (CreateBillingGroup -> CreateBillingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBillingGroup -> CreateBillingGroup -> Bool
$c/= :: CreateBillingGroup -> CreateBillingGroup -> Bool
== :: CreateBillingGroup -> CreateBillingGroup -> Bool
$c== :: CreateBillingGroup -> CreateBillingGroup -> Bool
Prelude.Eq, Int -> CreateBillingGroup -> ShowS
[CreateBillingGroup] -> ShowS
CreateBillingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBillingGroup] -> ShowS
$cshowList :: [CreateBillingGroup] -> ShowS
show :: CreateBillingGroup -> String
$cshow :: CreateBillingGroup -> String
showsPrec :: Int -> CreateBillingGroup -> ShowS
$cshowsPrec :: Int -> CreateBillingGroup -> ShowS
Prelude.Show, forall x. Rep CreateBillingGroup x -> CreateBillingGroup
forall x. CreateBillingGroup -> Rep CreateBillingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBillingGroup x -> CreateBillingGroup
$cfrom :: forall x. CreateBillingGroup -> Rep CreateBillingGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateBillingGroup' 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:
--
-- 'clientToken', 'createBillingGroup_clientToken' - The token that is needed to support idempotency. Idempotency isn\'t
-- currently supported, but will be implemented in a future update.
--
-- 'description', 'createBillingGroup_description' - The description of the billing group.
--
-- 'primaryAccountId', 'createBillingGroup_primaryAccountId' - The account ID that serves as the main account in a billing group.
--
-- 'tags', 'createBillingGroup_tags' - A map that contains tag keys and tag values that are attached to a
-- billing group. This feature isn\'t available during the beta.
--
-- 'name', 'createBillingGroup_name' - The billing group name. The names must be unique.
--
-- 'accountGrouping', 'createBillingGroup_accountGrouping' - The set of accounts that will be under the billing group. The set of
-- accounts resemble the linked accounts in a consolidated family.
--
-- 'computationPreference', 'createBillingGroup_computationPreference' - The preferences and settings that will be used to compute the Amazon Web
-- Services charges for a billing group.
newCreateBillingGroup ::
  -- | 'name'
  Prelude.Text ->
  -- | 'accountGrouping'
  AccountGrouping ->
  -- | 'computationPreference'
  ComputationPreference ->
  CreateBillingGroup
newCreateBillingGroup :: Text
-> AccountGrouping -> ComputationPreference -> CreateBillingGroup
newCreateBillingGroup
  Text
pName_
  AccountGrouping
pAccountGrouping_
  ComputationPreference
pComputationPreference_ =
    CreateBillingGroup'
      { $sel:clientToken:CreateBillingGroup' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateBillingGroup' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:primaryAccountId:CreateBillingGroup' :: Maybe Text
primaryAccountId = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateBillingGroup' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateBillingGroup' :: Sensitive Text
name = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pName_,
        $sel:accountGrouping:CreateBillingGroup' :: AccountGrouping
accountGrouping = AccountGrouping
pAccountGrouping_,
        $sel:computationPreference:CreateBillingGroup' :: ComputationPreference
computationPreference = ComputationPreference
pComputationPreference_
      }

-- | The token that is needed to support idempotency. Idempotency isn\'t
-- currently supported, but will be implemented in a future update.
createBillingGroup_clientToken :: Lens.Lens' CreateBillingGroup (Prelude.Maybe Prelude.Text)
createBillingGroup_clientToken :: Lens' CreateBillingGroup (Maybe Text)
createBillingGroup_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Maybe Text
a -> CreateBillingGroup
s {$sel:clientToken:CreateBillingGroup' :: Maybe Text
clientToken = Maybe Text
a} :: CreateBillingGroup)

-- | The description of the billing group.
createBillingGroup_description :: Lens.Lens' CreateBillingGroup (Prelude.Maybe Prelude.Text)
createBillingGroup_description :: Lens' CreateBillingGroup (Maybe Text)
createBillingGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:CreateBillingGroup' :: CreateBillingGroup -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Maybe (Sensitive Text)
a -> CreateBillingGroup
s {$sel:description:CreateBillingGroup' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: CreateBillingGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The account ID that serves as the main account in a billing group.
createBillingGroup_primaryAccountId :: Lens.Lens' CreateBillingGroup (Prelude.Maybe Prelude.Text)
createBillingGroup_primaryAccountId :: Lens' CreateBillingGroup (Maybe Text)
createBillingGroup_primaryAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Maybe Text
primaryAccountId :: Maybe Text
$sel:primaryAccountId:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
primaryAccountId} -> Maybe Text
primaryAccountId) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Maybe Text
a -> CreateBillingGroup
s {$sel:primaryAccountId:CreateBillingGroup' :: Maybe Text
primaryAccountId = Maybe Text
a} :: CreateBillingGroup)

-- | A map that contains tag keys and tag values that are attached to a
-- billing group. This feature isn\'t available during the beta.
createBillingGroup_tags :: Lens.Lens' CreateBillingGroup (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createBillingGroup_tags :: Lens' CreateBillingGroup (Maybe (HashMap Text Text))
createBillingGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Maybe (HashMap Text Text)
a -> CreateBillingGroup
s {$sel:tags:CreateBillingGroup' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateBillingGroup) 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 billing group name. The names must be unique.
createBillingGroup_name :: Lens.Lens' CreateBillingGroup Prelude.Text
createBillingGroup_name :: Lens' CreateBillingGroup Text
createBillingGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Sensitive Text
name :: Sensitive Text
$sel:name:CreateBillingGroup' :: CreateBillingGroup -> Sensitive Text
name} -> Sensitive Text
name) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Sensitive Text
a -> CreateBillingGroup
s {$sel:name:CreateBillingGroup' :: Sensitive Text
name = Sensitive Text
a} :: CreateBillingGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The set of accounts that will be under the billing group. The set of
-- accounts resemble the linked accounts in a consolidated family.
createBillingGroup_accountGrouping :: Lens.Lens' CreateBillingGroup AccountGrouping
createBillingGroup_accountGrouping :: Lens' CreateBillingGroup AccountGrouping
createBillingGroup_accountGrouping = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {AccountGrouping
accountGrouping :: AccountGrouping
$sel:accountGrouping:CreateBillingGroup' :: CreateBillingGroup -> AccountGrouping
accountGrouping} -> AccountGrouping
accountGrouping) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} AccountGrouping
a -> CreateBillingGroup
s {$sel:accountGrouping:CreateBillingGroup' :: AccountGrouping
accountGrouping = AccountGrouping
a} :: CreateBillingGroup)

-- | The preferences and settings that will be used to compute the Amazon Web
-- Services charges for a billing group.
createBillingGroup_computationPreference :: Lens.Lens' CreateBillingGroup ComputationPreference
createBillingGroup_computationPreference :: Lens' CreateBillingGroup ComputationPreference
createBillingGroup_computationPreference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {ComputationPreference
computationPreference :: ComputationPreference
$sel:computationPreference:CreateBillingGroup' :: CreateBillingGroup -> ComputationPreference
computationPreference} -> ComputationPreference
computationPreference) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} ComputationPreference
a -> CreateBillingGroup
s {$sel:computationPreference:CreateBillingGroup' :: ComputationPreference
computationPreference = ComputationPreference
a} :: CreateBillingGroup)

instance Core.AWSRequest CreateBillingGroup where
  type
    AWSResponse CreateBillingGroup =
      CreateBillingGroupResponse
  request :: (Service -> Service)
-> CreateBillingGroup -> Request CreateBillingGroup
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 CreateBillingGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateBillingGroup)))
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 -> CreateBillingGroupResponse
CreateBillingGroupResponse'
            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
"Arn")
            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 CreateBillingGroup where
  hashWithSalt :: Int -> CreateBillingGroup -> Int
hashWithSalt Int
_salt CreateBillingGroup' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Sensitive Text
AccountGrouping
ComputationPreference
computationPreference :: ComputationPreference
accountGrouping :: AccountGrouping
name :: Sensitive Text
tags :: Maybe (HashMap Text Text)
primaryAccountId :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:computationPreference:CreateBillingGroup' :: CreateBillingGroup -> ComputationPreference
$sel:accountGrouping:CreateBillingGroup' :: CreateBillingGroup -> AccountGrouping
$sel:name:CreateBillingGroup' :: CreateBillingGroup -> Sensitive Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe (HashMap Text Text)
$sel:primaryAccountId:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
$sel:description:CreateBillingGroup' :: CreateBillingGroup -> Maybe (Sensitive Text)
$sel:clientToken:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
primaryAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AccountGrouping
accountGrouping
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ComputationPreference
computationPreference

instance Prelude.NFData CreateBillingGroup where
  rnf :: CreateBillingGroup -> ()
rnf CreateBillingGroup' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Sensitive Text
AccountGrouping
ComputationPreference
computationPreference :: ComputationPreference
accountGrouping :: AccountGrouping
name :: Sensitive Text
tags :: Maybe (HashMap Text Text)
primaryAccountId :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:computationPreference:CreateBillingGroup' :: CreateBillingGroup -> ComputationPreference
$sel:accountGrouping:CreateBillingGroup' :: CreateBillingGroup -> AccountGrouping
$sel:name:CreateBillingGroup' :: CreateBillingGroup -> Sensitive Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe (HashMap Text Text)
$sel:primaryAccountId:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
$sel:description:CreateBillingGroup' :: CreateBillingGroup -> Maybe (Sensitive Text)
$sel:clientToken:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
primaryAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AccountGrouping
accountGrouping
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ComputationPreference
computationPreference

instance Data.ToHeaders CreateBillingGroup where
  toHeaders :: CreateBillingGroup -> ResponseHeaders
toHeaders CreateBillingGroup' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Sensitive Text
AccountGrouping
ComputationPreference
computationPreference :: ComputationPreference
accountGrouping :: AccountGrouping
name :: Sensitive Text
tags :: Maybe (HashMap Text Text)
primaryAccountId :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:computationPreference:CreateBillingGroup' :: CreateBillingGroup -> ComputationPreference
$sel:accountGrouping:CreateBillingGroup' :: CreateBillingGroup -> AccountGrouping
$sel:name:CreateBillingGroup' :: CreateBillingGroup -> Sensitive Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe (HashMap Text Text)
$sel:primaryAccountId:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
$sel:description:CreateBillingGroup' :: CreateBillingGroup -> Maybe (Sensitive Text)
$sel:clientToken:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amzn-Client-Token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
clientToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON CreateBillingGroup where
  toJSON :: CreateBillingGroup -> Value
toJSON CreateBillingGroup' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Sensitive Text
AccountGrouping
ComputationPreference
computationPreference :: ComputationPreference
accountGrouping :: AccountGrouping
name :: Sensitive Text
tags :: Maybe (HashMap Text Text)
primaryAccountId :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:computationPreference:CreateBillingGroup' :: CreateBillingGroup -> ComputationPreference
$sel:accountGrouping:CreateBillingGroup' :: CreateBillingGroup -> AccountGrouping
$sel:name:CreateBillingGroup' :: CreateBillingGroup -> Sensitive Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe (HashMap Text Text)
$sel:primaryAccountId:CreateBillingGroup' :: CreateBillingGroup -> Maybe Text
$sel:description:CreateBillingGroup' :: CreateBillingGroup -> Maybe (Sensitive Text)
$sel:clientToken:CreateBillingGroup' :: CreateBillingGroup -> 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 (Sensitive Text)
description,
            (Key
"PrimaryAccountId" 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
primaryAccountId,
            (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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AccountGrouping" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AccountGrouping
accountGrouping),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ComputationPreference"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ComputationPreference
computationPreference
              )
          ]
      )

instance Data.ToPath CreateBillingGroup where
  toPath :: CreateBillingGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/create-billing-group"

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

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

-- |
-- Create a value of 'CreateBillingGroupResponse' 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:
--
-- 'arn', 'createBillingGroupResponse_arn' - The Amazon Resource Name (ARN) of the created billing group.
--
-- 'httpStatus', 'createBillingGroupResponse_httpStatus' - The response's http status code.
newCreateBillingGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBillingGroupResponse
newCreateBillingGroupResponse :: Int -> CreateBillingGroupResponse
newCreateBillingGroupResponse Int
pHttpStatus_ =
  CreateBillingGroupResponse'
    { $sel:arn:CreateBillingGroupResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBillingGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the created billing group.
createBillingGroupResponse_arn :: Lens.Lens' CreateBillingGroupResponse (Prelude.Maybe Prelude.Text)
createBillingGroupResponse_arn :: Lens' CreateBillingGroupResponse (Maybe Text)
createBillingGroupResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroupResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateBillingGroupResponse' :: CreateBillingGroupResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateBillingGroupResponse
s@CreateBillingGroupResponse' {} Maybe Text
a -> CreateBillingGroupResponse
s {$sel:arn:CreateBillingGroupResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateBillingGroupResponse)

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

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