{-# 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.EC2.CreatePlacementGroup
-- 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 placement group in which to launch instances. The strategy of
-- the placement group determines how the instances are organized within
-- the group.
--
-- A @cluster@ placement group is a logical grouping of instances within a
-- single Availability Zone that benefit from low network latency, high
-- network throughput. A @spread@ placement group places instances on
-- distinct hardware. A @partition@ placement group places groups of
-- instances in different partitions, where instances in one partition do
-- not share the same hardware with instances in another partition.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/placement-groups.html Placement groups>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.CreatePlacementGroup
  ( -- * Creating a Request
    CreatePlacementGroup (..),
    newCreatePlacementGroup,

    -- * Request Lenses
    createPlacementGroup_dryRun,
    createPlacementGroup_groupName,
    createPlacementGroup_partitionCount,
    createPlacementGroup_spreadLevel,
    createPlacementGroup_strategy,
    createPlacementGroup_tagSpecifications,

    -- * Destructuring the Response
    CreatePlacementGroupResponse (..),
    newCreatePlacementGroupResponse,

    -- * Response Lenses
    createPlacementGroupResponse_placementGroup,
    createPlacementGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreatePlacementGroup' smart constructor.
data CreatePlacementGroup = CreatePlacementGroup'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreatePlacementGroup -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | A name for the placement group. Must be unique within the scope of your
    -- account for the Region.
    --
    -- Constraints: Up to 255 ASCII characters
    CreatePlacementGroup -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text,
    -- | The number of partitions. Valid only when __Strategy__ is set to
    -- @partition@.
    CreatePlacementGroup -> Maybe Int
partitionCount :: Prelude.Maybe Prelude.Int,
    -- | Determines how placement groups spread instances.
    --
    -- -   Host – You can use @host@ only with Outpost placement groups.
    --
    -- -   Rack – No usage restrictions.
    CreatePlacementGroup -> Maybe SpreadLevel
spreadLevel :: Prelude.Maybe SpreadLevel,
    -- | The placement strategy.
    CreatePlacementGroup -> Maybe PlacementStrategy
strategy :: Prelude.Maybe PlacementStrategy,
    -- | The tags to apply to the new placement group.
    CreatePlacementGroup -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification]
  }
  deriving (CreatePlacementGroup -> CreatePlacementGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlacementGroup -> CreatePlacementGroup -> Bool
$c/= :: CreatePlacementGroup -> CreatePlacementGroup -> Bool
== :: CreatePlacementGroup -> CreatePlacementGroup -> Bool
$c== :: CreatePlacementGroup -> CreatePlacementGroup -> Bool
Prelude.Eq, ReadPrec [CreatePlacementGroup]
ReadPrec CreatePlacementGroup
Int -> ReadS CreatePlacementGroup
ReadS [CreatePlacementGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlacementGroup]
$creadListPrec :: ReadPrec [CreatePlacementGroup]
readPrec :: ReadPrec CreatePlacementGroup
$creadPrec :: ReadPrec CreatePlacementGroup
readList :: ReadS [CreatePlacementGroup]
$creadList :: ReadS [CreatePlacementGroup]
readsPrec :: Int -> ReadS CreatePlacementGroup
$creadsPrec :: Int -> ReadS CreatePlacementGroup
Prelude.Read, Int -> CreatePlacementGroup -> ShowS
[CreatePlacementGroup] -> ShowS
CreatePlacementGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlacementGroup] -> ShowS
$cshowList :: [CreatePlacementGroup] -> ShowS
show :: CreatePlacementGroup -> String
$cshow :: CreatePlacementGroup -> String
showsPrec :: Int -> CreatePlacementGroup -> ShowS
$cshowsPrec :: Int -> CreatePlacementGroup -> ShowS
Prelude.Show, forall x. Rep CreatePlacementGroup x -> CreatePlacementGroup
forall x. CreatePlacementGroup -> Rep CreatePlacementGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePlacementGroup x -> CreatePlacementGroup
$cfrom :: forall x. CreatePlacementGroup -> Rep CreatePlacementGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlacementGroup' 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:
--
-- 'dryRun', 'createPlacementGroup_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'groupName', 'createPlacementGroup_groupName' - A name for the placement group. Must be unique within the scope of your
-- account for the Region.
--
-- Constraints: Up to 255 ASCII characters
--
-- 'partitionCount', 'createPlacementGroup_partitionCount' - The number of partitions. Valid only when __Strategy__ is set to
-- @partition@.
--
-- 'spreadLevel', 'createPlacementGroup_spreadLevel' - Determines how placement groups spread instances.
--
-- -   Host – You can use @host@ only with Outpost placement groups.
--
-- -   Rack – No usage restrictions.
--
-- 'strategy', 'createPlacementGroup_strategy' - The placement strategy.
--
-- 'tagSpecifications', 'createPlacementGroup_tagSpecifications' - The tags to apply to the new placement group.
newCreatePlacementGroup ::
  CreatePlacementGroup
newCreatePlacementGroup :: CreatePlacementGroup
newCreatePlacementGroup =
  CreatePlacementGroup'
    { $sel:dryRun:CreatePlacementGroup' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:CreatePlacementGroup' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing,
      $sel:partitionCount:CreatePlacementGroup' :: Maybe Int
partitionCount = forall a. Maybe a
Prelude.Nothing,
      $sel:spreadLevel:CreatePlacementGroup' :: Maybe SpreadLevel
spreadLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:strategy:CreatePlacementGroup' :: Maybe PlacementStrategy
strategy = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreatePlacementGroup' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createPlacementGroup_dryRun :: Lens.Lens' CreatePlacementGroup (Prelude.Maybe Prelude.Bool)
createPlacementGroup_dryRun :: Lens' CreatePlacementGroup (Maybe Bool)
createPlacementGroup_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlacementGroup' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreatePlacementGroup
s@CreatePlacementGroup' {} Maybe Bool
a -> CreatePlacementGroup
s {$sel:dryRun:CreatePlacementGroup' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreatePlacementGroup)

-- | A name for the placement group. Must be unique within the scope of your
-- account for the Region.
--
-- Constraints: Up to 255 ASCII characters
createPlacementGroup_groupName :: Lens.Lens' CreatePlacementGroup (Prelude.Maybe Prelude.Text)
createPlacementGroup_groupName :: Lens' CreatePlacementGroup (Maybe Text)
createPlacementGroup_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlacementGroup' {Maybe Text
groupName :: Maybe Text
$sel:groupName:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Text
groupName} -> Maybe Text
groupName) (\s :: CreatePlacementGroup
s@CreatePlacementGroup' {} Maybe Text
a -> CreatePlacementGroup
s {$sel:groupName:CreatePlacementGroup' :: Maybe Text
groupName = Maybe Text
a} :: CreatePlacementGroup)

-- | The number of partitions. Valid only when __Strategy__ is set to
-- @partition@.
createPlacementGroup_partitionCount :: Lens.Lens' CreatePlacementGroup (Prelude.Maybe Prelude.Int)
createPlacementGroup_partitionCount :: Lens' CreatePlacementGroup (Maybe Int)
createPlacementGroup_partitionCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlacementGroup' {Maybe Int
partitionCount :: Maybe Int
$sel:partitionCount:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Int
partitionCount} -> Maybe Int
partitionCount) (\s :: CreatePlacementGroup
s@CreatePlacementGroup' {} Maybe Int
a -> CreatePlacementGroup
s {$sel:partitionCount:CreatePlacementGroup' :: Maybe Int
partitionCount = Maybe Int
a} :: CreatePlacementGroup)

-- | Determines how placement groups spread instances.
--
-- -   Host – You can use @host@ only with Outpost placement groups.
--
-- -   Rack – No usage restrictions.
createPlacementGroup_spreadLevel :: Lens.Lens' CreatePlacementGroup (Prelude.Maybe SpreadLevel)
createPlacementGroup_spreadLevel :: Lens' CreatePlacementGroup (Maybe SpreadLevel)
createPlacementGroup_spreadLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlacementGroup' {Maybe SpreadLevel
spreadLevel :: Maybe SpreadLevel
$sel:spreadLevel:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe SpreadLevel
spreadLevel} -> Maybe SpreadLevel
spreadLevel) (\s :: CreatePlacementGroup
s@CreatePlacementGroup' {} Maybe SpreadLevel
a -> CreatePlacementGroup
s {$sel:spreadLevel:CreatePlacementGroup' :: Maybe SpreadLevel
spreadLevel = Maybe SpreadLevel
a} :: CreatePlacementGroup)

-- | The placement strategy.
createPlacementGroup_strategy :: Lens.Lens' CreatePlacementGroup (Prelude.Maybe PlacementStrategy)
createPlacementGroup_strategy :: Lens' CreatePlacementGroup (Maybe PlacementStrategy)
createPlacementGroup_strategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlacementGroup' {Maybe PlacementStrategy
strategy :: Maybe PlacementStrategy
$sel:strategy:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe PlacementStrategy
strategy} -> Maybe PlacementStrategy
strategy) (\s :: CreatePlacementGroup
s@CreatePlacementGroup' {} Maybe PlacementStrategy
a -> CreatePlacementGroup
s {$sel:strategy:CreatePlacementGroup' :: Maybe PlacementStrategy
strategy = Maybe PlacementStrategy
a} :: CreatePlacementGroup)

-- | The tags to apply to the new placement group.
createPlacementGroup_tagSpecifications :: Lens.Lens' CreatePlacementGroup (Prelude.Maybe [TagSpecification])
createPlacementGroup_tagSpecifications :: Lens' CreatePlacementGroup (Maybe [TagSpecification])
createPlacementGroup_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlacementGroup' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreatePlacementGroup
s@CreatePlacementGroup' {} Maybe [TagSpecification]
a -> CreatePlacementGroup
s {$sel:tagSpecifications:CreatePlacementGroup' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreatePlacementGroup) 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

instance Core.AWSRequest CreatePlacementGroup where
  type
    AWSResponse CreatePlacementGroup =
      CreatePlacementGroupResponse
  request :: (Service -> Service)
-> CreatePlacementGroup -> Request CreatePlacementGroup
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreatePlacementGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePlacementGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe PlacementGroup -> Int -> CreatePlacementGroupResponse
CreatePlacementGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"placementGroup")
            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 CreatePlacementGroup where
  hashWithSalt :: Int -> CreatePlacementGroup -> Int
hashWithSalt Int
_salt CreatePlacementGroup' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe PlacementStrategy
Maybe SpreadLevel
tagSpecifications :: Maybe [TagSpecification]
strategy :: Maybe PlacementStrategy
spreadLevel :: Maybe SpreadLevel
partitionCount :: Maybe Int
groupName :: Maybe Text
dryRun :: Maybe Bool
$sel:tagSpecifications:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe [TagSpecification]
$sel:strategy:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe PlacementStrategy
$sel:spreadLevel:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe SpreadLevel
$sel:partitionCount:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Int
$sel:groupName:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Text
$sel:dryRun:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
partitionCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpreadLevel
spreadLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PlacementStrategy
strategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications

instance Prelude.NFData CreatePlacementGroup where
  rnf :: CreatePlacementGroup -> ()
rnf CreatePlacementGroup' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe PlacementStrategy
Maybe SpreadLevel
tagSpecifications :: Maybe [TagSpecification]
strategy :: Maybe PlacementStrategy
spreadLevel :: Maybe SpreadLevel
partitionCount :: Maybe Int
groupName :: Maybe Text
dryRun :: Maybe Bool
$sel:tagSpecifications:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe [TagSpecification]
$sel:strategy:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe PlacementStrategy
$sel:spreadLevel:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe SpreadLevel
$sel:partitionCount:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Int
$sel:groupName:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Text
$sel:dryRun:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
partitionCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpreadLevel
spreadLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PlacementStrategy
strategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications

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

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

instance Data.ToQuery CreatePlacementGroup where
  toQuery :: CreatePlacementGroup -> QueryString
toQuery CreatePlacementGroup' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe PlacementStrategy
Maybe SpreadLevel
tagSpecifications :: Maybe [TagSpecification]
strategy :: Maybe PlacementStrategy
spreadLevel :: Maybe SpreadLevel
partitionCount :: Maybe Int
groupName :: Maybe Text
dryRun :: Maybe Bool
$sel:tagSpecifications:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe [TagSpecification]
$sel:strategy:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe PlacementStrategy
$sel:spreadLevel:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe SpreadLevel
$sel:partitionCount:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Int
$sel:groupName:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Text
$sel:dryRun:CreatePlacementGroup' :: CreatePlacementGroup -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreatePlacementGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"GroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
groupName,
        ByteString
"PartitionCount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
partitionCount,
        ByteString
"SpreadLevel" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SpreadLevel
spreadLevel,
        ByteString
"Strategy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe PlacementStrategy
strategy,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          )
      ]

-- | /See:/ 'newCreatePlacementGroupResponse' smart constructor.
data CreatePlacementGroupResponse = CreatePlacementGroupResponse'
  { -- | Information about the placement group.
    CreatePlacementGroupResponse -> Maybe PlacementGroup
placementGroup :: Prelude.Maybe PlacementGroup,
    -- | The response's http status code.
    CreatePlacementGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreatePlacementGroupResponse
-> CreatePlacementGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlacementGroupResponse
-> CreatePlacementGroupResponse -> Bool
$c/= :: CreatePlacementGroupResponse
-> CreatePlacementGroupResponse -> Bool
== :: CreatePlacementGroupResponse
-> CreatePlacementGroupResponse -> Bool
$c== :: CreatePlacementGroupResponse
-> CreatePlacementGroupResponse -> Bool
Prelude.Eq, ReadPrec [CreatePlacementGroupResponse]
ReadPrec CreatePlacementGroupResponse
Int -> ReadS CreatePlacementGroupResponse
ReadS [CreatePlacementGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlacementGroupResponse]
$creadListPrec :: ReadPrec [CreatePlacementGroupResponse]
readPrec :: ReadPrec CreatePlacementGroupResponse
$creadPrec :: ReadPrec CreatePlacementGroupResponse
readList :: ReadS [CreatePlacementGroupResponse]
$creadList :: ReadS [CreatePlacementGroupResponse]
readsPrec :: Int -> ReadS CreatePlacementGroupResponse
$creadsPrec :: Int -> ReadS CreatePlacementGroupResponse
Prelude.Read, Int -> CreatePlacementGroupResponse -> ShowS
[CreatePlacementGroupResponse] -> ShowS
CreatePlacementGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlacementGroupResponse] -> ShowS
$cshowList :: [CreatePlacementGroupResponse] -> ShowS
show :: CreatePlacementGroupResponse -> String
$cshow :: CreatePlacementGroupResponse -> String
showsPrec :: Int -> CreatePlacementGroupResponse -> ShowS
$cshowsPrec :: Int -> CreatePlacementGroupResponse -> ShowS
Prelude.Show, forall x.
Rep CreatePlacementGroupResponse x -> CreatePlacementGroupResponse
forall x.
CreatePlacementGroupResponse -> Rep CreatePlacementGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePlacementGroupResponse x -> CreatePlacementGroupResponse
$cfrom :: forall x.
CreatePlacementGroupResponse -> Rep CreatePlacementGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlacementGroupResponse' 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:
--
-- 'placementGroup', 'createPlacementGroupResponse_placementGroup' - Information about the placement group.
--
-- 'httpStatus', 'createPlacementGroupResponse_httpStatus' - The response's http status code.
newCreatePlacementGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePlacementGroupResponse
newCreatePlacementGroupResponse :: Int -> CreatePlacementGroupResponse
newCreatePlacementGroupResponse Int
pHttpStatus_ =
  CreatePlacementGroupResponse'
    { $sel:placementGroup:CreatePlacementGroupResponse' :: Maybe PlacementGroup
placementGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePlacementGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the placement group.
createPlacementGroupResponse_placementGroup :: Lens.Lens' CreatePlacementGroupResponse (Prelude.Maybe PlacementGroup)
createPlacementGroupResponse_placementGroup :: Lens' CreatePlacementGroupResponse (Maybe PlacementGroup)
createPlacementGroupResponse_placementGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlacementGroupResponse' {Maybe PlacementGroup
placementGroup :: Maybe PlacementGroup
$sel:placementGroup:CreatePlacementGroupResponse' :: CreatePlacementGroupResponse -> Maybe PlacementGroup
placementGroup} -> Maybe PlacementGroup
placementGroup) (\s :: CreatePlacementGroupResponse
s@CreatePlacementGroupResponse' {} Maybe PlacementGroup
a -> CreatePlacementGroupResponse
s {$sel:placementGroup:CreatePlacementGroupResponse' :: Maybe PlacementGroup
placementGroup = Maybe PlacementGroup
a} :: CreatePlacementGroupResponse)

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

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