{-# 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.UpdateRelationalDatabase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allows the update of one or more attributes of a database in Amazon
-- Lightsail.
--
-- Updates are applied immediately, or in cases where the updates could
-- result in an outage, are applied during the database\'s predefined
-- maintenance window.
--
-- The @update relational database@ operation supports tag-based access
-- control via resource tags applied to the resource identified by
-- relationalDatabaseName. For more information, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-controlling-access-using-tags Amazon Lightsail Developer Guide>.
module Amazonka.Lightsail.UpdateRelationalDatabase
  ( -- * Creating a Request
    UpdateRelationalDatabase (..),
    newUpdateRelationalDatabase,

    -- * Request Lenses
    updateRelationalDatabase_applyImmediately,
    updateRelationalDatabase_caCertificateIdentifier,
    updateRelationalDatabase_disableBackupRetention,
    updateRelationalDatabase_enableBackupRetention,
    updateRelationalDatabase_masterUserPassword,
    updateRelationalDatabase_preferredBackupWindow,
    updateRelationalDatabase_preferredMaintenanceWindow,
    updateRelationalDatabase_publiclyAccessible,
    updateRelationalDatabase_rotateMasterUserPassword,
    updateRelationalDatabase_relationalDatabaseName,

    -- * Destructuring the Response
    UpdateRelationalDatabaseResponse (..),
    newUpdateRelationalDatabaseResponse,

    -- * Response Lenses
    updateRelationalDatabaseResponse_operations,
    updateRelationalDatabaseResponse_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:/ 'newUpdateRelationalDatabase' smart constructor.
data UpdateRelationalDatabase = UpdateRelationalDatabase'
  { -- | When @true@, applies changes immediately. When @false@, applies changes
    -- during the preferred maintenance window. Some changes may cause an
    -- outage.
    --
    -- Default: @false@
    UpdateRelationalDatabase -> Maybe Bool
applyImmediately :: Prelude.Maybe Prelude.Bool,
    -- | Indicates the certificate that needs to be associated with the database.
    UpdateRelationalDatabase -> Maybe Text
caCertificateIdentifier :: Prelude.Maybe Prelude.Text,
    -- | When @true@, disables automated backup retention for your database.
    --
    -- Disabling backup retention deletes all automated database backups.
    -- Before disabling this, you may want to create a snapshot of your
    -- database using the @create relational database snapshot@ operation.
    --
    -- Updates are applied during the next maintenance window because this can
    -- result in an outage.
    UpdateRelationalDatabase -> Maybe Bool
disableBackupRetention :: Prelude.Maybe Prelude.Bool,
    -- | When @true@, enables automated backup retention for your database.
    --
    -- Updates are applied during the next maintenance window because this can
    -- result in an outage.
    UpdateRelationalDatabase -> Maybe Bool
enableBackupRetention :: Prelude.Maybe Prelude.Bool,
    -- | The password for the master user. The password can include any printable
    -- ASCII character except \"\/\", \"\"\", or \"\@\".
    --
    -- My__SQL__
    --
    -- Constraints: Must contain from 8 to 41 characters.
    --
    -- __PostgreSQL__
    --
    -- Constraints: Must contain from 8 to 128 characters.
    UpdateRelationalDatabase -> Maybe (Sensitive Text)
masterUserPassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The daily time range during which automated backups are created for your
    -- database if automated backups are enabled.
    --
    -- Constraints:
    --
    -- -   Must be in the @hh24:mi-hh24:mi@ format.
    --
    --     Example: @16:00-16:30@
    --
    -- -   Specified in Coordinated Universal Time (UTC).
    --
    -- -   Must not conflict with the preferred maintenance window.
    --
    -- -   Must be at least 30 minutes.
    UpdateRelationalDatabase -> Maybe Text
preferredBackupWindow :: Prelude.Maybe Prelude.Text,
    -- | The weekly time range during which system maintenance can occur on your
    -- database.
    --
    -- The default is a 30-minute window selected at random from an 8-hour
    -- block of time for each Amazon Web Services Region, occurring on a random
    -- day of the week.
    --
    -- Constraints:
    --
    -- -   Must be in the @ddd:hh24:mi-ddd:hh24:mi@ format.
    --
    -- -   Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
    --
    -- -   Must be at least 30 minutes.
    --
    -- -   Specified in Coordinated Universal Time (UTC).
    --
    -- -   Example: @Tue:17:00-Tue:17:30@
    UpdateRelationalDatabase -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | Specifies the accessibility options for your database. A value of @true@
    -- specifies a database that is available to resources outside of your
    -- Lightsail account. A value of @false@ specifies a database that is
    -- available only to your Lightsail resources in the same region as your
    -- database.
    UpdateRelationalDatabase -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | When @true@, the master user password is changed to a new strong
    -- password generated by Lightsail.
    --
    -- Use the @get relational database master user password@ operation to get
    -- the new password.
    UpdateRelationalDatabase -> Maybe Bool
rotateMasterUserPassword :: Prelude.Maybe Prelude.Bool,
    -- | The name of your Lightsail database resource to update.
    UpdateRelationalDatabase -> Text
relationalDatabaseName :: Prelude.Text
  }
  deriving (UpdateRelationalDatabase -> UpdateRelationalDatabase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRelationalDatabase -> UpdateRelationalDatabase -> Bool
$c/= :: UpdateRelationalDatabase -> UpdateRelationalDatabase -> Bool
== :: UpdateRelationalDatabase -> UpdateRelationalDatabase -> Bool
$c== :: UpdateRelationalDatabase -> UpdateRelationalDatabase -> Bool
Prelude.Eq, Int -> UpdateRelationalDatabase -> ShowS
[UpdateRelationalDatabase] -> ShowS
UpdateRelationalDatabase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRelationalDatabase] -> ShowS
$cshowList :: [UpdateRelationalDatabase] -> ShowS
show :: UpdateRelationalDatabase -> String
$cshow :: UpdateRelationalDatabase -> String
showsPrec :: Int -> UpdateRelationalDatabase -> ShowS
$cshowsPrec :: Int -> UpdateRelationalDatabase -> ShowS
Prelude.Show, forall x.
Rep UpdateRelationalDatabase x -> UpdateRelationalDatabase
forall x.
UpdateRelationalDatabase -> Rep UpdateRelationalDatabase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRelationalDatabase x -> UpdateRelationalDatabase
$cfrom :: forall x.
UpdateRelationalDatabase -> Rep UpdateRelationalDatabase x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRelationalDatabase' 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:
--
-- 'applyImmediately', 'updateRelationalDatabase_applyImmediately' - When @true@, applies changes immediately. When @false@, applies changes
-- during the preferred maintenance window. Some changes may cause an
-- outage.
--
-- Default: @false@
--
-- 'caCertificateIdentifier', 'updateRelationalDatabase_caCertificateIdentifier' - Indicates the certificate that needs to be associated with the database.
--
-- 'disableBackupRetention', 'updateRelationalDatabase_disableBackupRetention' - When @true@, disables automated backup retention for your database.
--
-- Disabling backup retention deletes all automated database backups.
-- Before disabling this, you may want to create a snapshot of your
-- database using the @create relational database snapshot@ operation.
--
-- Updates are applied during the next maintenance window because this can
-- result in an outage.
--
-- 'enableBackupRetention', 'updateRelationalDatabase_enableBackupRetention' - When @true@, enables automated backup retention for your database.
--
-- Updates are applied during the next maintenance window because this can
-- result in an outage.
--
-- 'masterUserPassword', 'updateRelationalDatabase_masterUserPassword' - The password for the master user. The password can include any printable
-- ASCII character except \"\/\", \"\"\", or \"\@\".
--
-- My__SQL__
--
-- Constraints: Must contain from 8 to 41 characters.
--
-- __PostgreSQL__
--
-- Constraints: Must contain from 8 to 128 characters.
--
-- 'preferredBackupWindow', 'updateRelationalDatabase_preferredBackupWindow' - The daily time range during which automated backups are created for your
-- database if automated backups are enabled.
--
-- Constraints:
--
-- -   Must be in the @hh24:mi-hh24:mi@ format.
--
--     Example: @16:00-16:30@
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Must not conflict with the preferred maintenance window.
--
-- -   Must be at least 30 minutes.
--
-- 'preferredMaintenanceWindow', 'updateRelationalDatabase_preferredMaintenanceWindow' - The weekly time range during which system maintenance can occur on your
-- database.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each Amazon Web Services Region, occurring on a random
-- day of the week.
--
-- Constraints:
--
-- -   Must be in the @ddd:hh24:mi-ddd:hh24:mi@ format.
--
-- -   Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
--
-- -   Must be at least 30 minutes.
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Example: @Tue:17:00-Tue:17:30@
--
-- 'publiclyAccessible', 'updateRelationalDatabase_publiclyAccessible' - Specifies the accessibility options for your database. A value of @true@
-- specifies a database that is available to resources outside of your
-- Lightsail account. A value of @false@ specifies a database that is
-- available only to your Lightsail resources in the same region as your
-- database.
--
-- 'rotateMasterUserPassword', 'updateRelationalDatabase_rotateMasterUserPassword' - When @true@, the master user password is changed to a new strong
-- password generated by Lightsail.
--
-- Use the @get relational database master user password@ operation to get
-- the new password.
--
-- 'relationalDatabaseName', 'updateRelationalDatabase_relationalDatabaseName' - The name of your Lightsail database resource to update.
newUpdateRelationalDatabase ::
  -- | 'relationalDatabaseName'
  Prelude.Text ->
  UpdateRelationalDatabase
newUpdateRelationalDatabase :: Text -> UpdateRelationalDatabase
newUpdateRelationalDatabase Text
pRelationalDatabaseName_ =
  UpdateRelationalDatabase'
    { $sel:applyImmediately:UpdateRelationalDatabase' :: Maybe Bool
applyImmediately =
        forall a. Maybe a
Prelude.Nothing,
      $sel:caCertificateIdentifier:UpdateRelationalDatabase' :: Maybe Text
caCertificateIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:disableBackupRetention:UpdateRelationalDatabase' :: Maybe Bool
disableBackupRetention = forall a. Maybe a
Prelude.Nothing,
      $sel:enableBackupRetention:UpdateRelationalDatabase' :: Maybe Bool
enableBackupRetention = forall a. Maybe a
Prelude.Nothing,
      $sel:masterUserPassword:UpdateRelationalDatabase' :: Maybe (Sensitive Text)
masterUserPassword = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredBackupWindow:UpdateRelationalDatabase' :: Maybe Text
preferredBackupWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:UpdateRelationalDatabase' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:publiclyAccessible:UpdateRelationalDatabase' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
      $sel:rotateMasterUserPassword:UpdateRelationalDatabase' :: Maybe Bool
rotateMasterUserPassword = forall a. Maybe a
Prelude.Nothing,
      $sel:relationalDatabaseName:UpdateRelationalDatabase' :: Text
relationalDatabaseName = Text
pRelationalDatabaseName_
    }

-- | When @true@, applies changes immediately. When @false@, applies changes
-- during the preferred maintenance window. Some changes may cause an
-- outage.
--
-- Default: @false@
updateRelationalDatabase_applyImmediately :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Bool)
updateRelationalDatabase_applyImmediately :: Lens' UpdateRelationalDatabase (Maybe Bool)
updateRelationalDatabase_applyImmediately = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Bool
applyImmediately :: Maybe Bool
$sel:applyImmediately:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
applyImmediately} -> Maybe Bool
applyImmediately) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Bool
a -> UpdateRelationalDatabase
s {$sel:applyImmediately:UpdateRelationalDatabase' :: Maybe Bool
applyImmediately = Maybe Bool
a} :: UpdateRelationalDatabase)

-- | Indicates the certificate that needs to be associated with the database.
updateRelationalDatabase_caCertificateIdentifier :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Text)
updateRelationalDatabase_caCertificateIdentifier :: Lens' UpdateRelationalDatabase (Maybe Text)
updateRelationalDatabase_caCertificateIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Text
caCertificateIdentifier :: Maybe Text
$sel:caCertificateIdentifier:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
caCertificateIdentifier} -> Maybe Text
caCertificateIdentifier) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Text
a -> UpdateRelationalDatabase
s {$sel:caCertificateIdentifier:UpdateRelationalDatabase' :: Maybe Text
caCertificateIdentifier = Maybe Text
a} :: UpdateRelationalDatabase)

-- | When @true@, disables automated backup retention for your database.
--
-- Disabling backup retention deletes all automated database backups.
-- Before disabling this, you may want to create a snapshot of your
-- database using the @create relational database snapshot@ operation.
--
-- Updates are applied during the next maintenance window because this can
-- result in an outage.
updateRelationalDatabase_disableBackupRetention :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Bool)
updateRelationalDatabase_disableBackupRetention :: Lens' UpdateRelationalDatabase (Maybe Bool)
updateRelationalDatabase_disableBackupRetention = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Bool
disableBackupRetention :: Maybe Bool
$sel:disableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
disableBackupRetention} -> Maybe Bool
disableBackupRetention) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Bool
a -> UpdateRelationalDatabase
s {$sel:disableBackupRetention:UpdateRelationalDatabase' :: Maybe Bool
disableBackupRetention = Maybe Bool
a} :: UpdateRelationalDatabase)

-- | When @true@, enables automated backup retention for your database.
--
-- Updates are applied during the next maintenance window because this can
-- result in an outage.
updateRelationalDatabase_enableBackupRetention :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Bool)
updateRelationalDatabase_enableBackupRetention :: Lens' UpdateRelationalDatabase (Maybe Bool)
updateRelationalDatabase_enableBackupRetention = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Bool
enableBackupRetention :: Maybe Bool
$sel:enableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
enableBackupRetention} -> Maybe Bool
enableBackupRetention) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Bool
a -> UpdateRelationalDatabase
s {$sel:enableBackupRetention:UpdateRelationalDatabase' :: Maybe Bool
enableBackupRetention = Maybe Bool
a} :: UpdateRelationalDatabase)

-- | The password for the master user. The password can include any printable
-- ASCII character except \"\/\", \"\"\", or \"\@\".
--
-- My__SQL__
--
-- Constraints: Must contain from 8 to 41 characters.
--
-- __PostgreSQL__
--
-- Constraints: Must contain from 8 to 128 characters.
updateRelationalDatabase_masterUserPassword :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Text)
updateRelationalDatabase_masterUserPassword :: Lens' UpdateRelationalDatabase (Maybe Text)
updateRelationalDatabase_masterUserPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe (Sensitive Text)
masterUserPassword :: Maybe (Sensitive Text)
$sel:masterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe (Sensitive Text)
masterUserPassword} -> Maybe (Sensitive Text)
masterUserPassword) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe (Sensitive Text)
a -> UpdateRelationalDatabase
s {$sel:masterUserPassword:UpdateRelationalDatabase' :: Maybe (Sensitive Text)
masterUserPassword = Maybe (Sensitive Text)
a} :: UpdateRelationalDatabase) 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 daily time range during which automated backups are created for your
-- database if automated backups are enabled.
--
-- Constraints:
--
-- -   Must be in the @hh24:mi-hh24:mi@ format.
--
--     Example: @16:00-16:30@
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Must not conflict with the preferred maintenance window.
--
-- -   Must be at least 30 minutes.
updateRelationalDatabase_preferredBackupWindow :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Text)
updateRelationalDatabase_preferredBackupWindow :: Lens' UpdateRelationalDatabase (Maybe Text)
updateRelationalDatabase_preferredBackupWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Text
preferredBackupWindow :: Maybe Text
$sel:preferredBackupWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
preferredBackupWindow} -> Maybe Text
preferredBackupWindow) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Text
a -> UpdateRelationalDatabase
s {$sel:preferredBackupWindow:UpdateRelationalDatabase' :: Maybe Text
preferredBackupWindow = Maybe Text
a} :: UpdateRelationalDatabase)

