{-# 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.Athena.GetPreparedStatement
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the prepared statement with the specified name from the
-- specified workgroup.
module Amazonka.Athena.GetPreparedStatement
  ( -- * Creating a Request
    GetPreparedStatement (..),
    newGetPreparedStatement,

    -- * Request Lenses
    getPreparedStatement_statementName,
    getPreparedStatement_workGroup,

    -- * Destructuring the Response
    GetPreparedStatementResponse (..),
    newGetPreparedStatementResponse,

    -- * Response Lenses
    getPreparedStatementResponse_preparedStatement,
    getPreparedStatementResponse_httpStatus,
  )
where

import Amazonka.Athena.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetPreparedStatement' smart constructor.
data GetPreparedStatement = GetPreparedStatement'
  { -- | The name of the prepared statement to retrieve.
    GetPreparedStatement -> Text
statementName :: Prelude.Text,
    -- | The workgroup to which the statement to be retrieved belongs.
    GetPreparedStatement -> Text
workGroup :: Prelude.Text
  }
  deriving (GetPreparedStatement -> GetPreparedStatement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPreparedStatement -> GetPreparedStatement -> Bool
$c/= :: GetPreparedStatement -> GetPreparedStatement -> Bool
== :: GetPreparedStatement -> GetPreparedStatement -> Bool
$c== :: GetPreparedStatement -> GetPreparedStatement -> Bool
Prelude.Eq, ReadPrec [GetPreparedStatement]
ReadPrec GetPreparedStatement
Int -> ReadS GetPreparedStatement
ReadS [GetPreparedStatement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPreparedStatement]
$creadListPrec :: ReadPrec [GetPreparedStatement]
readPrec :: ReadPrec GetPreparedStatement
$creadPrec :: ReadPrec GetPreparedStatement
readList :: ReadS [GetPreparedStatement]
$creadList :: ReadS [GetPreparedStatement]
readsPrec :: Int -> ReadS GetPreparedStatement
$creadsPrec :: Int -> ReadS GetPreparedStatement
Prelude.Read, Int -> GetPreparedStatement -> ShowS
[GetPreparedStatement] -> ShowS
GetPreparedStatement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPreparedStatement] -> ShowS
$cshowList :: [GetPreparedStatement] -> ShowS
show :: GetPreparedStatement -> String
$cshow :: GetPreparedStatement -> String
showsPrec :: Int -> GetPreparedStatement -> ShowS
$cshowsPrec :: Int -> GetPreparedStatement -> ShowS
Prelude.Show, forall x. Rep GetPreparedStatement x -> GetPreparedStatement
forall x. GetPreparedStatement -> Rep GetPreparedStatement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPreparedStatement x -> GetPreparedStatement
$cfrom :: forall x. GetPreparedStatement -> Rep GetPreparedStatement x
Prelude.Generic)

-- |
-- Create a value of 'GetPreparedStatement' 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:
--
-- 'statementName', 'getPreparedStatement_statementName' - The name of the prepared statement to retrieve.
--
-- 'workGroup', 'getPreparedStatement_workGroup' - The workgroup to which the statement to be retrieved belongs.
newGetPreparedStatement ::
  -- | 'statementName'
  Prelude.Text ->
  -- | 'workGroup'
  Prelude.Text ->
  GetPreparedStatement
newGetPreparedStatement :: Text -> Text -> GetPreparedStatement
newGetPreparedStatement Text
pStatementName_ Text
pWorkGroup_ =
  GetPreparedStatement'
    { $sel:statementName:GetPreparedStatement' :: Text
statementName =
        Text
pStatementName_,
      $sel:workGroup:GetPreparedStatement' :: Text
workGroup = Text
pWorkGroup_
    }

-- | The name of the prepared statement to retrieve.
getPreparedStatement_statementName :: Lens.Lens' GetPreparedStatement Prelude.Text
getPreparedStatement_statementName :: Lens' GetPreparedStatement Text
getPreparedStatement_statementName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPreparedStatement' {Text
statementName :: Text
$sel:statementName:GetPreparedStatement' :: GetPreparedStatement -> Text
statementName} -> Text
statementName) (\s :: GetPreparedStatement
s@GetPreparedStatement' {} Text
a -> GetPreparedStatement
s {$sel:statementName:GetPreparedStatement' :: Text
statementName = Text
a} :: GetPreparedStatement)

-- | The workgroup to which the statement to be retrieved belongs.
getPreparedStatement_workGroup :: Lens.Lens' GetPreparedStatement Prelude.Text
getPreparedStatement_workGroup :: Lens' GetPreparedStatement Text
getPreparedStatement_workGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPreparedStatement' {Text
workGroup :: Text
$sel:workGroup:GetPreparedStatement' :: GetPreparedStatement -> Text
workGroup} -> Text
workGroup) (\s :: GetPreparedStatement
s@GetPreparedStatement' {} Text
a -> GetPreparedStatement
s {$sel:workGroup:GetPreparedStatement' :: Text
workGroup = Text
a} :: GetPreparedStatement)

instance Core.AWSRequest GetPreparedStatement where
  type
    AWSResponse GetPreparedStatement =
      GetPreparedStatementResponse
  request :: (Service -> Service)
-> GetPreparedStatement -> Request GetPreparedStatement
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 GetPreparedStatement
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetPreparedStatement)))
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 PreparedStatement -> Int -> GetPreparedStatementResponse
GetPreparedStatementResponse'
            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
"PreparedStatement")
            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 GetPreparedStatement where
  hashWithSalt :: Int -> GetPreparedStatement -> Int
hashWithSalt Int
_salt GetPreparedStatement' {Text
workGroup :: Text
statementName :: Text
$sel:workGroup:GetPreparedStatement' :: GetPreparedStatement -> Text
$sel:statementName:GetPreparedStatement' :: GetPreparedStatement -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
statementName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workGroup

instance Prelude.NFData GetPreparedStatement where
  rnf :: GetPreparedStatement -> ()
rnf GetPreparedStatement' {Text
workGroup :: Text
statementName :: Text
$sel:workGroup:GetPreparedStatement' :: GetPreparedStatement -> Text
$sel:statementName:GetPreparedStatement' :: GetPreparedStatement -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
statementName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workGroup

instance Data.ToHeaders GetPreparedStatement where
  toHeaders :: GetPreparedStatement -> 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
"AmazonAthena.GetPreparedStatement" ::
                          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 GetPreparedStatement where
  toJSON :: GetPreparedStatement -> Value
toJSON GetPreparedStatement' {Text
workGroup :: Text
statementName :: Text
$sel:workGroup:GetPreparedStatement' :: GetPreparedStatement -> Text
$sel:statementName:GetPreparedStatement' :: GetPreparedStatement -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"StatementName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
statementName),
            forall a. a -> Maybe a
Prelude.Just (Key
"WorkGroup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workGroup)
          ]
      )

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

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

-- | /See:/ 'newGetPreparedStatementResponse' smart constructor.
data GetPreparedStatementResponse = GetPreparedStatementResponse'
  { -- | The name of the prepared statement that was retrieved.
    GetPreparedStatementResponse -> Maybe PreparedStatement
preparedStatement :: Prelude.Maybe PreparedStatement,
    -- | The response's http status code.
    GetPreparedStatementResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPreparedStatementResponse
-> GetPreparedStatementResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPreparedStatementResponse
-> GetPreparedStatementResponse -> Bool
$c/= :: GetPreparedStatementResponse
-> GetPreparedStatementResponse -> Bool
== :: GetPreparedStatementResponse
-> GetPreparedStatementResponse -> Bool
$c== :: GetPreparedStatementResponse
-> GetPreparedStatementResponse -> Bool
Prelude.Eq, ReadPrec [GetPreparedStatementResponse]
ReadPrec GetPreparedStatementResponse
Int -> ReadS GetPreparedStatementResponse
ReadS [GetPreparedStatementResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPreparedStatementResponse]
$creadListPrec :: ReadPrec [GetPreparedStatementResponse]
readPrec :: ReadPrec GetPreparedStatementResponse
$creadPrec :: ReadPrec GetPreparedStatementResponse
readList :: ReadS [GetPreparedStatementResponse]
$creadList :: ReadS [GetPreparedStatementResponse]
readsPrec :: Int -> ReadS GetPreparedStatementResponse
$creadsPrec :: Int -> ReadS GetPreparedStatementResponse
Prelude.Read, Int -> GetPreparedStatementResponse -> ShowS
[GetPreparedStatementResponse] -> ShowS
GetPreparedStatementResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPreparedStatementResponse] -> ShowS
$cshowList :: [GetPreparedStatementResponse] -> ShowS
show :: GetPreparedStatementResponse -> String
$cshow :: GetPreparedStatementResponse -> String
showsPrec :: Int -> GetPreparedStatementResponse -> ShowS
$cshowsPrec :: Int -> GetPreparedStatementResponse -> ShowS
Prelude.Show, forall x.
Rep GetPreparedStatementResponse x -> GetPreparedStatementResponse
forall x.
GetPreparedStatementResponse -> Rep GetPreparedStatementResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPreparedStatementResponse x -> GetPreparedStatementResponse
$cfrom :: forall x.
GetPreparedStatementResponse -> Rep GetPreparedStatementResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPreparedStatementResponse' 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:
--
-- 'preparedStatement', 'getPreparedStatementResponse_preparedStatement' - The name of the prepared statement that was retrieved.
--
-- 'httpStatus', 'getPreparedStatementResponse_httpStatus' - The response's http status code.
newGetPreparedStatementResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPreparedStatementResponse
newGetPreparedStatementResponse :: Int -> GetPreparedStatementResponse
newGetPreparedStatementResponse Int
pHttpStatus_ =
  GetPreparedStatementResponse'
    { $sel:preparedStatement:GetPreparedStatementResponse' :: Maybe PreparedStatement
preparedStatement =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPreparedStatementResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the prepared statement that was retrieved.
getPreparedStatementResponse_preparedStatement :: Lens.Lens' GetPreparedStatementResponse (Prelude.Maybe PreparedStatement)
getPreparedStatementResponse_preparedStatement :: Lens' GetPreparedStatementResponse (Maybe PreparedStatement)
getPreparedStatementResponse_preparedStatement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPreparedStatementResponse' {Maybe PreparedStatement
preparedStatement :: Maybe PreparedStatement
$sel:preparedStatement:GetPreparedStatementResponse' :: GetPreparedStatementResponse -> Maybe PreparedStatement
preparedStatement} -> Maybe PreparedStatement
preparedStatement) (\s :: GetPreparedStatementResponse
s@GetPreparedStatementResponse' {} Maybe PreparedStatement
a -> GetPreparedStatementResponse
s {$sel:preparedStatement:GetPreparedStatementResponse' :: Maybe PreparedStatement
preparedStatement = Maybe PreparedStatement
a} :: GetPreparedStatementResponse)

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

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