{-# 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.StopQueryExecution
-- 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 a query execution. Requires you to have access to the workgroup in
-- which the query ran.
--
-- For code samples using the Amazon Web Services SDK for Java, see
-- <http://docs.aws.amazon.com/athena/latest/ug/code-samples.html Examples and Code Samples>
-- in the /Amazon Athena User Guide/.
module Amazonka.Athena.StopQueryExecution
  ( -- * Creating a Request
    StopQueryExecution (..),
    newStopQueryExecution,

    -- * Request Lenses
    stopQueryExecution_queryExecutionId,

    -- * Destructuring the Response
    StopQueryExecutionResponse (..),
    newStopQueryExecutionResponse,

    -- * Response Lenses
    stopQueryExecutionResponse_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:/ 'newStopQueryExecution' smart constructor.
data StopQueryExecution = StopQueryExecution'
  { -- | The unique ID of the query execution to stop.
    StopQueryExecution -> Text
queryExecutionId :: Prelude.Text
  }
  deriving (StopQueryExecution -> StopQueryExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopQueryExecution -> StopQueryExecution -> Bool
$c/= :: StopQueryExecution -> StopQueryExecution -> Bool
== :: StopQueryExecution -> StopQueryExecution -> Bool
$c== :: StopQueryExecution -> StopQueryExecution -> Bool
Prelude.Eq, ReadPrec [StopQueryExecution]
ReadPrec StopQueryExecution
Int -> ReadS StopQueryExecution
ReadS [StopQueryExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopQueryExecution]
$creadListPrec :: ReadPrec [StopQueryExecution]
readPrec :: ReadPrec StopQueryExecution
$creadPrec :: ReadPrec StopQueryExecution
readList :: ReadS [StopQueryExecution]
$creadList :: ReadS [StopQueryExecution]
readsPrec :: Int -> ReadS StopQueryExecution
$creadsPrec :: Int -> ReadS StopQueryExecution
Prelude.Read, Int -> StopQueryExecution -> ShowS
[StopQueryExecution] -> ShowS
StopQueryExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopQueryExecution] -> ShowS
$cshowList :: [StopQueryExecution] -> ShowS
show :: StopQueryExecution -> String
$cshow :: StopQueryExecution -> String
showsPrec :: Int -> StopQueryExecution -> ShowS
$cshowsPrec :: Int -> StopQueryExecution -> ShowS
Prelude.Show, forall x. Rep StopQueryExecution x -> StopQueryExecution
forall x. StopQueryExecution -> Rep StopQueryExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopQueryExecution x -> StopQueryExecution
$cfrom :: forall x. StopQueryExecution -> Rep StopQueryExecution x
Prelude.Generic)

-- |
-- Create a value of 'StopQueryExecution' 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:
--
-- 'queryExecutionId', 'stopQueryExecution_queryExecutionId' - The unique ID of the query execution to stop.
newStopQueryExecution ::
  -- | 'queryExecutionId'
  Prelude.Text ->
  StopQueryExecution
newStopQueryExecution :: Text -> StopQueryExecution
newStopQueryExecution Text
pQueryExecutionId_ =
  StopQueryExecution'
    { $sel:queryExecutionId:StopQueryExecution' :: Text
queryExecutionId =
        Text
pQueryExecutionId_
    }

-- | The unique ID of the query execution to stop.
stopQueryExecution_queryExecutionId :: Lens.Lens' StopQueryExecution Prelude.Text
stopQueryExecution_queryExecutionId :: Lens' StopQueryExecution Text
stopQueryExecution_queryExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopQueryExecution' {Text
queryExecutionId :: Text
$sel:queryExecutionId:StopQueryExecution' :: StopQueryExecution -> Text
queryExecutionId} -> Text
queryExecutionId) (\s :: StopQueryExecution
s@StopQueryExecution' {} Text
a -> StopQueryExecution
s {$sel:queryExecutionId:StopQueryExecution' :: Text
queryExecutionId = Text
a} :: StopQueryExecution)

instance Core.AWSRequest StopQueryExecution where
  type
    AWSResponse StopQueryExecution =
      StopQueryExecutionResponse
  request :: (Service -> Service)
-> StopQueryExecution -> Request StopQueryExecution
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 StopQueryExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopQueryExecution)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> StopQueryExecutionResponse
StopQueryExecutionResponse'
            forall (f :: * -> *) a b. Functor 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 StopQueryExecution where
  hashWithSalt :: Int -> StopQueryExecution -> Int
hashWithSalt Int
_salt StopQueryExecution' {Text
queryExecutionId :: Text
$sel:queryExecutionId:StopQueryExecution' :: StopQueryExecution -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queryExecutionId

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

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

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

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

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

-- |
-- Create a value of 'StopQueryExecutionResponse' 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:
--
-- 'httpStatus', 'stopQueryExecutionResponse_httpStatus' - The response's http status code.
newStopQueryExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopQueryExecutionResponse
newStopQueryExecutionResponse :: Int -> StopQueryExecutionResponse
newStopQueryExecutionResponse Int
pHttpStatus_ =
  StopQueryExecutionResponse'
    { $sel:httpStatus:StopQueryExecutionResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData StopQueryExecutionResponse where
  rnf :: StopQueryExecutionResponse -> ()
rnf StopQueryExecutionResponse' {Int
httpStatus :: Int
$sel:httpStatus:StopQueryExecutionResponse' :: StopQueryExecutionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus