{-# 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.Redshift.GetClusterCredentialsWithIAM
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a database user name and temporary password with temporary
-- authorization to log in to an Amazon Redshift database. The database
-- user is mapped 1:1 to the source Identity and Access Management (IAM)
-- identity. For more information about IAM identities, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id.html IAM Identities (users, user groups, and roles)>
-- in the Amazon Web Services Identity and Access Management User Guide.
--
-- The Identity and Access Management (IAM) identity that runs this
-- operation must have an IAM policy attached that allows access to all
-- necessary actions and resources. For more information about permissions,
-- see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/redshift-iam-access-control-identity-based.html Using identity-based policies (IAM policies)>
-- in the Amazon Redshift Cluster Management Guide.
module Amazonka.Redshift.GetClusterCredentialsWithIAM
  ( -- * Creating a Request
    GetClusterCredentialsWithIAM (..),
    newGetClusterCredentialsWithIAM,

    -- * Request Lenses
    getClusterCredentialsWithIAM_dbName,
    getClusterCredentialsWithIAM_durationSeconds,
    getClusterCredentialsWithIAM_clusterIdentifier,

    -- * Destructuring the Response
    GetClusterCredentialsWithIAMResponse (..),
    newGetClusterCredentialsWithIAMResponse,

    -- * Response Lenses
    getClusterCredentialsWithIAMResponse_dbPassword,
    getClusterCredentialsWithIAMResponse_dbUser,
    getClusterCredentialsWithIAMResponse_expiration,
    getClusterCredentialsWithIAMResponse_nextRefreshTime,
    getClusterCredentialsWithIAMResponse_httpStatus,
  )
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.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetClusterCredentialsWithIAM' smart constructor.
data GetClusterCredentialsWithIAM = GetClusterCredentialsWithIAM'
  { -- | The name of the database for which you are requesting credentials. If
    -- the database name is specified, the IAM policy must allow access to the
    -- resource @dbname@ for the specified database name. If the database name
    -- is not specified, access to all databases is allowed.
    GetClusterCredentialsWithIAM -> Maybe Text
dbName :: Prelude.Maybe Prelude.Text,
    -- | The number of seconds until the returned temporary password expires.
    --
    -- Range: 900-3600. Default: 900.
    GetClusterCredentialsWithIAM -> Maybe Int
durationSeconds :: Prelude.Maybe Prelude.Int,
    -- | The unique identifier of the cluster that contains the database for
    -- which you are requesting credentials.
    GetClusterCredentialsWithIAM -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (GetClusterCredentialsWithIAM
-> GetClusterCredentialsWithIAM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetClusterCredentialsWithIAM
-> GetClusterCredentialsWithIAM -> Bool
$c/= :: GetClusterCredentialsWithIAM
-> GetClusterCredentialsWithIAM -> Bool
== :: GetClusterCredentialsWithIAM
-> GetClusterCredentialsWithIAM -> Bool
$c== :: GetClusterCredentialsWithIAM
-> GetClusterCredentialsWithIAM -> Bool
Prelude.Eq, ReadPrec [GetClusterCredentialsWithIAM]
ReadPrec GetClusterCredentialsWithIAM
Int -> ReadS GetClusterCredentialsWithIAM
ReadS [GetClusterCredentialsWithIAM]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetClusterCredentialsWithIAM]
$creadListPrec :: ReadPrec [GetClusterCredentialsWithIAM]
readPrec :: ReadPrec GetClusterCredentialsWithIAM
$creadPrec :: ReadPrec GetClusterCredentialsWithIAM
readList :: ReadS [GetClusterCredentialsWithIAM]
$creadList :: ReadS [GetClusterCredentialsWithIAM]
readsPrec :: Int -> ReadS GetClusterCredentialsWithIAM
$creadsPrec :: Int -> ReadS GetClusterCredentialsWithIAM
Prelude.Read, Int -> GetClusterCredentialsWithIAM -> ShowS
[GetClusterCredentialsWithIAM] -> ShowS
GetClusterCredentialsWithIAM -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetClusterCredentialsWithIAM] -> ShowS
$cshowList :: [GetClusterCredentialsWithIAM] -> ShowS
show :: GetClusterCredentialsWithIAM -> String
$cshow :: GetClusterCredentialsWithIAM -> String
showsPrec :: Int -> GetClusterCredentialsWithIAM -> ShowS
$cshowsPrec :: Int -> GetClusterCredentialsWithIAM -> ShowS
Prelude.Show, forall x.
Rep GetClusterCredentialsWithIAM x -> GetClusterCredentialsWithIAM
forall x.
GetClusterCredentialsWithIAM -> Rep GetClusterCredentialsWithIAM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetClusterCredentialsWithIAM x -> GetClusterCredentialsWithIAM
$cfrom :: forall x.
GetClusterCredentialsWithIAM -> Rep GetClusterCredentialsWithIAM x
Prelude.Generic)

-- |
-- Create a value of 'GetClusterCredentialsWithIAM' 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:
--
-- 'dbName', 'getClusterCredentialsWithIAM_dbName' - The name of the database for which you are requesting credentials. If
-- the database name is specified, the IAM policy must allow access to the
-- resource @dbname@ for the specified database name. If the database name
-- is not specified, access to all databases is allowed.
--
-- 'durationSeconds', 'getClusterCredentialsWithIAM_durationSeconds' - The number of seconds until the returned temporary password expires.
--
-- Range: 900-3600. Default: 900.
--
-- 'clusterIdentifier', 'getClusterCredentialsWithIAM_clusterIdentifier' - The unique identifier of the cluster that contains the database for
-- which you are requesting credentials.
newGetClusterCredentialsWithIAM ::
  -- | 'clusterIdentifier'
  Prelude.Text ->
  GetClusterCredentialsWithIAM
newGetClusterCredentialsWithIAM :: Text -> GetClusterCredentialsWithIAM
newGetClusterCredentialsWithIAM Text
pClusterIdentifier_ =
  GetClusterCredentialsWithIAM'
    { $sel:dbName:GetClusterCredentialsWithIAM' :: Maybe Text
dbName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:durationSeconds:GetClusterCredentialsWithIAM' :: Maybe Int
durationSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:GetClusterCredentialsWithIAM' :: Text
clusterIdentifier = Text
pClusterIdentifier_
    }

-- | The name of the database for which you are requesting credentials. If
-- the database name is specified, the IAM policy must allow access to the
-- resource @dbname@ for the specified database name. If the database name
-- is not specified, access to all databases is allowed.
getClusterCredentialsWithIAM_dbName :: Lens.Lens' GetClusterCredentialsWithIAM (Prelude.Maybe Prelude.Text)
getClusterCredentialsWithIAM_dbName :: Lens' GetClusterCredentialsWithIAM (Maybe Text)
getClusterCredentialsWithIAM_dbName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsWithIAM' {Maybe Text
dbName :: Maybe Text
$sel:dbName:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Text
dbName} -> Maybe Text
dbName) (\s :: GetClusterCredentialsWithIAM
s@GetClusterCredentialsWithIAM' {} Maybe Text
a -> GetClusterCredentialsWithIAM
s {$sel:dbName:GetClusterCredentialsWithIAM' :: Maybe Text
dbName = Maybe Text
a} :: GetClusterCredentialsWithIAM)

-- | The number of seconds until the returned temporary password expires.
--
-- Range: 900-3600. Default: 900.
getClusterCredentialsWithIAM_durationSeconds :: Lens.Lens' GetClusterCredentialsWithIAM (Prelude.Maybe Prelude.Int)
getClusterCredentialsWithIAM_durationSeconds :: Lens' GetClusterCredentialsWithIAM (Maybe Int)
getClusterCredentialsWithIAM_durationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsWithIAM' {Maybe Int
durationSeconds :: Maybe Int
$sel:durationSeconds:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Int
durationSeconds} -> Maybe Int
durationSeconds) (\s :: GetClusterCredentialsWithIAM
s@GetClusterCredentialsWithIAM' {} Maybe Int
a -> GetClusterCredentialsWithIAM
s {$sel:durationSeconds:GetClusterCredentialsWithIAM' :: Maybe Int
durationSeconds = Maybe Int
a} :: GetClusterCredentialsWithIAM)

-- | The unique identifier of the cluster that contains the database for
-- which you are requesting credentials.
getClusterCredentialsWithIAM_clusterIdentifier :: Lens.Lens' GetClusterCredentialsWithIAM Prelude.Text
getClusterCredentialsWithIAM_clusterIdentifier :: Lens' GetClusterCredentialsWithIAM Text
getClusterCredentialsWithIAM_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsWithIAM' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: GetClusterCredentialsWithIAM
s@GetClusterCredentialsWithIAM' {} Text
a -> GetClusterCredentialsWithIAM
s {$sel:clusterIdentifier:GetClusterCredentialsWithIAM' :: Text
clusterIdentifier = Text
a} :: GetClusterCredentialsWithIAM)

instance Core.AWSRequest GetClusterCredentialsWithIAM where
  type
    AWSResponse GetClusterCredentialsWithIAM =
      GetClusterCredentialsWithIAMResponse
  request :: (Service -> Service)
-> GetClusterCredentialsWithIAM
-> Request GetClusterCredentialsWithIAM
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 GetClusterCredentialsWithIAM
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetClusterCredentialsWithIAM)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetClusterCredentialsWithIAMResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe (Sensitive Text)
-> Maybe Text
-> Maybe ISO8601
-> Maybe ISO8601
-> Int
-> GetClusterCredentialsWithIAMResponse
GetClusterCredentialsWithIAMResponse'
            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
"DbPassword")
            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
"DbUser")
            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
"Expiration")
            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
"NextRefreshTime")
            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
    GetClusterCredentialsWithIAM
  where
  hashWithSalt :: Int -> GetClusterCredentialsWithIAM -> Int
hashWithSalt Int
_salt GetClusterCredentialsWithIAM' {Maybe Int
Maybe Text
Text
clusterIdentifier :: Text
durationSeconds :: Maybe Int
dbName :: Maybe Text
$sel:clusterIdentifier:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Text
$sel:durationSeconds:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Int
$sel:dbName:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
durationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData GetClusterCredentialsWithIAM where
  rnf :: GetClusterCredentialsWithIAM -> ()
rnf GetClusterCredentialsWithIAM' {Maybe Int
Maybe Text
Text
clusterIdentifier :: Text
durationSeconds :: Maybe Int
dbName :: Maybe Text
$sel:clusterIdentifier:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Text
$sel:durationSeconds:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Int
$sel:dbName:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
durationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterIdentifier

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

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

instance Data.ToQuery GetClusterCredentialsWithIAM where
  toQuery :: GetClusterCredentialsWithIAM -> QueryString
toQuery GetClusterCredentialsWithIAM' {Maybe Int
Maybe Text
Text
clusterIdentifier :: Text
durationSeconds :: Maybe Int
dbName :: Maybe Text
$sel:clusterIdentifier:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Text
$sel:durationSeconds:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Int
$sel:dbName:GetClusterCredentialsWithIAM' :: GetClusterCredentialsWithIAM -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"GetClusterCredentialsWithIAM" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"DbName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbName,
        ByteString
"DurationSeconds" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
durationSeconds,
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier
      ]

-- | /See:/ 'newGetClusterCredentialsWithIAMResponse' smart constructor.
data GetClusterCredentialsWithIAMResponse = GetClusterCredentialsWithIAMResponse'
  { -- | A temporary password that you provide when you connect to a database.
    GetClusterCredentialsWithIAMResponse -> Maybe (Sensitive Text)
dbPassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A database user name that you provide when you connect to a database.
    -- The database user is mapped 1:1 to the source IAM identity.
    GetClusterCredentialsWithIAMResponse -> Maybe Text
dbUser :: Prelude.Maybe Prelude.Text,
    -- | The time (UTC) when the temporary password expires. After this
    -- timestamp, a log in with the temporary password fails.
    GetClusterCredentialsWithIAMResponse -> Maybe ISO8601
expiration :: Prelude.Maybe Data.ISO8601,
    -- | Reserved for future use.
    GetClusterCredentialsWithIAMResponse -> Maybe ISO8601
nextRefreshTime :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    GetClusterCredentialsWithIAMResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetClusterCredentialsWithIAMResponse
-> GetClusterCredentialsWithIAMResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetClusterCredentialsWithIAMResponse
-> GetClusterCredentialsWithIAMResponse -> Bool
$c/= :: GetClusterCredentialsWithIAMResponse
-> GetClusterCredentialsWithIAMResponse -> Bool
== :: GetClusterCredentialsWithIAMResponse
-> GetClusterCredentialsWithIAMResponse -> Bool
$c== :: GetClusterCredentialsWithIAMResponse
-> GetClusterCredentialsWithIAMResponse -> Bool
Prelude.Eq, Int -> GetClusterCredentialsWithIAMResponse -> ShowS
[GetClusterCredentialsWithIAMResponse] -> ShowS
GetClusterCredentialsWithIAMResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetClusterCredentialsWithIAMResponse] -> ShowS
$cshowList :: [GetClusterCredentialsWithIAMResponse] -> ShowS
show :: GetClusterCredentialsWithIAMResponse -> String
$cshow :: GetClusterCredentialsWithIAMResponse -> String
showsPrec :: Int -> GetClusterCredentialsWithIAMResponse -> ShowS
$cshowsPrec :: Int -> GetClusterCredentialsWithIAMResponse -> ShowS
Prelude.Show, forall x.
Rep GetClusterCredentialsWithIAMResponse x
-> GetClusterCredentialsWithIAMResponse
forall x.
GetClusterCredentialsWithIAMResponse
-> Rep GetClusterCredentialsWithIAMResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetClusterCredentialsWithIAMResponse x
-> GetClusterCredentialsWithIAMResponse
$cfrom :: forall x.
GetClusterCredentialsWithIAMResponse
-> Rep GetClusterCredentialsWithIAMResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetClusterCredentialsWithIAMResponse' 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:
--
-- 'dbPassword', 'getClusterCredentialsWithIAMResponse_dbPassword' - A temporary password that you provide when you connect to a database.
--
-- 'dbUser', 'getClusterCredentialsWithIAMResponse_dbUser' - A database user name that you provide when you connect to a database.
-- The database user is mapped 1:1 to the source IAM identity.
--
-- 'expiration', 'getClusterCredentialsWithIAMResponse_expiration' - The time (UTC) when the temporary password expires. After this
-- timestamp, a log in with the temporary password fails.
--
-- 'nextRefreshTime', 'getClusterCredentialsWithIAMResponse_nextRefreshTime' - Reserved for future use.
--
-- 'httpStatus', 'getClusterCredentialsWithIAMResponse_httpStatus' - The response's http status code.
newGetClusterCredentialsWithIAMResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetClusterCredentialsWithIAMResponse
newGetClusterCredentialsWithIAMResponse :: Int -> GetClusterCredentialsWithIAMResponse
newGetClusterCredentialsWithIAMResponse Int
pHttpStatus_ =
  GetClusterCredentialsWithIAMResponse'
    { $sel:dbPassword:GetClusterCredentialsWithIAMResponse' :: Maybe (Sensitive Text)
dbPassword =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dbUser:GetClusterCredentialsWithIAMResponse' :: Maybe Text
dbUser = forall a. Maybe a
Prelude.Nothing,
      $sel:expiration:GetClusterCredentialsWithIAMResponse' :: Maybe ISO8601
expiration = forall a. Maybe a
Prelude.Nothing,
      $sel:nextRefreshTime:GetClusterCredentialsWithIAMResponse' :: Maybe ISO8601
nextRefreshTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetClusterCredentialsWithIAMResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A temporary password that you provide when you connect to a database.
getClusterCredentialsWithIAMResponse_dbPassword :: Lens.Lens' GetClusterCredentialsWithIAMResponse (Prelude.Maybe Prelude.Text)
getClusterCredentialsWithIAMResponse_dbPassword :: Lens' GetClusterCredentialsWithIAMResponse (Maybe Text)
getClusterCredentialsWithIAMResponse_dbPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsWithIAMResponse' {Maybe (Sensitive Text)
dbPassword :: Maybe (Sensitive Text)
$sel:dbPassword:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe (Sensitive Text)
dbPassword} -> Maybe (Sensitive Text)
dbPassword) (\s :: GetClusterCredentialsWithIAMResponse
s@GetClusterCredentialsWithIAMResponse' {} Maybe (Sensitive Text)
a -> GetClusterCredentialsWithIAMResponse
s {$sel:dbPassword:GetClusterCredentialsWithIAMResponse' :: Maybe (Sensitive Text)
dbPassword = Maybe (Sensitive Text)
a} :: GetClusterCredentialsWithIAMResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | A database user name that you provide when you connect to a database.
-- The database user is mapped 1:1 to the source IAM identity.
getClusterCredentialsWithIAMResponse_dbUser :: Lens.Lens' GetClusterCredentialsWithIAMResponse (Prelude.Maybe Prelude.Text)
getClusterCredentialsWithIAMResponse_dbUser :: Lens' GetClusterCredentialsWithIAMResponse (Maybe Text)
getClusterCredentialsWithIAMResponse_dbUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsWithIAMResponse' {Maybe Text
dbUser :: Maybe Text
$sel:dbUser:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe Text
dbUser} -> Maybe Text
dbUser) (\s :: GetClusterCredentialsWithIAMResponse
s@GetClusterCredentialsWithIAMResponse' {} Maybe Text
a -> GetClusterCredentialsWithIAMResponse
s {$sel:dbUser:GetClusterCredentialsWithIAMResponse' :: Maybe Text
dbUser = Maybe Text
a} :: GetClusterCredentialsWithIAMResponse)

