{-# 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.UpdateFirewallConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the configuration of the firewall behavior provided by DNS
-- Firewall for a single VPC from Amazon Virtual Private Cloud (Amazon
-- VPC).
module Amazonka.Route53Resolver.UpdateFirewallConfig
  ( -- * Creating a Request
    UpdateFirewallConfig (..),
    newUpdateFirewallConfig,

    -- * Request Lenses
    updateFirewallConfig_resourceId,
    updateFirewallConfig_firewallFailOpen,

    -- * Destructuring the Response
    UpdateFirewallConfigResponse (..),
    newUpdateFirewallConfigResponse,

    -- * Response Lenses
    updateFirewallConfigResponse_firewallConfig,
    updateFirewallConfigResponse_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:/ 'newUpdateFirewallConfig' smart constructor.
data UpdateFirewallConfig = UpdateFirewallConfig'
  { -- | The ID of the VPC that the configuration is for.
    UpdateFirewallConfig -> Text
resourceId :: Prelude.Text,
    -- | Determines how Route 53 Resolver handles queries during failures, for
    -- example when all traffic that is sent to DNS Firewall fails to receive a
    -- reply.
    --
    -- -   By default, fail open is disabled, which means the failure mode is
    --     closed. This approach favors security over availability. DNS
    --     Firewall blocks queries that it is unable to evaluate properly.
    --
    -- -   If you enable this option, the failure mode is open. This approach
    --     favors availability over security. DNS Firewall allows queries to
    --     proceed if it is unable to properly evaluate them.
    --
    -- This behavior is only enforced for VPCs that have at least one DNS
    -- Firewall rule group association.
    UpdateFirewallConfig -> FirewallFailOpenStatus
firewallFailOpen :: FirewallFailOpenStatus
  }
  deriving (UpdateFirewallConfig -> UpdateFirewallConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFirewallConfig -> UpdateFirewallConfig -> Bool
$c/= :: UpdateFirewallConfig -> UpdateFirewallConfig -> Bool
== :: UpdateFirewallConfig -> UpdateFirewallConfig -> Bool
$c== :: UpdateFirewallConfig -> UpdateFirewallConfig -> Bool
Prelude.Eq, ReadPrec [UpdateFirewallConfig]
ReadPrec UpdateFirewallConfig
Int -> ReadS UpdateFirewallConfig
ReadS [UpdateFirewallConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFirewallConfig]
$creadListPrec :: ReadPrec [UpdateFirewallConfig]
readPrec :: ReadPrec UpdateFirewallConfig
$creadPrec :: ReadPrec UpdateFirewallConfig
readList :: ReadS [UpdateFirewallConfig]
$creadList :: ReadS [UpdateFirewallConfig]
readsPrec :: Int -> ReadS UpdateFirewallConfig
$creadsPrec :: Int -> ReadS UpdateFirewallConfig
Prelude.Read, Int -> UpdateFirewallConfig -> ShowS
[UpdateFirewallConfig] -> ShowS
UpdateFirewallConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFirewallConfig] -> ShowS
$cshowList :: [UpdateFirewallConfig] -> ShowS
show :: UpdateFirewallConfig -> String
$cshow :: UpdateFirewallConfig -> String
showsPrec :: Int -> UpdateFirewallConfig -> ShowS
$cshowsPrec :: Int -> UpdateFirewallConfig -> ShowS
Prelude.Show, forall x. Rep UpdateFirewallConfig x -> UpdateFirewallConfig
forall x. UpdateFirewallConfig -> Rep UpdateFirewallConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFirewallConfig x -> UpdateFirewallConfig
$cfrom :: forall x. UpdateFirewallConfig -> Rep UpdateFirewallConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFirewallConfig' 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:
--
-- 'resourceId', 'updateFirewallConfig_resourceId' - The ID of the VPC that the configuration is for.
--
-- 'firewallFailOpen', 'updateFirewallConfig_firewallFailOpen' - Determines how Route 53 Resolver handles queries during failures, for
-- example when all traffic that is sent to DNS Firewall fails to receive a
-- reply.
--
-- -   By default, fail open is disabled, which means the failure mode is
--     closed. This approach favors security over availability. DNS
--     Firewall blocks queries that it is unable to evaluate properly.
--
-- -   If you enable this option, the failure mode is open. This approach
--     favors availability over security. DNS Firewall allows queries to
--     proceed if it is unable to properly evaluate them.
--
-- This behavior is only enforced for VPCs that have at least one DNS
-- Firewall rule group association.
newUpdateFirewallConfig ::
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'firewallFailOpen'
  FirewallFailOpenStatus ->
  UpdateFirewallConfig
newUpdateFirewallConfig :: Text -> FirewallFailOpenStatus -> UpdateFirewallConfig
newUpdateFirewallConfig
  Text
pResourceId_
  FirewallFailOpenStatus
pFirewallFailOpen_ =
    UpdateFirewallConfig'
      { $sel:resourceId:UpdateFirewallConfig' :: Text
resourceId = Text
pResourceId_,
        $sel:firewallFailOpen:UpdateFirewallConfig' :: FirewallFailOpenStatus
firewallFailOpen = FirewallFailOpenStatus
pFirewallFailOpen_
      }

-- | The ID of the VPC that the configuration is for.
updateFirewallConfig_resourceId :: Lens.Lens' UpdateFirewallConfig Prelude.Text
updateFirewallConfig_resourceId :: Lens' UpdateFirewallConfig Text
updateFirewallConfig_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFirewallConfig' {Text
resourceId :: Text
$sel:resourceId:UpdateFirewallConfig' :: UpdateFirewallConfig -> Text
resourceId} -> Text
resourceId) (\s :: UpdateFirewallConfig
s@UpdateFirewallConfig' {} Text
a -> UpdateFirewallConfig
s {$sel:resourceId:UpdateFirewallConfig' :: Text
resourceId = Text
a} :: UpdateFirewallConfig)

-- | Determines how Route 53 Resolver handles queries during failures, for
-- example when all traffic that is sent to DNS Firewall fails to receive a
-- reply.
--
-- -   By default, fail open is disabled, which means the failure mode is
--     closed. This approach favors security over availability. DNS
--     Firewall blocks queries that it is unable to evaluate properly.
--
-- -   If you enable this option, the failure mode is open. This approach
--     favors availability over security. DNS Firewall allows queries to
--     proceed if it is unable to properly evaluate them.
--
-- This behavior is only enforced for VPCs that have at least one DNS
-- Firewall rule group association.
updateFirewallConfig_firewallFailOpen :: Lens.Lens' UpdateFirewallConfig FirewallFailOpenStatus
updateFirewallConfig_firewallFailOpen :: Lens' UpdateFirewallConfig FirewallFailOpenStatus
updateFirewallConfig_firewallFailOpen = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFirewallConfig' {FirewallFailOpenStatus
firewallFailOpen :: FirewallFailOpenStatus
$sel:firewallFailOpen:UpdateFirewallConfig' :: UpdateFirewallConfig -> FirewallFailOpenStatus
firewallFailOpen} -> FirewallFailOpenStatus
firewallFailOpen) (\s :: UpdateFirewallConfig
s@UpdateFirewallConfig' {} FirewallFailOpenStatus
a -> UpdateFirewallConfig
s {$sel:firewallFailOpen:UpdateFirewallConfig' :: FirewallFailOpenStatus
firewallFailOpen = FirewallFailOpenStatus
a} :: UpdateFirewallConfig)

instance Core.AWSRequest UpdateFirewallConfig where
  type
    AWSResponse UpdateFirewallConfig =
      UpdateFirewallConfigResponse
  request :: (Service -> Service)
-> UpdateFirewallConfig -> Request UpdateFirewallConfig
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 UpdateFirewallConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateFirewallConfig)))
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 FirewallConfig -> Int -> UpdateFirewallConfigResponse
UpdateFirewallConfigResponse'
            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
"FirewallConfig")
            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 UpdateFirewallConfig where
  hashWithSalt :: Int -> UpdateFirewallConfig -> Int
hashWithSalt Int
_salt UpdateFirewallConfig' {Text
FirewallFailOpenStatus
firewallFailOpen :: FirewallFailOpenStatus
resourceId :: Text
$sel:firewallFailOpen:UpdateFirewallConfig' :: UpdateFirewallConfig -> FirewallFailOpenStatus
$sel:resourceId:UpdateFirewallConfig' :: UpdateFirewallConfig -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FirewallFailOpenStatus
firewallFailOpen

instance Prelude.NFData UpdateFirewallConfig where
  rnf :: UpdateFirewallConfig -> ()
rnf UpdateFirewallConfig' {Text
FirewallFailOpenStatus
firewallFailOpen :: FirewallFailOpenStatus
resourceId :: Text
$sel:firewallFailOpen:UpdateFirewallConfig' :: UpdateFirewallConfig -> FirewallFailOpenStatus
$sel:resourceId:UpdateFirewallConfig' :: UpdateFirewallConfig -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FirewallFailOpenStatus
firewallFailOpen

instance Data.ToHeaders UpdateFirewallConfig where
  toHeaders :: UpdateFirewallConfig -> 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.UpdateFirewallConfig" ::
                          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 UpdateFirewallConfig where
  toJSON :: UpdateFirewallConfig -> Value
toJSON UpdateFirewallConfig' {Text
FirewallFailOpenStatus
firewallFailOpen :: FirewallFailOpenStatus
resourceId :: Text
$sel:firewallFailOpen:UpdateFirewallConfig' :: UpdateFirewallConfig -> FirewallFailOpenStatus
$sel:resourceId:UpdateFirewallConfig' :: UpdateFirewallConfig -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"FirewallFailOpen" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FirewallFailOpenStatus
firewallFailOpen)
          ]
      )

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

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

-- | /See:/ 'newUpdateFirewallConfigResponse' smart constructor.
data UpdateFirewallConfigResponse = UpdateFirewallConfigResponse'
  { -- | Configuration of the firewall behavior provided by DNS Firewall for a
    -- single VPC.
    UpdateFirewallConfigResponse -> Maybe FirewallConfig
firewallConfig :: Prelude.Maybe FirewallConfig,
    -- | The response's http status code.
    UpdateFirewallConfigResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateFirewallConfigResponse
-> UpdateFirewallConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFirewallConfigResponse
-> UpdateFirewallConfigResponse -> Bool
$c/= :: UpdateFirewallConfigResponse
-> UpdateFirewallConfigResponse -> Bool
== :: UpdateFirewallConfigResponse
-> UpdateFirewallConfigResponse -> Bool
$c== :: UpdateFirewallConfigResponse
-> UpdateFirewallConfigResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFirewallConfigResponse]
ReadPrec UpdateFirewallConfigResponse
Int -> ReadS UpdateFirewallConfigResponse
ReadS [UpdateFirewallConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFirewallConfigResponse]
$creadListPrec :: ReadPrec [UpdateFirewallConfigResponse]
readPrec :: ReadPrec UpdateFirewallConfigResponse
$creadPrec :: ReadPrec UpdateFirewallConfigResponse
readList :: ReadS [UpdateFirewallConfigResponse]
$creadList :: ReadS [UpdateFirewallConfigResponse]
readsPrec :: Int -> ReadS UpdateFirewallConfigResponse
$creadsPrec :: Int -> ReadS UpdateFirewallConfigResponse
Prelude.Read, Int -> UpdateFirewallConfigResponse -> ShowS
[UpdateFirewallConfigResponse] -> ShowS
UpdateFirewallConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFirewallConfigResponse] -> ShowS
$cshowList :: [UpdateFirewallConfigResponse] -> ShowS
show :: UpdateFirewallConfigResponse -> String
$cshow :: UpdateFirewallConfigResponse -> String
showsPrec :: Int -> UpdateFirewallConfigResponse -> ShowS
$cshowsPrec :: Int -> UpdateFirewallConfigResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateFirewallConfigResponse x -> UpdateFirewallConfigResponse
forall x.
UpdateFirewallConfigResponse -> Rep UpdateFirewallConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateFirewallConfigResponse x -> UpdateFirewallConfigResponse
$cfrom :: forall x.
UpdateFirewallConfigResponse -> Rep UpdateFirewallConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFirewallConfigResponse' 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:
--
-- 'firewallConfig', 'updateFirewallConfigResponse_firewallConfig' - Configuration of the firewall behavior provided by DNS Firewall for a
-- single VPC.
--
-- 'httpStatus', 'updateFirewallConfigResponse_httpStatus' - The response's http status code.
newUpdateFirewallConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFirewallConfigResponse
newUpdateFirewallConfigResponse :: Int -> UpdateFirewallConfigResponse
newUpdateFirewallConfigResponse Int
pHttpStatus_ =
  UpdateFirewallConfigResponse'
    { $sel:firewallConfig:UpdateFirewallConfigResponse' :: Maybe FirewallConfig
firewallConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFirewallConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Configuration of the firewall behavior provided by DNS Firewall for a
-- single VPC.
updateFirewallConfigResponse_firewallConfig :: Lens.Lens' UpdateFirewallConfigResponse (Prelude.Maybe FirewallConfig)
updateFirewallConfigResponse_firewallConfig :: Lens' UpdateFirewallConfigResponse (Maybe FirewallConfig)
updateFirewallConfigResponse_firewallConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFirewallConfigResponse' {Maybe FirewallConfig
firewallConfig :: Maybe FirewallConfig
$sel:firewallConfig:UpdateFirewallConfigResponse' :: UpdateFirewallConfigResponse -> Maybe FirewallConfig
firewallConfig} -> Maybe FirewallConfig
firewallConfig) (\s :: UpdateFirewallConfigResponse
s@UpdateFirewallConfigResponse' {} Maybe FirewallConfig
a -> UpdateFirewallConfigResponse
s {$sel:firewallConfig:UpdateFirewallConfigResponse' :: Maybe FirewallConfig
firewallConfig = Maybe FirewallConfig
a} :: UpdateFirewallConfigResponse)

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

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