{-# 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.Lightsail.GetRelationalDatabaseMasterUserPassword
-- 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 the current, previous, or pending versions of the master user
-- password for a Lightsail database.
--
-- The @GetRelationalDatabaseMasterUserPassword@ operation supports
-- tag-based access control via resource tags applied to the resource
-- identified by relationalDatabaseName.
module Amazonka.Lightsail.GetRelationalDatabaseMasterUserPassword
  ( -- * Creating a Request
    GetRelationalDatabaseMasterUserPassword (..),
    newGetRelationalDatabaseMasterUserPassword,

    -- * Request Lenses
    getRelationalDatabaseMasterUserPassword_passwordVersion,
    getRelationalDatabaseMasterUserPassword_relationalDatabaseName,

    -- * Destructuring the Response
    GetRelationalDatabaseMasterUserPasswordResponse (..),
    newGetRelationalDatabaseMasterUserPasswordResponse,

    -- * Response Lenses
    getRelationalDatabaseMasterUserPasswordResponse_createdAt,
    getRelationalDatabaseMasterUserPasswordResponse_masterUserPassword,
    getRelationalDatabaseMasterUserPasswordResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lightsail.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetRelationalDatabaseMasterUserPassword' smart constructor.
data GetRelationalDatabaseMasterUserPassword = GetRelationalDatabaseMasterUserPassword'
  { -- | The password version to return.
    --
    -- Specifying @CURRENT@ or @PREVIOUS@ returns the current or previous
    -- passwords respectively. Specifying @PENDING@ returns the newest version
    -- of the password that will rotate to @CURRENT@. After the @PENDING@
    -- password rotates to @CURRENT@, the @PENDING@ password is no longer
    -- available.
    --
    -- Default: @CURRENT@
    GetRelationalDatabaseMasterUserPassword
-> Maybe RelationalDatabasePasswordVersion
passwordVersion :: Prelude.Maybe RelationalDatabasePasswordVersion,
    -- | The name of your database for which to get the master user password.
    GetRelationalDatabaseMasterUserPassword -> Text
relationalDatabaseName :: Prelude.Text
  }
  deriving (GetRelationalDatabaseMasterUserPassword
-> GetRelationalDatabaseMasterUserPassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRelationalDatabaseMasterUserPassword
-> GetRelationalDatabaseMasterUserPassword -> Bool
$c/= :: GetRelationalDatabaseMasterUserPassword
-> GetRelationalDatabaseMasterUserPassword -> Bool
== :: GetRelationalDatabaseMasterUserPassword
-> GetRelationalDatabaseMasterUserPassword -> Bool
$c== :: GetRelationalDatabaseMasterUserPassword
-> GetRelationalDatabaseMasterUserPassword -> Bool
Prelude.Eq, ReadPrec [GetRelationalDatabaseMasterUserPassword]
ReadPrec GetRelationalDatabaseMasterUserPassword
Int -> ReadS GetRelationalDatabaseMasterUserPassword
ReadS [GetRelationalDatabaseMasterUserPassword]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRelationalDatabaseMasterUserPassword]
$creadListPrec :: ReadPrec [GetRelationalDatabaseMasterUserPassword]
readPrec :: ReadPrec GetRelationalDatabaseMasterUserPassword
$creadPrec :: ReadPrec GetRelationalDatabaseMasterUserPassword
readList :: ReadS [GetRelationalDatabaseMasterUserPassword]
$creadList :: ReadS [GetRelationalDatabaseMasterUserPassword]
readsPrec :: Int -> ReadS GetRelationalDatabaseMasterUserPassword
$creadsPrec :: Int -> ReadS GetRelationalDatabaseMasterUserPassword
Prelude.Read, Int -> GetRelationalDatabaseMasterUserPassword -> ShowS
[GetRelationalDatabaseMasterUserPassword] -> ShowS
GetRelationalDatabaseMasterUserPassword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRelationalDatabaseMasterUserPassword] -> ShowS
$cshowList :: [GetRelationalDatabaseMasterUserPassword] -> ShowS
show :: GetRelationalDatabaseMasterUserPassword -> String
$cshow :: GetRelationalDatabaseMasterUserPassword -> String
showsPrec :: Int -> GetRelationalDatabaseMasterUserPassword -> ShowS
$cshowsPrec :: Int -> GetRelationalDatabaseMasterUserPassword -> ShowS
Prelude.Show, forall x.
Rep GetRelationalDatabaseMasterUserPassword x
-> GetRelationalDatabaseMasterUserPassword
forall x.
GetRelationalDatabaseMasterUserPassword
-> Rep GetRelationalDatabaseMasterUserPassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRelationalDatabaseMasterUserPassword x
-> GetRelationalDatabaseMasterUserPassword
$cfrom :: forall x.
GetRelationalDatabaseMasterUserPassword
-> Rep GetRelationalDatabaseMasterUserPassword x
Prelude.Generic)

-- |
-- Create a value of 'GetRelationalDatabaseMasterUserPassword' 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:
--
-- 'passwordVersion', 'getRelationalDatabaseMasterUserPassword_passwordVersion' - The password version to return.
--
-- Specifying @CURRENT@ or @PREVIOUS@ returns the current or previous
-- passwords respectively. Specifying @PENDING@ returns the newest version
-- of the password that will rotate to @CURRENT@. After the @PENDING@
-- password rotates to @CURRENT@, the @PENDING@ password is no longer
-- available.
--
-- Default: @CURRENT@
--
-- 'relationalDatabaseName', 'getRelationalDatabaseMasterUserPassword_relationalDatabaseName' - The name of your database for which to get the master user password.
newGetRelationalDatabaseMasterUserPassword ::
  -- | 'relationalDatabaseName'
  Prelude.Text ->
  GetRelationalDatabaseMasterUserPassword
newGetRelationalDatabaseMasterUserPassword :: Text -> GetRelationalDatabaseMasterUserPassword
newGetRelationalDatabaseMasterUserPassword
  Text
pRelationalDatabaseName_ =
    GetRelationalDatabaseMasterUserPassword'
      { $sel:passwordVersion:GetRelationalDatabaseMasterUserPassword' :: Maybe RelationalDatabasePasswordVersion
passwordVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:relationalDatabaseName:GetRelationalDatabaseMasterUserPassword' :: Text
relationalDatabaseName =
          Text
pRelationalDatabaseName_
      }

-- | The password version to return.
--
-- Specifying @CURRENT@ or @PREVIOUS@ returns the current or previous
-- passwords respectively. Specifying @PENDING@ returns the newest version
-- of the password that will rotate to @CURRENT@. After the @PENDING@
-- password rotates to @CURRENT@, the @PENDING@ password is no longer
-- available.
--
-- Default: @CURRENT@
getRelationalDatabaseMasterUserPassword_passwordVersion :: Lens.Lens' GetRelationalDatabaseMasterUserPassword (Prelude.Maybe RelationalDatabasePasswordVersion)
getRelationalDatabaseMasterUserPassword_passwordVersion :: Lens'
  GetRelationalDatabaseMasterUserPassword
  (Maybe RelationalDatabasePasswordVersion)
getRelationalDatabaseMasterUserPassword_passwordVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRelationalDatabaseMasterUserPassword' {Maybe RelationalDatabasePasswordVersion
passwordVersion :: Maybe RelationalDatabasePasswordVersion
$sel:passwordVersion:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword
-> Maybe RelationalDatabasePasswordVersion
passwordVersion} -> Maybe RelationalDatabasePasswordVersion
passwordVersion) (\s :: GetRelationalDatabaseMasterUserPassword
s@GetRelationalDatabaseMasterUserPassword' {} Maybe RelationalDatabasePasswordVersion
a -> GetRelationalDatabaseMasterUserPassword
s {$sel:passwordVersion:GetRelationalDatabaseMasterUserPassword' :: Maybe RelationalDatabasePasswordVersion
passwordVersion = Maybe RelationalDatabasePasswordVersion
a} :: GetRelationalDatabaseMasterUserPassword)

-- | The name of your database for which to get the master user password.
getRelationalDatabaseMasterUserPassword_relationalDatabaseName :: Lens.Lens' GetRelationalDatabaseMasterUserPassword Prelude.Text
getRelationalDatabaseMasterUserPassword_relationalDatabaseName :: Lens' GetRelationalDatabaseMasterUserPassword Text
getRelationalDatabaseMasterUserPassword_relationalDatabaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRelationalDatabaseMasterUserPassword' {Text
relationalDatabaseName :: Text
$sel:relationalDatabaseName:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword -> Text
relationalDatabaseName} -> Text
relationalDatabaseName) (\s :: GetRelationalDatabaseMasterUserPassword
s@GetRelationalDatabaseMasterUserPassword' {} Text
a -> GetRelationalDatabaseMasterUserPassword
s {$sel:relationalDatabaseName:GetRelationalDatabaseMasterUserPassword' :: Text
relationalDatabaseName = Text
a} :: GetRelationalDatabaseMasterUserPassword)

instance
  Core.AWSRequest
    GetRelationalDatabaseMasterUserPassword
  where
  type
    AWSResponse
      GetRelationalDatabaseMasterUserPassword =
      GetRelationalDatabaseMasterUserPasswordResponse
  request :: (Service -> Service)
-> GetRelationalDatabaseMasterUserPassword
-> Request GetRelationalDatabaseMasterUserPassword
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetRelationalDatabaseMasterUserPassword
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse GetRelationalDatabaseMasterUserPassword)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe POSIX
-> Maybe (Sensitive Text)
-> Int
-> GetRelationalDatabaseMasterUserPasswordResponse
GetRelationalDatabaseMasterUserPasswordResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"createdAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"masterUserPassword")
            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
    GetRelationalDatabaseMasterUserPassword
  where
  hashWithSalt :: Int -> GetRelationalDatabaseMasterUserPassword -> Int
hashWithSalt
    Int
_salt
    GetRelationalDatabaseMasterUserPassword' {Maybe RelationalDatabasePasswordVersion
Text
relationalDatabaseName :: Text
passwordVersion :: Maybe RelationalDatabasePasswordVersion
$sel:relationalDatabaseName:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword -> Text
$sel:passwordVersion:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword
-> Maybe RelationalDatabasePasswordVersion
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RelationalDatabasePasswordVersion
passwordVersion
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
relationalDatabaseName

instance
  Prelude.NFData
    GetRelationalDatabaseMasterUserPassword
  where
  rnf :: GetRelationalDatabaseMasterUserPassword -> ()
rnf GetRelationalDatabaseMasterUserPassword' {Maybe RelationalDatabasePasswordVersion
Text
relationalDatabaseName :: Text
passwordVersion :: Maybe RelationalDatabasePasswordVersion
$sel:relationalDatabaseName:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword -> Text
$sel:passwordVersion:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword
-> Maybe RelationalDatabasePasswordVersion
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RelationalDatabasePasswordVersion
passwordVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
relationalDatabaseName

instance
  Data.ToHeaders
    GetRelationalDatabaseMasterUserPassword
  where
  toHeaders :: GetRelationalDatabaseMasterUserPassword -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Lightsail_20161128.GetRelationalDatabaseMasterUserPassword" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance
  Data.ToJSON
    GetRelationalDatabaseMasterUserPassword
  where
  toJSON :: GetRelationalDatabaseMasterUserPassword -> Value
toJSON GetRelationalDatabaseMasterUserPassword' {Maybe RelationalDatabasePasswordVersion
Text
relationalDatabaseName :: Text
passwordVersion :: Maybe RelationalDatabasePasswordVersion
$sel:relationalDatabaseName:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword -> Text
$sel:passwordVersion:GetRelationalDatabaseMasterUserPassword' :: GetRelationalDatabaseMasterUserPassword
-> Maybe RelationalDatabasePasswordVersion
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"passwordVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RelationalDatabasePasswordVersion
passwordVersion,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"relationalDatabaseName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
relationalDatabaseName
              )
          ]
      )

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

instance
  Data.ToQuery
    GetRelationalDatabaseMasterUserPassword
  where
  toQuery :: GetRelationalDatabaseMasterUserPassword -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetRelationalDatabaseMasterUserPasswordResponse' smart constructor.
data GetRelationalDatabaseMasterUserPasswordResponse = GetRelationalDatabaseMasterUserPasswordResponse'
  { -- | The timestamp when the specified version of the master user password was
    -- created.
    GetRelationalDatabaseMasterUserPasswordResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The master user password for the @password version@ specified.
    GetRelationalDatabaseMasterUserPasswordResponse
-> Maybe (Sensitive Text)
masterUserPassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The response's http status code.
    GetRelationalDatabaseMasterUserPasswordResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRelationalDatabaseMasterUserPasswordResponse
-> GetRelationalDatabaseMasterUserPasswordResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRelationalDatabaseMasterUserPasswordResponse
-> GetRelationalDatabaseMasterUserPasswordResponse -> Bool
$c/= :: GetRelationalDatabaseMasterUserPasswordResponse
-> GetRelationalDatabaseMasterUserPasswordResponse -> Bool
== :: GetRelationalDatabaseMasterUserPasswordResponse
-> GetRelationalDatabaseMasterUserPasswordResponse -> Bool
$c== :: GetRelationalDatabaseMasterUserPasswordResponse
-> GetRelationalDatabaseMasterUserPasswordResponse -> Bool
Prelude.Eq, Int -> GetRelationalDatabaseMasterUserPasswordResponse -> ShowS
[GetRelationalDatabaseMasterUserPasswordResponse] -> ShowS
GetRelationalDatabaseMasterUserPasswordResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRelationalDatabaseMasterUserPasswordResponse] -> ShowS
$cshowList :: [GetRelationalDatabaseMasterUserPasswordResponse] -> ShowS
show :: GetRelationalDatabaseMasterUserPasswordResponse -> String
$cshow :: GetRelationalDatabaseMasterUserPasswordResponse -> String
showsPrec :: Int -> GetRelationalDatabaseMasterUserPasswordResponse -> ShowS
$cshowsPrec :: Int -> GetRelationalDatabaseMasterUserPasswordResponse -> ShowS
Prelude.Show, forall x.
Rep GetRelationalDatabaseMasterUserPasswordResponse x
-> GetRelationalDatabaseMasterUserPasswordResponse
forall x.
GetRelationalDatabaseMasterUserPasswordResponse
-> Rep GetRelationalDatabaseMasterUserPasswordResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRelationalDatabaseMasterUserPasswordResponse x
-> GetRelationalDatabaseMasterUserPasswordResponse
$cfrom :: forall x.
GetRelationalDatabaseMasterUserPasswordResponse
-> Rep GetRelationalDatabaseMasterUserPasswordResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRelationalDatabaseMasterUserPasswordResponse' 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:
--
-- 'createdAt', 'getRelationalDatabaseMasterUserPasswordResponse_createdAt' - The timestamp when the specified version of the master user password was
-- created.
--
-- 'masterUserPassword', 'getRelationalDatabaseMasterUserPasswordResponse_masterUserPassword' - The master user password for the @password version@ specified.
--
-- 'httpStatus', 'getRelationalDatabaseMasterUserPasswordResponse_httpStatus' - The response's http status code.
newGetRelationalDatabaseMasterUserPasswordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRelationalDatabaseMasterUserPasswordResponse
newGetRelationalDatabaseMasterUserPasswordResponse :: Int -> GetRelationalDatabaseMasterUserPasswordResponse
newGetRelationalDatabaseMasterUserPasswordResponse
  Int
pHttpStatus_ =
    GetRelationalDatabaseMasterUserPasswordResponse'
      { $sel:createdAt:GetRelationalDatabaseMasterUserPasswordResponse' :: Maybe POSIX
createdAt =
          forall a. Maybe a
Prelude.Nothing,
        $sel:masterUserPassword:GetRelationalDatabaseMasterUserPasswordResponse' :: Maybe (Sensitive Text)
masterUserPassword =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetRelationalDatabaseMasterUserPasswordResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The timestamp when the specified version of the master user password was
-- created.
getRelationalDatabaseMasterUserPasswordResponse_createdAt :: Lens.Lens' GetRelationalDatabaseMasterUserPasswordResponse (Prelude.Maybe Prelude.UTCTime)
getRelationalDatabaseMasterUserPasswordResponse_createdAt :: Lens'
  GetRelationalDatabaseMasterUserPasswordResponse (Maybe UTCTime)
getRelationalDatabaseMasterUserPasswordResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRelationalDatabaseMasterUserPasswordResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:GetRelationalDatabaseMasterUserPasswordResponse' :: GetRelationalDatabaseMasterUserPasswordResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: GetRelationalDatabaseMasterUserPasswordResponse
s@GetRelationalDatabaseMasterUserPasswordResponse' {} Maybe POSIX
a -> GetRelationalDatabaseMasterUserPasswordResponse
s {$sel:createdAt:GetRelationalDatabaseMasterUserPasswordResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: GetRelationalDatabaseMasterUserPasswordResponse) 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 master user password for the @password version@ specified.
getRelationalDatabaseMasterUserPasswordResponse_masterUserPassword :: Lens.Lens' GetRelationalDatabaseMasterUserPasswordResponse (Prelude.Maybe Prelude.Text)
getRelationalDatabaseMasterUserPasswordResponse_masterUserPassword :: Lens' GetRelationalDatabaseMasterUserPasswordResponse (Maybe Text)
getRelationalDatabaseMasterUserPasswordResponse_masterUserPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRelationalDatabaseMasterUserPasswordResponse' {Maybe (Sensitive Text)
masterUserPassword :: Maybe (Sensitive Text)
$sel:masterUserPassword:GetRelationalDatabaseMasterUserPasswordResponse' :: GetRelationalDatabaseMasterUserPasswordResponse
-> Maybe (Sensitive Text)
masterUserPassword} -> Maybe (Sensitive Text)
masterUserPassword) (\s :: GetRelationalDatabaseMasterUserPasswordResponse
s@GetRelationalDatabaseMasterUserPasswordResponse' {} Maybe (Sensitive Text)
a -> GetRelationalDatabaseMasterUserPasswordResponse
s {$sel:masterUserPassword:GetRelationalDatabaseMasterUserPasswordResponse' :: Maybe (Sensitive Text)
masterUserPassword = Maybe (Sensitive Text)
a} :: GetRelationalDatabaseMasterUserPasswordResponse) 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

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

instance
  Prelude.NFData
    GetRelationalDatabaseMasterUserPasswordResponse
  where
  rnf :: GetRelationalDatabaseMasterUserPasswordResponse -> ()
rnf
    GetRelationalDatabaseMasterUserPasswordResponse' {Int
Maybe (Sensitive Text)
Maybe POSIX
httpStatus :: Int
masterUserPassword :: Maybe (Sensitive Text)
createdAt :: Maybe POSIX
$sel:httpStatus:GetRelationalDatabaseMasterUserPasswordResponse' :: GetRelationalDatabaseMasterUserPasswordResponse -> Int
$sel:masterUserPassword:GetRelationalDatabaseMasterUserPasswordResponse' :: GetRelationalDatabaseMasterUserPasswordResponse
-> Maybe (Sensitive Text)
$sel:createdAt:GetRelationalDatabaseMasterUserPasswordResponse' :: GetRelationalDatabaseMasterUserPasswordResponse -> Maybe POSIX
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
masterUserPassword
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus