{-# 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.RDSData.BeginTransaction
-- 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 a SQL transaction.
--
-- A transaction can run for a maximum of 24 hours. A transaction is
-- terminated and rolled back automatically after 24 hours.
--
-- A transaction times out if no calls use its transaction ID in three
-- minutes. If a transaction times out before it\'s committed, it\'s rolled
-- back automatically.
--
-- DDL statements inside a transaction cause an implicit commit. We
-- recommend that you run each DDL statement in a separate
-- @ExecuteStatement@ call with @continueAfterTimeout@ enabled.
module Amazonka.RDSData.BeginTransaction
  ( -- * Creating a Request
    BeginTransaction (..),
    newBeginTransaction,

    -- * Request Lenses
    beginTransaction_database,
    beginTransaction_schema,
    beginTransaction_resourceArn,
    beginTransaction_secretArn,

    -- * Destructuring the Response
    BeginTransactionResponse (..),
    newBeginTransactionResponse,

    -- * Response Lenses
    beginTransactionResponse_transactionId,
    beginTransactionResponse_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.RDSData.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The request parameters represent the input of a request to start a SQL
-- transaction.
--
-- /See:/ 'newBeginTransaction' smart constructor.
data BeginTransaction = BeginTransaction'
  { -- | The name of the database.
    BeginTransaction -> Maybe Text
database :: Prelude.Maybe Prelude.Text,
    -- | The name of the database schema.
    BeginTransaction -> Maybe Text
schema :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
    BeginTransaction -> Text
resourceArn :: Prelude.Text,
    -- | The name or ARN of the secret that enables access to the DB cluster.
    BeginTransaction -> Text
secretArn :: Prelude.Text
  }
  deriving (BeginTransaction -> BeginTransaction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeginTransaction -> BeginTransaction -> Bool
$c/= :: BeginTransaction -> BeginTransaction -> Bool
== :: BeginTransaction -> BeginTransaction -> Bool
$c== :: BeginTransaction -> BeginTransaction -> Bool
Prelude.Eq, ReadPrec [BeginTransaction]
ReadPrec BeginTransaction
Int -> ReadS BeginTransaction
ReadS [BeginTransaction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BeginTransaction]
$creadListPrec :: ReadPrec [BeginTransaction]
readPrec :: ReadPrec BeginTransaction
$creadPrec :: ReadPrec BeginTransaction
readList :: ReadS [BeginTransaction]
$creadList :: ReadS [BeginTransaction]
readsPrec :: Int -> ReadS BeginTransaction
$creadsPrec :: Int -> ReadS BeginTransaction
Prelude.Read, Int -> BeginTransaction -> ShowS
[BeginTransaction] -> ShowS
BeginTransaction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeginTransaction] -> ShowS
$cshowList :: [BeginTransaction] -> ShowS
show :: BeginTransaction -> String
$cshow :: BeginTransaction -> String
showsPrec :: Int -> BeginTransaction -> ShowS
$cshowsPrec :: Int -> BeginTransaction -> ShowS
Prelude.Show, forall x. Rep BeginTransaction x -> BeginTransaction
forall x. BeginTransaction -> Rep BeginTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeginTransaction x -> BeginTransaction
$cfrom :: forall x. BeginTransaction -> Rep BeginTransaction x
Prelude.Generic)

-- |
-- Create a value of 'BeginTransaction' 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:
--
-- 'database', 'beginTransaction_database' - The name of the database.
--
-- 'schema', 'beginTransaction_schema' - The name of the database schema.
--
-- 'resourceArn', 'beginTransaction_resourceArn' - The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
--
-- 'secretArn', 'beginTransaction_secretArn' - The name or ARN of the secret that enables access to the DB cluster.
newBeginTransaction ::
  -- | 'resourceArn'
  Prelude.Text ->
  -- | 'secretArn'
  Prelude.Text ->
  BeginTransaction
newBeginTransaction :: Text -> Text -> BeginTransaction
newBeginTransaction Text
pResourceArn_ Text
pSecretArn_ =
  BeginTransaction'
    { $sel:database:BeginTransaction' :: Maybe Text
database = forall a. Maybe a
Prelude.Nothing,
      $sel:schema:BeginTransaction' :: Maybe Text
schema = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:BeginTransaction' :: Text
resourceArn = Text
pResourceArn_,
      $sel:secretArn:BeginTransaction' :: Text
secretArn = Text
pSecretArn_
    }

-- | The name of the database.
beginTransaction_database :: Lens.Lens' BeginTransaction (Prelude.Maybe Prelude.Text)
beginTransaction_database :: Lens' BeginTransaction (Maybe Text)
beginTransaction_database = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BeginTransaction' {Maybe Text
database :: Maybe Text
$sel:database:BeginTransaction' :: BeginTransaction -> Maybe Text
database} -> Maybe Text
database) (\s :: BeginTransaction
s@BeginTransaction' {} Maybe Text
a -> BeginTransaction
s {$sel:database:BeginTransaction' :: Maybe Text
database = Maybe Text
a} :: BeginTransaction)

-- | The name of the database schema.
beginTransaction_schema :: Lens.Lens' BeginTransaction (Prelude.Maybe Prelude.Text)
beginTransaction_schema :: Lens' BeginTransaction (Maybe Text)
beginTransaction_schema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BeginTransaction' {Maybe Text
schema :: Maybe Text
$sel:schema:BeginTransaction' :: BeginTransaction -> Maybe Text
schema} -> Maybe Text
schema) (\s :: BeginTransaction
s@BeginTransaction' {} Maybe Text
a -> BeginTransaction
s {$sel:schema:BeginTransaction' :: Maybe Text
schema = Maybe Text
a} :: BeginTransaction)

-- | The Amazon Resource Name (ARN) of the Aurora Serverless DB cluster.
beginTransaction_resourceArn :: Lens.Lens' BeginTransaction Prelude.Text
beginTransaction_resourceArn :: Lens' BeginTransaction Text
beginTransaction_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BeginTransaction' {Text
resourceArn :: Text
$sel:resourceArn:BeginTransaction' :: BeginTransaction -> Text
resourceArn} -> Text
resourceArn) (\s :: BeginTransaction
s@BeginTransaction' {} Text
a -> BeginTransaction
s {$sel:resourceArn:BeginTransaction' :: Text
resourceArn = Text
a} :: BeginTransaction)

-- | The name or ARN of the secret that enables access to the DB cluster.
beginTransaction_secretArn :: Lens.Lens' BeginTransaction Prelude.Text
beginTransaction_secretArn :: Lens' BeginTransaction Text
beginTransaction_secretArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BeginTransaction' {Text
secretArn :: Text
$sel:secretArn:BeginTransaction' :: BeginTransaction -> Text
secretArn} -> Text
secretArn) (\s :: BeginTransaction
s@BeginTransaction' {} Text
a -> BeginTransaction
s {$sel:secretArn:BeginTransaction' :: Text
secretArn = Text
a} :: BeginTransaction)

instance Core.AWSRequest BeginTransaction where
  type
    AWSResponse BeginTransaction =
      BeginTransactionResponse
  request :: (Service -> Service)
-> BeginTransaction -> Request BeginTransaction
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 BeginTransaction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BeginTransaction)))
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 Text -> Int -> BeginTransactionResponse
BeginTransactionResponse'
            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
"transactionId")
            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 BeginTransaction where
  hashWithSalt :: Int -> BeginTransaction -> Int
hashWithSalt Int
_salt BeginTransaction' {Maybe Text
Text
secretArn :: Text
resourceArn :: Text
schema :: Maybe Text
database :: Maybe Text
$sel:secretArn:BeginTransaction' :: BeginTransaction -> Text
$sel:resourceArn:BeginTransaction' :: BeginTransaction -> Text
$sel:schema:BeginTransaction' :: BeginTransaction -> Maybe Text
$sel:database:BeginTransaction' :: BeginTransaction -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
database
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
schema
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
secretArn

instance Prelude.NFData BeginTransaction where
  rnf :: BeginTransaction -> ()
rnf BeginTransaction' {Maybe Text
Text
secretArn :: Text
resourceArn :: Text
schema :: Maybe Text
database :: Maybe Text
$sel:secretArn:BeginTransaction' :: BeginTransaction -> Text
$sel:resourceArn:BeginTransaction' :: BeginTransaction -> Text
$sel:schema:BeginTransaction' :: BeginTransaction -> Maybe Text
$sel:database:BeginTransaction' :: BeginTransaction -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
database
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schema
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
secretArn

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

instance Data.ToJSON BeginTransaction where
  toJSON :: BeginTransaction -> Value
toJSON BeginTransaction' {Maybe Text
Text
secretArn :: Text
resourceArn :: Text
schema :: Maybe Text
database :: Maybe Text
$sel:secretArn:BeginTransaction' :: BeginTransaction -> Text
$sel:resourceArn:BeginTransaction' :: BeginTransaction -> Text
$sel:schema:BeginTransaction' :: BeginTransaction -> Maybe Text
$sel:database:BeginTransaction' :: BeginTransaction -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"database" 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
database,
            (Key
"schema" 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
schema,
            forall a. a -> Maybe a
Prelude.Just (Key
"resourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"secretArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
secretArn)
          ]
      )

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

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

-- | The response elements represent the output of a request to start a SQL
-- transaction.
--
-- /See:/ 'newBeginTransactionResponse' smart constructor.
data BeginTransactionResponse = BeginTransactionResponse'
  { -- | The transaction ID of the transaction started by the call.
    BeginTransactionResponse -> Maybe Text
transactionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    BeginTransactionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BeginTransactionResponse -> BeginTransactionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeginTransactionResponse -> BeginTransactionResponse -> Bool
$c/= :: BeginTransactionResponse -> BeginTransactionResponse -> Bool
== :: BeginTransactionResponse -> BeginTransactionResponse -> Bool
$c== :: BeginTransactionResponse -> BeginTransactionResponse -> Bool
Prelude.Eq, ReadPrec [BeginTransactionResponse]
ReadPrec BeginTransactionResponse
Int -> ReadS BeginTransactionResponse
ReadS [BeginTransactionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BeginTransactionResponse]
$creadListPrec :: ReadPrec [BeginTransactionResponse]
readPrec :: ReadPrec BeginTransactionResponse
$creadPrec :: ReadPrec BeginTransactionResponse
readList :: ReadS [BeginTransactionResponse]
$creadList :: ReadS [BeginTransactionResponse]
readsPrec :: Int -> ReadS BeginTransactionResponse
$creadsPrec :: Int -> ReadS BeginTransactionResponse
Prelude.Read, Int -> BeginTransactionResponse -> ShowS
[BeginTransactionResponse] -> ShowS
BeginTransactionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeginTransactionResponse] -> ShowS
$cshowList :: [BeginTransactionResponse] -> ShowS
show :: BeginTransactionResponse -> String
$cshow :: BeginTransactionResponse -> String
showsPrec :: Int -> BeginTransactionResponse -> ShowS
$cshowsPrec :: Int -> BeginTransactionResponse -> ShowS
Prelude.Show, forall x.
Rep BeginTransactionResponse x -> BeginTransactionResponse
forall x.
BeginTransactionResponse -> Rep BeginTransactionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BeginTransactionResponse x -> BeginTransactionResponse
$cfrom :: forall x.
BeginTransactionResponse -> Rep BeginTransactionResponse x
Prelude.Generic)

-- |
-- Create a value of 'BeginTransactionResponse' 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:
--
-- 'transactionId', 'beginTransactionResponse_transactionId' - The transaction ID of the transaction started by the call.
--
-- 'httpStatus', 'beginTransactionResponse_httpStatus' - The response's http status code.
newBeginTransactionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BeginTransactionResponse
newBeginTransactionResponse :: Int -> BeginTransactionResponse
newBeginTransactionResponse Int
pHttpStatus_ =
  BeginTransactionResponse'
    { $sel:transactionId:BeginTransactionResponse' :: Maybe Text
transactionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BeginTransactionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The transaction ID of the transaction started by the call.
beginTransactionResponse_transactionId :: Lens.Lens' BeginTransactionResponse (Prelude.Maybe Prelude.Text)
beginTransactionResponse_transactionId :: Lens' BeginTransactionResponse (Maybe Text)
beginTransactionResponse_transactionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BeginTransactionResponse' {Maybe Text
transactionId :: Maybe Text
$sel:transactionId:BeginTransactionResponse' :: BeginTransactionResponse -> Maybe Text
transactionId} -> Maybe Text
transactionId) (\s :: BeginTransactionResponse
s@BeginTransactionResponse' {} Maybe Text
a -> BeginTransactionResponse
s {$sel:transactionId:BeginTransactionResponse' :: Maybe Text
transactionId = Maybe Text
a} :: BeginTransactionResponse)

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

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