{-# 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.RevokeClientVpnIngress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes an ingress authorization rule from a Client VPN endpoint.
module Amazonka.EC2.RevokeClientVpnIngress
  ( -- * Creating a Request
    RevokeClientVpnIngress (..),
    newRevokeClientVpnIngress,

    -- * Request Lenses
    revokeClientVpnIngress_accessGroupId,
    revokeClientVpnIngress_dryRun,
    revokeClientVpnIngress_revokeAllGroups,
    revokeClientVpnIngress_clientVpnEndpointId,
    revokeClientVpnIngress_targetNetworkCidr,

    -- * Destructuring the Response
    RevokeClientVpnIngressResponse (..),
    newRevokeClientVpnIngressResponse,

    -- * Response Lenses
    revokeClientVpnIngressResponse_status,
    revokeClientVpnIngressResponse_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:/ 'newRevokeClientVpnIngress' smart constructor.
data RevokeClientVpnIngress = RevokeClientVpnIngress'
  { -- | The ID of the Active Directory group for which to revoke access.
    RevokeClientVpnIngress -> Maybe Text
accessGroupId :: 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@.
    RevokeClientVpnIngress -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether access should be revoked for all clients.
    RevokeClientVpnIngress -> Maybe Bool
revokeAllGroups :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Client VPN endpoint with which the authorization rule is
    -- associated.
    RevokeClientVpnIngress -> Text
clientVpnEndpointId :: Prelude.Text,
    -- | The IPv4 address range, in CIDR notation, of the network for which
    -- access is being removed.
    RevokeClientVpnIngress -> Text
targetNetworkCidr :: Prelude.Text
  }
  deriving (RevokeClientVpnIngress -> RevokeClientVpnIngress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeClientVpnIngress -> RevokeClientVpnIngress -> Bool
$c/= :: RevokeClientVpnIngress -> RevokeClientVpnIngress -> Bool
== :: RevokeClientVpnIngress -> RevokeClientVpnIngress -> Bool
$c== :: RevokeClientVpnIngress -> RevokeClientVpnIngress -> Bool
Prelude.Eq, ReadPrec [RevokeClientVpnIngress]
ReadPrec RevokeClientVpnIngress
Int -> ReadS RevokeClientVpnIngress
ReadS [RevokeClientVpnIngress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeClientVpnIngress]
$creadListPrec :: ReadPrec [RevokeClientVpnIngress]
readPrec :: ReadPrec RevokeClientVpnIngress
$creadPrec :: ReadPrec RevokeClientVpnIngress
readList :: ReadS [RevokeClientVpnIngress]
$creadList :: ReadS [RevokeClientVpnIngress]
readsPrec :: Int -> ReadS RevokeClientVpnIngress
$creadsPrec :: Int -> ReadS RevokeClientVpnIngress
Prelude.Read, Int -> RevokeClientVpnIngress -> ShowS
[RevokeClientVpnIngress] -> ShowS
RevokeClientVpnIngress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeClientVpnIngress] -> ShowS
$cshowList :: [RevokeClientVpnIngress] -> ShowS
show :: RevokeClientVpnIngress -> String
$cshow :: RevokeClientVpnIngress -> String
showsPrec :: Int -> RevokeClientVpnIngress -> ShowS
$cshowsPrec :: Int -> RevokeClientVpnIngress -> ShowS
Prelude.Show, forall x. Rep RevokeClientVpnIngress x -> RevokeClientVpnIngress
forall x. RevokeClientVpnIngress -> Rep RevokeClientVpnIngress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokeClientVpnIngress x -> RevokeClientVpnIngress
$cfrom :: forall x. RevokeClientVpnIngress -> Rep RevokeClientVpnIngress x
Prelude.Generic)

-- |
-- Create a value of 'RevokeClientVpnIngress' 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:
--
-- 'accessGroupId', 'revokeClientVpnIngress_accessGroupId' - The ID of the Active Directory group for which to revoke access.
--
-- 'dryRun', 'revokeClientVpnIngress_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@.
--
-- 'revokeAllGroups', 'revokeClientVpnIngress_revokeAllGroups' - Indicates whether access should be revoked for all clients.
--
-- 'clientVpnEndpointId', 'revokeClientVpnIngress_clientVpnEndpointId' - The ID of the Client VPN endpoint with which the authorization rule is
-- associated.
--
-- 'targetNetworkCidr', 'revokeClientVpnIngress_targetNetworkCidr' - The IPv4 address range, in CIDR notation, of the network for which
-- access is being removed.
newRevokeClientVpnIngress ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  -- | 'targetNetworkCidr'
  Prelude.Text ->
  RevokeClientVpnIngress
newRevokeClientVpnIngress :: Text -> Text -> RevokeClientVpnIngress
newRevokeClientVpnIngress
  Text
pClientVpnEndpointId_
  Text
pTargetNetworkCidr_ =
    RevokeClientVpnIngress'
      { $sel:accessGroupId:RevokeClientVpnIngress' :: Maybe Text
accessGroupId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:RevokeClientVpnIngress' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:revokeAllGroups:RevokeClientVpnIngress' :: Maybe Bool
revokeAllGroups = forall a. Maybe a
Prelude.Nothing,
        $sel:clientVpnEndpointId:RevokeClientVpnIngress' :: Text
clientVpnEndpointId = Text
pClientVpnEndpointId_,
        $sel:targetNetworkCidr:RevokeClientVpnIngress' :: Text
targetNetworkCidr = Text
pTargetNetworkCidr_
      }

-- | The ID of the Active Directory group for which to revoke access.
revokeClientVpnIngress_accessGroupId :: Lens.Lens' RevokeClientVpnIngress (Prelude.Maybe Prelude.Text)
revokeClientVpnIngress_accessGroupId :: Lens' RevokeClientVpnIngress (Maybe Text)
revokeClientVpnIngress_accessGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeClientVpnIngress' {Maybe Text
accessGroupId :: Maybe Text
$sel:accessGroupId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Text
accessGroupId} -> Maybe Text
accessGroupId) (\s :: RevokeClientVpnIngress
s@RevokeClientVpnIngress' {} Maybe Text
a -> RevokeClientVpnIngress
s {$sel:accessGroupId:RevokeClientVpnIngress' :: Maybe Text
accessGroupId = Maybe Text
a} :: RevokeClientVpnIngress)

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

-- | Indicates whether access should be revoked for all clients.
revokeClientVpnIngress_revokeAllGroups :: Lens.Lens' RevokeClientVpnIngress (Prelude.Maybe Prelude.Bool)
revokeClientVpnIngress_revokeAllGroups :: Lens' RevokeClientVpnIngress (Maybe Bool)
revokeClientVpnIngress_revokeAllGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeClientVpnIngress' {Maybe Bool
revokeAllGroups :: Maybe Bool
$sel:revokeAllGroups:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Bool
revokeAllGroups} -> Maybe Bool
revokeAllGroups) (\s :: RevokeClientVpnIngress
s@RevokeClientVpnIngress' {} Maybe Bool
a -> RevokeClientVpnIngress
s {$sel:revokeAllGroups:RevokeClientVpnIngress' :: Maybe Bool
revokeAllGroups = Maybe Bool
a} :: RevokeClientVpnIngress)

-- | The ID of the Client VPN endpoint with which the authorization rule is
-- associated.
revokeClientVpnIngress_clientVpnEndpointId :: Lens.Lens' RevokeClientVpnIngress Prelude.Text
revokeClientVpnIngress_clientVpnEndpointId :: Lens' RevokeClientVpnIngress Text
revokeClientVpnIngress_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeClientVpnIngress' {Text
clientVpnEndpointId :: Text
$sel:clientVpnEndpointId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
clientVpnEndpointId} -> Text
clientVpnEndpointId) (\s :: RevokeClientVpnIngress
s@RevokeClientVpnIngress' {} Text
a -> RevokeClientVpnIngress
s {$sel:clientVpnEndpointId:RevokeClientVpnIngress' :: Text
clientVpnEndpointId = Text
a} :: RevokeClientVpnIngress)

-- | The IPv4 address range, in CIDR notation, of the network for which
-- access is being removed.
revokeClientVpnIngress_targetNetworkCidr :: Lens.Lens' RevokeClientVpnIngress Prelude.Text
revokeClientVpnIngress_targetNetworkCidr :: Lens' RevokeClientVpnIngress Text
revokeClientVpnIngress_targetNetworkCidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeClientVpnIngress' {Text
targetNetworkCidr :: Text
$sel:targetNetworkCidr:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
targetNetworkCidr} -> Text
targetNetworkCidr) (\s :: RevokeClientVpnIngress
s@RevokeClientVpnIngress' {} Text
a -> RevokeClientVpnIngress
s {$sel:targetNetworkCidr:RevokeClientVpnIngress' :: Text
targetNetworkCidr = Text
a} :: RevokeClientVpnIngress)

instance Core.AWSRequest RevokeClientVpnIngress where
  type
    AWSResponse RevokeClientVpnIngress =
      RevokeClientVpnIngressResponse
  request :: (Service -> Service)
-> RevokeClientVpnIngress -> Request RevokeClientVpnIngress
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 RevokeClientVpnIngress
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RevokeClientVpnIngress)))
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 ClientVpnAuthorizationRuleStatus
-> Int -> RevokeClientVpnIngressResponse
RevokeClientVpnIngressResponse'
            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
"status")
            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 RevokeClientVpnIngress where
  hashWithSalt :: Int -> RevokeClientVpnIngress -> Int
hashWithSalt Int
_salt RevokeClientVpnIngress' {Maybe Bool
Maybe Text
Text
targetNetworkCidr :: Text
clientVpnEndpointId :: Text
revokeAllGroups :: Maybe Bool
dryRun :: Maybe Bool
accessGroupId :: Maybe Text
$sel:targetNetworkCidr:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
$sel:clientVpnEndpointId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
$sel:revokeAllGroups:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Bool
$sel:dryRun:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Bool
$sel:accessGroupId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accessGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
revokeAllGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientVpnEndpointId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetNetworkCidr

instance Prelude.NFData RevokeClientVpnIngress where
  rnf :: RevokeClientVpnIngress -> ()
rnf RevokeClientVpnIngress' {Maybe Bool
Maybe Text
Text
targetNetworkCidr :: Text
clientVpnEndpointId :: Text
revokeAllGroups :: Maybe Bool
dryRun :: Maybe Bool
accessGroupId :: Maybe Text
$sel:targetNetworkCidr:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
$sel:clientVpnEndpointId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
$sel:revokeAllGroups:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Bool
$sel:dryRun:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Bool
$sel:accessGroupId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accessGroupId
      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 Bool
revokeAllGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientVpnEndpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetNetworkCidr

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

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

instance Data.ToQuery RevokeClientVpnIngress where
  toQuery :: RevokeClientVpnIngress -> QueryString
toQuery RevokeClientVpnIngress' {Maybe Bool
Maybe Text
Text
targetNetworkCidr :: Text
clientVpnEndpointId :: Text
revokeAllGroups :: Maybe Bool
dryRun :: Maybe Bool
accessGroupId :: Maybe Text
$sel:targetNetworkCidr:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
$sel:clientVpnEndpointId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Text
$sel:revokeAllGroups:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Bool
$sel:dryRun:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Bool
$sel:accessGroupId:RevokeClientVpnIngress' :: RevokeClientVpnIngress -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RevokeClientVpnIngress" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AccessGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
accessGroupId,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"RevokeAllGroups" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
revokeAllGroups,
        ByteString
"ClientVpnEndpointId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clientVpnEndpointId,
        ByteString
"TargetNetworkCidr" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetNetworkCidr
      ]

-- | /See:/ 'newRevokeClientVpnIngressResponse' smart constructor.
data RevokeClientVpnIngressResponse = RevokeClientVpnIngressResponse'
  { -- | The current state of the authorization rule.
    RevokeClientVpnIngressResponse
-> Maybe ClientVpnAuthorizationRuleStatus
status :: Prelude.Maybe ClientVpnAuthorizationRuleStatus,
    -- | The response's http status code.
    RevokeClientVpnIngressResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RevokeClientVpnIngressResponse
-> RevokeClientVpnIngressResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeClientVpnIngressResponse
-> RevokeClientVpnIngressResponse -> Bool
$c/= :: RevokeClientVpnIngressResponse
-> RevokeClientVpnIngressResponse -> Bool
== :: RevokeClientVpnIngressResponse
-> RevokeClientVpnIngressResponse -> Bool
$c== :: RevokeClientVpnIngressResponse
-> RevokeClientVpnIngressResponse -> Bool
Prelude.Eq, ReadPrec [RevokeClientVpnIngressResponse]
ReadPrec RevokeClientVpnIngressResponse
Int -> ReadS RevokeClientVpnIngressResponse
ReadS [RevokeClientVpnIngressResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeClientVpnIngressResponse]
$creadListPrec :: ReadPrec [RevokeClientVpnIngressResponse]
readPrec :: ReadPrec RevokeClientVpnIngressResponse
$creadPrec :: ReadPrec RevokeClientVpnIngressResponse
readList :: ReadS [RevokeClientVpnIngressResponse]
$creadList :: ReadS [RevokeClientVpnIngressResponse]
readsPrec :: Int -> ReadS RevokeClientVpnIngressResponse
$creadsPrec :: Int -> ReadS RevokeClientVpnIngressResponse
Prelude.Read, Int -> RevokeClientVpnIngressResponse -> ShowS
[RevokeClientVpnIngressResponse] -> ShowS
RevokeClientVpnIngressResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeClientVpnIngressResponse] -> ShowS
$cshowList :: [RevokeClientVpnIngressResponse] -> ShowS
show :: RevokeClientVpnIngressResponse -> String
$cshow :: RevokeClientVpnIngressResponse -> String
showsPrec :: Int -> RevokeClientVpnIngressResponse -> ShowS
$cshowsPrec :: Int -> RevokeClientVpnIngressResponse -> ShowS
Prelude.Show, forall x.
Rep RevokeClientVpnIngressResponse x
-> RevokeClientVpnIngressResponse
forall x.
RevokeClientVpnIngressResponse
-> Rep RevokeClientVpnIngressResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RevokeClientVpnIngressResponse x
-> RevokeClientVpnIngressResponse
$cfrom :: forall x.
RevokeClientVpnIngressResponse
-> Rep RevokeClientVpnIngressResponse x
Prelude.Generic)

-- |
-- Create a value of 'RevokeClientVpnIngressResponse' 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:
--
-- 'status', 'revokeClientVpnIngressResponse_status' - The current state of the authorization rule.
--
-- 'httpStatus', 'revokeClientVpnIngressResponse_httpStatus' - The response's http status code.
newRevokeClientVpnIngressResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RevokeClientVpnIngressResponse
newRevokeClientVpnIngressResponse :: Int -> RevokeClientVpnIngressResponse
newRevokeClientVpnIngressResponse Int
pHttpStatus_ =
  RevokeClientVpnIngressResponse'
    { $sel:status:RevokeClientVpnIngressResponse' :: Maybe ClientVpnAuthorizationRuleStatus
status =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RevokeClientVpnIngressResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current state of the authorization rule.
revokeClientVpnIngressResponse_status :: Lens.Lens' RevokeClientVpnIngressResponse (Prelude.Maybe ClientVpnAuthorizationRuleStatus)
revokeClientVpnIngressResponse_status :: Lens'
  RevokeClientVpnIngressResponse
  (Maybe ClientVpnAuthorizationRuleStatus)
revokeClientVpnIngressResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeClientVpnIngressResponse' {Maybe ClientVpnAuthorizationRuleStatus
status :: Maybe ClientVpnAuthorizationRuleStatus
$sel:status:RevokeClientVpnIngressResponse' :: RevokeClientVpnIngressResponse
-> Maybe ClientVpnAuthorizationRuleStatus
status} -> Maybe ClientVpnAuthorizationRuleStatus
status) (\s :: RevokeClientVpnIngressResponse
s@RevokeClientVpnIngressResponse' {} Maybe ClientVpnAuthorizationRuleStatus
a -> RevokeClientVpnIngressResponse
s {$sel:status:RevokeClientVpnIngressResponse' :: Maybe ClientVpnAuthorizationRuleStatus
status = Maybe ClientVpnAuthorizationRuleStatus
a} :: RevokeClientVpnIngressResponse)

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

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