{-# 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.IoT.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.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateBillingGroup>
-- action.
module Amazonka.IoT.CreateBillingGroup
  ( -- * Creating a Request
    CreateBillingGroup (..),
    newCreateBillingGroup,

    -- * Request Lenses
    createBillingGroup_billingGroupProperties,
    createBillingGroup_tags,
    createBillingGroup_billingGroupName,

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

    -- * Response Lenses
    createBillingGroupResponse_billingGroupArn,
    createBillingGroupResponse_billingGroupId,
    createBillingGroupResponse_billingGroupName,
    createBillingGroupResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
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 properties of the billing group.
    CreateBillingGroup -> Maybe BillingGroupProperties
billingGroupProperties :: Prelude.Maybe BillingGroupProperties,
    -- | Metadata which can be used to manage the billing group.
    CreateBillingGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name you wish to give to the billing group.
    CreateBillingGroup -> Text
billingGroupName :: Prelude.Text
  }
  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, ReadPrec [CreateBillingGroup]
ReadPrec CreateBillingGroup
Int -> ReadS CreateBillingGroup
ReadS [CreateBillingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBillingGroup]
$creadListPrec :: ReadPrec [CreateBillingGroup]
readPrec :: ReadPrec CreateBillingGroup
$creadPrec :: ReadPrec CreateBillingGroup
readList :: ReadS [CreateBillingGroup]
$creadList :: ReadS [CreateBillingGroup]
readsPrec :: Int -> ReadS CreateBillingGroup
$creadsPrec :: Int -> ReadS CreateBillingGroup
Prelude.Read, 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:
--
-- 'billingGroupProperties', 'createBillingGroup_billingGroupProperties' - The properties of the billing group.
--
-- 'tags', 'createBillingGroup_tags' - Metadata which can be used to manage the billing group.
--
-- 'billingGroupName', 'createBillingGroup_billingGroupName' - The name you wish to give to the billing group.
newCreateBillingGroup ::
  -- | 'billingGroupName'
  Prelude.Text ->
  CreateBillingGroup
newCreateBillingGroup :: Text -> CreateBillingGroup
newCreateBillingGroup Text
pBillingGroupName_ =
  CreateBillingGroup'
    { $sel:billingGroupProperties:CreateBillingGroup' :: Maybe BillingGroupProperties
billingGroupProperties =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateBillingGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:billingGroupName:CreateBillingGroup' :: Text
billingGroupName = Text
pBillingGroupName_
    }

-- | The properties of the billing group.
createBillingGroup_billingGroupProperties :: Lens.Lens' CreateBillingGroup (Prelude.Maybe BillingGroupProperties)
createBillingGroup_billingGroupProperties :: Lens' CreateBillingGroup (Maybe BillingGroupProperties)
createBillingGroup_billingGroupProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Maybe BillingGroupProperties
billingGroupProperties :: Maybe BillingGroupProperties
$sel:billingGroupProperties:CreateBillingGroup' :: CreateBillingGroup -> Maybe BillingGroupProperties
billingGroupProperties} -> Maybe BillingGroupProperties
billingGroupProperties) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Maybe BillingGroupProperties
a -> CreateBillingGroup
s {$sel:billingGroupProperties:CreateBillingGroup' :: Maybe BillingGroupProperties
billingGroupProperties = Maybe BillingGroupProperties
a} :: CreateBillingGroup)

-- | Metadata which can be used to manage the billing group.
createBillingGroup_tags :: Lens.Lens' CreateBillingGroup (Prelude.Maybe [Tag])
createBillingGroup_tags :: Lens' CreateBillingGroup (Maybe [Tag])
createBillingGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Maybe [Tag]
a -> CreateBillingGroup
s {$sel:tags:CreateBillingGroup' :: Maybe [Tag]
tags = Maybe [Tag]
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 name you wish to give to the billing group.
createBillingGroup_billingGroupName :: Lens.Lens' CreateBillingGroup Prelude.Text
createBillingGroup_billingGroupName :: Lens' CreateBillingGroup Text
createBillingGroup_billingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroup' {Text
billingGroupName :: Text
$sel:billingGroupName:CreateBillingGroup' :: CreateBillingGroup -> Text
billingGroupName} -> Text
billingGroupName) (\s :: CreateBillingGroup
s@CreateBillingGroup' {} Text
a -> CreateBillingGroup
s {$sel:billingGroupName:CreateBillingGroup' :: Text
billingGroupName = Text
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
-> Maybe Text -> 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
"billingGroupArn")
            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
"billingGroupId")
            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
"billingGroupName")
            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 [Tag]
Maybe BillingGroupProperties
Text
billingGroupName :: Text
tags :: Maybe [Tag]
billingGroupProperties :: Maybe BillingGroupProperties
$sel:billingGroupName:CreateBillingGroup' :: CreateBillingGroup -> Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe [Tag]
$sel:billingGroupProperties:CreateBillingGroup' :: CreateBillingGroup -> Maybe BillingGroupProperties
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BillingGroupProperties
billingGroupProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
billingGroupName

instance Prelude.NFData CreateBillingGroup where
  rnf :: CreateBillingGroup -> ()
