{-# 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.CloudWatchLogs.GetQueryResults
-- 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 results from the specified query.
--
-- Only the fields requested in the query are returned, along with a
-- @\@ptr@ field, which is the identifier for the log record. You can use
-- the value of @\@ptr@ in a
-- <https://docs.aws.amazon.com/AmazonCloudWatchLogs/latest/APIReference/API_GetLogRecord.html GetLogRecord>
-- operation to get the full log record.
--
-- @GetQueryResults@ does not start running a query. To run a query, use
-- <https://docs.aws.amazon.com/AmazonCloudWatchLogs/latest/APIReference/API_StartQuery.html StartQuery>.
--
-- If the value of the @Status@ field in the output is @Running@, this
-- operation returns only partial results. If you see a value of
-- @Scheduled@ or @Running@ for the status, you can retry the operation
-- later to see the final results.
--
-- If you are using CloudWatch cross-account observability, you can use
-- this operation in a monitoring account to start queries in linked source
-- accounts. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-Unified-Cross-Account.html CloudWatch cross-account observability>.
module Amazonka.CloudWatchLogs.GetQueryResults
  ( -- * Creating a Request
    GetQueryResults (..),
    newGetQueryResults,

    -- * Request Lenses
    getQueryResults_queryId,

    -- * Destructuring the Response
    GetQueryResultsResponse (..),
    newGetQueryResultsResponse,

    -- * Response Lenses
    getQueryResultsResponse_results,
    getQueryResultsResponse_statistics,
    getQueryResultsResponse_status,
    getQueryResultsResponse_httpStatus,
  )
where

import Amazonka.CloudWatchLogs.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:/ 'newGetQueryResults' smart constructor.
data GetQueryResults = GetQueryResults'
  { -- | The ID number of the query.
    GetQueryResults -> Text
queryId :: Prelude.Text
  }
  deriving (GetQueryResults -> GetQueryResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQueryResults -> GetQueryResults -> Bool
$c/= :: GetQueryResults -> GetQueryResults -> Bool
== :: GetQueryResults -> GetQueryResults -> Bool
$c== :: GetQueryResults -> GetQueryResults -> Bool
Prelude.Eq, ReadPrec [GetQueryResults]
ReadPrec GetQueryResults
Int -> ReadS GetQueryResults
ReadS [GetQueryResults]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQueryResults]
$creadListPrec :: ReadPrec [GetQueryResults]
readPrec :: ReadPrec GetQueryResults
$creadPrec :: ReadPrec GetQueryResults
readList :: ReadS [GetQueryResults]
$creadList :: ReadS [GetQueryResults]
readsPrec :: Int -> ReadS GetQueryResults
$creadsPrec :: Int -> ReadS GetQueryResults
Prelude.Read, Int -> GetQueryResults -> ShowS
[GetQueryResults] -> ShowS
GetQueryResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQueryResults] -> ShowS
$cshowList :: [GetQueryResults] -> ShowS
show :: GetQueryResults -> String
$cshow :: GetQueryResults -> String
showsPrec :: Int -> GetQueryResults -> ShowS
$cshowsPrec :: Int -> GetQueryResults -> ShowS
Prelude.Show, forall x. Rep GetQueryResults x -> GetQueryResults
forall x. GetQueryResults -> Rep GetQueryResults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetQueryResults x -> GetQueryResults
$cfrom :: forall x. GetQueryResults -> Rep GetQueryResults x
Prelude.Generic)

-- |
-- Create a value of 'GetQueryResults' 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:
--
-- 'queryId', 'getQueryResults_queryId' - The ID number of the query.
newGetQueryResults ::
  -- | 'queryId'
  Prelude.Text ->
  GetQueryResults
newGetQueryResults :: Text -> GetQueryResults
newGetQueryResults Text
pQueryId_ =
  GetQueryResults' {$sel:queryId:GetQueryResults' :: Text
queryId = Text
pQueryId_}

-- | The ID number of the query.
getQueryResults_queryId :: Lens.Lens' GetQueryResults Prelude.Text
getQueryResults_queryId :: Lens' GetQueryResults Text
getQueryResults_queryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQueryResults' {Text
queryId :: Text
$sel:queryId:GetQueryResults' :: GetQueryResults -> Text
queryId} -> Text
queryId) (\s :: GetQueryResults
s@GetQueryResults' {} Text
a -> GetQueryResults
s {$sel:queryId:GetQueryResults' :: Text
queryId = Text
a} :: GetQueryResults)

instance Core.AWSRequest GetQueryResults where
  type
    AWSResponse GetQueryResults =
      GetQueryResultsResponse
  request :: (Service -> Service) -> GetQueryResults -> Request GetQueryResults
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 GetQueryResults
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetQueryResults)))
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 [[ResultField]]
-> Maybe QueryStatistics
-> Maybe QueryStatus
-> Int
-> GetQueryResultsResponse
GetQueryResultsResponse'
            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
"results" 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
"statistics")
            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
"status")
            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 GetQueryResults where
  hashWithSalt :: Int -> GetQueryResults -> Int
hashWithSalt Int
_salt GetQueryResults' {Text
queryId :: Text
$sel:queryId:GetQueryResults' :: GetQueryResults -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queryId

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

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

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

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

-- | /See:/ 'newGetQueryResultsResponse' smart constructor.
data GetQueryResultsResponse = GetQueryResultsResponse'
  { -- | The log events that matched the query criteria during the most recent
    -- time it ran.
    --
    -- The @results@ value is an array of arrays. Each log event is one object
    -- in the top-level array. Each of these log event objects is an array of
    -- @field@\/@value@ pairs.
    GetQueryResultsResponse -> Maybe [[ResultField]]
results :: Prelude.Maybe [[ResultField]],
    -- | Includes the number of log events scanned by the query, the number of
    -- log events that matched the query criteria, and the total number of
    -- bytes in the log events that were scanned. These values reflect the full
    -- raw results of the query.
    GetQueryResultsResponse -> Maybe QueryStatistics
statistics :: Prelude.Maybe QueryStatistics,
    -- | The status of the most recent running of the query. Possible values are
    -- @Cancelled@, @Complete@, @Failed@, @Running@, @Scheduled@, @Timeout@,
    -- and @Unknown@.
    --
    -- Queries time out after 15 minutes of runtime. To avoid having your
    -- queries time out, reduce the time range being searched or partition your
    -- query into a number of queries.
    GetQueryResultsResponse -> Maybe QueryStatus
status :: Prelude.Maybe QueryStatus,
    -- | The response's http status code.
    GetQueryResultsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetQueryResultsResponse -> GetQueryResultsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQueryResultsResponse -> GetQueryResultsResponse -> Bool
$c/= :: GetQueryResultsResponse -> GetQueryResultsResponse -> Bool
== :: GetQueryResultsResponse -> GetQueryResultsResponse -> Bool
$c== :: GetQueryResultsResponse -> GetQueryResultsResponse -> Bool
Prelude.Eq, ReadPrec [GetQueryResultsResponse]
ReadPrec GetQueryResultsResponse
Int -> ReadS GetQueryResultsResponse
ReadS [GetQueryResultsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQueryResultsResponse]
$creadListPrec :: ReadPrec [GetQueryResultsResponse]
readPrec :: ReadPrec GetQueryResultsResponse
$creadPrec :: ReadPrec GetQueryResultsResponse
readList :: ReadS [GetQueryResultsResponse]
$creadList :: ReadS [GetQueryResultsResponse]
readsPrec :: Int -> ReadS GetQueryResultsResponse
$creadsPrec :: Int -> ReadS GetQueryResultsResponse
Prelude.Read, Int -> GetQueryResultsResponse -> ShowS
[GetQueryResultsResponse] -> ShowS
GetQueryResultsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQueryResultsResponse] -> ShowS
$cshowList :: [GetQueryResultsResponse] -> ShowS
show :: GetQueryResultsResponse -> String
$cshow :: GetQueryResultsResponse -> String
showsPrec :: Int -> GetQueryResultsResponse -> ShowS
$cshowsPrec :: Int -> GetQueryResultsResponse -> ShowS
Prelude.Show, forall x. Rep GetQueryResultsResponse x -> GetQueryResultsResponse
forall x. GetQueryResultsResponse -> Rep GetQueryResultsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetQueryResultsResponse x -> GetQueryResultsResponse
$cfrom :: forall x. GetQueryResultsResponse -> Rep GetQueryResultsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetQueryResultsResponse' 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:
--
-- 'results', 'getQueryResultsResponse_results' - The log events that matched the query criteria during the most recent
-- time it ran.
--
-- The @results@ value is an array of arrays. Each log event is one object
-- in the top-level array. Each of these log event objects is an array of
-- @field@\/@value@ pairs.
--
-- 'statistics', 'getQueryResultsResponse_statistics' - Includes the number of log events scanned by the query, the number of
-- log events that matched the query criteria, and the total number of
-- bytes in the log events that were scanned. These values reflect the full
-- raw results of the query.
--
-- 'status', 'getQueryResultsResponse_status' - The status of the most recent running of the query. Possible values are
-- @Cancelled@, @Complete@, @Failed@, @Running@, @Scheduled@, @Timeout@,
-- and @Unknown@.
--
-- Queries time out after 15 minutes of runtime. To avoid having your
-- queries time out, reduce the time range being searched or partition your
-- query into a number of queries.
--
-- 'httpStatus', 'getQueryResultsResponse_httpStatus' - The response's http status code.
newGetQueryResultsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetQueryResultsResponse
newGetQueryResultsResponse :: Int -> GetQueryResultsResponse
newGetQueryResultsResponse Int
pHttpStatus_ =
  GetQueryResultsResponse'
    { $sel:results:GetQueryResultsResponse' :: Maybe [[ResultField]]
results = forall a. Maybe a
Prelude.Nothing,
      $sel:statistics:GetQueryResultsResponse' :: Maybe QueryStatistics
statistics = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetQueryResultsResponse' :: Maybe QueryStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetQueryResultsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The log events that matched the query criteria during the most recent
-- time it ran.
--
-- The @results@ value is an array of arrays. Each log event is one object
-- in the top-level array. Each of these log event objects is an array of
-- @field@\/@value@ pairs.
getQueryResultsResponse_results :: Lens.Lens' GetQueryResultsResponse (Prelude.Maybe [[ResultField]])
getQueryResultsResponse_results :: Lens' GetQueryResultsResponse (Maybe [[ResultField]])
getQueryResultsResponse_results = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQueryResultsResponse' {Maybe [[ResultField]]
results :: Maybe [[ResultField]]
$sel:results:GetQueryResultsResponse' :: GetQueryResultsResponse -> Maybe [[ResultField]]
results} -> Maybe [[ResultField]]
results) (\s :: GetQueryResultsResponse
s@GetQueryResultsResponse' {} Maybe [[ResultField]]
a -> GetQueryResultsResponse
s {$sel:results:GetQueryResultsResponse' :: Maybe [[ResultField]]
results = Maybe [[ResultField]]
a} :: GetQueryResultsResponse) 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

-- | Includes the number of log events scanned by the query, the number of
-- log events that matched the query criteria, and the total number of
-- bytes in the log events that were scanned. These values reflect the full
-- raw results of the query.
getQueryResultsResponse_statistics :: Lens.Lens' GetQueryResultsResponse (Prelude.Maybe QueryStatistics)
getQueryResultsResponse_statistics :: Lens' GetQueryResultsResponse (Maybe QueryStatistics)
getQueryResultsResponse_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQueryResultsResponse' {Maybe QueryStatistics
statistics :: Maybe QueryStatistics
$sel:statistics:GetQueryResultsResponse' :: GetQueryResultsResponse -> Maybe QueryStatistics
statistics} -> Maybe QueryStatistics
statistics) (\s :: GetQueryResultsResponse
s@GetQueryResultsResponse' {} Maybe QueryStatistics
a -> GetQueryResultsResponse
s {$sel:statistics:GetQueryResultsResponse' :: Maybe QueryStatistics
statistics = Maybe QueryStatistics
a} :: GetQueryResultsResponse)

-- | The status of the most recent running of the query. Possible values are
-- @Cancelled@, @Complete@, @Failed@, @Running@, @Scheduled@, @Timeout@,
-- and @Unknown@.
--
-- Queries time out after 15 minutes of runtime. To avoid having your
-- queries time out, reduce the time range being searched or partition your
-- query into a number of queries.
getQueryResultsResponse_status :: Lens.Lens' GetQueryResultsResponse (Prelude.Maybe QueryStatus)
getQueryResultsResponse_status :: Lens' GetQueryResultsResponse (Maybe QueryStatus)
getQueryResultsResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQueryResultsResponse' {Maybe QueryStatus
status :: Maybe QueryStatus
$sel:status:GetQueryResultsResponse' :: GetQueryResultsResponse -> Maybe QueryStatus
status} -> Maybe QueryStatus
status) (\s :: GetQueryResultsResponse
s@GetQueryResultsResponse' {} Maybe QueryStatus
a -> GetQueryResultsResponse
s {$sel:status:GetQueryResultsResponse' :: Maybe QueryStatus
status = Maybe QueryStatus
a} :: GetQueryResultsResponse)

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

instance Prelude.NFData GetQueryResultsResponse where
  rnf :: GetQueryResultsResponse -> ()
rnf GetQueryResultsResponse' {Int
Maybe [[ResultField]]
Maybe QueryStatistics
Maybe QueryStatus
httpStatus :: Int
status :: Maybe QueryStatus
statistics :: Maybe QueryStatistics
results :: Maybe [[ResultField]]
$sel:httpStatus:GetQueryResultsResponse' :: GetQueryResultsResponse -> Int
$sel:status:GetQueryResultsResponse' :: GetQueryResultsResponse -> Maybe QueryStatus
$sel:statistics:GetQueryResultsResponse' :: GetQueryResultsResponse -> Maybe QueryStatistics
$sel:results:GetQueryResultsResponse' :: GetQueryResultsResponse -> Maybe [[ResultField]]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [[ResultField]]
results
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QueryStatistics
statistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QueryStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus