{-# 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.GetClusterCredentials
-- 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 on to an Amazon Redshift database. The action
-- returns the database user name prefixed with @IAM:@ if @AutoCreate@ is
-- @False@ or @IAMA:@ if @AutoCreate@ is @True@. You can optionally specify
-- one or more database user groups that the user will join at log on. By
-- default, the temporary credentials expire in 900 seconds. You can
-- optionally specify a duration between 900 seconds (15 minutes) and 3600
-- seconds (60 minutes). For more information, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/generating-user-credentials.html Using IAM Authentication to Generate Database User Credentials>
-- in the Amazon Redshift Cluster Management Guide.
--
-- The Identity and Access Management (IAM) user or role that runs
-- GetClusterCredentials 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#redshift-policy-resources.getclustercredentials-resources Resource Policies for GetClusterCredentials>
-- in the Amazon Redshift Cluster Management Guide.
--
-- If the @DbGroups@ parameter is specified, the IAM policy must allow the
-- @redshift:JoinGroup@ action with access to the listed @dbgroups@.
--
-- In addition, if the @AutoCreate@ parameter is set to @True@, then the
-- policy must include the @redshift:CreateClusterUser@ permission.
--
-- If the @DbName@ parameter is specified, the IAM policy must allow access
-- to the resource @dbname@ for the specified database name.
module Amazonka.Redshift.GetClusterCredentials
  ( -- * Creating a Request
    GetClusterCredentials (..),
    newGetClusterCredentials,

    -- * Request Lenses
    getClusterCredentials_autoCreate,
    getClusterCredentials_dbGroups,
    getClusterCredentials_dbName,
    getClusterCredentials_durationSeconds,
    getClusterCredentials_dbUser,
    getClusterCredentials_clusterIdentifier,

    -- * Destructuring the Response
    GetClusterCredentialsResponse (..),
    newGetClusterCredentialsResponse,

    -- * Response Lenses
    getClusterCredentialsResponse_dbPassword,
    getClusterCredentialsResponse_dbUser,
    getClusterCredentialsResponse_expiration,
    getClusterCredentialsResponse_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

-- | The request parameters to get cluster credentials.
--
-- /See:/ 'newGetClusterCredentials' smart constructor.
data GetClusterCredentials = GetClusterCredentials'
  { -- | Create a database user with the name specified for the user named in
    -- @DbUser@ if one does not exist.
    GetClusterCredentials -> Maybe Bool
autoCreate :: Prelude.Maybe Prelude.Bool,
    -- | A list of the names of existing database groups that the user named in
    -- @DbUser@ will join for the current session, in addition to any group
    -- memberships for an existing user. If not specified, a new user is added
    -- only to PUBLIC.
    --
    -- Database group name constraints
    --
    -- -   Must be 1 to 64 alphanumeric characters or hyphens
    --
    -- -   Must contain only lowercase letters, numbers, underscore, plus sign,
    --     period (dot), at symbol (\@), or hyphen.
    --
    -- -   First character must be a letter.
    --
    -- -   Must not contain a colon ( : ) or slash ( \/ ).
    --
    -- -   Cannot be a reserved word. A list of reserved words can be found in
    --     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
    --     in the Amazon Redshift Database Developer Guide.
    GetClusterCredentials -> Maybe [Text]
dbGroups :: Prelude.Maybe [Prelude.Text],
    -- | The name of a database that @DbUser@ is authorized to log on to. If
    -- @DbName@ is not specified, @DbUser@ can log on to any existing database.
    --
    -- Constraints:
    --
    -- -   Must be 1 to 64 alphanumeric characters or hyphens
    --
    -- -   Must contain uppercase or lowercase letters, numbers, underscore,
    --     plus sign, period (dot), at symbol (\@), or hyphen.
    --
    -- -   First character must be a letter.
    --
    -- -   Must not contain a colon ( : ) or slash ( \/ ).
    --
    -- -   Cannot be a reserved word. A list of reserved words can be found in
    --     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
    --     in the Amazon Redshift Database Developer Guide.
    GetClusterCredentials -> Maybe Text
dbName :: Prelude.Maybe Prelude.Text,
    -- | The number of seconds until the returned temporary password expires.
    --
    -- Constraint: minimum 900, maximum 3600.
    --
    -- Default: 900
    GetClusterCredentials -> Maybe Int
durationSeconds :: Prelude.Maybe Prelude.Int,
    -- | The name of a database user. If a user name matching @DbUser@ exists in
    -- the database, the temporary user credentials have the same permissions
    -- as the existing user. If @DbUser@ doesn\'t exist in the database and
    -- @Autocreate@ is @True@, a new user is created using the value for
    -- @DbUser@ with PUBLIC permissions. If a database user matching the value
    -- for @DbUser@ doesn\'t exist and @Autocreate@ is @False@, then the
    -- command succeeds but the connection attempt will fail because the user
    -- doesn\'t exist in the database.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/redshift/latest/dg/r_CREATE_USER.html CREATE USER>
    -- in the Amazon Redshift Database Developer Guide.
    --
    -- Constraints:
    --
    -- -   Must be 1 to 64 alphanumeric characters or hyphens. The user name
    --     can\'t be @PUBLIC@.
    --
    -- -   Must contain uppercase or lowercase letters, numbers, underscore,
    --     plus sign, period (dot), at symbol (\@), or hyphen.
    --
    -- -   First character must be a letter.
    --
    -- -   Must not contain a colon ( : ) or slash ( \/ ).
    --
    -- -   Cannot be a reserved word. A list of reserved words can be found in
    --     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
    --     in the Amazon Redshift Database Developer Guide.
    GetClusterCredentials -> Text
dbUser :: Prelude.Text,
    -- | The unique identifier of the cluster that contains the database for
    -- which you are requesting credentials. This parameter is case sensitive.
    GetClusterCredentials -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (GetClusterCredentials -> GetClusterCredentials -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetClusterCredentials -> GetClusterCredentials -> Bool
$c/= :: GetClusterCredentials -> GetClusterCredentials -> Bool
== :: GetClusterCredentials -> GetClusterCredentials -> Bool
$c== :: GetClusterCredentials -> GetClusterCredentials -> Bool
Prelude.Eq, ReadPrec [GetClusterCredentials]
ReadPrec GetClusterCredentials
Int -> ReadS GetClusterCredentials
ReadS [GetClusterCredentials]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetClusterCredentials]
$creadListPrec :: ReadPrec [GetClusterCredentials]
readPrec :: ReadPrec GetClusterCredentials
$creadPrec :: ReadPrec GetClusterCredentials
readList :: ReadS [GetClusterCredentials]
$creadList :: ReadS [GetClusterCredentials]
readsPrec :: Int -> ReadS GetClusterCredentials
$creadsPrec :: Int -> ReadS GetClusterCredentials
Prelude.Read, Int -> GetClusterCredentials -> ShowS
[GetClusterCredentials] -> ShowS
GetClusterCredentials -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetClusterCredentials] -> ShowS
$cshowList :: [GetClusterCredentials] -> ShowS
show :: GetClusterCredentials -> String
$cshow :: GetClusterCredentials -> String
showsPrec :: Int -> GetClusterCredentials -> ShowS
$cshowsPrec :: Int -> GetClusterCredentials -> ShowS
Prelude.Show, forall x. Rep GetClusterCredentials x -> GetClusterCredentials
forall x. GetClusterCredentials -> Rep GetClusterCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetClusterCredentials x -> GetClusterCredentials
$cfrom :: forall x. GetClusterCredentials -> Rep GetClusterCredentials x
Prelude.Generic)

-- |
-- Create a value of 'GetClusterCredentials' 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:
--
-- 'autoCreate', 'getClusterCredentials_autoCreate' - Create a database user with the name specified for the user named in
-- @DbUser@ if one does not exist.
--
-- 'dbGroups', 'getClusterCredentials_dbGroups' - A list of the names of existing database groups that the user named in
-- @DbUser@ will join for the current session, in addition to any group
-- memberships for an existing user. If not specified, a new user is added
-- only to PUBLIC.
--
-- Database group name constraints
--
-- -   Must be 1 to 64 alphanumeric characters or hyphens
--
-- -   Must contain only lowercase letters, numbers, underscore, plus sign,
--     period (dot), at symbol (\@), or hyphen.
--
-- -   First character must be a letter.
--
-- -   Must not contain a colon ( : ) or slash ( \/ ).
--
-- -   Cannot be a reserved word. A list of reserved words can be found in
--     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
--     in the Amazon Redshift Database Developer Guide.
--
-- 'dbName', 'getClusterCredentials_dbName' - The name of a database that @DbUser@ is authorized to log on to. If
-- @DbName@ is not specified, @DbUser@ can log on to any existing database.
--
-- Constraints:
--
-- -   Must be 1 to 64 alphanumeric characters or hyphens
--
-- -   Must contain uppercase or lowercase letters, numbers, underscore,
--     plus sign, period (dot), at symbol (\@), or hyphen.
--
-- -   First character must be a letter.
--
-- -   Must not contain a colon ( : ) or slash ( \/ ).
--
-- -   Cannot be a reserved word. A list of reserved words can be found in
--     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
--     in the Amazon Redshift Database Developer Guide.
--
-- 'durationSeconds', 'getClusterCredentials_durationSeconds' - The number of seconds until the returned temporary password expires.
--
-- Constraint: minimum 900, maximum 3600.
--
-- Default: 900
--
-- 'dbUser', 'getClusterCredentials_dbUser' - The name of a database user. If a user name matching @DbUser@ exists in
-- the database, the temporary user credentials have the same permissions
-- as the existing user. If @DbUser@ doesn\'t exist in the database and
-- @Autocreate@ is @True@, a new user is created using the value for
-- @DbUser@ with PUBLIC permissions. If a database user matching the value
-- for @DbUser@ doesn\'t exist and @Autocreate@ is @False@, then the
-- command succeeds but the connection attempt will fail because the user
-- doesn\'t exist in the database.
--
-- For more information, see
-- <https://docs.aws.amazon.com/redshift/latest/dg/r_CREATE_USER.html CREATE USER>
-- in the Amazon Redshift Database Developer Guide.
--
-- Constraints:
--
-- -   Must be 1 to 64 alphanumeric characters or hyphens. The user name
--     can\'t be @PUBLIC@.
--
-- -   Must contain uppercase or lowercase letters, numbers, underscore,
--     plus sign, period (dot), at symbol (\@), or hyphen.
--
-- -   First character must be a letter.
--
-- -   Must not contain a colon ( : ) or slash ( \/ ).
--
-- -   Cannot be a reserved word. A list of reserved words can be found in
--     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
--     in the Amazon Redshift Database Developer Guide.
--
-- 'clusterIdentifier', 'getClusterCredentials_clusterIdentifier' - The unique identifier of the cluster that contains the database for
-- which you are requesting credentials. This parameter is case sensitive.
newGetClusterCredentials ::
  -- | 'dbUser'
  Prelude.Text ->
  -- | 'clusterIdentifier'
  Prelude.Text ->
  GetClusterCredentials
newGetClusterCredentials :: Text -> Text -> GetClusterCredentials
newGetClusterCredentials Text
pDbUser_ Text
pClusterIdentifier_ =
  GetClusterCredentials'
    { $sel:autoCreate:GetClusterCredentials' :: Maybe Bool
autoCreate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dbGroups:GetClusterCredentials' :: Maybe [Text]
dbGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:dbName:GetClusterCredentials' :: Maybe Text
dbName = forall a. Maybe a
Prelude.Nothing,
      $sel:durationSeconds:GetClusterCredentials' :: Maybe Int
durationSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:dbUser:GetClusterCredentials' :: Text
dbUser = Text
pDbUser_,
      $sel:clusterIdentifier:GetClusterCredentials' :: Text
clusterIdentifier = Text
pClusterIdentifier_
    }

-- | Create a database user with the name specified for the user named in
-- @DbUser@ if one does not exist.
getClusterCredentials_autoCreate :: Lens.Lens' GetClusterCredentials (Prelude.Maybe Prelude.Bool)
getClusterCredentials_autoCreate :: Lens' GetClusterCredentials (Maybe Bool)
getClusterCredentials_autoCreate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentials' {Maybe Bool
autoCreate :: Maybe Bool
$sel:autoCreate:GetClusterCredentials' :: GetClusterCredentials -> Maybe Bool
autoCreate} -> Maybe Bool
autoCreate) (\s :: GetClusterCredentials
s@GetClusterCredentials' {} Maybe Bool
a -> GetClusterCredentials
s {$sel:autoCreate:GetClusterCredentials' :: Maybe Bool
autoCreate = Maybe Bool
a} :: GetClusterCredentials)

-- | A list of the names of existing database groups that the user named in
-- @DbUser@ will join for the current session, in addition to any group
-- memberships for an existing user. If not specified, a new user is added
-- only to PUBLIC.
--
-- Database group name constraints
--
-- -   Must be 1 to 64 alphanumeric characters or hyphens
--
-- -   Must contain only lowercase letters, numbers, underscore, plus sign,
--     period (dot), at symbol (\@), or hyphen.
--
-- -   First character must be a letter.
--
-- -   Must not contain a colon ( : ) or slash ( \/ ).
--
-- -   Cannot be a reserved word. A list of reserved words can be found in
--     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
--     in the Amazon Redshift Database Developer Guide.
getClusterCredentials_dbGroups :: Lens.Lens' GetClusterCredentials (Prelude.Maybe [Prelude.Text])
getClusterCredentials_dbGroups :: Lens' GetClusterCredentials (Maybe [Text])
getClusterCredentials_dbGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentials' {Maybe [Text]
dbGroups :: Maybe [Text]
$sel:dbGroups:GetClusterCredentials' :: GetClusterCredentials -> Maybe [Text]
dbGroups} -> Maybe [Text]
dbGroups) (\s :: GetClusterCredentials
s@GetClusterCredentials' {} Maybe [Text]
a -> GetClusterCredentials
s {$sel:dbGroups:GetClusterCredentials' :: Maybe [Text]
dbGroups = Maybe [Text]
a} :: GetClusterCredentials) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of a database that @DbUser@ is authorized to log on to. If
-- @DbName@ is not specified, @DbUser@ can log on to any existing database.
--
-- Constraints:
--
-- -   Must be 1 to 64 alphanumeric characters or hyphens
--
-- -   Must contain uppercase or lowercase letters, numbers, underscore,
--     plus sign, period (dot), at symbol (\@), or hyphen.
--
-- -   First character must be a letter.
--
-- -   Must not contain a colon ( : ) or slash ( \/ ).
--
-- -   Cannot be a reserved word. A list of reserved words can be found in
--     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
--     in the Amazon Redshift Database Developer Guide.
getClusterCredentials_dbName :: Lens.Lens' GetClusterCredentials (Prelude.Maybe Prelude.Text)
getClusterCredentials_dbName :: Lens' GetClusterCredentials (Maybe Text)
getClusterCredentials_dbName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentials' {Maybe Text
dbName :: Maybe Text
$sel:dbName:GetClusterCredentials' :: GetClusterCredentials -> Maybe Text
dbName} -> Maybe Text
dbName) (\s :: GetClusterCredentials
s@GetClusterCredentials' {} Maybe Text
a -> GetClusterCredentials
s {$sel:dbName:GetClusterCredentials' :: Maybe Text
dbName = Maybe Text
a} :: GetClusterCredentials)

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

-- | The name of a database user. If a user name matching @DbUser@ exists in
-- the database, the temporary user credentials have the same permissions
-- as the existing user. If @DbUser@ doesn\'t exist in the database and
-- @Autocreate@ is @True@, a new user is created using the value for
-- @DbUser@ with PUBLIC permissions. If a database user matching the value
-- for @DbUser@ doesn\'t exist and @Autocreate@ is @False@, then the
-- command succeeds but the connection attempt will fail because the user
-- doesn\'t exist in the database.
--
-- For more information, see
-- <https://docs.aws.amazon.com/redshift/latest/dg/r_CREATE_USER.html CREATE USER>
-- in the Amazon Redshift Database Developer Guide.
--
-- Constraints:
--
-- -   Must be 1 to 64 alphanumeric characters or hyphens. The user name
--     can\'t be @PUBLIC@.
--
-- -   Must contain uppercase or lowercase letters, numbers, underscore,
--     plus sign, period (dot), at symbol (\@), or hyphen.
--
-- -   First character must be a letter.
--
-- -   Must not contain a colon ( : ) or slash ( \/ ).
--
-- -   Cannot be a reserved word. A list of reserved words can be found in
--     <http://docs.aws.amazon.com/redshift/latest/dg/r_pg_keywords.html Reserved Words>
--     in the Amazon Redshift Database Developer Guide.
getClusterCredentials_dbUser :: Lens.Lens' GetClusterCredentials Prelude.Text
getClusterCredentials_dbUser :: Lens' GetClusterCredentials Text
getClusterCredentials_dbUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentials' {Text
dbUser :: Text
$sel:dbUser:GetClusterCredentials' :: GetClusterCredentials -> Text
dbUser} -> Text
dbUser) (\s :: GetClusterCredentials
s@GetClusterCredentials' {} Text
a -> GetClusterCredentials
s {$sel:dbUser:GetClusterCredentials' :: Text
dbUser = Text
a} :: GetClusterCredentials)

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

instance Core.AWSRequest GetClusterCredentials where
  type
    AWSResponse GetClusterCredentials =
      GetClusterCredentialsResponse
  request :: (Service -> Service)
-> GetClusterCredentials -> Request GetClusterCredentials
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 GetClusterCredentials
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetClusterCredentials)))
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
"GetClusterCredentialsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe (Sensitive Text)
-> Maybe Text
-> Maybe ISO8601
-> Int
-> GetClusterCredentialsResponse
GetClusterCredentialsResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetClusterCredentials where
  hashWithSalt :: Int -> GetClusterCredentials -> Int
hashWithSalt Int
_salt GetClusterCredentials' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
clusterIdentifier :: Text
dbUser :: Text
durationSeconds :: Maybe Int
dbName :: Maybe Text
dbGroups :: Maybe [Text]
autoCreate :: Maybe Bool
$sel:clusterIdentifier:GetClusterCredentials' :: GetClusterCredentials -> Text
$sel:dbUser:GetClusterCredentials' :: GetClusterCredentials -> Text
$sel:durationSeconds:GetClusterCredentials' :: GetClusterCredentials -> Maybe Int
$sel:dbName:GetClusterCredentials' :: GetClusterCredentials -> Maybe Text
$sel:dbGroups:GetClusterCredentials' :: GetClusterCredentials -> Maybe [Text]
$sel:autoCreate:GetClusterCredentials' :: GetClusterCredentials -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoCreate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
dbGroups
      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
dbUser
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData GetClusterCredentials where
  rnf :: GetClusterCredentials -> ()
rnf GetClusterCredentials' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
clusterIdentifier :: Text
dbUser :: Text
durationSeconds :: Maybe Int
dbName :: Maybe Text
dbGroups :: Maybe [Text]
autoCreate :: Maybe Bool
$sel:clusterIdentifier:GetClusterCredentials' :: GetClusterCredentials -> Text
$sel:dbUser:GetClusterCredentials' :: GetClusterCredentials -> Text
$sel:durationSeconds:GetClusterCredentials' :: GetClusterCredentials -> Maybe Int
$sel:dbName:GetClusterCredentials' :: GetClusterCredentials -> Maybe Text
$sel:dbGroups:GetClusterCredentials' :: GetClusterCredentials -> Maybe [Text]
$sel:autoCreate:GetClusterCredentials' :: GetClusterCredentials -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoCreate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
dbGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
dbUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterIdentifier

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

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

instance Data.ToQuery GetClusterCredentials where
  toQuery :: GetClusterCredentials -> QueryString
toQuery GetClusterCredentials' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
clusterIdentifier :: Text
dbUser :: Text
durationSeconds :: Maybe Int
dbName :: Maybe Text
dbGroups :: Maybe [Text]
autoCreate :: Maybe Bool
$sel:clusterIdentifier:GetClusterCredentials' :: GetClusterCredentials -> Text
$sel:dbUser:GetClusterCredentials' :: GetClusterCredentials -> Text
$sel:durationSeconds:GetClusterCredentials' :: GetClusterCredentials -> Maybe Int
$sel:dbName:GetClusterCredentials' :: GetClusterCredentials -> Maybe Text
$sel:dbGroups:GetClusterCredentials' :: GetClusterCredentials -> Maybe [Text]
$sel:autoCreate:GetClusterCredentials' :: GetClusterCredentials -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetClusterCredentials" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"AutoCreate" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
autoCreate,
        ByteString
"DbGroups"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"DbGroup" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
dbGroups),
        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
"DbUser" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbUser,
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier
      ]

-- | Temporary credentials with authorization to log on to an Amazon Redshift
-- database.
--
-- /See:/ 'newGetClusterCredentialsResponse' smart constructor.
data GetClusterCredentialsResponse = GetClusterCredentialsResponse'
  { -- | A temporary password that authorizes the user name returned by @DbUser@
    -- to log on to the database @DbName@.
    GetClusterCredentialsResponse -> Maybe (Sensitive Text)
dbPassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A database user name that is authorized to log on to the database
    -- @DbName@ using the password @DbPassword@. If the specified DbUser exists
    -- in the database, the new user name has the same database permissions as
    -- the the user named in DbUser. By default, the user is added to PUBLIC.
    -- If the @DbGroups@ parameter is specifed, @DbUser@ is added to the listed
    -- groups for any sessions created using these credentials.
    GetClusterCredentialsResponse -> Maybe Text
dbUser :: Prelude.Maybe Prelude.Text,
    -- | The date and time the password in @DbPassword@ expires.
    GetClusterCredentialsResponse -> Maybe ISO8601
expiration :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    GetClusterCredentialsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetClusterCredentialsResponse
-> GetClusterCredentialsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetClusterCredentialsResponse
-> GetClusterCredentialsResponse -> Bool
$c/= :: GetClusterCredentialsResponse
-> GetClusterCredentialsResponse -> Bool
== :: GetClusterCredentialsResponse
-> GetClusterCredentialsResponse -> Bool
$c== :: GetClusterCredentialsResponse
-> GetClusterCredentialsResponse -> Bool
Prelude.Eq, Int -> GetClusterCredentialsResponse -> ShowS
[GetClusterCredentialsResponse] -> ShowS
GetClusterCredentialsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetClusterCredentialsResponse] -> ShowS
$cshowList :: [GetClusterCredentialsResponse] -> ShowS
show :: GetClusterCredentialsResponse -> String
$cshow :: GetClusterCredentialsResponse -> String
showsPrec :: Int -> GetClusterCredentialsResponse -> ShowS
$cshowsPrec :: Int -> GetClusterCredentialsResponse -> ShowS
Prelude.Show, forall x.
Rep GetClusterCredentialsResponse x
-> GetClusterCredentialsResponse
forall x.
GetClusterCredentialsResponse
-> Rep GetClusterCredentialsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetClusterCredentialsResponse x
-> GetClusterCredentialsResponse
$cfrom :: forall x.
GetClusterCredentialsResponse
-> Rep GetClusterCredentialsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetClusterCredentialsResponse' 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', 'getClusterCredentialsResponse_dbPassword' - A temporary password that authorizes the user name returned by @DbUser@
-- to log on to the database @DbName@.
--
-- 'dbUser', 'getClusterCredentialsResponse_dbUser' - A database user name that is authorized to log on to the database
-- @DbName@ using the password @DbPassword@. If the specified DbUser exists
-- in the database, the new user name has the same database permissions as
-- the the user named in DbUser. By default, the user is added to PUBLIC.
-- If the @DbGroups@ parameter is specifed, @DbUser@ is added to the listed
-- groups for any sessions created using these credentials.
--
-- 'expiration', 'getClusterCredentialsResponse_expiration' - The date and time the password in @DbPassword@ expires.
--
-- 'httpStatus', 'getClusterCredentialsResponse_httpStatus' - The response's http status code.
newGetClusterCredentialsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetClusterCredentialsResponse
newGetClusterCredentialsResponse :: Int -> GetClusterCredentialsResponse
newGetClusterCredentialsResponse Int
pHttpStatus_ =
  GetClusterCredentialsResponse'
    { $sel:dbPassword:GetClusterCredentialsResponse' :: Maybe (Sensitive Text)
dbPassword =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dbUser:GetClusterCredentialsResponse' :: Maybe Text
dbUser = forall a. Maybe a
Prelude.Nothing,
      $sel:expiration:GetClusterCredentialsResponse' :: Maybe ISO8601
expiration = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetClusterCredentialsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A temporary password that authorizes the user name returned by @DbUser@
-- to log on to the database @DbName@.
getClusterCredentialsResponse_dbPassword :: Lens.Lens' GetClusterCredentialsResponse (Prelude.Maybe Prelude.Text)
getClusterCredentialsResponse_dbPassword :: Lens' GetClusterCredentialsResponse (Maybe Text)
getClusterCredentialsResponse_dbPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsResponse' {Maybe (Sensitive Text)
dbPassword :: Maybe (Sensitive Text)
$sel:dbPassword:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> Maybe (Sensitive Text)
dbPassword} -> Maybe (Sensitive Text)
dbPassword) (\s :: GetClusterCredentialsResponse
s@GetClusterCredentialsResponse' {} Maybe (Sensitive Text)
a -> GetClusterCredentialsResponse
s {$sel:dbPassword:GetClusterCredentialsResponse' :: Maybe (Sensitive Text)
dbPassword = Maybe (Sensitive Text)
a} :: GetClusterCredentialsResponse) 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 is authorized to log on to the database
-- @DbName@ using the password @DbPassword@. If the specified DbUser exists
-- in the database, the new user name has the same database permissions as
-- the the user named in DbUser. By default, the user is added to PUBLIC.
-- If the @DbGroups@ parameter is specifed, @DbUser@ is added to the listed
-- groups for any sessions created using these credentials.
getClusterCredentialsResponse_dbUser :: Lens.Lens' GetClusterCredentialsResponse (Prelude.Maybe Prelude.Text)
getClusterCredentialsResponse_dbUser :: Lens' GetClusterCredentialsResponse (Maybe Text)
getClusterCredentialsResponse_dbUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsResponse' {Maybe Text
dbUser :: Maybe Text
$sel:dbUser:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> Maybe Text
dbUser} -> Maybe Text
dbUser) (\s :: GetClusterCredentialsResponse
s@GetClusterCredentialsResponse' {} Maybe Text
a -> GetClusterCredentialsResponse
s {$sel:dbUser:GetClusterCredentialsResponse' :: Maybe Text
dbUser = Maybe Text
a} :: GetClusterCredentialsResponse)

-- | The date and time the password in @DbPassword@ expires.
getClusterCredentialsResponse_expiration :: Lens.Lens' GetClusterCredentialsResponse (Prelude.Maybe Prelude.UTCTime)
getClusterCredentialsResponse_expiration :: Lens' GetClusterCredentialsResponse (Maybe UTCTime)
getClusterCredentialsResponse_expiration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsResponse' {Maybe ISO8601
expiration :: Maybe ISO8601
$sel:expiration:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> Maybe ISO8601
expiration} -> Maybe ISO8601
expiration) (\s :: GetClusterCredentialsResponse
s@GetClusterCredentialsResponse' {} Maybe ISO8601
a -> GetClusterCredentialsResponse
s {$sel:expiration:GetClusterCredentialsResponse' :: Maybe ISO8601
expiration = Maybe ISO8601
a} :: GetClusterCredentialsResponse) 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.
getClusterCredentialsResponse_httpStatus :: Lens.Lens' GetClusterCredentialsResponse Prelude.Int
getClusterCredentialsResponse_httpStatus :: Lens' GetClusterCredentialsResponse Int
getClusterCredentialsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClusterCredentialsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetClusterCredentialsResponse
s@GetClusterCredentialsResponse' {} Int
a -> GetClusterCredentialsResponse
s {$sel:httpStatus:GetClusterCredentialsResponse' :: Int
httpStatus = Int
a} :: GetClusterCredentialsResponse)

instance Prelude.NFData GetClusterCredentialsResponse where
  rnf :: GetClusterCredentialsResponse -> ()
rnf GetClusterCredentialsResponse' {Int
Maybe Text
Maybe (Sensitive Text)
Maybe ISO8601
httpStatus :: Int
expiration :: Maybe ISO8601
dbUser :: Maybe Text
dbPassword :: Maybe (Sensitive Text)
$sel:httpStatus:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> Int
$sel:expiration:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> Maybe ISO8601
$sel:dbUser:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> Maybe Text
$sel:dbPassword:GetClusterCredentialsResponse' :: GetClusterCredentialsResponse -> 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 Int
httpStatus