-- | The time (UTC) when the temporary password expires. After this
-- timestamp, a log in with the temporary password fails.
getClusterCredentialsWithIAMResponse_expiration :: Lens.Lens' GetClusterCredentialsWithIAMResponse (Prelude.Maybe Prelude.UTCTime)
getClusterCredentialsWithIAMResponse_expiration :: Lens' GetClusterCredentialsWithIAMResponse (Maybe UTCTime)
getClusterCredentialsWithIAMResponse_expiration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsWithIAMResponse' {Maybe ISO8601
expiration :: Maybe ISO8601
$sel:expiration:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe ISO8601
expiration} -> Maybe ISO8601
expiration) (\s :: GetClusterCredentialsWithIAMResponse
s@GetClusterCredentialsWithIAMResponse' {} Maybe ISO8601
a -> GetClusterCredentialsWithIAMResponse
s {$sel:expiration:GetClusterCredentialsWithIAMResponse' :: Maybe ISO8601
expiration = Maybe ISO8601
a} :: GetClusterCredentialsWithIAMResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Reserved for future use.
getClusterCredentialsWithIAMResponse_nextRefreshTime :: Lens.Lens' GetClusterCredentialsWithIAMResponse (Prelude.Maybe Prelude.UTCTime)
getClusterCredentialsWithIAMResponse_nextRefreshTime :: Lens' GetClusterCredentialsWithIAMResponse (Maybe UTCTime)
getClusterCredentialsWithIAMResponse_nextRefreshTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsWithIAMResponse' {Maybe ISO8601
nextRefreshTime :: Maybe ISO8601
$sel:nextRefreshTime:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe ISO8601
nextRefreshTime} -> Maybe ISO8601
nextRefreshTime) (\s :: GetClusterCredentialsWithIAMResponse
s@GetClusterCredentialsWithIAMResponse' {} Maybe ISO8601
a -> GetClusterCredentialsWithIAMResponse
s {$sel:nextRefreshTime:GetClusterCredentialsWithIAMResponse' :: Maybe ISO8601
nextRefreshTime = Maybe ISO8601
a} :: GetClusterCredentialsWithIAMResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance
  Prelude.NFData
    GetClusterCredentialsWithIAMResponse
  where
  rnf :: GetClusterCredentialsWithIAMResponse -> ()
rnf GetClusterCredentialsWithIAMResponse' {Int
Maybe Text
Maybe (Sensitive Text)
Maybe ISO8601
httpStatus :: Int
nextRefreshTime :: Maybe ISO8601
expiration :: Maybe ISO8601
dbUser :: Maybe Text
dbPassword :: Maybe (Sensitive Text)
$sel:httpStatus:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Int
$sel:nextRefreshTime:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe ISO8601
$sel:expiration:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe ISO8601
$sel:dbUser:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe Text
$sel:dbPassword:GetClusterCredentialsWithIAMResponse' :: GetClusterCredentialsWithIAMResponse -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
dbPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
expiration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
nextRefreshTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus