{-# 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.Route53Resolver.CreateFirewallRuleGroup
-- 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 an empty DNS Firewall rule group for filtering DNS network
-- traffic in a VPC. You can add rules to the new rule group by calling
-- CreateFirewallRule.
module Amazonka.Route53Resolver.CreateFirewallRuleGroup
  ( -- * Creating a Request
    CreateFirewallRuleGroup (..),
    newCreateFirewallRuleGroup,

    -- * Request Lenses
    createFirewallRuleGroup_tags,
    createFirewallRuleGroup_creatorRequestId,
    createFirewallRuleGroup_name,

    -- * Destructuring the Response
    CreateFirewallRuleGroupResponse (..),
    newCreateFirewallRuleGroupResponse,

    -- * Response Lenses
    createFirewallRuleGroupResponse_firewallRuleGroup,
    createFirewallRuleGroupResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Route53Resolver.Types

-- | /See:/ 'newCreateFirewallRuleGroup' smart constructor.
data CreateFirewallRuleGroup = CreateFirewallRuleGroup'
  { -- | A list of the tag keys and values that you want to associate with the
    -- rule group.
    CreateFirewallRuleGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A unique string defined by you to identify the request. This allows you
    -- to retry failed requests without the risk of running the operation
    -- twice. This can be any unique string, for example, a timestamp.
    CreateFirewallRuleGroup -> Text
creatorRequestId :: Prelude.Text,
    -- | A name that lets you identify the rule group, to manage and use it.
    CreateFirewallRuleGroup -> Text
name :: Prelude.Text
  }
  deriving (CreateFirewallRuleGroup -> CreateFirewallRuleGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFirewallRuleGroup -> CreateFirewallRuleGroup -> Bool
$c/= :: CreateFirewallRuleGroup -> CreateFirewallRuleGroup -> Bool
== :: CreateFirewallRuleGroup -> CreateFirewallRuleGroup -> Bool
$c== :: CreateFirewallRuleGroup -> CreateFirewallRuleGroup -> Bool
Prelude.Eq, ReadPrec [CreateFirewallRuleGroup]
ReadPrec CreateFirewallRuleGroup
Int -> ReadS CreateFirewallRuleGroup
ReadS [CreateFirewallRuleGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFirewallRuleGroup]
$creadListPrec :: ReadPrec [CreateFirewallRuleGroup]
readPrec :: ReadPrec CreateFirewallRuleGroup
$creadPrec :: ReadPrec CreateFirewallRuleGroup
readList :: ReadS [CreateFirewallRuleGroup]
$creadList :: ReadS [CreateFirewallRuleGroup]
readsPrec :: Int -> ReadS CreateFirewallRuleGroup
$creadsPrec :: Int -> ReadS CreateFirewallRuleGroup
Prelude.Read, Int -> CreateFirewallRuleGroup -> ShowS
[CreateFirewallRuleGroup] -> ShowS
CreateFirewallRuleGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFirewallRuleGroup] -> ShowS
$cshowList :: [CreateFirewallRuleGroup] -> ShowS
show :: CreateFirewallRuleGroup -> String
$cshow :: CreateFirewallRuleGroup -> String
showsPrec :: Int -> CreateFirewallRuleGroup -> ShowS
$cshowsPrec :: Int -> CreateFirewallRuleGroup -> ShowS
Prelude.Show, forall x. Rep CreateFirewallRuleGroup x -> CreateFirewallRuleGroup
forall x. CreateFirewallRuleGroup -> Rep CreateFirewallRuleGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFirewallRuleGroup x -> CreateFirewallRuleGroup
$cfrom :: forall x. CreateFirewallRuleGroup -> Rep CreateFirewallRuleGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateFirewallRuleGroup' 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:
--
-- 'tags', 'createFirewallRuleGroup_tags' - A list of the tag keys and values that you want to associate with the
-- rule group.
--
-- 'creatorRequestId', 'createFirewallRuleGroup_creatorRequestId' - A unique string defined by you to identify the request. This allows you
-- to retry failed requests without the risk of running the operation
-- twice. This can be any unique string, for example, a timestamp.
--
-- 'name', 'createFirewallRuleGroup_name' - A name that lets you identify the rule group, to manage and use it.
newCreateFirewallRuleGroup ::
  -- | 'creatorRequestId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateFirewallRuleGroup
newCreateFirewallRuleGroup :: Text -> Text -> CreateFirewallRuleGroup
newCreateFirewallRuleGroup Text
pCreatorRequestId_ Text
pName_ =
  CreateFirewallRuleGroup'
    { $sel:tags:CreateFirewallRuleGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:creatorRequestId:CreateFirewallRuleGroup' :: Text
creatorRequestId = Text
pCreatorRequestId_,
      $sel:name:CreateFirewallRuleGroup' :: Text
name = Text
pName_
    }

-- | A list of the tag keys and values that you want to associate with the
-- rule group.
createFirewallRuleGroup_tags :: Lens.Lens' CreateFirewallRuleGroup (Prelude.Maybe [Tag])
createFirewallRuleGroup_tags :: Lens' CreateFirewallRuleGroup (Maybe [Tag])
createFirewallRuleGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFirewallRuleGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateFirewallRuleGroup
s@CreateFirewallRuleGroup' {} Maybe [Tag]
a -> CreateFirewallRuleGroup
s {$sel:tags:CreateFirewallRuleGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateFirewallRuleGroup) 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 unique string defined by you to identify the request. This allows you
-- to retry failed requests without the risk of running the operation
-- twice. This can be any unique string, for example, a timestamp.
createFirewallRuleGroup_creatorRequestId :: Lens.Lens' CreateFirewallRuleGroup Prelude.Text
createFirewallRuleGroup_creatorRequestId :: Lens' CreateFirewallRuleGroup Text
createFirewallRuleGroup_creatorRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFirewallRuleGroup' {Text
creatorRequestId :: Text
$sel:creatorRequestId:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
creatorRequestId} -> Text
creatorRequestId) (\s :: CreateFirewallRuleGroup
s@CreateFirewallRuleGroup' {} Text
a -> CreateFirewallRuleGroup
s {$sel:creatorRequestId:CreateFirewallRuleGroup' :: Text
creatorRequestId = Text
a} :: CreateFirewallRuleGroup)

-- | A name that lets you identify the rule group, to manage and use it.
createFirewallRuleGroup_name :: Lens.Lens' CreateFirewallRuleGroup Prelude.Text
createFirewallRuleGroup_name :: Lens' CreateFirewallRuleGroup Text
createFirewallRuleGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFirewallRuleGroup' {Text
name :: Text
$sel:name:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
name} -> Text
name) (\s :: CreateFirewallRuleGroup
s@CreateFirewallRuleGroup' {} Text
a -> CreateFirewallRuleGroup
s {$sel:name:CreateFirewallRuleGroup' :: Text
name = Text
a} :: CreateFirewallRuleGroup)

instance Core.AWSRequest CreateFirewallRuleGroup where
  type
    AWSResponse CreateFirewallRuleGroup =
      CreateFirewallRuleGroupResponse
  request :: (Service -> Service)
-> CreateFirewallRuleGroup -> Request CreateFirewallRuleGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateFirewallRuleGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateFirewallRuleGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe FirewallRuleGroup -> Int -> CreateFirewallRuleGroupResponse
CreateFirewallRuleGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FirewallRuleGroup")
            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 CreateFirewallRuleGroup where
  hashWithSalt :: Int -> CreateFirewallRuleGroup -> Int
hashWithSalt Int
_salt CreateFirewallRuleGroup' {Maybe [Tag]
Text
name :: Text
creatorRequestId :: Text
tags :: Maybe [Tag]
$sel:name:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
$sel:creatorRequestId:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
$sel:tags:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
creatorRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateFirewallRuleGroup where
  rnf :: CreateFirewallRuleGroup -> ()
rnf CreateFirewallRuleGroup' {Maybe [Tag]
Text
name :: Text
creatorRequestId :: Text
tags :: Maybe [Tag]
$sel:name:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
$sel:creatorRequestId:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
$sel:tags:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
creatorRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateFirewallRuleGroup where
  toHeaders :: CreateFirewallRuleGroup -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Route53Resolver.CreateFirewallRuleGroup" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateFirewallRuleGroup where
  toJSON :: CreateFirewallRuleGroup -> Value
toJSON CreateFirewallRuleGroup' {Maybe [Tag]
Text
name :: Text
creatorRequestId :: Text
tags :: Maybe [Tag]
$sel:name:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
$sel:creatorRequestId:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Text
$sel:tags:CreateFirewallRuleGroup' :: CreateFirewallRuleGroup -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CreatorRequestId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
creatorRequestId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

instance Data.ToQuery CreateFirewallRuleGroup where
  toQuery :: CreateFirewallRuleGroup -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateFirewallRuleGroupResponse' smart constructor.
data CreateFirewallRuleGroupResponse = CreateFirewallRuleGroupResponse'
  { -- | A collection of rules used to filter DNS network traffic.
    CreateFirewallRuleGroupResponse -> Maybe FirewallRuleGroup
firewallRuleGroup :: Prelude.Maybe FirewallRuleGroup,
    -- | The response's http status code.
    CreateFirewallRuleGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateFirewallRuleGroupResponse
-> CreateFirewallRuleGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFirewallRuleGroupResponse
-> CreateFirewallRuleGroupResponse -> Bool
$c/= :: CreateFirewallRuleGroupResponse
-> CreateFirewallRuleGroupResponse -> Bool
== :: CreateFirewallRuleGroupResponse
-> CreateFirewallRuleGroupResponse -> Bool
$c== :: CreateFirewallRuleGroupResponse
-> CreateFirewallRuleGroupResponse -> Bool
Prelude.Eq, ReadPrec [CreateFirewallRuleGroupResponse]
ReadPrec CreateFirewallRuleGroupResponse
Int -> ReadS CreateFirewallRuleGroupResponse
ReadS [CreateFirewallRuleGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFirewallRuleGroupResponse]
$creadListPrec :: ReadPrec [CreateFirewallRuleGroupResponse]
readPrec :: ReadPrec CreateFirewallRuleGroupResponse
$creadPrec :: ReadPrec CreateFirewallRuleGroupResponse
readList :: ReadS [CreateFirewallRuleGroupResponse]
$creadList :: ReadS [CreateFirewallRuleGroupResponse]
readsPrec :: Int -> ReadS CreateFirewallRuleGroupResponse
$creadsPrec :: Int -> ReadS CreateFirewallRuleGroupResponse
Prelude.Read, Int -> CreateFirewallRuleGroupResponse -> ShowS
[CreateFirewallRuleGroupResponse] -> ShowS
CreateFirewallRuleGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFirewallRuleGroupResponse] -> ShowS
$cshowList :: [CreateFirewallRuleGroupResponse] -> ShowS
show :: CreateFirewallRuleGroupResponse -> String
$cshow :: CreateFirewallRuleGroupResponse -> String
showsPrec :: Int -> CreateFirewallRuleGroupResponse -> ShowS
$cshowsPrec :: Int -> CreateFirewallRuleGroupResponse -> ShowS
Prelude.Show, forall x.
Rep CreateFirewallRuleGroupResponse x
-> CreateFirewallRuleGroupResponse
forall x.
CreateFirewallRuleGroupResponse
-> Rep CreateFirewallRuleGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateFirewallRuleGroupResponse x
-> CreateFirewallRuleGroupResponse
$cfrom :: forall x.
CreateFirewallRuleGroupResponse
-> Rep CreateFirewallRuleGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateFirewallRuleGroupResponse' 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:
--
-- 'firewallRuleGroup', 'createFirewallRuleGroupResponse_firewallRuleGroup' - A collection of rules used to filter DNS network traffic.
--
-- 'httpStatus', 'createFirewallRuleGroupResponse_httpStatus' - The response's http status code.
newCreateFirewallRuleGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFirewallRuleGroupResponse
newCreateFirewallRuleGroupResponse :: Int -> CreateFirewallRuleGroupResponse
newCreateFirewallRuleGroupResponse Int
pHttpStatus_ =
  CreateFirewallRuleGroupResponse'
    { $sel:firewallRuleGroup:CreateFirewallRuleGroupResponse' :: Maybe FirewallRuleGroup
firewallRuleGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFirewallRuleGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A collection of rules used to filter DNS network traffic.
createFirewallRuleGroupResponse_firewallRuleGroup :: Lens.Lens' CreateFirewallRuleGroupResponse (Prelude.Maybe FirewallRuleGroup)
createFirewallRuleGroupResponse_firewallRuleGroup :: Lens' CreateFirewallRuleGroupResponse (Maybe FirewallRuleGroup)
createFirewallRuleGroupResponse_firewallRuleGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFirewallRuleGroupResponse' {Maybe FirewallRuleGroup
firewallRuleGroup :: Maybe FirewallRuleGroup
$sel:firewallRuleGroup:CreateFirewallRuleGroupResponse' :: CreateFirewallRuleGroupResponse -> Maybe FirewallRuleGroup
firewallRuleGroup} -> Maybe FirewallRuleGroup
firewallRuleGroup) (\s :: CreateFirewallRuleGroupResponse
s@CreateFirewallRuleGroupResponse' {} Maybe FirewallRuleGroup
a -> CreateFirewallRuleGroupResponse
s {$sel:firewallRuleGroup:CreateFirewallRuleGroupResponse' :: Maybe FirewallRuleGroup
firewallRuleGroup = Maybe FirewallRuleGroup
a} :: CreateFirewallRuleGroupResponse)

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

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