{-# 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.AuthorizeClientVpnIngress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds an ingress authorization rule to a Client VPN endpoint. Ingress
-- authorization rules act as firewall rules that grant access to networks.
-- You must configure ingress authorization rules to enable clients to
-- access resources in Amazon Web Services or on-premises networks.
module Amazonka.EC2.AuthorizeClientVpnIngress
  ( -- * Creating a Request
    AuthorizeClientVpnIngress (..),
    newAuthorizeClientVpnIngress,

    -- * Request Lenses
    authorizeClientVpnIngress_accessGroupId,
    authorizeClientVpnIngress_authorizeAllGroups,
    authorizeClientVpnIngress_clientToken,
    authorizeClientVpnIngress_description,
    authorizeClientVpnIngress_dryRun,
    authorizeClientVpnIngress_clientVpnEndpointId,
    authorizeClientVpnIngress_targetNetworkCidr,

    -- * Destructuring the Response
    AuthorizeClientVpnIngressResponse (..),
    newAuthorizeClientVpnIngressResponse,

    -- * Response Lenses
    authorizeClientVpnIngressResponse_status,
    authorizeClientVpnIngressResponse_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:/ 'newAuthorizeClientVpnIngress' smart constructor.
data AuthorizeClientVpnIngress = AuthorizeClientVpnIngress'
  { -- | The ID of the group to grant access to, for example, the Active
    -- Directory group or identity provider (IdP) group. Required if
    -- @AuthorizeAllGroups@ is @false@ or not specified.
    AuthorizeClientVpnIngress -> Maybe Text
accessGroupId :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to grant access to all clients. Specify @true@ to
    -- grant all clients who successfully establish a VPN connection access to
    -- the network. Must be set to @true@ if @AccessGroupId@ is not specified.
    AuthorizeClientVpnIngress -> Maybe Bool
authorizeAllGroups :: Prelude.Maybe Prelude.Bool,
    -- | Unique, case-sensitive identifier that 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 How to ensure idempotency>.
    AuthorizeClientVpnIngress -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A brief description of the authorization rule.
    AuthorizeClientVpnIngress -> Maybe Text
description :: 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@.
    AuthorizeClientVpnIngress -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Client VPN endpoint.
    AuthorizeClientVpnIngress -> Text
clientVpnEndpointId :: Prelude.Text,
    -- | The IPv4 address range, in CIDR notation, of the network for which
    -- access is being authorized.
    AuthorizeClientVpnIngress -> Text
targetNetworkCidr :: Prelude.Text
  }
  deriving (AuthorizeClientVpnIngress -> AuthorizeClientVpnIngress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeClientVpnIngress -> AuthorizeClientVpnIngress -> Bool
$c/= :: AuthorizeClientVpnIngress -> AuthorizeClientVpnIngress -> Bool
== :: AuthorizeClientVpnIngress -> AuthorizeClientVpnIngress -> Bool
$c== :: AuthorizeClientVpnIngress -> AuthorizeClientVpnIngress -> Bool
Prelude.Eq, ReadPrec [AuthorizeClientVpnIngress]
ReadPrec AuthorizeClientVpnIngress
Int -> ReadS AuthorizeClientVpnIngress
ReadS [AuthorizeClientVpnIngress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthorizeClientVpnIngress]
$creadListPrec :: ReadPrec [AuthorizeClientVpnIngress]
readPrec :: ReadPrec AuthorizeClientVpnIngress
$creadPrec :: ReadPrec AuthorizeClientVpnIngress
readList :: ReadS [AuthorizeClientVpnIngress]
$creadList :: ReadS [AuthorizeClientVpnIngress]
readsPrec :: Int -> ReadS AuthorizeClientVpnIngress
$creadsPrec :: Int -> ReadS AuthorizeClientVpnIngress
Prelude.Read, Int -> AuthorizeClientVpnIngress -> ShowS
[AuthorizeClientVpnIngress] -> ShowS
AuthorizeClientVpnIngress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizeClientVpnIngress] -> ShowS
$cshowList :: [AuthorizeClientVpnIngress] -> ShowS
show :: AuthorizeClientVpnIngress -> String
$cshow :: AuthorizeClientVpnIngress -> String
showsPrec :: Int -> AuthorizeClientVpnIngress -> ShowS
$cshowsPrec :: Int -> AuthorizeClientVpnIngress -> ShowS
Prelude.Show, forall x.
Rep AuthorizeClientVpnIngress x -> AuthorizeClientVpnIngress
forall x.
AuthorizeClientVpnIngress -> Rep AuthorizeClientVpnIngress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthorizeClientVpnIngress x -> AuthorizeClientVpnIngress
$cfrom :: forall x.
AuthorizeClientVpnIngress -> Rep AuthorizeClientVpnIngress x
Prelude.Generic)

-- |
-- Create a value of 'AuthorizeClientVpnIngress' 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', 'authorizeClientVpnIngress_accessGroupId' - The ID of the group to grant access to, for example, the Active
-- Directory group or identity provider (IdP) group. Required if
-- @AuthorizeAllGroups@ is @false@ or not specified.
--
-- 'authorizeAllGroups', 'authorizeClientVpnIngress_authorizeAllGroups' - Indicates whether to grant access to all clients. Specify @true@ to
-- grant all clients who successfully establish a VPN connection access to
-- the network. Must be set to @true@ if @AccessGroupId@ is not specified.
--
-- 'clientToken', 'authorizeClientVpnIngress_clientToken' - Unique, case-sensitive identifier that 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 How to ensure idempotency>.
--
-- 'description', 'authorizeClientVpnIngress_description' - A brief description of the authorization rule.
--
-- 'dryRun', 'authorizeClientVpnIngress_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@.
--
-- 'clientVpnEndpointId', 'authorizeClientVpnIngress_clientVpnEndpointId' - The ID of the Client VPN endpoint.
--
-- 'targetNetworkCidr', 'authorizeClientVpnIngress_targetNetworkCidr' - The IPv4 address range, in CIDR notation, of the network for which
-- access is being authorized.
newAuthorizeClientVpnIngress ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  -- | 'targetNetworkCidr'
  Prelude.Text ->
  AuthorizeClientVpnIngress
newAuthorizeClientVpnIngress :: Text -> Text -> AuthorizeClientVpnIngress
newAuthorizeClientVpnIngress
  Text
pClientVpnEndpointId_
  Text
pTargetNetworkCidr_ =
    AuthorizeClientVpnIngress'
      { $sel:accessGroupId:AuthorizeClientVpnIngress' :: Maybe Text
accessGroupId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:authorizeAllGroups:AuthorizeClientVpnIngress' :: Maybe Bool
authorizeAllGroups = forall a. Maybe a
Prelude.Nothing,
        $sel:clientToken:AuthorizeClientVpnIngress' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:description:AuthorizeClientVpnIngress' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:AuthorizeClientVpnIngress' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:clientVpnEndpointId:AuthorizeClientVpnIngress' :: Text
clientVpnEndpointId = Text
pClientVpnEndpointId_,
        $sel:targetNetworkCidr:AuthorizeClientVpnIngress' :: Text
targetNetworkCidr = Text
pTargetNetworkCidr_
      }

-- | The ID of the group to grant access to, for example, the Active
-- Directory group or identity provider (IdP) group. Required if
-- @AuthorizeAllGroups@ is @false@ or not specified.
authorizeClientVpnIngress_accessGroupId :: Lens.Lens' AuthorizeClientVpnIngress (Prelude.Maybe Prelude.Text)
authorizeClientVpnIngress_accessGroupId :: Lens' AuthorizeClientVpnIngress (Maybe Text)
authorizeClientVpnIngress_accessGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeClientVpnIngress' {Maybe Text
accessGroupId :: Maybe Text
$sel:accessGroupId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
accessGroupId} -> Maybe Text
accessGroupId) (\s :: AuthorizeClientVpnIngress
s@AuthorizeClientVpnIngress' {} Maybe Text
a -> AuthorizeClientVpnIngress
s {$sel:accessGroupId:AuthorizeClientVpnIngress' :: Maybe Text
accessGroupId = Maybe Text
a} :: AuthorizeClientVpnIngress)

-- | Indicates whether to grant access to all clients. Specify @true@ to
-- grant all clients who successfully establish a VPN connection access to
-- the network. Must be set to @true@ if @AccessGroupId@ is not specified.
authorizeClientVpnIngress_authorizeAllGroups :: Lens.Lens' AuthorizeClientVpnIngress (Prelude.Maybe Prelude.Bool)
authorizeClientVpnIngress_authorizeAllGroups :: Lens' AuthorizeClientVpnIngress (Maybe Bool)
authorizeClientVpnIngress_authorizeAllGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeClientVpnIngress' {Maybe Bool
authorizeAllGroups :: Maybe Bool
$sel:authorizeAllGroups:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Bool
authorizeAllGroups} -> Maybe Bool
authorizeAllGroups) (\s :: AuthorizeClientVpnIngress
s@AuthorizeClientVpnIngress' {} Maybe Bool
a -> AuthorizeClientVpnIngress
s {$sel:authorizeAllGroups:AuthorizeClientVpnIngress' :: Maybe Bool
authorizeAllGroups = Maybe Bool
a} :: AuthorizeClientVpnIngress)

-- | Unique, case-sensitive identifier that 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 How to ensure idempotency>.
authorizeClientVpnIngress_clientToken :: Lens.Lens' AuthorizeClientVpnIngress (Prelude.Maybe Prelude.Text)
authorizeClientVpnIngress_clientToken :: Lens' AuthorizeClientVpnIngress (Maybe Text)
authorizeClientVpnIngress_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeClientVpnIngress' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: AuthorizeClientVpnIngress
s@AuthorizeClientVpnIngress' {} Maybe Text
a -> AuthorizeClientVpnIngress
s {$sel:clientToken:AuthorizeClientVpnIngress' :: Maybe Text
clientToken = Maybe Text
a} :: AuthorizeClientVpnIngress)

-- | A brief description of the authorization rule.
authorizeClientVpnIngress_description :: Lens.Lens' AuthorizeClientVpnIngress (Prelude.Maybe Prelude.Text)
authorizeClientVpnIngress_description :: Lens' AuthorizeClientVpnIngress (Maybe Text)
authorizeClientVpnIngress_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeClientVpnIngress' {Maybe Text
description :: Maybe Text
$sel:description:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
description} -> Maybe Text
description) (\s :: AuthorizeClientVpnIngress
s@AuthorizeClientVpnIngress' {} Maybe Text
a -> AuthorizeClientVpnIngress
s {$sel:description:AuthorizeClientVpnIngress' :: Maybe Text
description = Maybe Text
a} :: AuthorizeClientVpnIngress)

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

-- | The ID of the Client VPN endpoint.
authorizeClientVpnIngress_clientVpnEndpointId :: Lens.Lens' AuthorizeClientVpnIngress Prelude.Text
authorizeClientVpnIngress_clientVpnEndpointId :: Lens' AuthorizeClientVpnIngress Text
authorizeClientVpnIngress_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeClientVpnIngress' {Text
clientVpnEndpointId :: Text
$sel:clientVpnEndpointId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Text
clientVpnEndpointId} -> Text
clientVpnEndpointId) (\s :: AuthorizeClientVpnIngress
s@AuthorizeClientVpnIngress' {} Text
a -> AuthorizeClientVpnIngress
s {$sel:clientVpnEndpointId:AuthorizeClientVpnIngress' :: Text
clientVpnEndpointId = Text
a} :: AuthorizeClientVpnIngress)

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

instance Core.AWSRequest AuthorizeClientVpnIngress where
  type
    AWSResponse AuthorizeClientVpnIngress =
      AuthorizeClientVpnIngressResponse
  request :: (Service -> Service)
-> AuthorizeClientVpnIngress -> Request AuthorizeClientVpnIngress
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 AuthorizeClientVpnIngress
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AuthorizeClientVpnIngress)))
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 -> AuthorizeClientVpnIngressResponse
AuthorizeClientVpnIngressResponse'
            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 AuthorizeClientVpnIngress where
  hashWithSalt :: Int -> AuthorizeClientVpnIngress -> Int
hashWithSalt Int
_salt AuthorizeClientVpnIngress' {Maybe Bool
Maybe Text
Text
targetNetworkCidr :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
authorizeAllGroups :: Maybe Bool
accessGroupId :: Maybe Text
$sel:targetNetworkCidr:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Text
$sel:clientVpnEndpointId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Text
$sel:dryRun:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Bool
$sel:description:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
$sel:clientToken:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
$sel:authorizeAllGroups:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Bool
$sel:accessGroupId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> 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
authorizeAllGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      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 AuthorizeClientVpnIngress where
  rnf :: AuthorizeClientVpnIngress -> ()
rnf AuthorizeClientVpnIngress' {Maybe Bool
Maybe Text
Text
targetNetworkCidr :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
authorizeAllGroups :: Maybe Bool
accessGroupId :: Maybe Text
$sel:targetNetworkCidr:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Text
$sel:clientVpnEndpointId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Text
$sel:dryRun:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Bool
$sel:description:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
$sel:clientToken:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
$sel:authorizeAllGroups:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Bool
$sel:accessGroupId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> 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
authorizeAllGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
description
      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 Text
clientVpnEndpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetNetworkCidr

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

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

instance Data.ToQuery AuthorizeClientVpnIngress where
  toQuery :: AuthorizeClientVpnIngress -> QueryString
toQuery AuthorizeClientVpnIngress' {Maybe Bool
Maybe Text
Text
targetNetworkCidr :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
authorizeAllGroups :: Maybe Bool
accessGroupId :: Maybe Text
$sel:targetNetworkCidr:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Text
$sel:clientVpnEndpointId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Text
$sel:dryRun:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Bool
$sel:description:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
$sel:clientToken:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
$sel:authorizeAllGroups:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Bool
$sel:accessGroupId:AuthorizeClientVpnIngress' :: AuthorizeClientVpnIngress -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"AuthorizeClientVpnIngress" :: 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
"AuthorizeAllGroups" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
authorizeAllGroups,
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        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:/ 'newAuthorizeClientVpnIngressResponse' smart constructor.
data AuthorizeClientVpnIngressResponse = AuthorizeClientVpnIngressResponse'
  { -- | The current state of the authorization rule.
    AuthorizeClientVpnIngressResponse
-> Maybe ClientVpnAuthorizationRuleStatus
status :: Prelude.Maybe ClientVpnAuthorizationRuleStatus,
    -- | The response's http status code.
    AuthorizeClientVpnIngressResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AuthorizeClientVpnIngressResponse
-> AuthorizeClientVpnIngressResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeClientVpnIngressResponse
-> AuthorizeClientVpnIngressResponse -> Bool
$c/= :: AuthorizeClientVpnIngressResponse
-> AuthorizeClientVpnIngressResponse -> Bool
== :: AuthorizeClientVpnIngressResponse
-> AuthorizeClientVpnIngressResponse -> Bool
$c== :: AuthorizeClientVpnIngressResponse
-> AuthorizeClientVpnIngressResponse -> Bool
Prelude.Eq, ReadPrec [AuthorizeClientVpnIngressResponse]
ReadPrec AuthorizeClientVpnIngressResponse
Int -> ReadS AuthorizeClientVpnIngressResponse
ReadS [AuthorizeClientVpnIngressResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthorizeClientVpnIngressResponse]
$creadListPrec :: ReadPrec [AuthorizeClientVpnIngressResponse]
readPrec :: ReadPrec AuthorizeClientVpnIngressResponse
$creadPrec :: ReadPrec AuthorizeClientVpnIngressResponse
readList :: ReadS [AuthorizeClientVpnIngressResponse]
$creadList :: ReadS [AuthorizeClientVpnIngressResponse]
readsPrec :: Int -> ReadS AuthorizeClientVpnIngressResponse
$creadsPrec :: Int -> ReadS AuthorizeClientVpnIngressResponse
Prelude.Read, Int -> AuthorizeClientVpnIngressResponse -> ShowS
[AuthorizeClientVpnIngressResponse] -> ShowS
AuthorizeClientVpnIngressResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizeClientVpnIngressResponse] -> ShowS
$cshowList :: [AuthorizeClientVpnIngressResponse] -> ShowS
show :: AuthorizeClientVpnIngressResponse -> String
$cshow :: AuthorizeClientVpnIngressResponse -> String
showsPrec :: Int -> AuthorizeClientVpnIngressResponse -> ShowS
$cshowsPrec :: Int -> AuthorizeClientVpnIngressResponse -> ShowS
Prelude.Show, forall x.
Rep AuthorizeClientVpnIngressResponse x
-> AuthorizeClientVpnIngressResponse
forall x.
AuthorizeClientVpnIngressResponse
-> Rep AuthorizeClientVpnIngressResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthorizeClientVpnIngressResponse x
-> AuthorizeClientVpnIngressResponse
$cfrom :: forall x.
AuthorizeClientVpnIngressResponse
-> Rep AuthorizeClientVpnIngressResponse x
Prelude.Generic)

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

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

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

instance
  Prelude.NFData
    AuthorizeClientVpnIngressResponse
  where
  rnf :: AuthorizeClientVpnIngressResponse -> ()
rnf AuthorizeClientVpnIngressResponse' {Int
Maybe ClientVpnAuthorizationRuleStatus
httpStatus :: Int
status :: Maybe ClientVpnAuthorizationRuleStatus
$sel:httpStatus:AuthorizeClientVpnIngressResponse' :: AuthorizeClientVpnIngressResponse -> Int
$sel:status:AuthorizeClientVpnIngressResponse' :: AuthorizeClientVpnIngressResponse
-> 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