{-# 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.OpsWorks.RegisterRdsDbInstance
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers an Amazon RDS instance with a stack.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.RegisterRdsDbInstance
  ( -- * Creating a Request
    RegisterRdsDbInstance (..),
    newRegisterRdsDbInstance,

    -- * Request Lenses
    registerRdsDbInstance_stackId,
    registerRdsDbInstance_rdsDbInstanceArn,
    registerRdsDbInstance_dbUser,
    registerRdsDbInstance_dbPassword,

    -- * Destructuring the Response
    RegisterRdsDbInstanceResponse (..),
    newRegisterRdsDbInstanceResponse,
  )
where

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

-- | /See:/ 'newRegisterRdsDbInstance' smart constructor.
data RegisterRdsDbInstance = RegisterRdsDbInstance'
  { -- | The stack ID.
    RegisterRdsDbInstance -> Text
stackId :: Prelude.Text,
    -- | The Amazon RDS instance\'s ARN.
    RegisterRdsDbInstance -> Text
rdsDbInstanceArn :: Prelude.Text,
    -- | The database\'s master user name.
    RegisterRdsDbInstance -> Text
dbUser :: Prelude.Text,
    -- | The database password.
    RegisterRdsDbInstance -> Text
dbPassword :: Prelude.Text
  }
  deriving (RegisterRdsDbInstance -> RegisterRdsDbInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterRdsDbInstance -> RegisterRdsDbInstance -> Bool
$c/= :: RegisterRdsDbInstance -> RegisterRdsDbInstance -> Bool
== :: RegisterRdsDbInstance -> RegisterRdsDbInstance -> Bool
$c== :: RegisterRdsDbInstance -> RegisterRdsDbInstance -> Bool
Prelude.Eq, ReadPrec [RegisterRdsDbInstance]
ReadPrec RegisterRdsDbInstance
Int -> ReadS RegisterRdsDbInstance
ReadS [RegisterRdsDbInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterRdsDbInstance]
$creadListPrec :: ReadPrec [RegisterRdsDbInstance]
readPrec :: ReadPrec RegisterRdsDbInstance
$creadPrec :: ReadPrec RegisterRdsDbInstance
readList :: ReadS [RegisterRdsDbInstance]
$creadList :: ReadS [RegisterRdsDbInstance]
readsPrec :: Int -> ReadS RegisterRdsDbInstance
$creadsPrec :: Int -> ReadS RegisterRdsDbInstance
Prelude.Read, Int -> RegisterRdsDbInstance -> ShowS
[RegisterRdsDbInstance] -> ShowS
RegisterRdsDbInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterRdsDbInstance] -> ShowS
$cshowList :: [RegisterRdsDbInstance] -> ShowS
show :: RegisterRdsDbInstance -> String
$cshow :: RegisterRdsDbInstance -> String
showsPrec :: Int -> RegisterRdsDbInstance -> ShowS
$cshowsPrec :: Int -> RegisterRdsDbInstance -> ShowS
Prelude.Show, forall x. Rep RegisterRdsDbInstance x -> RegisterRdsDbInstance
forall x. RegisterRdsDbInstance -> Rep RegisterRdsDbInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterRdsDbInstance x -> RegisterRdsDbInstance
$cfrom :: forall x. RegisterRdsDbInstance -> Rep RegisterRdsDbInstance x
Prelude.Generic)

-- |
-- Create a value of 'RegisterRdsDbInstance' 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:
--
-- 'stackId', 'registerRdsDbInstance_stackId' - The stack ID.
--
-- 'rdsDbInstanceArn', 'registerRdsDbInstance_rdsDbInstanceArn' - The Amazon RDS instance\'s ARN.
--
-- 'dbUser', 'registerRdsDbInstance_dbUser' - The database\'s master user name.
--
-- 'dbPassword', 'registerRdsDbInstance_dbPassword' - The database password.
newRegisterRdsDbInstance ::
  -- | 'stackId'
  Prelude.Text ->
  -- | 'rdsDbInstanceArn'
  Prelude.Text ->
  -- | 'dbUser'
  Prelude.Text ->
  -- | 'dbPassword'
  Prelude.Text ->
  RegisterRdsDbInstance
newRegisterRdsDbInstance :: Text -> Text -> Text -> Text -> RegisterRdsDbInstance
newRegisterRdsDbInstance
  Text
pStackId_
  Text
pRdsDbInstanceArn_
  Text
pDbUser_
  Text
pDbPassword_ =
    RegisterRdsDbInstance'
      { $sel:stackId:RegisterRdsDbInstance' :: Text
stackId = Text
pStackId_,
        $sel:rdsDbInstanceArn:RegisterRdsDbInstance' :: Text
rdsDbInstanceArn = Text
pRdsDbInstanceArn_,
        $sel:dbUser:RegisterRdsDbInstance' :: Text
dbUser = Text
pDbUser_,
        $sel:dbPassword:RegisterRdsDbInstance' :: Text
dbPassword = Text
pDbPassword_
      }

-- | The stack ID.
registerRdsDbInstance_stackId :: Lens.Lens' RegisterRdsDbInstance Prelude.Text
registerRdsDbInstance_stackId :: Lens' RegisterRdsDbInstance Text
registerRdsDbInstance_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterRdsDbInstance' {Text
stackId :: Text
$sel:stackId:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
stackId} -> Text
stackId) (\s :: RegisterRdsDbInstance
s@RegisterRdsDbInstance' {} Text
a -> RegisterRdsDbInstance
s {$sel:stackId:RegisterRdsDbInstance' :: Text
stackId = Text
a} :: RegisterRdsDbInstance)

-- | The Amazon RDS instance\'s ARN.
registerRdsDbInstance_rdsDbInstanceArn :: Lens.Lens' RegisterRdsDbInstance Prelude.Text
registerRdsDbInstance_rdsDbInstanceArn :: Lens' RegisterRdsDbInstance Text
registerRdsDbInstance_rdsDbInstanceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterRdsDbInstance' {Text
rdsDbInstanceArn :: Text
$sel:rdsDbInstanceArn:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
rdsDbInstanceArn} -> Text
rdsDbInstanceArn) (\s :: RegisterRdsDbInstance
s@RegisterRdsDbInstance' {} Text
a -> RegisterRdsDbInstance
s {$sel:rdsDbInstanceArn:RegisterRdsDbInstance' :: Text
rdsDbInstanceArn = Text
a} :: RegisterRdsDbInstance)

-- | The database\'s master user name.
registerRdsDbInstance_dbUser :: Lens.Lens' RegisterRdsDbInstance Prelude.Text
registerRdsDbInstance_dbUser :: Lens' RegisterRdsDbInstance Text
registerRdsDbInstance_dbUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterRdsDbInstance' {Text
dbUser :: Text
$sel:dbUser:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
dbUser} -> Text
dbUser) (\s :: RegisterRdsDbInstance
s@RegisterRdsDbInstance' {} Text
a -> RegisterRdsDbInstance
s {$sel:dbUser:RegisterRdsDbInstance' :: Text
dbUser = Text
a} :: RegisterRdsDbInstance)

-- | The database password.
registerRdsDbInstance_dbPassword :: Lens.Lens' RegisterRdsDbInstance Prelude.Text
registerRdsDbInstance_dbPassword :: Lens' RegisterRdsDbInstance Text
registerRdsDbInstance_dbPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterRdsDbInstance' {Text
dbPassword :: Text
$sel:dbPassword:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
dbPassword} -> Text
dbPassword) (\s :: RegisterRdsDbInstance
s@RegisterRdsDbInstance' {} Text
a -> RegisterRdsDbInstance
s {$sel:dbPassword:RegisterRdsDbInstance' :: Text
dbPassword = Text
a} :: RegisterRdsDbInstance)

instance Core.AWSRequest RegisterRdsDbInstance where
  type
    AWSResponse RegisterRdsDbInstance =
      RegisterRdsDbInstanceResponse
  request :: (Service -> Service)
-> RegisterRdsDbInstance -> Request RegisterRdsDbInstance
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 RegisterRdsDbInstance
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterRdsDbInstance)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull RegisterRdsDbInstanceResponse
RegisterRdsDbInstanceResponse'

instance Prelude.Hashable RegisterRdsDbInstance where
  hashWithSalt :: Int -> RegisterRdsDbInstance -> Int
hashWithSalt Int
_salt RegisterRdsDbInstance' {Text
dbPassword :: Text
dbUser :: Text
rdsDbInstanceArn :: Text
stackId :: Text
$sel:dbPassword:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:dbUser:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:rdsDbInstanceArn:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:stackId:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
rdsDbInstanceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbUser
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbPassword

instance Prelude.NFData RegisterRdsDbInstance where
  rnf :: RegisterRdsDbInstance -> ()
rnf RegisterRdsDbInstance' {Text
dbPassword :: Text
dbUser :: Text
rdsDbInstanceArn :: Text
stackId :: Text
$sel:dbPassword:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:dbUser:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:rdsDbInstanceArn:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:stackId:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
stackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
rdsDbInstanceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbPassword

instance Data.ToHeaders RegisterRdsDbInstance where
  toHeaders :: RegisterRdsDbInstance -> [Header]
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 -> [Header]
Data.=# ( ByteString
"OpsWorks_20130218.RegisterRdsDbInstance" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RegisterRdsDbInstance where
  toJSON :: RegisterRdsDbInstance -> Value
toJSON RegisterRdsDbInstance' {Text
dbPassword :: Text
dbUser :: Text
rdsDbInstanceArn :: Text
stackId :: Text
$sel:dbPassword:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:dbUser:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:rdsDbInstanceArn:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
$sel:stackId:RegisterRdsDbInstance' :: RegisterRdsDbInstance -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"StackId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RdsDbInstanceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
rdsDbInstanceArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"DbUser" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dbUser),
            forall a. a -> Maybe a
Prelude.Just (Key
"DbPassword" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dbPassword)
          ]
      )

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

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

-- | /See:/ 'newRegisterRdsDbInstanceResponse' smart constructor.
data RegisterRdsDbInstanceResponse = RegisterRdsDbInstanceResponse'
  {
  }
  deriving (RegisterRdsDbInstanceResponse
-> RegisterRdsDbInstanceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterRdsDbInstanceResponse
-> RegisterRdsDbInstanceResponse -> Bool
$c/= :: RegisterRdsDbInstanceResponse
-> RegisterRdsDbInstanceResponse -> Bool
== :: RegisterRdsDbInstanceResponse
-> RegisterRdsDbInstanceResponse -> Bool
$c== :: RegisterRdsDbInstanceResponse
-> RegisterRdsDbInstanceResponse -> Bool
Prelude.Eq, ReadPrec [RegisterRdsDbInstanceResponse]
ReadPrec RegisterRdsDbInstanceResponse
Int -> ReadS RegisterRdsDbInstanceResponse
ReadS [RegisterRdsDbInstanceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterRdsDbInstanceResponse]
$creadListPrec :: ReadPrec [RegisterRdsDbInstanceResponse]
readPrec :: ReadPrec RegisterRdsDbInstanceResponse
$creadPrec :: ReadPrec RegisterRdsDbInstanceResponse
readList :: ReadS [RegisterRdsDbInstanceResponse]
$creadList :: ReadS [RegisterRdsDbInstanceResponse]
readsPrec :: Int -> ReadS RegisterRdsDbInstanceResponse
$creadsPrec :: Int -> ReadS RegisterRdsDbInstanceResponse
Prelude.Read, Int -> RegisterRdsDbInstanceResponse -> ShowS
[RegisterRdsDbInstanceResponse] -> ShowS
RegisterRdsDbInstanceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterRdsDbInstanceResponse] -> ShowS
$cshowList :: [RegisterRdsDbInstanceResponse] -> ShowS
show :: RegisterRdsDbInstanceResponse -> String
$cshow :: RegisterRdsDbInstanceResponse -> String
showsPrec :: Int -> RegisterRdsDbInstanceResponse -> ShowS
$cshowsPrec :: Int -> RegisterRdsDbInstanceResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterRdsDbInstanceResponse x
-> RegisterRdsDbInstanceResponse
forall x.
RegisterRdsDbInstanceResponse
-> Rep RegisterRdsDbInstanceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterRdsDbInstanceResponse x
-> RegisterRdsDbInstanceResponse
$cfrom :: forall x.
RegisterRdsDbInstanceResponse
-> Rep RegisterRdsDbInstanceResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterRdsDbInstanceResponse' 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.
newRegisterRdsDbInstanceResponse ::
  RegisterRdsDbInstanceResponse
newRegisterRdsDbInstanceResponse :: RegisterRdsDbInstanceResponse
newRegisterRdsDbInstanceResponse =
  RegisterRdsDbInstanceResponse
RegisterRdsDbInstanceResponse'

instance Prelude.NFData RegisterRdsDbInstanceResponse where
  rnf :: RegisterRdsDbInstanceResponse -> ()
rnf RegisterRdsDbInstanceResponse
_ = ()