-- | The weekly time range during which system maintenance can occur on your
-- database.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each Amazon Web Services Region, occurring on a random
-- day of the week.
--
-- Constraints:
--
-- -   Must be in the @ddd:hh24:mi-ddd:hh24:mi@ format.
--
-- -   Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
--
-- -   Must be at least 30 minutes.
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Example: @Tue:17:00-Tue:17:30@
updateRelationalDatabase_preferredMaintenanceWindow :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Text)
updateRelationalDatabase_preferredMaintenanceWindow :: Lens' UpdateRelationalDatabase (Maybe Text)
updateRelationalDatabase_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Text
a -> UpdateRelationalDatabase
s {$sel:preferredMaintenanceWindow:UpdateRelationalDatabase' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: UpdateRelationalDatabase)

-- | Specifies the accessibility options for your database. A value of @true@
-- specifies a database that is available to resources outside of your
-- Lightsail account. A value of @false@ specifies a database that is
-- available only to your Lightsail resources in the same region as your
-- database.
updateRelationalDatabase_publiclyAccessible :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Bool)
updateRelationalDatabase_publiclyAccessible :: Lens' UpdateRelationalDatabase (Maybe Bool)
updateRelationalDatabase_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Bool
a -> UpdateRelationalDatabase
s {$sel:publiclyAccessible:UpdateRelationalDatabase' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: UpdateRelationalDatabase)

-- | When @true@, the master user password is changed to a new strong
-- password generated by Lightsail.
--
-- Use the @get relational database master user password@ operation to get
-- the new password.
updateRelationalDatabase_rotateMasterUserPassword :: Lens.Lens' UpdateRelationalDatabase (Prelude.Maybe Prelude.Bool)
updateRelationalDatabase_rotateMasterUserPassword :: Lens' UpdateRelationalDatabase (Maybe Bool)
updateRelationalDatabase_rotateMasterUserPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Maybe Bool
rotateMasterUserPassword :: Maybe Bool
$sel:rotateMasterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
rotateMasterUserPassword} -> Maybe Bool
rotateMasterUserPassword) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Maybe Bool
a -> UpdateRelationalDatabase
s {$sel:rotateMasterUserPassword:UpdateRelationalDatabase' :: Maybe Bool
rotateMasterUserPassword = Maybe Bool
a} :: UpdateRelationalDatabase)

-- | The name of your Lightsail database resource to update.
updateRelationalDatabase_relationalDatabaseName :: Lens.Lens' UpdateRelationalDatabase Prelude.Text
updateRelationalDatabase_relationalDatabaseName :: Lens' UpdateRelationalDatabase Text
updateRelationalDatabase_relationalDatabaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabase' {Text
relationalDatabaseName :: Text
$sel:relationalDatabaseName:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Text
relationalDatabaseName} -> Text
relationalDatabaseName) (\s :: UpdateRelationalDatabase
s@UpdateRelationalDatabase' {} Text
a -> UpdateRelationalDatabase
s {$sel:relationalDatabaseName:UpdateRelationalDatabase' :: Text
relationalDatabaseName = Text
a} :: UpdateRelationalDatabase)

instance Core.AWSRequest UpdateRelationalDatabase where
  type
    AWSResponse UpdateRelationalDatabase =
      UpdateRelationalDatabaseResponse
  request :: (Service -> Service)
-> UpdateRelationalDatabase -> Request UpdateRelationalDatabase
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 UpdateRelationalDatabase
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateRelationalDatabase)))
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 [Operation] -> Int -> UpdateRelationalDatabaseResponse
UpdateRelationalDatabaseResponse'
            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
"operations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 UpdateRelationalDatabase where
  hashWithSalt :: Int -> UpdateRelationalDatabase -> Int
hashWithSalt Int
_salt UpdateRelationalDatabase' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Text
relationalDatabaseName :: Text
rotateMasterUserPassword :: Maybe Bool
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
masterUserPassword :: Maybe (Sensitive Text)
enableBackupRetention :: Maybe Bool
disableBackupRetention :: Maybe Bool
caCertificateIdentifier :: Maybe Text
applyImmediately :: Maybe Bool
$sel:relationalDatabaseName:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Text
$sel:rotateMasterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:publiclyAccessible:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:preferredMaintenanceWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:preferredBackupWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:masterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe (Sensitive Text)
$sel:enableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:disableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:caCertificateIdentifier:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:applyImmediately:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
applyImmediately
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
caCertificateIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
disableBackupRetention
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableBackupRetention
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
masterUserPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredBackupWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
publiclyAccessible
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
rotateMasterUserPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
relationalDatabaseName

instance Prelude.NFData UpdateRelationalDatabase where
  rnf :: UpdateRelationalDatabase -> ()
rnf UpdateRelationalDatabase' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Text
relationalDatabaseName :: Text
rotateMasterUserPassword :: Maybe Bool
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
masterUserPassword :: Maybe (Sensitive Text)
enableBackupRetention :: Maybe Bool
disableBackupRetention :: Maybe Bool
caCertificateIdentifier :: Maybe Text
applyImmediately :: Maybe Bool
$sel:relationalDatabaseName:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Text
$sel:rotateMasterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:publiclyAccessible:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:preferredMaintenanceWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:preferredBackupWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:masterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe (Sensitive Text)
$sel:enableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:disableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:caCertificateIdentifier:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:applyImmediately:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
applyImmediately
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
caCertificateIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
disableBackupRetention
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableBackupRetention
      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 Maybe Text
preferredBackupWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
publiclyAccessible
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
rotateMasterUserPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
relationalDatabaseName

instance Data.ToHeaders UpdateRelationalDatabase where
  toHeaders :: UpdateRelationalDatabase -> 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.UpdateRelationalDatabase" ::
                          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 UpdateRelationalDatabase where
  toJSON :: UpdateRelationalDatabase -> Value
toJSON UpdateRelationalDatabase' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Text
relationalDatabaseName :: Text
rotateMasterUserPassword :: Maybe Bool
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
masterUserPassword :: Maybe (Sensitive Text)
enableBackupRetention :: Maybe Bool
disableBackupRetention :: Maybe Bool
caCertificateIdentifier :: Maybe Text
applyImmediately :: Maybe Bool
$sel:relationalDatabaseName:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Text
$sel:rotateMasterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:publiclyAccessible:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:preferredMaintenanceWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:preferredBackupWindow:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:masterUserPassword:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe (Sensitive Text)
$sel:enableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:disableBackupRetention:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
$sel:caCertificateIdentifier:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Text
$sel:applyImmediately:UpdateRelationalDatabase' :: UpdateRelationalDatabase -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"applyImmediately" 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 Bool
applyImmediately,
            (Key
"caCertificateIdentifier" 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 Text
caCertificateIdentifier,
            (Key
"disableBackupRetention" 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 Bool
disableBackupRetention,
            (Key
"enableBackupRetention" 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 Bool
enableBackupRetention,
            (Key
"masterUserPassword" 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 (Sensitive Text)
masterUserPassword,
            (Key
"preferredBackupWindow" 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 Text
preferredBackupWindow,
            (Key
"preferredMaintenanceWindow" 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 Text
preferredMaintenanceWindow,
            (Key
"publiclyAccessible" 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 Bool
publiclyAccessible,
            (Key
"rotateMasterUserPassword" 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 Bool
rotateMasterUserPassword,
            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 UpdateRelationalDatabase where
  toPath :: UpdateRelationalDatabase -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdateRelationalDatabaseResponse' smart constructor.
data UpdateRelationalDatabaseResponse = UpdateRelationalDatabaseResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    UpdateRelationalDatabaseResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    UpdateRelationalDatabaseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateRelationalDatabaseResponse
-> UpdateRelationalDatabaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRelationalDatabaseResponse
-> UpdateRelationalDatabaseResponse -> Bool
$c/= :: UpdateRelationalDatabaseResponse
-> UpdateRelationalDatabaseResponse -> Bool
== :: UpdateRelationalDatabaseResponse
-> UpdateRelationalDatabaseResponse -> Bool
$c== :: UpdateRelationalDatabaseResponse
-> UpdateRelationalDatabaseResponse -> Bool
Prelude.Eq, ReadPrec [UpdateRelationalDatabaseResponse]
ReadPrec UpdateRelationalDatabaseResponse
Int -> ReadS UpdateRelationalDatabaseResponse
ReadS [UpdateRelationalDatabaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRelationalDatabaseResponse]
$creadListPrec :: ReadPrec [UpdateRelationalDatabaseResponse]
readPrec :: ReadPrec UpdateRelationalDatabaseResponse
$creadPrec :: ReadPrec UpdateRelationalDatabaseResponse
readList :: ReadS [UpdateRelationalDatabaseResponse]
$creadList :: ReadS [UpdateRelationalDatabaseResponse]
readsPrec :: Int -> ReadS UpdateRelationalDatabaseResponse
$creadsPrec :: Int -> ReadS UpdateRelationalDatabaseResponse
Prelude.Read, Int -> UpdateRelationalDatabaseResponse -> ShowS
[UpdateRelationalDatabaseResponse] -> ShowS
UpdateRelationalDatabaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRelationalDatabaseResponse] -> ShowS
$cshowList :: [UpdateRelationalDatabaseResponse] -> ShowS
show :: UpdateRelationalDatabaseResponse -> String
$cshow :: UpdateRelationalDatabaseResponse -> String
showsPrec :: Int -> UpdateRelationalDatabaseResponse -> ShowS
$cshowsPrec :: Int -> UpdateRelationalDatabaseResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateRelationalDatabaseResponse x
-> UpdateRelationalDatabaseResponse
forall x.
UpdateRelationalDatabaseResponse
-> Rep UpdateRelationalDatabaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRelationalDatabaseResponse x
-> UpdateRelationalDatabaseResponse
$cfrom :: forall x.
UpdateRelationalDatabaseResponse
-> Rep UpdateRelationalDatabaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRelationalDatabaseResponse' 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:
--
-- 'operations', 'updateRelationalDatabaseResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'updateRelationalDatabaseResponse_httpStatus' - The response's http status code.
newUpdateRelationalDatabaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateRelationalDatabaseResponse
newUpdateRelationalDatabaseResponse :: Int -> UpdateRelationalDatabaseResponse
newUpdateRelationalDatabaseResponse Int
pHttpStatus_ =
  UpdateRelationalDatabaseResponse'
    { $sel:operations:UpdateRelationalDatabaseResponse' :: Maybe [Operation]
operations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateRelationalDatabaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
updateRelationalDatabaseResponse_operations :: Lens.Lens' UpdateRelationalDatabaseResponse (Prelude.Maybe [Operation])
updateRelationalDatabaseResponse_operations :: Lens' UpdateRelationalDatabaseResponse (Maybe [Operation])
updateRelationalDatabaseResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabaseResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:UpdateRelationalDatabaseResponse' :: UpdateRelationalDatabaseResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: UpdateRelationalDatabaseResponse
s@UpdateRelationalDatabaseResponse' {} Maybe [Operation]
a -> UpdateRelationalDatabaseResponse
s {$sel:operations:UpdateRelationalDatabaseResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: UpdateRelationalDatabaseResponse) 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 response's http status code.
updateRelationalDatabaseResponse_httpStatus :: Lens.Lens' UpdateRelationalDatabaseResponse Prelude.Int
updateRelationalDatabaseResponse_httpStatus :: Lens' UpdateRelationalDatabaseResponse Int
updateRelationalDatabaseResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRelationalDatabaseResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateRelationalDatabaseResponse' :: UpdateRelationalDatabaseResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateRelationalDatabaseResponse
s@UpdateRelationalDatabaseResponse' {} Int
a -> UpdateRelationalDatabaseResponse
s {$sel:httpStatus:UpdateRelationalDatabaseResponse' :: Int
httpStatus = Int
a} :: UpdateRelationalDatabaseResponse)

instance
  Prelude.NFData
    UpdateRelationalDatabaseResponse
  where
  rnf :: UpdateRelationalDatabaseResponse -> ()
rnf UpdateRelationalDatabaseResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:UpdateRelationalDatabaseResponse' :: UpdateRelationalDatabaseResponse -> Int
$sel:operations:UpdateRelationalDatabaseResponse' :: UpdateRelationalDatabaseResponse -> Maybe [Operation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Operation]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus