{-# 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.CreateManagedPrefixList
-- 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 managed prefix list. You can specify one or more entries for
-- the prefix list. Each entry consists of a CIDR block and an optional
-- description.
module Amazonka.EC2.CreateManagedPrefixList
  ( -- * Creating a Request
    CreateManagedPrefixList (..),
    newCreateManagedPrefixList,

    -- * Request Lenses
    createManagedPrefixList_clientToken,
    createManagedPrefixList_dryRun,
    createManagedPrefixList_entries,
    createManagedPrefixList_tagSpecifications,
    createManagedPrefixList_prefixListName,
    createManagedPrefixList_maxEntries,
    createManagedPrefixList_addressFamily,

    -- * Destructuring the Response
    CreateManagedPrefixListResponse (..),
    newCreateManagedPrefixListResponse,

    -- * Response Lenses
    createManagedPrefixListResponse_prefixList,
    createManagedPrefixListResponse_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:/ 'newCreateManagedPrefixList' smart constructor.
data CreateManagedPrefixList = CreateManagedPrefixList'
  { -- | Unique, case-sensitive identifier 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>.
    --
    -- Constraints: Up to 255 UTF-8 characters in length.
    CreateManagedPrefixList -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | 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@.
    CreateManagedPrefixList -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | One or more entries for the prefix list.
    CreateManagedPrefixList -> Maybe [AddPrefixListEntry]
entries :: Prelude.Maybe [AddPrefixListEntry],
    -- | The tags to apply to the prefix list during creation.
    CreateManagedPrefixList -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | A name for the prefix list.
    --
    -- Constraints: Up to 255 characters in length. The name cannot start with
    -- @com.amazonaws@.
    CreateManagedPrefixList -> Text
prefixListName :: Prelude.Text,
    -- | The maximum number of entries for the prefix list.
    CreateManagedPrefixList -> Int
maxEntries :: Prelude.Int,
    -- | The IP address type.
    --
    -- Valid Values: @IPv4@ | @IPv6@
    CreateManagedPrefixList -> Text
addressFamily :: Prelude.Text
  }
  deriving (CreateManagedPrefixList -> CreateManagedPrefixList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateManagedPrefixList -> CreateManagedPrefixList -> Bool
$c/= :: CreateManagedPrefixList -> CreateManagedPrefixList -> Bool
== :: CreateManagedPrefixList -> CreateManagedPrefixList -> Bool
$c== :: CreateManagedPrefixList -> CreateManagedPrefixList -> Bool
Prelude.Eq, ReadPrec [CreateManagedPrefixList]
ReadPrec CreateManagedPrefixList
Int -> ReadS CreateManagedPrefixList
ReadS [CreateManagedPrefixList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateManagedPrefixList]
$creadListPrec :: ReadPrec [CreateManagedPrefixList]
readPrec :: ReadPrec CreateManagedPrefixList
$creadPrec :: ReadPrec CreateManagedPrefixList
readList :: ReadS [CreateManagedPrefixList]
$creadList :: ReadS [CreateManagedPrefixList]
readsPrec :: Int -> ReadS CreateManagedPrefixList
$creadsPrec :: Int -> ReadS CreateManagedPrefixList
Prelude.Read, Int -> CreateManagedPrefixList -> ShowS
[CreateManagedPrefixList] -> ShowS
CreateManagedPrefixList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateManagedPrefixList] -> ShowS
$cshowList :: [CreateManagedPrefixList] -> ShowS
show :: CreateManagedPrefixList -> String
$cshow :: CreateManagedPrefixList -> String
showsPrec :: Int -> CreateManagedPrefixList -> ShowS
$cshowsPrec :: Int -> CreateManagedPrefixList -> ShowS
Prelude.Show, forall x. Rep CreateManagedPrefixList x -> CreateManagedPrefixList
forall x. CreateManagedPrefixList -> Rep CreateManagedPrefixList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateManagedPrefixList x -> CreateManagedPrefixList
$cfrom :: forall x. CreateManagedPrefixList -> Rep CreateManagedPrefixList x
Prelude.Generic)

-- |
-- Create a value of 'CreateManagedPrefixList' 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', 'createManagedPrefixList_clientToken' - Unique, case-sensitive identifier 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>.
--
-- Constraints: Up to 255 UTF-8 characters in length.
--
-- 'dryRun', 'createManagedPrefixList_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@.
--
-- 'entries', 'createManagedPrefixList_entries' - One or more entries for the prefix list.
--
-- 'tagSpecifications', 'createManagedPrefixList_tagSpecifications' - The tags to apply to the prefix list during creation.
--
-- 'prefixListName', 'createManagedPrefixList_prefixListName' - A name for the prefix list.
--
-- Constraints: Up to 255 characters in length. The name cannot start with
-- @com.amazonaws@.
--
-- 'maxEntries', 'createManagedPrefixList_maxEntries' - The maximum number of entries for the prefix list.
--
-- 'addressFamily', 'createManagedPrefixList_addressFamily' - The IP address type.
--
-- Valid Values: @IPv4@ | @IPv6@
newCreateManagedPrefixList ::
  -- | 'prefixListName'
  Prelude.Text ->
  -- | 'maxEntries'
  Prelude.Int ->
  -- | 'addressFamily'
  Prelude.Text ->
  CreateManagedPrefixList
newCreateManagedPrefixList :: Text -> Int -> Text -> CreateManagedPrefixList
newCreateManagedPrefixList
  Text
pPrefixListName_
  Int
pMaxEntries_
  Text
pAddressFamily_ =
    CreateManagedPrefixList'
      { $sel:clientToken:CreateManagedPrefixList' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:CreateManagedPrefixList' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:entries:CreateManagedPrefixList' :: Maybe [AddPrefixListEntry]
entries = forall a. Maybe a
Prelude.Nothing,
        $sel:tagSpecifications:CreateManagedPrefixList' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
        $sel:prefixListName:CreateManagedPrefixList' :: Text
prefixListName = Text
pPrefixListName_,
        $sel:maxEntries:CreateManagedPrefixList' :: Int
maxEntries = Int
pMaxEntries_,
        $sel:addressFamily:CreateManagedPrefixList' :: Text
addressFamily = Text
pAddressFamily_
      }

-- | Unique, case-sensitive identifier 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>.
--
-- Constraints: Up to 255 UTF-8 characters in length.
createManagedPrefixList_clientToken :: Lens.Lens' CreateManagedPrefixList (Prelude.Maybe Prelude.Text)
createManagedPrefixList_clientToken :: Lens' CreateManagedPrefixList (Maybe Text)
createManagedPrefixList_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedPrefixList' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateManagedPrefixList
s@CreateManagedPrefixList' {} Maybe Text
a -> CreateManagedPrefixList
s {$sel:clientToken:CreateManagedPrefixList' :: Maybe Text
clientToken = Maybe Text
a} :: CreateManagedPrefixList)

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

-- | One or more entries for the prefix list.
createManagedPrefixList_entries :: Lens.Lens' CreateManagedPrefixList (Prelude.Maybe [AddPrefixListEntry])
createManagedPrefixList_entries :: Lens' CreateManagedPrefixList (Maybe [AddPrefixListEntry])
createManagedPrefixList_entries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedPrefixList' {Maybe [AddPrefixListEntry]
entries :: Maybe [AddPrefixListEntry]
$sel:entries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [AddPrefixListEntry]
entries} -> Maybe [AddPrefixListEntry]
entries) (\s :: CreateManagedPrefixList
s@CreateManagedPrefixList' {} Maybe [AddPrefixListEntry]
a -> CreateManagedPrefixList
s {$sel:entries:CreateManagedPrefixList' :: Maybe [AddPrefixListEntry]
entries = Maybe [AddPrefixListEntry]
a} :: CreateManagedPrefixList) 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 tags to apply to the prefix list during creation.
createManagedPrefixList_tagSpecifications :: Lens.Lens' CreateManagedPrefixList (Prelude.Maybe [TagSpecification])
createManagedPrefixList_tagSpecifications :: Lens' CreateManagedPrefixList (Maybe [TagSpecification])
createManagedPrefixList_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedPrefixList' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateManagedPrefixList
s@CreateManagedPrefixList' {} Maybe [TagSpecification]
a -> CreateManagedPrefixList
s {$sel:tagSpecifications:CreateManagedPrefixList' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateManagedPrefixList) 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

-- | A name for the prefix list.
--
-- Constraints: Up to 255 characters in length. The name cannot start with
-- @com.amazonaws@.
createManagedPrefixList_prefixListName :: Lens.Lens' CreateManagedPrefixList Prelude.Text
createManagedPrefixList_prefixListName :: Lens' CreateManagedPrefixList Text
createManagedPrefixList_prefixListName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedPrefixList' {Text
prefixListName :: Text
$sel:prefixListName:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
prefixListName} -> Text
prefixListName) (\s :: CreateManagedPrefixList
s@CreateManagedPrefixList' {} Text
a -> CreateManagedPrefixList
s {$sel:prefixListName:CreateManagedPrefixList' :: Text
prefixListName = Text
a} :: CreateManagedPrefixList)

-- | The maximum number of entries for the prefix list.
createManagedPrefixList_maxEntries :: Lens.Lens' CreateManagedPrefixList Prelude.Int
createManagedPrefixList_maxEntries :: Lens' CreateManagedPrefixList Int
createManagedPrefixList_maxEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedPrefixList' {Int
maxEntries :: Int
$sel:maxEntries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Int
maxEntries} -> Int
maxEntries) (\s :: CreateManagedPrefixList
s@CreateManagedPrefixList' {} Int
a -> CreateManagedPrefixList
s {$sel:maxEntries:CreateManagedPrefixList' :: Int
maxEntries = Int
a} :: CreateManagedPrefixList)

-- | The IP address type.
--
-- Valid Values: @IPv4@ | @IPv6@
createManagedPrefixList_addressFamily :: Lens.Lens' CreateManagedPrefixList Prelude.Text
createManagedPrefixList_addressFamily :: Lens' CreateManagedPrefixList Text
createManagedPrefixList_addressFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedPrefixList' {Text
addressFamily :: Text
$sel:addressFamily:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
addressFamily} -> Text
addressFamily) (\s :: CreateManagedPrefixList
s@CreateManagedPrefixList' {} Text
a -> CreateManagedPrefixList
s {$sel:addressFamily:CreateManagedPrefixList' :: Text
addressFamily = Text
a} :: CreateManagedPrefixList)

instance Core.AWSRequest CreateManagedPrefixList where
  type
    AWSResponse CreateManagedPrefixList =
      CreateManagedPrefixListResponse
  request :: (Service -> Service)
-> CreateManagedPrefixList -> Request CreateManagedPrefixList
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 CreateManagedPrefixList
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateManagedPrefixList)))
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 ManagedPrefixList -> Int -> CreateManagedPrefixListResponse
CreateManagedPrefixListResponse'
            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
"prefixList")
            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 CreateManagedPrefixList where
  hashWithSalt :: Int -> CreateManagedPrefixList -> Int
hashWithSalt Int
_salt CreateManagedPrefixList' {Int
Maybe Bool
Maybe [AddPrefixListEntry]
Maybe [TagSpecification]
Maybe Text
Text
addressFamily :: Text
maxEntries :: Int
prefixListName :: Text
tagSpecifications :: Maybe [TagSpecification]
entries :: Maybe [AddPrefixListEntry]
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:addressFamily:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
$sel:maxEntries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Int
$sel:prefixListName:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
$sel:tagSpecifications:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [TagSpecification]
$sel:entries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [AddPrefixListEntry]
$sel:dryRun:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe Bool
$sel:clientToken:CreateManagedPrefixList' :: CreateManagedPrefixList -> 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 Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AddPrefixListEntry]
entries
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
prefixListName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
maxEntries
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
addressFamily

instance Prelude.NFData CreateManagedPrefixList where
  rnf :: CreateManagedPrefixList -> ()
rnf CreateManagedPrefixList' {Int
Maybe Bool
Maybe [AddPrefixListEntry]
Maybe [TagSpecification]
Maybe Text
Text
addressFamily :: Text
maxEntries :: Int
prefixListName :: Text
tagSpecifications :: Maybe [TagSpecification]
entries :: Maybe [AddPrefixListEntry]
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:addressFamily:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
$sel:maxEntries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Int
$sel:prefixListName:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
$sel:tagSpecifications:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [TagSpecification]
$sel:entries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [AddPrefixListEntry]
$sel:dryRun:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe Bool
$sel:clientToken:CreateManagedPrefixList' :: CreateManagedPrefixList -> 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 Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AddPrefixListEntry]
entries
      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
prefixListName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
maxEntries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
addressFamily

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

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

instance Data.ToQuery CreateManagedPrefixList where
  toQuery :: CreateManagedPrefixList -> QueryString
toQuery CreateManagedPrefixList' {Int
Maybe Bool
Maybe [AddPrefixListEntry]
Maybe [TagSpecification]
Maybe Text
Text
addressFamily :: Text
maxEntries :: Int
prefixListName :: Text
tagSpecifications :: Maybe [TagSpecification]
entries :: Maybe [AddPrefixListEntry]
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:addressFamily:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
$sel:maxEntries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Int
$sel:prefixListName:CreateManagedPrefixList' :: CreateManagedPrefixList -> Text
$sel:tagSpecifications:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [TagSpecification]
$sel:entries:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe [AddPrefixListEntry]
$sel:dryRun:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe Bool
$sel:clientToken:CreateManagedPrefixList' :: CreateManagedPrefixList -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateManagedPrefixList" :: 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
"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
"Entry" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [AddPrefixListEntry]
entries),
        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
"PrefixListName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
prefixListName,
        ByteString
"MaxEntries" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Int
maxEntries,
        ByteString
"AddressFamily" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
addressFamily
      ]

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

-- |
-- Create a value of 'CreateManagedPrefixListResponse' 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:
--
-- 'prefixList', 'createManagedPrefixListResponse_prefixList' - Information about the prefix list.
--
-- 'httpStatus', 'createManagedPrefixListResponse_httpStatus' - The response's http status code.
newCreateManagedPrefixListResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateManagedPrefixListResponse
newCreateManagedPrefixListResponse :: Int -> CreateManagedPrefixListResponse
newCreateManagedPrefixListResponse Int
pHttpStatus_ =
  CreateManagedPrefixListResponse'
    { $sel:prefixList:CreateManagedPrefixListResponse' :: Maybe ManagedPrefixList
prefixList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateManagedPrefixListResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the prefix list.
createManagedPrefixListResponse_prefixList :: Lens.Lens' CreateManagedPrefixListResponse (Prelude.Maybe ManagedPrefixList)
createManagedPrefixListResponse_prefixList :: Lens' CreateManagedPrefixListResponse (Maybe ManagedPrefixList)
createManagedPrefixListResponse_prefixList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedPrefixListResponse' {Maybe ManagedPrefixList
prefixList :: Maybe ManagedPrefixList
$sel:prefixList:CreateManagedPrefixListResponse' :: CreateManagedPrefixListResponse -> Maybe ManagedPrefixList
prefixList} -> Maybe ManagedPrefixList
prefixList) (\s :: CreateManagedPrefixListResponse
s@CreateManagedPrefixListResponse' {} Maybe ManagedPrefixList
a -> CreateManagedPrefixListResponse
s {$sel:prefixList:CreateManagedPrefixListResponse' :: Maybe ManagedPrefixList
prefixList = Maybe ManagedPrefixList
a} :: CreateManagedPrefixListResponse)

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

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