{-# 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.RDS.StopDBInstance
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops an Amazon RDS DB instance. When you stop a DB instance, Amazon RDS
-- retains the DB instance\'s metadata, including its endpoint, DB
-- parameter group, and option group membership. Amazon RDS also retains
-- the transaction logs so you can do a point-in-time restore if necessary.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_StopInstance.html Stopping an Amazon RDS DB Instance Temporarily>
-- in the /Amazon RDS User Guide./
--
-- This command doesn\'t apply to RDS Custom, Aurora MySQL, and Aurora
-- PostgreSQL. For Aurora clusters, use @StopDBCluster@ instead.
module Amazonka.RDS.StopDBInstance
  ( -- * Creating a Request
    StopDBInstance (..),
    newStopDBInstance,

    -- * Request Lenses
    stopDBInstance_dbSnapshotIdentifier,
    stopDBInstance_dbInstanceIdentifier,

    -- * Destructuring the Response
    StopDBInstanceResponse (..),
    newStopDBInstanceResponse,

    -- * Response Lenses
    stopDBInstanceResponse_dbInstance,
    stopDBInstanceResponse_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.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newStopDBInstance' smart constructor.
data StopDBInstance = StopDBInstance'
  { -- | The user-supplied instance identifier of the DB Snapshot created
    -- immediately before the DB instance is stopped.
    StopDBInstance -> Maybe Text
dbSnapshotIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The user-supplied instance identifier.
    StopDBInstance -> Text
dbInstanceIdentifier :: Prelude.Text
  }
  deriving (StopDBInstance -> StopDBInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopDBInstance -> StopDBInstance -> Bool
$c/= :: StopDBInstance -> StopDBInstance -> Bool
== :: StopDBInstance -> StopDBInstance -> Bool
$c== :: StopDBInstance -> StopDBInstance -> Bool
Prelude.Eq, ReadPrec [StopDBInstance]
ReadPrec StopDBInstance
Int -> ReadS StopDBInstance
ReadS [StopDBInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopDBInstance]
$creadListPrec :: ReadPrec [StopDBInstance]
readPrec :: ReadPrec StopDBInstance
$creadPrec :: ReadPrec StopDBInstance
readList :: ReadS [StopDBInstance]
$creadList :: ReadS [StopDBInstance]
readsPrec :: Int -> ReadS StopDBInstance
$creadsPrec :: Int -> ReadS StopDBInstance
Prelude.Read, Int -> StopDBInstance -> ShowS
[StopDBInstance] -> ShowS
StopDBInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopDBInstance] -> ShowS
$cshowList :: [StopDBInstance] -> ShowS
show :: StopDBInstance -> String
$cshow :: StopDBInstance -> String
showsPrec :: Int -> StopDBInstance -> ShowS
$cshowsPrec :: Int -> StopDBInstance -> ShowS
Prelude.Show, forall x. Rep StopDBInstance x -> StopDBInstance
forall x. StopDBInstance -> Rep StopDBInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopDBInstance x -> StopDBInstance
$cfrom :: forall x. StopDBInstance -> Rep StopDBInstance x
Prelude.Generic)

-- |
-- Create a value of 'StopDBInstance' 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:
--
-- 'dbSnapshotIdentifier', 'stopDBInstance_dbSnapshotIdentifier' - The user-supplied instance identifier of the DB Snapshot created
-- immediately before the DB instance is stopped.
--
-- 'dbInstanceIdentifier', 'stopDBInstance_dbInstanceIdentifier' - The user-supplied instance identifier.
newStopDBInstance ::
  -- | 'dbInstanceIdentifier'
  Prelude.Text ->
  StopDBInstance
newStopDBInstance :: Text -> StopDBInstance
newStopDBInstance Text
pDBInstanceIdentifier_ =
  StopDBInstance'
    { $sel:dbSnapshotIdentifier:StopDBInstance' :: Maybe Text
dbSnapshotIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceIdentifier:StopDBInstance' :: Text
dbInstanceIdentifier = Text
pDBInstanceIdentifier_
    }

-- | The user-supplied instance identifier of the DB Snapshot created
-- immediately before the DB instance is stopped.
stopDBInstance_dbSnapshotIdentifier :: Lens.Lens' StopDBInstance (Prelude.Maybe Prelude.Text)
stopDBInstance_dbSnapshotIdentifier :: Lens' StopDBInstance (Maybe Text)
stopDBInstance_dbSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopDBInstance' {Maybe Text
dbSnapshotIdentifier :: Maybe Text
$sel:dbSnapshotIdentifier:StopDBInstance' :: StopDBInstance -> Maybe Text
dbSnapshotIdentifier} -> Maybe Text
dbSnapshotIdentifier) (\s :: StopDBInstance
s@StopDBInstance' {} Maybe Text
a -> StopDBInstance
s {$sel:dbSnapshotIdentifier:StopDBInstance' :: Maybe Text
dbSnapshotIdentifier = Maybe Text
a} :: StopDBInstance)

-- | The user-supplied instance identifier.
stopDBInstance_dbInstanceIdentifier :: Lens.Lens' StopDBInstance Prelude.Text
stopDBInstance_dbInstanceIdentifier :: Lens' StopDBInstance Text
stopDBInstance_dbInstanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopDBInstance' {Text
dbInstanceIdentifier :: Text
$sel:dbInstanceIdentifier:StopDBInstance' :: StopDBInstance -> Text
dbInstanceIdentifier} -> Text
dbInstanceIdentifier) (\s :: StopDBInstance
s@StopDBInstance' {} Text
a -> StopDBInstance
s {$sel:dbInstanceIdentifier:StopDBInstance' :: Text
dbInstanceIdentifier = Text
a} :: StopDBInstance)

instance Core.AWSRequest StopDBInstance where
  type
    AWSResponse StopDBInstance =
      StopDBInstanceResponse
  request :: (Service -> Service) -> StopDBInstance -> Request StopDBInstance
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 StopDBInstance
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopDBInstance)))
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
"StopDBInstanceResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBInstance -> Int -> StopDBInstanceResponse
StopDBInstanceResponse'
            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
"DBInstance")
            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 StopDBInstance where
  hashWithSalt :: Int -> StopDBInstance -> Int
hashWithSalt Int
_salt StopDBInstance' {Maybe Text
Text
dbInstanceIdentifier :: Text
dbSnapshotIdentifier :: Maybe Text
$sel:dbInstanceIdentifier:StopDBInstance' :: StopDBInstance -> Text
$sel:dbSnapshotIdentifier:StopDBInstance' :: StopDBInstance -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbSnapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbInstanceIdentifier

instance Prelude.NFData StopDBInstance where
  rnf :: StopDBInstance -> ()
rnf StopDBInstance' {Maybe Text
Text
dbInstanceIdentifier :: Text
dbSnapshotIdentifier :: Maybe Text
$sel:dbInstanceIdentifier:StopDBInstance' :: StopDBInstance -> Text
$sel:dbSnapshotIdentifier:StopDBInstance' :: StopDBInstance -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbSnapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbInstanceIdentifier

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

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

instance Data.ToQuery StopDBInstance where
  toQuery :: StopDBInstance -> QueryString
toQuery StopDBInstance' {Maybe Text
Text
dbInstanceIdentifier :: Text
dbSnapshotIdentifier :: Maybe Text
$sel:dbInstanceIdentifier:StopDBInstance' :: StopDBInstance -> Text
$sel:dbSnapshotIdentifier:StopDBInstance' :: StopDBInstance -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"StopDBInstance" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBSnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbSnapshotIdentifier,
        ByteString
"DBInstanceIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbInstanceIdentifier
      ]

-- | /See:/ 'newStopDBInstanceResponse' smart constructor.
data StopDBInstanceResponse = StopDBInstanceResponse'
  { StopDBInstanceResponse -> Maybe DBInstance
dbInstance :: Prelude.Maybe DBInstance,
    -- | The response's http status code.
    StopDBInstanceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StopDBInstanceResponse -> StopDBInstanceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopDBInstanceResponse -> StopDBInstanceResponse -> Bool
$c/= :: StopDBInstanceResponse -> StopDBInstanceResponse -> Bool
== :: StopDBInstanceResponse -> StopDBInstanceResponse -> Bool
$c== :: StopDBInstanceResponse -> StopDBInstanceResponse -> Bool
Prelude.Eq, ReadPrec [StopDBInstanceResponse]
ReadPrec StopDBInstanceResponse
Int -> ReadS StopDBInstanceResponse
ReadS [StopDBInstanceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopDBInstanceResponse]
$creadListPrec :: ReadPrec [StopDBInstanceResponse]
readPrec :: ReadPrec StopDBInstanceResponse
$creadPrec :: ReadPrec StopDBInstanceResponse
readList :: ReadS [StopDBInstanceResponse]
$creadList :: ReadS [StopDBInstanceResponse]
readsPrec :: Int -> ReadS StopDBInstanceResponse
$creadsPrec :: Int -> ReadS StopDBInstanceResponse
Prelude.Read, Int -> StopDBInstanceResponse -> ShowS
[StopDBInstanceResponse] -> ShowS
StopDBInstanceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopDBInstanceResponse] -> ShowS
$cshowList :: [StopDBInstanceResponse] -> ShowS
show :: StopDBInstanceResponse -> String
$cshow :: StopDBInstanceResponse -> String
showsPrec :: Int -> StopDBInstanceResponse -> ShowS
$cshowsPrec :: Int -> StopDBInstanceResponse -> ShowS
Prelude.Show, forall x. Rep StopDBInstanceResponse x -> StopDBInstanceResponse
forall x. StopDBInstanceResponse -> Rep StopDBInstanceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopDBInstanceResponse x -> StopDBInstanceResponse
$cfrom :: forall x. StopDBInstanceResponse -> Rep StopDBInstanceResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopDBInstanceResponse' 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:
--
-- 'dbInstance', 'stopDBInstanceResponse_dbInstance' - Undocumented member.
--
-- 'httpStatus', 'stopDBInstanceResponse_httpStatus' - The response's http status code.
newStopDBInstanceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopDBInstanceResponse
newStopDBInstanceResponse :: Int -> StopDBInstanceResponse
newStopDBInstanceResponse Int
pHttpStatus_ =
  StopDBInstanceResponse'
    { $sel:dbInstance:StopDBInstanceResponse' :: Maybe DBInstance
dbInstance =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopDBInstanceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
stopDBInstanceResponse_dbInstance :: Lens.Lens' StopDBInstanceResponse (Prelude.Maybe DBInstance)
stopDBInstanceResponse_dbInstance :: Lens' StopDBInstanceResponse (Maybe DBInstance)
stopDBInstanceResponse_dbInstance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopDBInstanceResponse' {Maybe DBInstance
dbInstance :: Maybe DBInstance
$sel:dbInstance:StopDBInstanceResponse' :: StopDBInstanceResponse -> Maybe DBInstance
dbInstance} -> Maybe DBInstance
dbInstance) (\s :: StopDBInstanceResponse
s@StopDBInstanceResponse' {} Maybe DBInstance
a -> StopDBInstanceResponse
s {$sel:dbInstance:StopDBInstanceResponse' :: Maybe DBInstance
dbInstance = Maybe DBInstance
a} :: StopDBInstanceResponse)

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

instance Prelude.NFData StopDBInstanceResponse where
  rnf :: StopDBInstanceResponse -> ()
rnf StopDBInstanceResponse' {Int
Maybe DBInstance
httpStatus :: Int
dbInstance :: Maybe DBInstance
$sel:httpStatus:StopDBInstanceResponse' :: StopDBInstanceResponse -> Int
$sel:dbInstance:StopDBInstanceResponse' :: StopDBInstanceResponse -> Maybe DBInstance
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DBInstance
dbInstance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus