{-# 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.CreateIpam
-- 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. Amazon VPC IP Address Manager (IPAM) is a VPC feature
-- that you can use to automate your IP address management workflows
-- including assigning, tracking, troubleshooting, and auditing IP
-- addresses across Amazon Web Services Regions and accounts throughout
-- your Amazon Web Services Organization.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/create-ipam.html Create an IPAM>
-- in the /Amazon VPC IPAM User Guide/.
module Amazonka.EC2.CreateIpam
  ( -- * Creating a Request
    CreateIpam (..),
    newCreateIpam,

    -- * Request Lenses
    createIpam_clientToken,
    createIpam_description,
    createIpam_dryRun,
    createIpam_operatingRegions,
    createIpam_tagSpecifications,

    -- * Destructuring the Response
    CreateIpamResponse (..),
    newCreateIpamResponse,

    -- * Response Lenses
    createIpamResponse_ipam,
    createIpamResponse_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:/ 'newCreateIpam' smart constructor.
data CreateIpam = CreateIpam'
  { -- | 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>.
    CreateIpam -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the IPAM.
    CreateIpam -> 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@.
    CreateIpam -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The operating Regions for the IPAM. Operating Regions are Amazon Web
    -- Services Regions where the IPAM is allowed to manage IP address CIDRs.
    -- IPAM only discovers and monitors resources in the Amazon Web Services
    -- Regions you select as operating Regions.
    --
    -- For more information about operating Regions, see
    -- <https://docs.aws.amazon.com/vpc/latest/ipam/create-ipam.html Create an IPAM>
    -- in the /Amazon VPC IPAM User Guide/.
    CreateIpam -> Maybe [AddIpamOperatingRegion]
operatingRegions :: Prelude.Maybe [AddIpamOperatingRegion],
    -- | 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.
    CreateIpam -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification]
  }
  deriving (CreateIpam -> CreateIpam -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIpam -> CreateIpam -> Bool
$c/= :: CreateIpam -> CreateIpam -> Bool
== :: CreateIpam -> CreateIpam -> Bool
$c== :: CreateIpam -> CreateIpam -> Bool
Prelude.Eq, ReadPrec [CreateIpam]
ReadPrec CreateIpam
Int -> ReadS CreateIpam
ReadS [CreateIpam]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIpam]
$creadListPrec :: ReadPrec [CreateIpam]
readPrec :: ReadPrec CreateIpam
$creadPrec :: ReadPrec CreateIpam
readList :: ReadS [CreateIpam]
$creadList :: ReadS [CreateIpam]
readsPrec :: Int -> ReadS CreateIpam
$creadsPrec :: Int -> ReadS CreateIpam
Prelude.Read, Int -> CreateIpam -> ShowS
[CreateIpam] -> ShowS
CreateIpam -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIpam] -> ShowS
$cshowList :: [CreateIpam] -> ShowS
show :: CreateIpam -> String
$cshow :: CreateIpam -> String
showsPrec :: Int -> CreateIpam -> ShowS
$cshowsPrec :: Int -> CreateIpam -> ShowS
Prelude.Show, forall x. Rep CreateIpam x -> CreateIpam
forall x. CreateIpam -> Rep CreateIpam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIpam x -> CreateIpam
$cfrom :: forall x. CreateIpam -> Rep CreateIpam x
Prelude.Generic)

-- |
-- Create a value of 'CreateIpam' 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', 'createIpam_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', 'createIpam_description' - A description for the IPAM.
--
-- 'dryRun', 'createIpam_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@.
--
-- 'operatingRegions', 'createIpam_operatingRegions' - The operating Regions for the IPAM. Operating Regions are Amazon Web
-- Services Regions where the IPAM is allowed to manage IP address CIDRs.
-- IPAM only discovers and monitors resources in the Amazon Web Services
-- Regions you select as operating Regions.
--
-- For more information about operating Regions, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/create-ipam.html Create an IPAM>
-- in the /Amazon VPC IPAM User Guide/.
--
-- 'tagSpecifications', 'createIpam_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.
newCreateIpam ::
  CreateIpam
newCreateIpam :: CreateIpam
newCreateIpam =
  CreateIpam'
    { $sel:clientToken:CreateIpam' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateIpam' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateIpam' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:operatingRegions:CreateIpam' :: Maybe [AddIpamOperatingRegion]
operatingRegions = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateIpam' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing
    }

-- | 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>.
createIpam_clientToken :: Lens.Lens' CreateIpam (Prelude.Maybe Prelude.Text)
createIpam_clientToken :: Lens' CreateIpam (Maybe Text)
createIpam_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpam' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateIpam' :: CreateIpam -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateIpam
s@CreateIpam' {} Maybe Text
a -> CreateIpam
s {$sel:clientToken:CreateIpam' :: Maybe Text
clientToken = Maybe Text
a} :: CreateIpam)

-- | A description for the IPAM.
createIpam_description :: Lens.Lens' CreateIpam (Prelude.Maybe Prelude.Text)
createIpam_description :: Lens' CreateIpam (Maybe Text)
createIpam_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpam' {Maybe Text
description :: Maybe Text
$sel:description:CreateIpam' :: CreateIpam -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateIpam
s@CreateIpam' {} Maybe Text
a -> CreateIpam
s {$sel:description:CreateIpam' :: Maybe Text
description = Maybe Text
a} :: CreateIpam)

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

-- | The operating Regions for the IPAM. Operating Regions are Amazon Web
-- Services Regions where the IPAM is allowed to manage IP address CIDRs.
-- IPAM only discovers and monitors resources in the Amazon Web Services
-- Regions you select as operating Regions.
--
-- For more information about operating Regions, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/create-ipam.html Create an IPAM>
-- in the /Amazon VPC IPAM User Guide/.
createIpam_operatingRegions :: Lens.Lens' CreateIpam (Prelude.Maybe [AddIpamOperatingRegion])
createIpam_operatingRegions :: Lens' CreateIpam (Maybe [AddIpamOperatingRegion])
createIpam_operatingRegions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpam' {Maybe [AddIpamOperatingRegion]
operatingRegions :: Maybe [AddIpamOperatingRegion]
$sel:operatingRegions:CreateIpam' :: CreateIpam -> Maybe [AddIpamOperatingRegion]
operatingRegions} -> Maybe [AddIpamOperatingRegion]
operatingRegions) (\s :: CreateIpam
s@CreateIpam' {} Maybe [AddIpamOperatingRegion]
a -> CreateIpam
s {$sel:operatingRegions:CreateIpam' :: Maybe [AddIpamOperatingRegion]
operatingRegions = Maybe [AddIpamOperatingRegion]
a} :: CreateIpam) 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 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.
createIpam_tagSpecifications :: Lens.Lens' CreateIpam (Prelude.Maybe [TagSpecification])
createIpam_tagSpecifications :: Lens' CreateIpam (Maybe [TagSpecification])
createIpam_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpam' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateIpam' :: CreateIpam -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateIpam
s@CreateIpam' {} Maybe [TagSpecification]
a -> CreateIpam
s {$sel:tagSpecifications:CreateIpam' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateIpam) 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 CreateIpam where
  type AWSResponse CreateIpam = CreateIpamResponse
  request :: (Service -> Service) -> CreateIpam -> Request CreateIpam
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 CreateIpam
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateIpam)))
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 Ipam -> Int -> CreateIpamResponse
CreateIpamResponse'
            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
"ipam")
            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 CreateIpam where
  hashWithSalt :: Int -> CreateIpam -> Int
hashWithSalt Int
_salt CreateIpam' {Maybe Bool
Maybe [AddIpamOperatingRegion]
Maybe [TagSpecification]
Maybe Text
tagSpecifications :: Maybe [TagSpecification]
operatingRegions :: Maybe [AddIpamOperatingRegion]
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:tagSpecifications:CreateIpam' :: CreateIpam -> Maybe [TagSpecification]
$sel:operatingRegions:CreateIpam' :: CreateIpam -> Maybe [AddIpamOperatingRegion]
$sel:dryRun:CreateIpam' :: CreateIpam -> Maybe Bool
$sel:description:CreateIpam' :: CreateIpam -> Maybe Text
$sel:clientToken:CreateIpam' :: CreateIpam -> 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 [AddIpamOperatingRegion]
operatingRegions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications

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

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

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

instance Data.ToQuery CreateIpam where
  toQuery :: CreateIpam -> QueryString
toQuery CreateIpam' {Maybe Bool
Maybe [AddIpamOperatingRegion]
Maybe [TagSpecification]
Maybe Text
tagSpecifications :: Maybe [TagSpecification]
operatingRegions :: Maybe [AddIpamOperatingRegion]
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:tagSpecifications:CreateIpam' :: CreateIpam -> Maybe [TagSpecification]
$sel:operatingRegions:CreateIpam' :: CreateIpam -> Maybe [AddIpamOperatingRegion]
$sel:dryRun:CreateIpam' :: CreateIpam -> Maybe Bool
$sel:description:CreateIpam' :: CreateIpam -> Maybe Text
$sel:clientToken:CreateIpam' :: CreateIpam -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateIpam" :: 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
"OperatingRegion"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [AddIpamOperatingRegion]
operatingRegions
          ),
        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:/ 'newCreateIpamResponse' smart constructor.
data CreateIpamResponse = CreateIpamResponse'
  { -- | Information about the IPAM created.
    CreateIpamResponse -> Maybe Ipam
ipam :: Prelude.Maybe Ipam,
    -- | The response's http status code.
    CreateIpamResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateIpamResponse -> CreateIpamResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIpamResponse -> CreateIpamResponse -> Bool
$c/= :: CreateIpamResponse -> CreateIpamResponse -> Bool
== :: CreateIpamResponse -> CreateIpamResponse -> Bool
$c== :: CreateIpamResponse -> CreateIpamResponse -> Bool
Prelude.Eq, ReadPrec [CreateIpamResponse]
ReadPrec CreateIpamResponse
Int -> ReadS CreateIpamResponse
ReadS [CreateIpamResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIpamResponse]
$creadListPrec :: ReadPrec [CreateIpamResponse]
readPrec :: ReadPrec CreateIpamResponse
$creadPrec :: ReadPrec CreateIpamResponse
readList :: ReadS [CreateIpamResponse]
$creadList :: ReadS [CreateIpamResponse]
readsPrec :: Int -> ReadS CreateIpamResponse
$creadsPrec :: Int -> ReadS CreateIpamResponse
Prelude.Read, Int -> CreateIpamResponse -> ShowS
[CreateIpamResponse] -> ShowS
CreateIpamResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIpamResponse] -> ShowS
$cshowList :: [CreateIpamResponse] -> ShowS
show :: CreateIpamResponse -> String
$cshow :: CreateIpamResponse -> String
showsPrec :: Int -> CreateIpamResponse -> ShowS
$cshowsPrec :: Int -> CreateIpamResponse -> ShowS
Prelude.Show, forall x. Rep CreateIpamResponse x -> CreateIpamResponse
forall x. CreateIpamResponse -> Rep CreateIpamResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIpamResponse x -> CreateIpamResponse
$cfrom :: forall x. CreateIpamResponse -> Rep CreateIpamResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateIpamResponse' 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:
--
-- 'ipam', 'createIpamResponse_ipam' - Information about the IPAM created.
--
-- 'httpStatus', 'createIpamResponse_httpStatus' - The response's http status code.
newCreateIpamResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateIpamResponse
newCreateIpamResponse :: Int -> CreateIpamResponse
newCreateIpamResponse Int
pHttpStatus_ =
  CreateIpamResponse'
    { $sel:ipam:CreateIpamResponse' :: Maybe Ipam
ipam = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateIpamResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the IPAM created.
createIpamResponse_ipam :: Lens.Lens' CreateIpamResponse (Prelude.Maybe Ipam)
createIpamResponse_ipam :: Lens' CreateIpamResponse (Maybe Ipam)
createIpamResponse_ipam = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIpamResponse' {Maybe Ipam
ipam :: Maybe Ipam
$sel:ipam:CreateIpamResponse' :: CreateIpamResponse -> Maybe Ipam
ipam} -> Maybe Ipam
ipam) (\s :: CreateIpamResponse
s@CreateIpamResponse' {} Maybe Ipam
a -> CreateIpamResponse
s {$sel:ipam:CreateIpamResponse' :: Maybe Ipam
ipam = Maybe Ipam
a} :: CreateIpamResponse)

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

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