{-# 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.CreateNetworkAcl
-- 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 network ACL in a VPC. Network ACLs provide an optional layer
-- of security (in addition to security groups) for the instances in your
-- VPC.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_ACLs.html Network ACLs>
-- in the /Amazon Virtual Private Cloud User Guide/.
module Amazonka.EC2.CreateNetworkAcl
  ( -- * Creating a Request
    CreateNetworkAcl (..),
    newCreateNetworkAcl,

    -- * Request Lenses
    createNetworkAcl_dryRun,
    createNetworkAcl_tagSpecifications,
    createNetworkAcl_vpcId,

    -- * Destructuring the Response
    CreateNetworkAclResponse (..),
    newCreateNetworkAclResponse,

    -- * Response Lenses
    createNetworkAclResponse_networkAcl,
    createNetworkAclResponse_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:/ 'newCreateNetworkAcl' smart constructor.
data CreateNetworkAcl = CreateNetworkAcl'
  { -- | 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@.
    CreateNetworkAcl -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The tags to assign to the network ACL.
    CreateNetworkAcl -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the VPC.
    CreateNetworkAcl -> Text
vpcId :: Prelude.Text
  }
  deriving (CreateNetworkAcl -> CreateNetworkAcl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNetworkAcl -> CreateNetworkAcl -> Bool
$c/= :: CreateNetworkAcl -> CreateNetworkAcl -> Bool
== :: CreateNetworkAcl -> CreateNetworkAcl -> Bool
$c== :: CreateNetworkAcl -> CreateNetworkAcl -> Bool
Prelude.Eq, ReadPrec [CreateNetworkAcl]
ReadPrec CreateNetworkAcl
Int -> ReadS CreateNetworkAcl
ReadS [CreateNetworkAcl]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNetworkAcl]
$creadListPrec :: ReadPrec [CreateNetworkAcl]
readPrec :: ReadPrec CreateNetworkAcl
$creadPrec :: ReadPrec CreateNetworkAcl
readList :: ReadS [CreateNetworkAcl]
$creadList :: ReadS [CreateNetworkAcl]
readsPrec :: Int -> ReadS CreateNetworkAcl
$creadsPrec :: Int -> ReadS CreateNetworkAcl
Prelude.Read, Int -> CreateNetworkAcl -> ShowS
[CreateNetworkAcl] -> ShowS
CreateNetworkAcl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNetworkAcl] -> ShowS
$cshowList :: [CreateNetworkAcl] -> ShowS
show :: CreateNetworkAcl -> String
$cshow :: CreateNetworkAcl -> String
showsPrec :: Int -> CreateNetworkAcl -> ShowS
$cshowsPrec :: Int -> CreateNetworkAcl -> ShowS
Prelude.Show, forall x. Rep CreateNetworkAcl x -> CreateNetworkAcl
forall x. CreateNetworkAcl -> Rep CreateNetworkAcl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateNetworkAcl x -> CreateNetworkAcl
$cfrom :: forall x. CreateNetworkAcl -> Rep CreateNetworkAcl x
Prelude.Generic)

-- |
-- Create a value of 'CreateNetworkAcl' 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', 'createNetworkAcl_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', 'createNetworkAcl_tagSpecifications' - The tags to assign to the network ACL.
--
-- 'vpcId', 'createNetworkAcl_vpcId' - The ID of the VPC.
newCreateNetworkAcl ::
  -- | 'vpcId'
  Prelude.Text ->
  CreateNetworkAcl
newCreateNetworkAcl :: Text -> CreateNetworkAcl
newCreateNetworkAcl Text
pVpcId_ =
  CreateNetworkAcl'
    { $sel:dryRun:CreateNetworkAcl' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateNetworkAcl' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:CreateNetworkAcl' :: Text
vpcId = Text
pVpcId_
    }

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

-- | The tags to assign to the network ACL.
createNetworkAcl_tagSpecifications :: Lens.Lens' CreateNetworkAcl (Prelude.Maybe [TagSpecification])
createNetworkAcl_tagSpecifications :: Lens' CreateNetworkAcl (Maybe [TagSpecification])
createNetworkAcl_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAcl' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateNetworkAcl' :: CreateNetworkAcl -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateNetworkAcl
s@CreateNetworkAcl' {} Maybe [TagSpecification]
a -> CreateNetworkAcl
s {$sel:tagSpecifications:CreateNetworkAcl' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateNetworkAcl) 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 VPC.
createNetworkAcl_vpcId :: Lens.Lens' CreateNetworkAcl Prelude.Text
createNetworkAcl_vpcId :: Lens' CreateNetworkAcl Text
createNetworkAcl_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAcl' {Text
vpcId :: Text
$sel:vpcId:CreateNetworkAcl' :: CreateNetworkAcl -> Text
vpcId} -> Text
vpcId) (\s :: CreateNetworkAcl
s@CreateNetworkAcl' {} Text
a -> CreateNetworkAcl
s {$sel:vpcId:CreateNetworkAcl' :: Text
vpcId = Text
a} :: CreateNetworkAcl)

instance Core.AWSRequest CreateNetworkAcl where
  type
    AWSResponse CreateNetworkAcl =
      CreateNetworkAclResponse
  request :: (Service -> Service)
-> CreateNetworkAcl -> Request CreateNetworkAcl
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 CreateNetworkAcl
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateNetworkAcl)))
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 NetworkAcl -> Int -> CreateNetworkAclResponse
CreateNetworkAclResponse'
            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
"networkAcl")
            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 CreateNetworkAcl where
  hashWithSalt :: Int -> CreateNetworkAcl -> Int
hashWithSalt Int
_salt CreateNetworkAcl' {Maybe Bool
Maybe [TagSpecification]
Text
vpcId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:vpcId:CreateNetworkAcl' :: CreateNetworkAcl -> Text
$sel:tagSpecifications:CreateNetworkAcl' :: CreateNetworkAcl -> Maybe [TagSpecification]
$sel:dryRun:CreateNetworkAcl' :: CreateNetworkAcl -> 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
vpcId

instance Prelude.NFData CreateNetworkAcl where
  rnf :: CreateNetworkAcl -> ()
rnf CreateNetworkAcl' {Maybe Bool
Maybe [TagSpecification]
Text
vpcId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:vpcId:CreateNetworkAcl' :: CreateNetworkAcl -> Text
$sel:tagSpecifications:CreateNetworkAcl' :: CreateNetworkAcl -> Maybe [TagSpecification]
$sel:dryRun:CreateNetworkAcl' :: CreateNetworkAcl -> 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
vpcId

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

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

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

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

-- |
-- Create a value of 'CreateNetworkAclResponse' 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:
--
-- 'networkAcl', 'createNetworkAclResponse_networkAcl' - Information about the network ACL.
--
-- 'httpStatus', 'createNetworkAclResponse_httpStatus' - The response's http status code.
newCreateNetworkAclResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateNetworkAclResponse
newCreateNetworkAclResponse :: Int -> CreateNetworkAclResponse
newCreateNetworkAclResponse Int
pHttpStatus_ =
  CreateNetworkAclResponse'
    { $sel:networkAcl:CreateNetworkAclResponse' :: Maybe NetworkAcl
networkAcl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateNetworkAclResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the network ACL.
createNetworkAclResponse_networkAcl :: Lens.Lens' CreateNetworkAclResponse (Prelude.Maybe NetworkAcl)
createNetworkAclResponse_networkAcl :: Lens' CreateNetworkAclResponse (Maybe NetworkAcl)
createNetworkAclResponse_networkAcl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAclResponse' {Maybe NetworkAcl
networkAcl :: Maybe NetworkAcl
$sel:networkAcl:CreateNetworkAclResponse' :: CreateNetworkAclResponse -> Maybe NetworkAcl
networkAcl} -> Maybe NetworkAcl
networkAcl) (\s :: CreateNetworkAclResponse
s@CreateNetworkAclResponse' {} Maybe NetworkAcl
a -> CreateNetworkAclResponse
s {$sel:networkAcl:CreateNetworkAclResponse' :: Maybe NetworkAcl
networkAcl = Maybe NetworkAcl
a} :: CreateNetworkAclResponse)

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

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