{-# 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.RDS.Types.UserAuthConfigInfo
-- 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.RDS.Types.UserAuthConfigInfo 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 Amazonka.RDS.Types.AuthScheme
import Amazonka.RDS.Types.ClientPasswordAuthType
import Amazonka.RDS.Types.IAMAuthMode

-- | Returns the details of authentication used by a proxy to log in as a
-- specific database user.
--
-- /See:/ 'newUserAuthConfigInfo' smart constructor.
data UserAuthConfigInfo = UserAuthConfigInfo'
  { -- | The type of authentication that the proxy uses for connections from the
    -- proxy to the underlying database.
    UserAuthConfigInfo -> Maybe AuthScheme
authScheme :: Prelude.Maybe AuthScheme,
    -- | The type of authentication the proxy uses for connections from clients.
    UserAuthConfigInfo -> Maybe ClientPasswordAuthType
clientPasswordAuthType :: Prelude.Maybe ClientPasswordAuthType,
    -- | A user-specified description about the authentication used by a proxy to
    -- log in as a specific database user.
    UserAuthConfigInfo -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Whether to require or disallow Amazon Web Services Identity and Access
    -- Management (IAM) authentication for connections to the proxy. The
    -- @ENABLED@ value is valid only for proxies with RDS for Microsoft SQL
    -- Server.
    UserAuthConfigInfo -> Maybe IAMAuthMode
iAMAuth :: Prelude.Maybe IAMAuthMode,
    -- | The Amazon Resource Name (ARN) representing the secret that the proxy
    -- uses to authenticate to the RDS DB instance or Aurora DB cluster. These
    -- secrets are stored within Amazon Secrets Manager.
    UserAuthConfigInfo -> Maybe Text
secretArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the database user to which the proxy connects.
    UserAuthConfigInfo -> Maybe Text
userName :: Prelude.Maybe Prelude.Text
  }
  deriving (UserAuthConfigInfo -> UserAuthConfigInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserAuthConfigInfo -> UserAuthConfigInfo -> Bool
$c/= :: UserAuthConfigInfo -> UserAuthConfigInfo -> Bool
== :: UserAuthConfigInfo -> UserAuthConfigInfo -> Bool
$c== :: UserAuthConfigInfo -> UserAuthConfigInfo -> Bool
Prelude.Eq, ReadPrec [UserAuthConfigInfo]
ReadPrec UserAuthConfigInfo
Int -> ReadS UserAuthConfigInfo
ReadS [UserAuthConfigInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserAuthConfigInfo]
$creadListPrec :: ReadPrec [UserAuthConfigInfo]
readPrec :: ReadPrec UserAuthConfigInfo
$creadPrec :: ReadPrec UserAuthConfigInfo
readList :: ReadS [UserAuthConfigInfo]
$creadList :: ReadS [UserAuthConfigInfo]
readsPrec :: Int -> ReadS UserAuthConfigInfo
$creadsPrec :: Int -> ReadS UserAuthConfigInfo
Prelude.Read, Int -> UserAuthConfigInfo -> ShowS
[UserAuthConfigInfo] -> ShowS
UserAuthConfigInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserAuthConfigInfo] -> ShowS
$cshowList :: [UserAuthConfigInfo] -> ShowS
show :: UserAuthConfigInfo -> String
$cshow :: UserAuthConfigInfo -> String
showsPrec :: Int -> UserAuthConfigInfo -> ShowS
$cshowsPrec :: Int -> UserAuthConfigInfo -> ShowS
Prelude.Show, forall x. Rep UserAuthConfigInfo x -> UserAuthConfigInfo
forall x. UserAuthConfigInfo -> Rep UserAuthConfigInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserAuthConfigInfo x -> UserAuthConfigInfo
$cfrom :: forall x. UserAuthConfigInfo -> Rep UserAuthConfigInfo x
Prelude.Generic)

-- |
-- Create a value of 'UserAuthConfigInfo' 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:
--
-- 'authScheme', 'userAuthConfigInfo_authScheme' - The type of authentication that the proxy uses for connections from the
-- proxy to the underlying database.
--
-- 'clientPasswordAuthType', 'userAuthConfigInfo_clientPasswordAuthType' - The type of authentication the proxy uses for connections from clients.
--
-- 'description', 'userAuthConfigInfo_description' - A user-specified description about the authentication used by a proxy to
-- log in as a specific database user.
--
-- 'iAMAuth', 'userAuthConfigInfo_iAMAuth' - Whether to require or disallow Amazon Web Services Identity and Access
-- Management (IAM) authentication for connections to the proxy. The
-- @ENABLED@ value is valid only for proxies with RDS for Microsoft SQL
-- Server.
--
-- 'secretArn', 'userAuthConfigInfo_secretArn' - The Amazon Resource Name (ARN) representing the secret that the proxy
-- uses to authenticate to the RDS DB instance or Aurora DB cluster. These
-- secrets are stored within Amazon Secrets Manager.
--
-- 'userName', 'userAuthConfigInfo_userName' - The name of the database user to which the proxy connects.
newUserAuthConfigInfo ::
  UserAuthConfigInfo
newUserAuthConfigInfo :: UserAuthConfigInfo
newUserAuthConfigInfo =
  UserAuthConfigInfo'
    { $sel:authScheme:UserAuthConfigInfo' :: Maybe AuthScheme
authScheme = forall a. Maybe a
Prelude.Nothing,
      $sel:clientPasswordAuthType:UserAuthConfigInfo' :: Maybe ClientPasswordAuthType
clientPasswordAuthType = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UserAuthConfigInfo' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:iAMAuth:UserAuthConfigInfo' :: Maybe IAMAuthMode
iAMAuth = forall a. Maybe a
Prelude.Nothing,
      $sel:secretArn:UserAuthConfigInfo' :: Maybe Text
secretArn = forall a. Maybe a
Prelude.Nothing,
      $sel:userName:UserAuthConfigInfo' :: Maybe Text
userName = forall a. Maybe a
Prelude.Nothing
    }

-- | The type of authentication that the proxy uses for connections from the
-- proxy to the underlying database.
userAuthConfigInfo_authScheme :: Lens.Lens' UserAuthConfigInfo (Prelude.Maybe AuthScheme)
userAuthConfigInfo_authScheme :: Lens' UserAuthConfigInfo (Maybe AuthScheme)
userAuthConfigInfo_authScheme = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserAuthConfigInfo' {Maybe AuthScheme
authScheme :: Maybe AuthScheme
$sel:authScheme:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe AuthScheme
authScheme} -> Maybe AuthScheme
authScheme) (\s :: UserAuthConfigInfo
s@UserAuthConfigInfo' {} Maybe AuthScheme
a -> UserAuthConfigInfo
s {$sel:authScheme:UserAuthConfigInfo' :: Maybe AuthScheme
authScheme = Maybe AuthScheme
a} :: UserAuthConfigInfo)

-- | The type of authentication the proxy uses for connections from clients.
userAuthConfigInfo_clientPasswordAuthType :: Lens.Lens' UserAuthConfigInfo (Prelude.Maybe ClientPasswordAuthType)
userAuthConfigInfo_clientPasswordAuthType :: Lens' UserAuthConfigInfo (Maybe ClientPasswordAuthType)
userAuthConfigInfo_clientPasswordAuthType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserAuthConfigInfo' {Maybe ClientPasswordAuthType
clientPasswordAuthType :: Maybe ClientPasswordAuthType
$sel:clientPasswordAuthType:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe ClientPasswordAuthType
clientPasswordAuthType} -> Maybe ClientPasswordAuthType
clientPasswordAuthType) (\s :: UserAuthConfigInfo
s@UserAuthConfigInfo' {} Maybe ClientPasswordAuthType
a -> UserAuthConfigInfo
s {$sel:clientPasswordAuthType:UserAuthConfigInfo' :: Maybe ClientPasswordAuthType
clientPasswordAuthType = Maybe ClientPasswordAuthType
a} :: UserAuthConfigInfo)

-- | A user-specified description about the authentication used by a proxy to
-- log in as a specific database user.
userAuthConfigInfo_description :: Lens.Lens' UserAuthConfigInfo (Prelude.Maybe Prelude.Text)
userAuthConfigInfo_description :: Lens' UserAuthConfigInfo (Maybe Text)
userAuthConfigInfo_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserAuthConfigInfo' {Maybe Text
description :: Maybe Text
$sel:description:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
description} -> Maybe Text
description) (\s :: UserAuthConfigInfo
s@UserAuthConfigInfo' {} Maybe Text
a -> UserAuthConfigInfo
s {$sel:description:UserAuthConfigInfo' :: Maybe Text
description = Maybe Text
a} :: UserAuthConfigInfo)

-- | Whether to require or disallow Amazon Web Services Identity and Access
-- Management (IAM) authentication for connections to the proxy. The
-- @ENABLED@ value is valid only for proxies with RDS for Microsoft SQL
-- Server.
userAuthConfigInfo_iAMAuth :: Lens.Lens' UserAuthConfigInfo (Prelude.Maybe IAMAuthMode)
userAuthConfigInfo_iAMAuth :: Lens' UserAuthConfigInfo (Maybe IAMAuthMode)
userAuthConfigInfo_iAMAuth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserAuthConfigInfo' {Maybe IAMAuthMode
iAMAuth :: Maybe IAMAuthMode
$sel:iAMAuth:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe IAMAuthMode
iAMAuth} -> Maybe IAMAuthMode
iAMAuth) (\s :: UserAuthConfigInfo
s@UserAuthConfigInfo' {} Maybe IAMAuthMode
a -> UserAuthConfigInfo
s {$sel:iAMAuth:UserAuthConfigInfo' :: Maybe IAMAuthMode
iAMAuth = Maybe IAMAuthMode
a} :: UserAuthConfigInfo)

-- | The Amazon Resource Name (ARN) representing the secret that the proxy
-- uses to authenticate to the RDS DB instance or Aurora DB cluster. These
-- secrets are stored within Amazon Secrets Manager.
userAuthConfigInfo_secretArn :: Lens.Lens' UserAuthConfigInfo (Prelude.Maybe Prelude.Text)
userAuthConfigInfo_secretArn :: Lens' UserAuthConfigInfo (Maybe Text)
userAuthConfigInfo_secretArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserAuthConfigInfo' {Maybe Text
secretArn :: Maybe Text
$sel:secretArn:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
secretArn} -> Maybe Text
secretArn) (\s :: UserAuthConfigInfo
s@UserAuthConfigInfo' {} Maybe Text
a -> UserAuthConfigInfo
s {$sel:secretArn:UserAuthConfigInfo' :: Maybe Text
secretArn = Maybe Text
a} :: UserAuthConfigInfo)

-- | The name of the database user to which the proxy connects.
userAuthConfigInfo_userName :: Lens.Lens' UserAuthConfigInfo (Prelude.Maybe Prelude.Text)
userAuthConfigInfo_userName :: Lens' UserAuthConfigInfo (Maybe Text)
userAuthConfigInfo_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserAuthConfigInfo' {Maybe Text
userName :: Maybe Text
$sel:userName:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
userName} -> Maybe Text
userName) (\s :: UserAuthConfigInfo
s@UserAuthConfigInfo' {} Maybe Text
a -> UserAuthConfigInfo
s {$sel:userName:UserAuthConfigInfo' :: Maybe Text
userName = Maybe Text
a} :: UserAuthConfigInfo)

instance Data.FromXML UserAuthConfigInfo where
  parseXML :: [Node] -> Either String UserAuthConfigInfo
parseXML [Node]
x =
    Maybe AuthScheme
-> Maybe ClientPasswordAuthType
-> Maybe Text
-> Maybe IAMAuthMode
-> Maybe Text
-> Maybe Text
-> UserAuthConfigInfo
UserAuthConfigInfo'
      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
"AuthScheme")
      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
"ClientPasswordAuthType")
      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
"Description")
      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
"IAMAuth")
      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
"SecretArn")
      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
"UserName")

instance Prelude.Hashable UserAuthConfigInfo where
  hashWithSalt :: Int -> UserAuthConfigInfo -> Int
hashWithSalt Int
_salt UserAuthConfigInfo' {Maybe Text
Maybe AuthScheme
Maybe ClientPasswordAuthType
Maybe IAMAuthMode
userName :: Maybe Text
secretArn :: Maybe Text
iAMAuth :: Maybe IAMAuthMode
description :: Maybe Text
clientPasswordAuthType :: Maybe ClientPasswordAuthType
authScheme :: Maybe AuthScheme
$sel:userName:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
$sel:secretArn:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
$sel:iAMAuth:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe IAMAuthMode
$sel:description:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
$sel:clientPasswordAuthType:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe ClientPasswordAuthType
$sel:authScheme:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe AuthScheme
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuthScheme
authScheme
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientPasswordAuthType
clientPasswordAuthType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IAMAuthMode
iAMAuth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
secretArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userName

instance Prelude.NFData UserAuthConfigInfo where
  rnf :: UserAuthConfigInfo -> ()
rnf UserAuthConfigInfo' {Maybe Text
Maybe AuthScheme
Maybe ClientPasswordAuthType
Maybe IAMAuthMode
userName :: Maybe Text
secretArn :: Maybe Text
iAMAuth :: Maybe IAMAuthMode
description :: Maybe Text
clientPasswordAuthType :: Maybe ClientPasswordAuthType
authScheme :: Maybe AuthScheme
$sel:userName:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
$sel:secretArn:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
$sel:iAMAuth:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe IAMAuthMode
$sel:description:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe Text
$sel:clientPasswordAuthType:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe ClientPasswordAuthType
$sel:authScheme:UserAuthConfigInfo' :: UserAuthConfigInfo -> Maybe AuthScheme
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthScheme
authScheme
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientPasswordAuthType
clientPasswordAuthType
      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 IAMAuthMode
iAMAuth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
secretArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userName