rnf CreateBillingGroup' {Maybe [Tag]
Maybe BillingGroupProperties
Text
billingGroupName :: Text
tags :: Maybe [Tag]
billingGroupProperties :: Maybe BillingGroupProperties
$sel:billingGroupName:CreateBillingGroup' :: CreateBillingGroup -> Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe [Tag]
$sel:billingGroupProperties:CreateBillingGroup' :: CreateBillingGroup -> Maybe BillingGroupProperties
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BillingGroupProperties
billingGroupProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
billingGroupName

instance Data.ToHeaders CreateBillingGroup where
  toHeaders :: CreateBillingGroup -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON CreateBillingGroup where
  toJSON :: CreateBillingGroup -> Value
toJSON CreateBillingGroup' {Maybe [Tag]
Maybe BillingGroupProperties
Text
billingGroupName :: Text
tags :: Maybe [Tag]
billingGroupProperties :: Maybe BillingGroupProperties
$sel:billingGroupName:CreateBillingGroup' :: CreateBillingGroup -> Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe [Tag]
$sel:billingGroupProperties:CreateBillingGroup' :: CreateBillingGroup -> Maybe BillingGroupProperties
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"billingGroupProperties" 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 BillingGroupProperties
billingGroupProperties,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags
          ]
      )

instance Data.ToPath CreateBillingGroup where
  toPath :: CreateBillingGroup -> ByteString
toPath CreateBillingGroup' {Maybe [Tag]
Maybe BillingGroupProperties
Text
billingGroupName :: Text
tags :: Maybe [Tag]
billingGroupProperties :: Maybe BillingGroupProperties
$sel:billingGroupName:CreateBillingGroup' :: CreateBillingGroup -> Text
$sel:tags:CreateBillingGroup' :: CreateBillingGroup -> Maybe [Tag]
$sel:billingGroupProperties:CreateBillingGroup' :: CreateBillingGroup -> Maybe BillingGroupProperties
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/billing-groups/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
billingGroupName]

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 ARN of the billing group.
    CreateBillingGroupResponse -> Maybe Text
billingGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the billing group.
    CreateBillingGroupResponse -> Maybe Text
billingGroupId :: Prelude.Maybe Prelude.Text,
    -- | The name you gave to the billing group.
    CreateBillingGroupResponse -> Maybe Text
billingGroupName :: 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:
--
-- 'billingGroupArn', 'createBillingGroupResponse_billingGroupArn' - The ARN of the billing group.
--
-- 'billingGroupId', 'createBillingGroupResponse_billingGroupId' - The ID of the billing group.
--
-- 'billingGroupName', 'createBillingGroupResponse_billingGroupName' - The name you gave to the billing group.
--
-- 'httpStatus', 'createBillingGroupResponse_httpStatus' - The response's http status code.
newCreateBillingGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBillingGroupResponse
newCreateBillingGroupResponse :: Int -> CreateBillingGroupResponse
newCreateBillingGroupResponse Int
pHttpStatus_ =
  CreateBillingGroupResponse'
    { $sel:billingGroupArn:CreateBillingGroupResponse' :: Maybe Text
billingGroupArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:billingGroupId:CreateBillingGroupResponse' :: Maybe Text
billingGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:billingGroupName:CreateBillingGroupResponse' :: Maybe Text
billingGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBillingGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The ID of the billing group.
createBillingGroupResponse_billingGroupId :: Lens.Lens' CreateBillingGroupResponse (Prelude.Maybe Prelude.Text)
createBillingGroupResponse_billingGroupId :: Lens' CreateBillingGroupResponse (Maybe Text)
createBillingGroupResponse_billingGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroupResponse' {Maybe Text
billingGroupId :: Maybe Text
$sel:billingGroupId:CreateBillingGroupResponse' :: CreateBillingGroupResponse -> Maybe Text
billingGroupId} -> Maybe Text
billingGroupId) (\s :: CreateBillingGroupResponse
s@CreateBillingGroupResponse' {} Maybe Text
a -> CreateBillingGroupResponse
s {$sel:billingGroupId:CreateBillingGroupResponse' :: Maybe Text
billingGroupId = Maybe Text
a} :: CreateBillingGroupResponse)

-- | The name you gave to the billing group.
createBillingGroupResponse_billingGroupName :: Lens.Lens' CreateBillingGroupResponse (Prelude.Maybe Prelude.Text)
createBillingGroupResponse_billingGroupName :: Lens' CreateBillingGroupResponse (Maybe Text)
createBillingGroupResponse_billingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBillingGroupResponse' {Maybe Text
billingGroupName :: Maybe Text
$sel:billingGroupName:CreateBillingGroupResponse' :: CreateBillingGroupResponse -> Maybe Text
billingGroupName} -> Maybe Text
billingGroupName) (\s :: CreateBillingGroupResponse
s@CreateBillingGroupResponse' {} Maybe Text
a -> CreateBillingGroupResponse
s {$sel:billingGroupName:CreateBillingGroupResponse' :: Maybe Text
billingGroupName = 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
billingGroupName :: Maybe Text
billingGroupId :: Maybe Text
billingGroupArn :: Maybe Text
$sel:httpStatus:CreateBillingGroupResponse' :: CreateBillingGroupResponse -> Int
$sel:billingGroupName:CreateBillingGroupResponse' :: CreateBillingGroupResponse -> Maybe Text
$sel:billingGroupId:CreateBillingGroupResponse' :: CreateBillingGroupResponse -> Maybe Text
$sel:billingGroupArn:CreateBillingGroupResponse' :: CreateBillingGroupResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
billingGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
billingGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
billingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus