{-# 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.StartDBInstance
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts an Amazon RDS DB instance that was stopped using the Amazon Web
-- Services console, the stop-db-instance CLI command, or the
-- StopDBInstance action.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_StartInstance.html Starting an Amazon RDS DB instance That Was Previously Stopped>
-- in the /Amazon RDS User Guide./
--
-- This command doesn\'t apply to RDS Custom, Aurora MySQL, and Aurora
-- PostgreSQL. For Aurora DB clusters, use @StartDBCluster@ instead.
module Amazonka.RDS.StartDBInstance
  ( -- * Creating a Request
    StartDBInstance (..),
    newStartDBInstance,

    -- * Request Lenses
    startDBInstance_dbInstanceIdentifier,

    -- * Destructuring the Response
    StartDBInstanceResponse (..),
    newStartDBInstanceResponse,

    -- * Response Lenses
    startDBInstanceResponse_dbInstance,
    startDBInstanceResponse_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:/ 'newStartDBInstance' smart constructor.
data StartDBInstance = StartDBInstance'
  { -- | The user-supplied instance identifier.
    StartDBInstance -> Text
dbInstanceIdentifier :: Prelude.Text
  }
  deriving (StartDBInstance -> StartDBInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartDBInstance -> StartDBInstance -> Bool
$c/= :: StartDBInstance -> StartDBInstance -> Bool
== :: StartDBInstance -> StartDBInstance -> Bool
$c== :: StartDBInstance -> StartDBInstance -> Bool
Prelude.Eq, ReadPrec [StartDBInstance]
ReadPrec StartDBInstance
Int -> ReadS StartDBInstance
ReadS [StartDBInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartDBInstance]
$creadListPrec :: ReadPrec [StartDBInstance]
readPrec :: ReadPrec StartDBInstance
$creadPrec :: ReadPrec StartDBInstance
readList :: ReadS [StartDBInstance]
$creadList :: ReadS [StartDBInstance]
readsPrec :: Int -> ReadS StartDBInstance
$creadsPrec :: Int -> ReadS StartDBInstance
Prelude.Read, Int -> StartDBInstance -> ShowS
[StartDBInstance] -> ShowS
StartDBInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartDBInstance] -> ShowS
$cshowList :: [StartDBInstance] -> ShowS
show :: StartDBInstance -> String
$cshow :: StartDBInstance -> String
showsPrec :: Int -> StartDBInstance -> ShowS
$cshowsPrec :: Int -> StartDBInstance -> ShowS
Prelude.Show, forall x. Rep StartDBInstance x -> StartDBInstance
forall x. StartDBInstance -> Rep StartDBInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartDBInstance x -> StartDBInstance
$cfrom :: forall x. StartDBInstance -> Rep StartDBInstance x
Prelude.Generic)

-- |
-- Create a value of 'StartDBInstance' 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:
--
-- 'dbInstanceIdentifier', 'startDBInstance_dbInstanceIdentifier' - The user-supplied instance identifier.
newStartDBInstance ::
  -- | 'dbInstanceIdentifier'
  Prelude.Text ->
  StartDBInstance
newStartDBInstance :: Text -> StartDBInstance
newStartDBInstance Text
pDBInstanceIdentifier_ =
  StartDBInstance'
    { $sel:dbInstanceIdentifier:StartDBInstance' :: Text
dbInstanceIdentifier =
        Text
pDBInstanceIdentifier_
    }

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

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

instance Prelude.NFData StartDBInstance where
  rnf :: StartDBInstance -> ()
rnf StartDBInstance' {Text
dbInstanceIdentifier :: Text
$sel:dbInstanceIdentifier:StartDBInstance' :: StartDBInstance -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
dbInstanceIdentifier

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

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

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

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

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

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

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

instance Prelude.NFData StartDBInstanceResponse where
  rnf :: StartDBInstanceResponse -> ()
rnf StartDBInstanceResponse' {Int
Maybe DBInstance
httpStatus :: Int
dbInstance :: Maybe DBInstance
$sel:httpStatus:StartDBInstanceResponse' :: StartDBInstanceResponse -> Int
$sel:dbInstance:StartDBInstanceResponse' :: StartDBInstanceResponse -> 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