{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.ClientVpnAuthenticationRequest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Types.ClientVpnAuthenticationRequest where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.CertificateAuthenticationRequest
import Amazonka.EC2.Types.ClientVpnAuthenticationType
import Amazonka.EC2.Types.DirectoryServiceAuthenticationRequest
import Amazonka.EC2.Types.FederatedAuthenticationRequest
import qualified Amazonka.Prelude as Prelude

-- | Describes the authentication method to be used by a Client VPN endpoint.
-- For more information, see
-- <https://docs.aws.amazon.com/vpn/latest/clientvpn-admin/authentication-authrization.html#client-authentication Authentication>
-- in the /Client VPN Administrator Guide/.
--
-- /See:/ 'newClientVpnAuthenticationRequest' smart constructor.
data ClientVpnAuthenticationRequest = ClientVpnAuthenticationRequest'
  { -- | Information about the Active Directory to be used, if applicable. You
    -- must provide this information if __Type__ is
    -- @directory-service-authentication@.
    ClientVpnAuthenticationRequest
-> Maybe DirectoryServiceAuthenticationRequest
activeDirectory :: Prelude.Maybe DirectoryServiceAuthenticationRequest,
    -- | Information about the IAM SAML identity provider to be used, if
    -- applicable. You must provide this information if __Type__ is
    -- @federated-authentication@.
    ClientVpnAuthenticationRequest
-> Maybe FederatedAuthenticationRequest
federatedAuthentication :: Prelude.Maybe FederatedAuthenticationRequest,
    -- | Information about the authentication certificates to be used, if
    -- applicable. You must provide this information if __Type__ is
    -- @certificate-authentication@.
    ClientVpnAuthenticationRequest
-> Maybe CertificateAuthenticationRequest
mutualAuthentication :: Prelude.Maybe CertificateAuthenticationRequest,
    -- | The type of client authentication to be used.
    ClientVpnAuthenticationRequest -> Maybe ClientVpnAuthenticationType
type' :: Prelude.Maybe ClientVpnAuthenticationType
  }
  deriving (ClientVpnAuthenticationRequest
-> ClientVpnAuthenticationRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientVpnAuthenticationRequest
-> ClientVpnAuthenticationRequest -> Bool
$c/= :: ClientVpnAuthenticationRequest
-> ClientVpnAuthenticationRequest -> Bool
== :: ClientVpnAuthenticationRequest
-> ClientVpnAuthenticationRequest -> Bool
$c== :: ClientVpnAuthenticationRequest
-> ClientVpnAuthenticationRequest -> Bool
Prelude.Eq, ReadPrec [ClientVpnAuthenticationRequest]
ReadPrec ClientVpnAuthenticationRequest
Int -> ReadS ClientVpnAuthenticationRequest
ReadS [ClientVpnAuthenticationRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClientVpnAuthenticationRequest]
$creadListPrec :: ReadPrec [ClientVpnAuthenticationRequest]
readPrec :: ReadPrec ClientVpnAuthenticationRequest
$creadPrec :: ReadPrec ClientVpnAuthenticationRequest
readList :: ReadS [ClientVpnAuthenticationRequest]
$creadList :: ReadS [ClientVpnAuthenticationRequest]
readsPrec :: Int -> ReadS ClientVpnAuthenticationRequest
$creadsPrec :: Int -> ReadS ClientVpnAuthenticationRequest
Prelude.Read, Int -> ClientVpnAuthenticationRequest -> ShowS
[ClientVpnAuthenticationRequest] -> ShowS
ClientVpnAuthenticationRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientVpnAuthenticationRequest] -> ShowS
$cshowList :: [ClientVpnAuthenticationRequest] -> ShowS
show :: ClientVpnAuthenticationRequest -> String
$cshow :: ClientVpnAuthenticationRequest -> String
showsPrec :: Int -> ClientVpnAuthenticationRequest -> ShowS
$cshowsPrec :: Int -> ClientVpnAuthenticationRequest -> ShowS
Prelude.Show, forall x.
Rep ClientVpnAuthenticationRequest x
-> ClientVpnAuthenticationRequest
forall x.
ClientVpnAuthenticationRequest
-> Rep ClientVpnAuthenticationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ClientVpnAuthenticationRequest x
-> ClientVpnAuthenticationRequest
$cfrom :: forall x.
ClientVpnAuthenticationRequest
-> Rep ClientVpnAuthenticationRequest x
Prelude.Generic)

-- |
-- Create a value of 'ClientVpnAuthenticationRequest' 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:
--
-- 'activeDirectory', 'clientVpnAuthenticationRequest_activeDirectory' - Information about the Active Directory to be used, if applicable. You
-- must provide this information if __Type__ is
-- @directory-service-authentication@.
--
-- 'federatedAuthentication', 'clientVpnAuthenticationRequest_federatedAuthentication' - Information about the IAM SAML identity provider to be used, if
-- applicable. You must provide this information if __Type__ is
-- @federated-authentication@.
--
-- 'mutualAuthentication', 'clientVpnAuthenticationRequest_mutualAuthentication' - Information about the authentication certificates to be used, if
-- applicable. You must provide this information if __Type__ is
-- @certificate-authentication@.
--
-- 'type'', 'clientVpnAuthenticationRequest_type' - The type of client authentication to be used.
newClientVpnAuthenticationRequest ::
  ClientVpnAuthenticationRequest
newClientVpnAuthenticationRequest :: ClientVpnAuthenticationRequest
newClientVpnAuthenticationRequest =
  ClientVpnAuthenticationRequest'
    { $sel:activeDirectory:ClientVpnAuthenticationRequest' :: Maybe DirectoryServiceAuthenticationRequest
activeDirectory =
        forall a. Maybe a
Prelude.Nothing,
      $sel:federatedAuthentication:ClientVpnAuthenticationRequest' :: Maybe FederatedAuthenticationRequest
federatedAuthentication = forall a. Maybe a
Prelude.Nothing,
      $sel:mutualAuthentication:ClientVpnAuthenticationRequest' :: Maybe CertificateAuthenticationRequest
mutualAuthentication = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ClientVpnAuthenticationRequest' :: Maybe ClientVpnAuthenticationType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | Information about the Active Directory to be used, if applicable. You
-- must provide this information if __Type__ is
-- @directory-service-authentication@.
clientVpnAuthenticationRequest_activeDirectory :: Lens.Lens' ClientVpnAuthenticationRequest (Prelude.Maybe DirectoryServiceAuthenticationRequest)
clientVpnAuthenticationRequest_activeDirectory :: Lens'
  ClientVpnAuthenticationRequest
  (Maybe DirectoryServiceAuthenticationRequest)
clientVpnAuthenticationRequest_activeDirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthenticationRequest' {Maybe DirectoryServiceAuthenticationRequest
activeDirectory :: Maybe DirectoryServiceAuthenticationRequest
$sel:activeDirectory:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe DirectoryServiceAuthenticationRequest
activeDirectory} -> Maybe DirectoryServiceAuthenticationRequest
activeDirectory) (\s :: ClientVpnAuthenticationRequest
s@ClientVpnAuthenticationRequest' {} Maybe DirectoryServiceAuthenticationRequest
a -> ClientVpnAuthenticationRequest
s {$sel:activeDirectory:ClientVpnAuthenticationRequest' :: Maybe DirectoryServiceAuthenticationRequest
activeDirectory = Maybe DirectoryServiceAuthenticationRequest
a} :: ClientVpnAuthenticationRequest)

-- | Information about the IAM SAML identity provider to be used, if
-- applicable. You must provide this information if __Type__ is
-- @federated-authentication@.
clientVpnAuthenticationRequest_federatedAuthentication :: Lens.Lens' ClientVpnAuthenticationRequest (Prelude.Maybe FederatedAuthenticationRequest)
clientVpnAuthenticationRequest_federatedAuthentication :: Lens'
  ClientVpnAuthenticationRequest
  (Maybe FederatedAuthenticationRequest)
clientVpnAuthenticationRequest_federatedAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthenticationRequest' {Maybe FederatedAuthenticationRequest
federatedAuthentication :: Maybe FederatedAuthenticationRequest
$sel:federatedAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe FederatedAuthenticationRequest
federatedAuthentication} -> Maybe FederatedAuthenticationRequest
federatedAuthentication) (\s :: ClientVpnAuthenticationRequest
s@ClientVpnAuthenticationRequest' {} Maybe FederatedAuthenticationRequest
a -> ClientVpnAuthenticationRequest
s {$sel:federatedAuthentication:ClientVpnAuthenticationRequest' :: Maybe FederatedAuthenticationRequest
federatedAuthentication = Maybe FederatedAuthenticationRequest
a} :: ClientVpnAuthenticationRequest)

-- | Information about the authentication certificates to be used, if
-- applicable. You must provide this information if __Type__ is
-- @certificate-authentication@.
clientVpnAuthenticationRequest_mutualAuthentication :: Lens.Lens' ClientVpnAuthenticationRequest (Prelude.Maybe CertificateAuthenticationRequest)
clientVpnAuthenticationRequest_mutualAuthentication :: Lens'
  ClientVpnAuthenticationRequest
  (Maybe CertificateAuthenticationRequest)
clientVpnAuthenticationRequest_mutualAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthenticationRequest' {Maybe CertificateAuthenticationRequest
mutualAuthentication :: Maybe CertificateAuthenticationRequest
$sel:mutualAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe CertificateAuthenticationRequest
mutualAuthentication} -> Maybe CertificateAuthenticationRequest
mutualAuthentication) (\s :: ClientVpnAuthenticationRequest
s@ClientVpnAuthenticationRequest' {} Maybe CertificateAuthenticationRequest
a -> ClientVpnAuthenticationRequest
s {$sel:mutualAuthentication:ClientVpnAuthenticationRequest' :: Maybe CertificateAuthenticationRequest
mutualAuthentication = Maybe CertificateAuthenticationRequest
a} :: ClientVpnAuthenticationRequest)

-- | The type of client authentication to be used.
clientVpnAuthenticationRequest_type :: Lens.Lens' ClientVpnAuthenticationRequest (Prelude.Maybe ClientVpnAuthenticationType)
clientVpnAuthenticationRequest_type :: Lens'
  ClientVpnAuthenticationRequest (Maybe ClientVpnAuthenticationType)
clientVpnAuthenticationRequest_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthenticationRequest' {Maybe ClientVpnAuthenticationType
type' :: Maybe ClientVpnAuthenticationType
$sel:type':ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest -> Maybe ClientVpnAuthenticationType
type'} -> Maybe ClientVpnAuthenticationType
type') (\s :: ClientVpnAuthenticationRequest
s@ClientVpnAuthenticationRequest' {} Maybe ClientVpnAuthenticationType
a -> ClientVpnAuthenticationRequest
s {$sel:type':ClientVpnAuthenticationRequest' :: Maybe ClientVpnAuthenticationType
type' = Maybe ClientVpnAuthenticationType
a} :: ClientVpnAuthenticationRequest)

instance
  Prelude.Hashable
    ClientVpnAuthenticationRequest
  where
  hashWithSalt :: Int -> ClientVpnAuthenticationRequest -> Int
hashWithSalt
    Int
_salt
    ClientVpnAuthenticationRequest' {Maybe CertificateAuthenticationRequest
Maybe ClientVpnAuthenticationType
Maybe DirectoryServiceAuthenticationRequest
Maybe FederatedAuthenticationRequest
type' :: Maybe ClientVpnAuthenticationType
mutualAuthentication :: Maybe CertificateAuthenticationRequest
federatedAuthentication :: Maybe FederatedAuthenticationRequest
activeDirectory :: Maybe DirectoryServiceAuthenticationRequest
$sel:type':ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest -> Maybe ClientVpnAuthenticationType
$sel:mutualAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe CertificateAuthenticationRequest
$sel:federatedAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe FederatedAuthenticationRequest
$sel:activeDirectory:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe DirectoryServiceAuthenticationRequest
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DirectoryServiceAuthenticationRequest
activeDirectory
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FederatedAuthenticationRequest
federatedAuthentication
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateAuthenticationRequest
mutualAuthentication
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientVpnAuthenticationType
type'

instance
  Prelude.NFData
    ClientVpnAuthenticationRequest
  where
  rnf :: ClientVpnAuthenticationRequest -> ()
rnf ClientVpnAuthenticationRequest' {Maybe CertificateAuthenticationRequest
Maybe ClientVpnAuthenticationType
Maybe DirectoryServiceAuthenticationRequest
Maybe FederatedAuthenticationRequest
type' :: Maybe ClientVpnAuthenticationType
mutualAuthentication :: Maybe CertificateAuthenticationRequest
federatedAuthentication :: Maybe FederatedAuthenticationRequest
activeDirectory :: Maybe DirectoryServiceAuthenticationRequest
$sel:type':ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest -> Maybe ClientVpnAuthenticationType
$sel:mutualAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe CertificateAuthenticationRequest
$sel:federatedAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe FederatedAuthenticationRequest
$sel:activeDirectory:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe DirectoryServiceAuthenticationRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DirectoryServiceAuthenticationRequest
activeDirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FederatedAuthenticationRequest
federatedAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateAuthenticationRequest
mutualAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientVpnAuthenticationType
type'

instance Data.ToQuery ClientVpnAuthenticationRequest where
  toQuery :: ClientVpnAuthenticationRequest -> QueryString
toQuery ClientVpnAuthenticationRequest' {Maybe CertificateAuthenticationRequest
Maybe ClientVpnAuthenticationType
Maybe DirectoryServiceAuthenticationRequest
Maybe FederatedAuthenticationRequest
type' :: Maybe ClientVpnAuthenticationType
mutualAuthentication :: Maybe CertificateAuthenticationRequest
federatedAuthentication :: Maybe FederatedAuthenticationRequest
activeDirectory :: Maybe DirectoryServiceAuthenticationRequest
$sel:type':ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest -> Maybe ClientVpnAuthenticationType
$sel:mutualAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe CertificateAuthenticationRequest
$sel:federatedAuthentication:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe FederatedAuthenticationRequest
$sel:activeDirectory:ClientVpnAuthenticationRequest' :: ClientVpnAuthenticationRequest
-> Maybe DirectoryServiceAuthenticationRequest
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"ActiveDirectory" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DirectoryServiceAuthenticationRequest
activeDirectory,
        ByteString
"FederatedAuthentication"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe FederatedAuthenticationRequest
federatedAuthentication,
        ByteString
"MutualAuthentication" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CertificateAuthenticationRequest
mutualAuthentication,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ClientVpnAuthenticationType
type'
      ]