{-# 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.CreateCoipPool
-- 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 pool of customer-owned IP (CoIP) addresses.
module Amazonka.EC2.CreateCoipPool
  ( -- * Creating a Request
    CreateCoipPool (..),
    newCreateCoipPool,

    -- * Request Lenses
    createCoipPool_dryRun,
    createCoipPool_tagSpecifications,
    createCoipPool_localGatewayRouteTableId,

    -- * Destructuring the Response
    CreateCoipPoolResponse (..),
    newCreateCoipPoolResponse,

    -- * Response Lenses
    createCoipPoolResponse_coipPool,
    createCoipPoolResponse_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:/ 'newCreateCoipPool' smart constructor.
data CreateCoipPool = CreateCoipPool'
  { -- | 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@.
    CreateCoipPool -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The tags to assign to the CoIP address pool.
    CreateCoipPool -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the local gateway route table.
    CreateCoipPool -> Text
localGatewayRouteTableId :: Prelude.Text
  }
  deriving (CreateCoipPool -> CreateCoipPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCoipPool -> CreateCoipPool -> Bool
$c/= :: CreateCoipPool -> CreateCoipPool -> Bool
== :: CreateCoipPool -> CreateCoipPool -> Bool
$c== :: CreateCoipPool -> CreateCoipPool -> Bool
Prelude.Eq, ReadPrec [CreateCoipPool]
ReadPrec CreateCoipPool
Int -> ReadS CreateCoipPool
ReadS [CreateCoipPool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCoipPool]
$creadListPrec :: ReadPrec [CreateCoipPool]
readPrec :: ReadPrec CreateCoipPool
$creadPrec :: ReadPrec CreateCoipPool
readList :: ReadS [CreateCoipPool]
$creadList :: ReadS [CreateCoipPool]
readsPrec :: Int -> ReadS CreateCoipPool
$creadsPrec :: Int -> ReadS CreateCoipPool
Prelude.Read, Int -> CreateCoipPool -> ShowS
[CreateCoipPool] -> ShowS
CreateCoipPool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCoipPool] -> ShowS
$cshowList :: [CreateCoipPool] -> ShowS
show :: CreateCoipPool -> String
$cshow :: CreateCoipPool -> String
showsPrec :: Int -> CreateCoipPool -> ShowS
$cshowsPrec :: Int -> CreateCoipPool -> ShowS
Prelude.Show, forall x. Rep CreateCoipPool x -> CreateCoipPool
forall x. CreateCoipPool -> Rep CreateCoipPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCoipPool x -> CreateCoipPool
$cfrom :: forall x. CreateCoipPool -> Rep CreateCoipPool x
Prelude.Generic)

-- |
-- Create a value of 'CreateCoipPool' 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', 'createCoipPool_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@.
--
-- 'tagSpecifications', 'createCoipPool_tagSpecifications' - The tags to assign to the CoIP address pool.
--
-- 'localGatewayRouteTableId', 'createCoipPool_localGatewayRouteTableId' - The ID of the local gateway route table.
newCreateCoipPool ::
  -- | 'localGatewayRouteTableId'
  Prelude.Text ->
  CreateCoipPool
newCreateCoipPool :: Text -> CreateCoipPool
newCreateCoipPool Text
pLocalGatewayRouteTableId_ =
  CreateCoipPool'
    { $sel:dryRun:CreateCoipPool' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateCoipPool' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:localGatewayRouteTableId:CreateCoipPool' :: Text
localGatewayRouteTableId =
        Text
pLocalGatewayRouteTableId_
    }

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

-- | The tags to assign to the CoIP address pool.
createCoipPool_tagSpecifications :: Lens.Lens' CreateCoipPool (Prelude.Maybe [TagSpecification])
createCoipPool_tagSpecifications :: Lens' CreateCoipPool (Maybe [TagSpecification])
createCoipPool_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCoipPool' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateCoipPool' :: CreateCoipPool -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateCoipPool
s@CreateCoipPool' {} Maybe [TagSpecification]
a -> CreateCoipPool
s {$sel:tagSpecifications:CreateCoipPool' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateCoipPool) 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 local gateway route table.
createCoipPool_localGatewayRouteTableId :: Lens.Lens' CreateCoipPool Prelude.Text
createCoipPool_localGatewayRouteTableId :: Lens' CreateCoipPool Text
createCoipPool_localGatewayRouteTableId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCoipPool' {Text
localGatewayRouteTableId :: Text
$sel:localGatewayRouteTableId:CreateCoipPool' :: CreateCoipPool -> Text
localGatewayRouteTableId} -> Text
localGatewayRouteTableId) (\s :: CreateCoipPool
s@CreateCoipPool' {} Text
a -> CreateCoipPool
s {$sel:localGatewayRouteTableId:CreateCoipPool' :: Text
localGatewayRouteTableId = Text
a} :: CreateCoipPool)

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

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

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

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

instance Data.ToQuery CreateCoipPool where
  toQuery :: CreateCoipPool -> QueryString
toQuery CreateCoipPool' {Maybe Bool
Maybe [TagSpecification]
Text
localGatewayRouteTableId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:localGatewayRouteTableId:CreateCoipPool' :: CreateCoipPool -> Text
$sel:tagSpecifications:CreateCoipPool' :: CreateCoipPool -> Maybe [TagSpecification]
$sel:dryRun:CreateCoipPool' :: CreateCoipPool -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateCoipPool" :: 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,
        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
"LocalGatewayRouteTableId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
localGatewayRouteTableId
      ]

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

-- |
-- Create a value of 'CreateCoipPoolResponse' 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:
--
-- 'coipPool', 'createCoipPoolResponse_coipPool' - Information about the CoIP address pool.
--
-- 'httpStatus', 'createCoipPoolResponse_httpStatus' - The response's http status code.
newCreateCoipPoolResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCoipPoolResponse
newCreateCoipPoolResponse :: Int -> CreateCoipPoolResponse
newCreateCoipPoolResponse Int
pHttpStatus_ =
  CreateCoipPoolResponse'
    { $sel:coipPool:CreateCoipPoolResponse' :: Maybe CoipPool
coipPool = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCoipPoolResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the CoIP address pool.
createCoipPoolResponse_coipPool :: Lens.Lens' CreateCoipPoolResponse (Prelude.Maybe CoipPool)
createCoipPoolResponse_coipPool :: Lens' CreateCoipPoolResponse (Maybe CoipPool)
createCoipPoolResponse_coipPool = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCoipPoolResponse' {Maybe CoipPool
coipPool :: Maybe CoipPool
$sel:coipPool:CreateCoipPoolResponse' :: CreateCoipPoolResponse -> Maybe CoipPool
coipPool} -> Maybe CoipPool
coipPool) (\s :: CreateCoipPoolResponse
s@CreateCoipPoolResponse' {} Maybe CoipPool
a -> CreateCoipPoolResponse
s {$sel:coipPool:CreateCoipPoolResponse' :: Maybe CoipPool
coipPool = Maybe CoipPool
a} :: CreateCoipPoolResponse)

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

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