{-# 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.ClientVpnAuthentication
-- 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.ClientVpnAuthentication 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.CertificateAuthentication
import Amazonka.EC2.Types.ClientVpnAuthenticationType
import Amazonka.EC2.Types.DirectoryServiceAuthentication
import Amazonka.EC2.Types.FederatedAuthentication
import qualified Amazonka.Prelude as Prelude

-- | Describes the authentication methods used by a Client VPN endpoint. For
-- more information, see
-- <https://docs.aws.amazon.com/vpn/latest/clientvpn-admin/client-authentication.html Authentication>
-- in the /Client VPN Administrator Guide/.
--
-- /See:/ 'newClientVpnAuthentication' smart constructor.
data ClientVpnAuthentication = ClientVpnAuthentication'
  { -- | Information about the Active Directory, if applicable.
    ClientVpnAuthentication -> Maybe DirectoryServiceAuthentication
activeDirectory :: Prelude.Maybe DirectoryServiceAuthentication,
    -- | Information about the IAM SAML identity provider, if applicable.
    ClientVpnAuthentication -> Maybe FederatedAuthentication
federatedAuthentication :: Prelude.Maybe FederatedAuthentication,
    -- | Information about the authentication certificates, if applicable.
    ClientVpnAuthentication -> Maybe CertificateAuthentication
mutualAuthentication :: Prelude.Maybe CertificateAuthentication,
    -- | The authentication type used.
    ClientVpnAuthentication -> Maybe ClientVpnAuthenticationType
type' :: Prelude.Maybe ClientVpnAuthenticationType
  }
  deriving (ClientVpnAuthentication -> ClientVpnAuthentication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientVpnAuthentication -> ClientVpnAuthentication -> Bool
$c/= :: ClientVpnAuthentication -> ClientVpnAuthentication -> Bool
== :: ClientVpnAuthentication -> ClientVpnAuthentication -> Bool
$c== :: ClientVpnAuthentication -> ClientVpnAuthentication -> Bool
Prelude.Eq, ReadPrec [ClientVpnAuthentication]
ReadPrec ClientVpnAuthentication
Int -> ReadS ClientVpnAuthentication
ReadS [ClientVpnAuthentication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClientVpnAuthentication]
$creadListPrec :: ReadPrec [ClientVpnAuthentication]
readPrec :: ReadPrec ClientVpnAuthentication
$creadPrec :: ReadPrec ClientVpnAuthentication
readList :: ReadS [ClientVpnAuthentication]
$creadList :: ReadS [ClientVpnAuthentication]
readsPrec :: Int -> ReadS ClientVpnAuthentication
$creadsPrec :: Int -> ReadS ClientVpnAuthentication
Prelude.Read, Int -> ClientVpnAuthentication -> ShowS
[ClientVpnAuthentication] -> ShowS
ClientVpnAuthentication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientVpnAuthentication] -> ShowS
$cshowList :: [ClientVpnAuthentication] -> ShowS
show :: ClientVpnAuthentication -> String
$cshow :: ClientVpnAuthentication -> String
showsPrec :: Int -> ClientVpnAuthentication -> ShowS
$cshowsPrec :: Int -> ClientVpnAuthentication -> ShowS
Prelude.Show, forall x. Rep ClientVpnAuthentication x -> ClientVpnAuthentication
forall x. ClientVpnAuthentication -> Rep ClientVpnAuthentication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientVpnAuthentication x -> ClientVpnAuthentication
$cfrom :: forall x. ClientVpnAuthentication -> Rep ClientVpnAuthentication x
Prelude.Generic)

-- |
-- Create a value of 'ClientVpnAuthentication' 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', 'clientVpnAuthentication_activeDirectory' - Information about the Active Directory, if applicable.
--
-- 'federatedAuthentication', 'clientVpnAuthentication_federatedAuthentication' - Information about the IAM SAML identity provider, if applicable.
--
-- 'mutualAuthentication', 'clientVpnAuthentication_mutualAuthentication' - Information about the authentication certificates, if applicable.
--
-- 'type'', 'clientVpnAuthentication_type' - The authentication type used.
newClientVpnAuthentication ::
  ClientVpnAuthentication
newClientVpnAuthentication :: ClientVpnAuthentication
newClientVpnAuthentication =
  ClientVpnAuthentication'
    { $sel:activeDirectory:ClientVpnAuthentication' :: Maybe DirectoryServiceAuthentication
activeDirectory =
        forall a. Maybe a
Prelude.Nothing,
      $sel:federatedAuthentication:ClientVpnAuthentication' :: Maybe FederatedAuthentication
federatedAuthentication = forall a. Maybe a
Prelude.Nothing,
      $sel:mutualAuthentication:ClientVpnAuthentication' :: Maybe CertificateAuthentication
mutualAuthentication = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ClientVpnAuthentication' :: Maybe ClientVpnAuthenticationType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | Information about the Active Directory, if applicable.
clientVpnAuthentication_activeDirectory :: Lens.Lens' ClientVpnAuthentication (Prelude.Maybe DirectoryServiceAuthentication)
clientVpnAuthentication_activeDirectory :: Lens'
  ClientVpnAuthentication (Maybe DirectoryServiceAuthentication)
clientVpnAuthentication_activeDirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthentication' {Maybe DirectoryServiceAuthentication
activeDirectory :: Maybe DirectoryServiceAuthentication
$sel:activeDirectory:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe DirectoryServiceAuthentication
activeDirectory} -> Maybe DirectoryServiceAuthentication
activeDirectory) (\s :: ClientVpnAuthentication
s@ClientVpnAuthentication' {} Maybe DirectoryServiceAuthentication
a -> ClientVpnAuthentication
s {$sel:activeDirectory:ClientVpnAuthentication' :: Maybe DirectoryServiceAuthentication
activeDirectory = Maybe DirectoryServiceAuthentication
a} :: ClientVpnAuthentication)

-- | Information about the IAM SAML identity provider, if applicable.
clientVpnAuthentication_federatedAuthentication :: Lens.Lens' ClientVpnAuthentication (Prelude.Maybe FederatedAuthentication)
clientVpnAuthentication_federatedAuthentication :: Lens' ClientVpnAuthentication (Maybe FederatedAuthentication)
clientVpnAuthentication_federatedAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthentication' {Maybe FederatedAuthentication
federatedAuthentication :: Maybe FederatedAuthentication
$sel:federatedAuthentication:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe FederatedAuthentication
federatedAuthentication} -> Maybe FederatedAuthentication
federatedAuthentication) (\s :: ClientVpnAuthentication
s@ClientVpnAuthentication' {} Maybe FederatedAuthentication
a -> ClientVpnAuthentication
s {$sel:federatedAuthentication:ClientVpnAuthentication' :: Maybe FederatedAuthentication
federatedAuthentication = Maybe FederatedAuthentication
a} :: ClientVpnAuthentication)

-- | Information about the authentication certificates, if applicable.
clientVpnAuthentication_mutualAuthentication :: Lens.Lens' ClientVpnAuthentication (Prelude.Maybe CertificateAuthentication)
clientVpnAuthentication_mutualAuthentication :: Lens' ClientVpnAuthentication (Maybe CertificateAuthentication)
clientVpnAuthentication_mutualAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthentication' {Maybe CertificateAuthentication
mutualAuthentication :: Maybe CertificateAuthentication
$sel:mutualAuthentication:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe CertificateAuthentication
mutualAuthentication} -> Maybe CertificateAuthentication
mutualAuthentication) (\s :: ClientVpnAuthentication
s@ClientVpnAuthentication' {} Maybe CertificateAuthentication
a -> ClientVpnAuthentication
s {$sel:mutualAuthentication:ClientVpnAuthentication' :: Maybe CertificateAuthentication
mutualAuthentication = Maybe CertificateAuthentication
a} :: ClientVpnAuthentication)

-- | The authentication type used.
clientVpnAuthentication_type :: Lens.Lens' ClientVpnAuthentication (Prelude.Maybe ClientVpnAuthenticationType)
clientVpnAuthentication_type :: Lens' ClientVpnAuthentication (Maybe ClientVpnAuthenticationType)
clientVpnAuthentication_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientVpnAuthentication' {Maybe ClientVpnAuthenticationType
type' :: Maybe ClientVpnAuthenticationType
$sel:type':ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe ClientVpnAuthenticationType
type'} -> Maybe ClientVpnAuthenticationType
type') (\s :: ClientVpnAuthentication
s@ClientVpnAuthentication' {} Maybe ClientVpnAuthenticationType
a -> ClientVpnAuthentication
s {$sel:type':ClientVpnAuthentication' :: Maybe ClientVpnAuthenticationType
type' = Maybe ClientVpnAuthenticationType
a} :: ClientVpnAuthentication)

instance Data.FromXML ClientVpnAuthentication where
  parseXML :: [Node] -> Either String ClientVpnAuthentication
parseXML [Node]
x =
    Maybe DirectoryServiceAuthentication
-> Maybe FederatedAuthentication
-> Maybe CertificateAuthentication
-> Maybe ClientVpnAuthenticationType
-> ClientVpnAuthentication
ClientVpnAuthentication'
      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
"activeDirectory")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"federatedAuthentication")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"mutualAuthentication")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"type")

instance Prelude.Hashable ClientVpnAuthentication where
  hashWithSalt :: Int -> ClientVpnAuthentication -> Int
hashWithSalt Int
_salt ClientVpnAuthentication' {Maybe CertificateAuthentication
Maybe ClientVpnAuthenticationType
Maybe DirectoryServiceAuthentication
Maybe FederatedAuthentication
type' :: Maybe ClientVpnAuthenticationType
mutualAuthentication :: Maybe CertificateAuthentication
federatedAuthentication :: Maybe FederatedAuthentication
activeDirectory :: Maybe DirectoryServiceAuthentication
$sel:type':ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe ClientVpnAuthenticationType
$sel:mutualAuthentication:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe CertificateAuthentication
$sel:federatedAuthentication:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe FederatedAuthentication
$sel:activeDirectory:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe DirectoryServiceAuthentication
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DirectoryServiceAuthentication
activeDirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FederatedAuthentication
federatedAuthentication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateAuthentication
mutualAuthentication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientVpnAuthenticationType
type'

instance Prelude.NFData ClientVpnAuthentication where
  rnf :: ClientVpnAuthentication -> ()
rnf ClientVpnAuthentication' {Maybe CertificateAuthentication
Maybe ClientVpnAuthenticationType
Maybe DirectoryServiceAuthentication
Maybe FederatedAuthentication
type' :: Maybe ClientVpnAuthenticationType
mutualAuthentication :: Maybe CertificateAuthentication
federatedAuthentication :: Maybe FederatedAuthentication
activeDirectory :: Maybe DirectoryServiceAuthentication
$sel:type':ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe ClientVpnAuthenticationType
$sel:mutualAuthentication:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe CertificateAuthentication
$sel:federatedAuthentication:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe FederatedAuthentication
$sel:activeDirectory:ClientVpnAuthentication' :: ClientVpnAuthentication -> Maybe DirectoryServiceAuthentication
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DirectoryServiceAuthentication
activeDirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FederatedAuthentication
federatedAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateAuthentication
mutualAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientVpnAuthenticationType
type'