{-# 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.CreateIpamScope
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create an IPAM scope. In IPAM, a scope is the highest-level container
-- within IPAM. An IPAM contains two default scopes. Each scope represents
-- the IP space for a single network. The private scope is intended for all
-- private IP address space. The public scope is intended for all public IP
-- address space. Scopes enable you to reuse IP addresses across multiple
-- unconnected networks without causing IP address overlap or conflict.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/add-scope-ipam.html Add a scope>
-- in the /Amazon VPC IPAM User Guide/.
module Amazonka.EC2.CreateIpamScope
  ( -- * Creating a Request
    CreateIpamScope (..),
    newCreateIpamScope,

    -- * Request Lenses
    createIpamScope_clientToken,
    createIpamScope_description,
    createIpamScope_dryRun,
    createIpamScope_tagSpecifications,
    createIpamScope_ipamId,

    -- * Destructuring the Response
    CreateIpamScopeResponse (..),
    newCreateIpamScopeResponse,

    -- * Response Lenses
    createIpamScopeResponse_ipamScope,
    createIpamScopeResponse_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:/ 'newCreateIpamScope' smart constructor.
data CreateIpamScope = CreateIpamScope'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    CreateIpamScope -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the scope you\'re creating.
    CreateIpamScope -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A check for 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@.
    CreateIpamScope -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The key\/value combination of a tag assigned to the resource. Use the
    -- tag key in the filter name and the tag value as the filter value. For
    -- example, to find all resources that have a tag with the key @Owner@ and
    -- the value @TeamA@, specify @tag:Owner@ for the filter name and @TeamA@
    -- for the filter value.
    CreateIpamScope -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the IPAM for which you\'re creating this scope.
    CreateIpamScope -> Text
ipamId :: Prelude.Text
  }
  deriving (CreateIpamScope -> CreateIpamScope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIpamScope -> CreateIpamScope -> Bool
$c/= :: CreateIpamScope -> CreateIpamScope -> Bool
== :: CreateIpamScope -> CreateIpamScope -> Bool
$c== :: CreateIpamScope -> CreateIpamScope -> Bool
Prelude.Eq, ReadPrec [CreateIpamScope]
ReadPrec CreateIpamScope
Int -> ReadS CreateIpamScope
ReadS [CreateIpamScope]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIpamScope]
$creadListPrec :: ReadPrec [CreateIpamScope]
readPrec :: ReadPrec CreateIpamScope
$creadPrec :: ReadPrec CreateIpamScope
readList :: ReadS [CreateIpamScope]
$creadList :: ReadS [CreateIpamScope]
readsPrec :: Int -> ReadS CreateIpamScope
$creadsPrec :: Int -> ReadS CreateIpamScope
Prelude.Read, Int -> CreateIpamScope -> ShowS
[CreateIpamScope] -> ShowS
CreateIpamScope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIpamScope] -> ShowS
$cshowList :: [CreateIpamScope] -> ShowS
show :: CreateIpamScope -> String
$cshow :: CreateIpamScope -> String
showsPrec :: Int -> CreateIpamScope -> ShowS
$cshowsPrec :: Int -> CreateIpamScope -> ShowS
Prelude.Show, forall x. Rep CreateIpamScope x -> CreateIpamScope
forall x. CreateIpamScope -> Rep CreateIpamScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIpamScope x -> CreateIpamScope
$cfrom :: forall x. CreateIpamScope -> Rep CreateIpamScope x
Prelude.Generic)

-- |
-- Create a value of 'CreateIpamScope' 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', 'createIpamScope_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'description', 'createIpamScope_description' - A description for the scope you\'re creating.
--
-- 'dryRun', 'createIpamScope_dryRun' - A check for 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@.
--
-- 'tagSpecifications', 'createIpamScope_tagSpecifications' - The key\/value combination of a tag assigned to the resource. Use the
-- tag key in the filter name and the tag value as the filter value. For
-- example, to find all resources that have a tag with the key @Owner@ and
-- the value @TeamA@, specify @tag:Owner@ for the filter name and @TeamA@
-- for the filter value.
--
-- 'ipamId', 'createIpamScope_ipamId' - The ID of the IPAM for which you\'re creating this scope.
newCreateIpamScope ::
  -- | 'ipamId'
  Prelude.Text ->
  CreateIpamScope
newCreateIpamScope :: Text -> CreateIpamScope
newCreateIpamScope Text
pIpamId_ =
  CreateIpamScope'
    { $sel:clientToken:CreateIpamScope' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateIpamScope' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateIpamScope' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateIpamScope' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:ipamId:CreateIpamScope' :: Text
ipamId = Text
pIpamId_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
createIpamScope_clientToken :: Lens.Lens' CreateIpamScope (Prelude.Maybe Prelude.Text)
createIpamScope_clientToken :: Lens' CreateIpamScope (Maybe Text)
createIpamScope_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpamScope' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateIpamScope' :: CreateIpamScope -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateIpamScope
s@CreateIpamScope' {} Maybe Text
a -> CreateIpamScope
s {$sel:clientToken:CreateIpamScope' :: Maybe Text
clientToken = Maybe Text
a} :: CreateIpamScope)

-- | A description for the scope you\'re creating.
createIpamScope_description :: Lens.Lens' CreateIpamScope (Prelude.Maybe Prelude.Text)
createIpamScope_description :: Lens' CreateIpamScope (Maybe Text)
createIpamScope_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpamScope' {Maybe Text
description :: Maybe Text
$sel:description:CreateIpamScope' :: CreateIpamScope -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateIpamScope
s@CreateIpamScope' {} Maybe Text
a -> CreateIpamScope
s {$sel:description:CreateIpamScope' :: Maybe Text
description = Maybe Text
a} :: CreateIpamScope)

-- | A check for 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@.
createIpamScope_dryRun :: Lens.Lens' CreateIpamScope (Prelude.Maybe Prelude.Bool)
createIpamScope_dryRun :: Lens' CreateIpamScope (Maybe Bool)
createIpamScope_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpamScope' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateIpamScope' :: CreateIpamScope -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateIpamScope
s@CreateIpamScope' {} Maybe Bool
a -> CreateIpamScope
s {$sel:dryRun:CreateIpamScope' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateIpamScope)

-- | The key\/value combination of a tag assigned to the resource. Use the
-- tag key in the filter name and the tag value as the filter value. For
-- example, to find all resources that have a tag with the key @Owner@ and
-- the value @TeamA@, specify @tag:Owner@ for the filter name and @TeamA@
-- for the filter value.
createIpamScope_tagSpecifications :: Lens.Lens' CreateIpamScope (Prelude.Maybe [TagSpecification])
createIpamScope_tagSpecifications :: Lens' CreateIpamScope (Maybe [TagSpecification])
createIpamScope_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpamScope' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateIpamScope' :: CreateIpamScope -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateIpamScope
s@CreateIpamScope' {} Maybe [TagSpecification]
a -> CreateIpamScope
s {$sel:tagSpecifications:CreateIpamScope' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateIpamScope) 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 ID of the IPAM for which you\'re creating this scope.
createIpamScope_ipamId :: Lens.Lens' CreateIpamScope Prelude.Text
createIpamScope_ipamId :: Lens' CreateIpamScope Text
createIpamScope_ipamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpamScope' {Text
ipamId :: Text
$sel:ipamId:CreateIpamScope' :: CreateIpamScope -> Text
ipamId} -> Text
ipamId) (\s :: CreateIpamScope
s@CreateIpamScope' {} Text
a -> CreateIpamScope
s {$sel:ipamId:CreateIpamScope' :: Text
ipamId = Text
a} :: CreateIpamScope)

instance Core.AWSRequest CreateIpamScope where
  type
    AWSResponse CreateIpamScope =
      CreateIpamScopeResponse
  request :: (Service -> Service) -> CreateIpamScope -> Request CreateIpamScope
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 CreateIpamScope
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateIpamScope)))
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 IpamScope -> Int -> CreateIpamScopeResponse
CreateIpamScopeResponse'
            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
"ipamScope")
            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 CreateIpamScope where
  hashWithSalt :: Int -> CreateIpamScope -> Int
hashWithSalt Int
_salt CreateIpamScope' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
ipamId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:ipamId:CreateIpamScope' :: CreateIpamScope -> Text
$sel:tagSpecifications:CreateIpamScope' :: CreateIpamScope -> Maybe [TagSpecification]
$sel:dryRun:CreateIpamScope' :: CreateIpamScope -> Maybe Bool
$sel:description:CreateIpamScope' :: CreateIpamScope -> Maybe Text
$sel:clientToken:CreateIpamScope' :: CreateIpamScope -> 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 Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ipamId

instance Prelude.NFData CreateIpamScope where
  rnf :: CreateIpamScope -> ()
rnf CreateIpamScope' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
ipamId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:ipamId:CreateIpamScope' :: CreateIpamScope -> Text
$sel:tagSpecifications:CreateIpamScope' :: CreateIpamScope -> Maybe [TagSpecification]
$sel:dryRun:CreateIpamScope' :: CreateIpamScope -> Maybe Bool
$sel:description:CreateIpamScope' :: CreateIpamScope -> Maybe Text
$sel:clientToken:CreateIpamScope' :: CreateIpamScope -> 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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ipamId

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

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

instance Data.ToQuery CreateIpamScope where
  toQuery :: CreateIpamScope -> QueryString
toQuery CreateIpamScope' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
ipamId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:ipamId:CreateIpamScope' :: CreateIpamScope -> Text
$sel:tagSpecifications:CreateIpamScope' :: CreateIpamScope -> Maybe [TagSpecification]
$sel:dryRun:CreateIpamScope' :: CreateIpamScope -> Maybe Bool
$sel:description:CreateIpamScope' :: CreateIpamScope -> Maybe Text
$sel:clientToken:CreateIpamScope' :: CreateIpamScope -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateIpamScope" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        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
          ),
        ByteString
"IpamId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
ipamId
      ]

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

-- |
-- Create a value of 'CreateIpamScopeResponse' 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:
--
-- 'ipamScope', 'createIpamScopeResponse_ipamScope' - Information about the created scope.
--
-- 'httpStatus', 'createIpamScopeResponse_httpStatus' - The response's http status code.
newCreateIpamScopeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateIpamScopeResponse
newCreateIpamScopeResponse :: Int -> CreateIpamScopeResponse
newCreateIpamScopeResponse Int
pHttpStatus_ =
  CreateIpamScopeResponse'
    { $sel:ipamScope:CreateIpamScopeResponse' :: Maybe IpamScope
ipamScope =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateIpamScopeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the created scope.
createIpamScopeResponse_ipamScope :: Lens.Lens' CreateIpamScopeResponse (Prelude.Maybe IpamScope)
createIpamScopeResponse_ipamScope :: Lens' CreateIpamScopeResponse (Maybe IpamScope)
createIpamScopeResponse_ipamScope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpamScopeResponse' {Maybe IpamScope
ipamScope :: Maybe IpamScope
$sel:ipamScope:CreateIpamScopeResponse' :: CreateIpamScopeResponse -> Maybe IpamScope
ipamScope} -> Maybe IpamScope
ipamScope) (\s :: CreateIpamScopeResponse
s@CreateIpamScopeResponse' {} Maybe IpamScope
a -> CreateIpamScopeResponse
s {$sel:ipamScope:CreateIpamScopeResponse' :: Maybe IpamScope
ipamScope = Maybe IpamScope
a} :: CreateIpamScopeResponse)

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

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