{-# 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.BatchGetQueryExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the details of a single query execution or a list of up to 50
-- query executions, which you provide as an array of query execution ID
-- strings. Requires you to have access to the workgroup in which the
-- queries ran. To get a list of query execution IDs, use
-- ListQueryExecutionsInput$WorkGroup. Query executions differ from named
-- (saved) queries. Use BatchGetNamedQueryInput to get details about named
-- queries.
module Amazonka.Athena.BatchGetQueryExecution
  ( -- * Creating a Request
    BatchGetQueryExecution (..),
    newBatchGetQueryExecution,

    -- * Request Lenses
    batchGetQueryExecution_queryExecutionIds,

    -- * Destructuring the Response
    BatchGetQueryExecutionResponse (..),
    newBatchGetQueryExecutionResponse,

    -- * Response Lenses
    batchGetQueryExecutionResponse_queryExecutions,
    batchGetQueryExecutionResponse_unprocessedQueryExecutionIds,
    batchGetQueryExecutionResponse_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

-- | Contains an array of query execution IDs.
--
-- /See:/ 'newBatchGetQueryExecution' smart constructor.
data BatchGetQueryExecution = BatchGetQueryExecution'
  { -- | An array of query execution IDs.
    BatchGetQueryExecution -> NonEmpty Text
queryExecutionIds :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchGetQueryExecution -> BatchGetQueryExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetQueryExecution -> BatchGetQueryExecution -> Bool
$c/= :: BatchGetQueryExecution -> BatchGetQueryExecution -> Bool
== :: BatchGetQueryExecution -> BatchGetQueryExecution -> Bool
$c== :: BatchGetQueryExecution -> BatchGetQueryExecution -> Bool
Prelude.Eq, ReadPrec [BatchGetQueryExecution]
ReadPrec BatchGetQueryExecution
Int -> ReadS BatchGetQueryExecution
ReadS [BatchGetQueryExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetQueryExecution]
$creadListPrec :: ReadPrec [BatchGetQueryExecution]
readPrec :: ReadPrec BatchGetQueryExecution
$creadPrec :: ReadPrec BatchGetQueryExecution
readList :: ReadS [BatchGetQueryExecution]
$creadList :: ReadS [BatchGetQueryExecution]
readsPrec :: Int -> ReadS BatchGetQueryExecution
$creadsPrec :: Int -> ReadS BatchGetQueryExecution
Prelude.Read, Int -> BatchGetQueryExecution -> ShowS
[BatchGetQueryExecution] -> ShowS
BatchGetQueryExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetQueryExecution] -> ShowS
$cshowList :: [BatchGetQueryExecution] -> ShowS
show :: BatchGetQueryExecution -> String
$cshow :: BatchGetQueryExecution -> String
showsPrec :: Int -> BatchGetQueryExecution -> ShowS
$cshowsPrec :: Int -> BatchGetQueryExecution -> ShowS
Prelude.Show, forall x. Rep BatchGetQueryExecution x -> BatchGetQueryExecution
forall x. BatchGetQueryExecution -> Rep BatchGetQueryExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetQueryExecution x -> BatchGetQueryExecution
$cfrom :: forall x. BatchGetQueryExecution -> Rep BatchGetQueryExecution x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetQueryExecution' 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:
--
-- 'queryExecutionIds', 'batchGetQueryExecution_queryExecutionIds' - An array of query execution IDs.
newBatchGetQueryExecution ::
  -- | 'queryExecutionIds'
  Prelude.NonEmpty Prelude.Text ->
  BatchGetQueryExecution
newBatchGetQueryExecution :: NonEmpty Text -> BatchGetQueryExecution
newBatchGetQueryExecution NonEmpty Text
pQueryExecutionIds_ =
  BatchGetQueryExecution'
    { $sel:queryExecutionIds:BatchGetQueryExecution' :: NonEmpty Text
queryExecutionIds =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pQueryExecutionIds_
    }

-- | An array of query execution IDs.
batchGetQueryExecution_queryExecutionIds :: Lens.Lens' BatchGetQueryExecution (Prelude.NonEmpty Prelude.Text)
batchGetQueryExecution_queryExecutionIds :: Lens' BatchGetQueryExecution (NonEmpty Text)
batchGetQueryExecution_queryExecutionIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetQueryExecution' {NonEmpty Text
queryExecutionIds :: NonEmpty Text
$sel:queryExecutionIds:BatchGetQueryExecution' :: BatchGetQueryExecution -> NonEmpty Text
queryExecutionIds} -> NonEmpty Text
queryExecutionIds) (\s :: BatchGetQueryExecution
s@BatchGetQueryExecution' {} NonEmpty Text
a -> BatchGetQueryExecution
s {$sel:queryExecutionIds:BatchGetQueryExecution' :: NonEmpty Text
queryExecutionIds = NonEmpty Text
a} :: BatchGetQueryExecution) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchGetQueryExecution where
  type
    AWSResponse BatchGetQueryExecution =
      BatchGetQueryExecutionResponse
  request :: (Service -> Service)
-> BatchGetQueryExecution -> Request BatchGetQueryExecution
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 BatchGetQueryExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetQueryExecution)))
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 [QueryExecution]
-> Maybe [UnprocessedQueryExecutionId]
-> Int
-> BatchGetQueryExecutionResponse
BatchGetQueryExecutionResponse'
            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
"QueryExecutions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UnprocessedQueryExecutionIds"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 BatchGetQueryExecution where
  hashWithSalt :: Int -> BatchGetQueryExecution -> Int
hashWithSalt Int
_salt BatchGetQueryExecution' {NonEmpty Text
queryExecutionIds :: NonEmpty Text
$sel:queryExecutionIds:BatchGetQueryExecution' :: BatchGetQueryExecution -> NonEmpty Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
queryExecutionIds

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

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

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

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

-- | /See:/ 'newBatchGetQueryExecutionResponse' smart constructor.
data BatchGetQueryExecutionResponse = BatchGetQueryExecutionResponse'
  { -- | Information about a query execution.
    BatchGetQueryExecutionResponse -> Maybe [QueryExecution]
queryExecutions :: Prelude.Maybe [QueryExecution],
    -- | Information about the query executions that failed to run.
    BatchGetQueryExecutionResponse
-> Maybe [UnprocessedQueryExecutionId]
unprocessedQueryExecutionIds :: Prelude.Maybe [UnprocessedQueryExecutionId],
    -- | The response's http status code.
    BatchGetQueryExecutionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetQueryExecutionResponse
-> BatchGetQueryExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetQueryExecutionResponse
-> BatchGetQueryExecutionResponse -> Bool
$c/= :: BatchGetQueryExecutionResponse
-> BatchGetQueryExecutionResponse -> Bool
== :: BatchGetQueryExecutionResponse
-> BatchGetQueryExecutionResponse -> Bool
$c== :: BatchGetQueryExecutionResponse
-> BatchGetQueryExecutionResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetQueryExecutionResponse]
ReadPrec BatchGetQueryExecutionResponse
Int -> ReadS BatchGetQueryExecutionResponse
ReadS [BatchGetQueryExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetQueryExecutionResponse]
$creadListPrec :: ReadPrec [BatchGetQueryExecutionResponse]
readPrec :: ReadPrec BatchGetQueryExecutionResponse
$creadPrec :: ReadPrec BatchGetQueryExecutionResponse
readList :: ReadS [BatchGetQueryExecutionResponse]
$creadList :: ReadS [BatchGetQueryExecutionResponse]
readsPrec :: Int -> ReadS BatchGetQueryExecutionResponse
$creadsPrec :: Int -> ReadS BatchGetQueryExecutionResponse
Prelude.Read, Int -> BatchGetQueryExecutionResponse -> ShowS
[BatchGetQueryExecutionResponse] -> ShowS
BatchGetQueryExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetQueryExecutionResponse] -> ShowS
$cshowList :: [BatchGetQueryExecutionResponse] -> ShowS
show :: BatchGetQueryExecutionResponse -> String
$cshow :: BatchGetQueryExecutionResponse -> String
showsPrec :: Int -> BatchGetQueryExecutionResponse -> ShowS
$cshowsPrec :: Int -> BatchGetQueryExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetQueryExecutionResponse x
-> BatchGetQueryExecutionResponse
forall x.
BatchGetQueryExecutionResponse
-> Rep BatchGetQueryExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetQueryExecutionResponse x
-> BatchGetQueryExecutionResponse
$cfrom :: forall x.
BatchGetQueryExecutionResponse
-> Rep BatchGetQueryExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetQueryExecutionResponse' 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:
--
-- 'queryExecutions', 'batchGetQueryExecutionResponse_queryExecutions' - Information about a query execution.
--
-- 'unprocessedQueryExecutionIds', 'batchGetQueryExecutionResponse_unprocessedQueryExecutionIds' - Information about the query executions that failed to run.
--
-- 'httpStatus', 'batchGetQueryExecutionResponse_httpStatus' - The response's http status code.
newBatchGetQueryExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetQueryExecutionResponse
newBatchGetQueryExecutionResponse :: Int -> BatchGetQueryExecutionResponse
newBatchGetQueryExecutionResponse Int
pHttpStatus_ =
  BatchGetQueryExecutionResponse'
    { $sel:queryExecutions:BatchGetQueryExecutionResponse' :: Maybe [QueryExecution]
queryExecutions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:unprocessedQueryExecutionIds:BatchGetQueryExecutionResponse' :: Maybe [UnprocessedQueryExecutionId]
unprocessedQueryExecutionIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetQueryExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about a query execution.
batchGetQueryExecutionResponse_queryExecutions :: Lens.Lens' BatchGetQueryExecutionResponse (Prelude.Maybe [QueryExecution])
batchGetQueryExecutionResponse_queryExecutions :: Lens' BatchGetQueryExecutionResponse (Maybe [QueryExecution])
batchGetQueryExecutionResponse_queryExecutions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetQueryExecutionResponse' {Maybe [QueryExecution]
queryExecutions :: Maybe [QueryExecution]
$sel:queryExecutions:BatchGetQueryExecutionResponse' :: BatchGetQueryExecutionResponse -> Maybe [QueryExecution]
queryExecutions} -> Maybe [QueryExecution]
queryExecutions) (\s :: BatchGetQueryExecutionResponse
s@BatchGetQueryExecutionResponse' {} Maybe [QueryExecution]
a -> BatchGetQueryExecutionResponse
s {$sel:queryExecutions:BatchGetQueryExecutionResponse' :: Maybe [QueryExecution]
queryExecutions = Maybe [QueryExecution]
a} :: BatchGetQueryExecutionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Information about the query executions that failed to run.
batchGetQueryExecutionResponse_unprocessedQueryExecutionIds :: Lens.Lens' BatchGetQueryExecutionResponse (Prelude.Maybe [UnprocessedQueryExecutionId])
batchGetQueryExecutionResponse_unprocessedQueryExecutionIds :: Lens'
  BatchGetQueryExecutionResponse
  (Maybe [UnprocessedQueryExecutionId])
batchGetQueryExecutionResponse_unprocessedQueryExecutionIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetQueryExecutionResponse' {Maybe [UnprocessedQueryExecutionId]
unprocessedQueryExecutionIds :: Maybe [UnprocessedQueryExecutionId]
$sel:unprocessedQueryExecutionIds:BatchGetQueryExecutionResponse' :: BatchGetQueryExecutionResponse
-> Maybe [UnprocessedQueryExecutionId]
unprocessedQueryExecutionIds} -> Maybe [UnprocessedQueryExecutionId]
unprocessedQueryExecutionIds) (\s :: BatchGetQueryExecutionResponse
s@BatchGetQueryExecutionResponse' {} Maybe [UnprocessedQueryExecutionId]
a -> BatchGetQueryExecutionResponse
s {$sel:unprocessedQueryExecutionIds:BatchGetQueryExecutionResponse' :: Maybe [UnprocessedQueryExecutionId]
unprocessedQueryExecutionIds = Maybe [UnprocessedQueryExecutionId]
a} :: BatchGetQueryExecutionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    BatchGetQueryExecutionResponse
  where
  rnf :: BatchGetQueryExecutionResponse -> ()
rnf BatchGetQueryExecutionResponse' {Int
Maybe [QueryExecution]
Maybe [UnprocessedQueryExecutionId]
httpStatus :: Int
unprocessedQueryExecutionIds :: Maybe [UnprocessedQueryExecutionId]
queryExecutions :: Maybe [QueryExecution]
$sel:httpStatus:BatchGetQueryExecutionResponse' :: BatchGetQueryExecutionResponse -> Int
$sel:unprocessedQueryExecutionIds:BatchGetQueryExecutionResponse' :: BatchGetQueryExecutionResponse
-> Maybe [UnprocessedQueryExecutionId]
$sel:queryExecutions:BatchGetQueryExecutionResponse' :: BatchGetQueryExecutionResponse -> Maybe [QueryExecution]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [QueryExecution]
queryExecutions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnprocessedQueryExecutionId]
unprocessedQueryExecutionIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus