{-# 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.StartQuery
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Schedules a query of a log group using CloudWatch Logs Insights. You
-- specify the log group and time range to query and the query string to
-- use.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/logs/CWL_QuerySyntax.html CloudWatch Logs Insights Query Syntax>.
--
-- Queries time out after 15 minutes of runtime. If your queries are timing
-- out, reduce the time range being searched or partition your query into a
-- number of queries.
--
-- If you are using CloudWatch cross-account observability, you can use
-- this operation in a monitoring account to start a query in a linked
-- source account. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-Unified-Cross-Account.html CloudWatch cross-account observability>.
-- For a cross-account @StartQuery@ operation, the query definition must be
-- defined in the monitoring account.
--
-- You can have up to 20 concurrent CloudWatch Logs insights queries,
-- including queries that have been added to dashboards.
module Amazonka.CloudWatchLogs.StartQuery
  ( -- * Creating a Request
    StartQuery (..),
    newStartQuery,

    -- * Request Lenses
    startQuery_limit,
    startQuery_logGroupIdentifiers,
    startQuery_logGroupName,
    startQuery_logGroupNames,
    startQuery_startTime,
    startQuery_endTime,
    startQuery_queryString,

    -- * Destructuring the Response
    StartQueryResponse (..),
    newStartQueryResponse,

    -- * Response Lenses
    startQueryResponse_queryId,
    startQueryResponse_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:/ 'newStartQuery' smart constructor.
data StartQuery = StartQuery'
  { -- | The maximum number of log events to return in the query. If the query
    -- string uses the @fields@ command, only the specified fields and their
    -- values are returned. The default is 1000.
    StartQuery -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The list of log groups to query. You can include up to 50 log groups.
    --
    -- You can specify them by the log group name or ARN. If a log group that
    -- you\'re querying is in a source account and you\'re using a monitoring
    -- account, you must specify the ARN of the log group here. The query
    -- definition must also be defined in the monitoring account.
    --
    -- If you specify an ARN, the ARN can\'t end with an asterisk (*).
    --
    -- A @StartQuery@ operation must include exactly one of the following
    -- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
    StartQuery -> Maybe [Text]
logGroupIdentifiers :: Prelude.Maybe [Prelude.Text],
    -- | The log group on which to perform the query.
    --
    -- A @StartQuery@ operation must include exactly one of the following
    -- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
    StartQuery -> Maybe Text
logGroupName :: Prelude.Maybe Prelude.Text,
    -- | The list of log groups to be queried. You can include up to 50 log
    -- groups.
    --
    -- A @StartQuery@ operation must include exactly one of the following
    -- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
    StartQuery -> Maybe [Text]
logGroupNames :: Prelude.Maybe [Prelude.Text],
    -- | The beginning of the time range to query. The range is inclusive, so the
    -- specified start time is included in the query. Specified as epoch time,
    -- the number of seconds since @January 1, 1970, 00:00:00 UTC@.
    StartQuery -> Natural
startTime :: Prelude.Natural,
    -- | The end of the time range to query. The range is inclusive, so the
    -- specified end time is included in the query. Specified as epoch time,
    -- the number of seconds since @January 1, 1970, 00:00:00 UTC@.
    StartQuery -> Natural
endTime :: Prelude.Natural,
    -- | The query string to use. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/logs/CWL_QuerySyntax.html CloudWatch Logs Insights Query Syntax>.
    StartQuery -> Text
queryString :: Prelude.Text
  }
  deriving (StartQuery -> StartQuery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartQuery -> StartQuery -> Bool
$c/= :: StartQuery -> StartQuery -> Bool
== :: StartQuery -> StartQuery -> Bool
$c== :: StartQuery -> StartQuery -> Bool
Prelude.Eq, ReadPrec [StartQuery]
ReadPrec StartQuery
Int -> ReadS StartQuery
ReadS [StartQuery]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartQuery]
$creadListPrec :: ReadPrec [StartQuery]
readPrec :: ReadPrec StartQuery
$creadPrec :: ReadPrec StartQuery
readList :: ReadS [StartQuery]
$creadList :: ReadS [StartQuery]
readsPrec :: Int -> ReadS StartQuery
$creadsPrec :: Int -> ReadS StartQuery
Prelude.Read, Int -> StartQuery -> ShowS
[StartQuery] -> ShowS
StartQuery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartQuery] -> ShowS
$cshowList :: [StartQuery] -> ShowS
show :: StartQuery -> String
$cshow :: StartQuery -> String
showsPrec :: Int -> StartQuery -> ShowS
$cshowsPrec :: Int -> StartQuery -> ShowS
Prelude.Show, forall x. Rep StartQuery x -> StartQuery
forall x. StartQuery -> Rep StartQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartQuery x -> StartQuery
$cfrom :: forall x. StartQuery -> Rep StartQuery x
Prelude.Generic)

-- |
-- Create a value of 'StartQuery' 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:
--
-- 'limit', 'startQuery_limit' - The maximum number of log events to return in the query. If the query
-- string uses the @fields@ command, only the specified fields and their
-- values are returned. The default is 1000.
--
-- 'logGroupIdentifiers', 'startQuery_logGroupIdentifiers' - The list of log groups to query. You can include up to 50 log groups.
--
-- You can specify them by the log group name or ARN. If a log group that
-- you\'re querying is in a source account and you\'re using a monitoring
-- account, you must specify the ARN of the log group here. The query
-- definition must also be defined in the monitoring account.
--
-- If you specify an ARN, the ARN can\'t end with an asterisk (*).
--
-- A @StartQuery@ operation must include exactly one of the following
-- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
--
-- 'logGroupName', 'startQuery_logGroupName' - The log group on which to perform the query.
--
-- A @StartQuery@ operation must include exactly one of the following
-- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
--
-- 'logGroupNames', 'startQuery_logGroupNames' - The list of log groups to be queried. You can include up to 50 log
-- groups.
--
-- A @StartQuery@ operation must include exactly one of the following
-- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
--
-- 'startTime', 'startQuery_startTime' - The beginning of the time range to query. The range is inclusive, so the
-- specified start time is included in the query. Specified as epoch time,
-- the number of seconds since @January 1, 1970, 00:00:00 UTC@.
--
-- 'endTime', 'startQuery_endTime' - The end of the time range to query. The range is inclusive, so the
-- specified end time is included in the query. Specified as epoch time,
-- the number of seconds since @January 1, 1970, 00:00:00 UTC@.
--
-- 'queryString', 'startQuery_queryString' - The query string to use. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/logs/CWL_QuerySyntax.html CloudWatch Logs Insights Query Syntax>.
newStartQuery ::
  -- | 'startTime'
  Prelude.Natural ->
  -- | 'endTime'
  Prelude.Natural ->
  -- | 'queryString'
  Prelude.Text ->
  StartQuery
newStartQuery :: Natural -> Natural -> Text -> StartQuery
newStartQuery Natural
pStartTime_ Natural
pEndTime_ Text
pQueryString_ =
  StartQuery'
    { $sel:limit:StartQuery' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupIdentifiers:StartQuery' :: Maybe [Text]
logGroupIdentifiers = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupName:StartQuery' :: Maybe Text
logGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupNames:StartQuery' :: Maybe [Text]
logGroupNames = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:StartQuery' :: Natural
startTime = Natural
pStartTime_,
      $sel:endTime:StartQuery' :: Natural
endTime = Natural
pEndTime_,
      $sel:queryString:StartQuery' :: Text
queryString = Text
pQueryString_
    }

-- | The maximum number of log events to return in the query. If the query
-- string uses the @fields@ command, only the specified fields and their
-- values are returned. The default is 1000.
startQuery_limit :: Lens.Lens' StartQuery (Prelude.Maybe Prelude.Natural)
startQuery_limit :: Lens' StartQuery (Maybe Natural)
startQuery_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartQuery' {Maybe Natural
limit :: Maybe Natural
$sel:limit:StartQuery' :: StartQuery -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: StartQuery
s@StartQuery' {} Maybe Natural
a -> StartQuery
s {$sel:limit:StartQuery' :: Maybe Natural
limit = Maybe Natural
a} :: StartQuery)

-- | The list of log groups to query. You can include up to 50 log groups.
--
-- You can specify them by the log group name or ARN. If a log group that
-- you\'re querying is in a source account and you\'re using a monitoring
-- account, you must specify the ARN of the log group here. The query
-- definition must also be defined in the monitoring account.
--
-- If you specify an ARN, the ARN can\'t end with an asterisk (*).
--
-- A @StartQuery@ operation must include exactly one of the following
-- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
startQuery_logGroupIdentifiers :: Lens.Lens' StartQuery (Prelude.Maybe [Prelude.Text])
startQuery_logGroupIdentifiers :: Lens' StartQuery (Maybe [Text])
startQuery_logGroupIdentifiers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartQuery' {Maybe [Text]
logGroupIdentifiers :: Maybe [Text]
$sel:logGroupIdentifiers:StartQuery' :: StartQuery -> Maybe [Text]
logGroupIdentifiers} -> Maybe [Text]
logGroupIdentifiers) (\s :: StartQuery
s@StartQuery' {} Maybe [Text]
a -> StartQuery
s {$sel:logGroupIdentifiers:StartQuery' :: Maybe [Text]
logGroupIdentifiers = Maybe [Text]
a} :: StartQuery) 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 log group on which to perform the query.
--
-- A @StartQuery@ operation must include exactly one of the following
-- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
startQuery_logGroupName :: Lens.Lens' StartQuery (Prelude.Maybe Prelude.Text)
startQuery_logGroupName :: Lens' StartQuery (Maybe Text)
startQuery_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartQuery' {Maybe Text
logGroupName :: Maybe Text
$sel:logGroupName:StartQuery' :: StartQuery -> Maybe Text
logGroupName} -> Maybe Text
logGroupName) (\s :: StartQuery
s@StartQuery' {} Maybe Text
a -> StartQuery
s {$sel:logGroupName:StartQuery' :: Maybe Text
logGroupName = Maybe Text
a} :: StartQuery)

-- | The list of log groups to be queried. You can include up to 50 log
-- groups.
--
-- A @StartQuery@ operation must include exactly one of the following
-- parameters: @logGroupName@, @logGroupNames@ or @logGroupIdentifiers@.
startQuery_logGroupNames :: Lens.Lens' StartQuery (Prelude.Maybe [Prelude.Text])
startQuery_logGroupNames :: Lens' StartQuery (Maybe [Text])
startQuery_logGroupNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartQuery' {Maybe [Text]
logGroupNames :: Maybe [Text]
$sel:logGroupNames:StartQuery' :: StartQuery -> Maybe [Text]
logGroupNames} -> Maybe [Text]
logGroupNames) (\s :: StartQuery
s@StartQuery' {} Maybe [Text]
a -> StartQuery
s {$sel:logGroupNames:StartQuery' :: Maybe [Text]
logGroupNames = Maybe [Text]
a} :: StartQuery) 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 beginning of the time range to query. The range is inclusive, so the
-- specified start time is included in the query. Specified as epoch time,
-- the number of seconds since @January 1, 1970, 00:00:00 UTC@.
startQuery_startTime :: Lens.Lens' StartQuery Prelude.Natural
startQuery_startTime :: Lens' StartQuery Natural
startQuery_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartQuery' {Natural
startTime :: Natural
$sel:startTime:StartQuery' :: StartQuery -> Natural
startTime} -> Natural
startTime) (\s :: StartQuery
s@StartQuery' {} Natural
a -> StartQuery
s {$sel:startTime:StartQuery' :: Natural
startTime = Natural
a} :: StartQuery)

-- | The end of the time range to query. The range is inclusive, so the
-- specified end time is included in the query. Specified as epoch time,
-- the number of seconds since @January 1, 1970, 00:00:00 UTC@.
startQuery_endTime :: Lens.Lens' StartQuery Prelude.Natural
startQuery_endTime :: Lens' StartQuery Natural
startQuery_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartQuery' {Natural
endTime :: Natural
$sel:endTime:StartQuery' :: StartQuery -> Natural
endTime} -> Natural
endTime) (\s :: StartQuery
s@StartQuery' {} Natural
a -> StartQuery
s {$sel:endTime:StartQuery' :: Natural
endTime = Natural
a} :: StartQuery)

-- | The query string to use. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/logs/CWL_QuerySyntax.html CloudWatch Logs Insights Query Syntax>.
startQuery_queryString :: Lens.Lens' StartQuery Prelude.Text
startQuery_queryString :: Lens' StartQuery Text
startQuery_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartQuery' {Text
queryString :: Text
$sel:queryString:StartQuery' :: StartQuery -> Text
queryString} -> Text
queryString) (\s :: StartQuery
s@StartQuery' {} Text
a -> StartQuery
s {$sel:queryString:StartQuery' :: Text
queryString = Text
a} :: StartQuery)

instance Core.AWSRequest StartQuery where
  type AWSResponse StartQuery = StartQueryResponse
  request :: (Service -> Service) -> StartQuery -> Request StartQuery
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 StartQuery
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartQuery)))
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 -> StartQueryResponse
StartQueryResponse'
            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
"queryId")
            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 StartQuery where
  hashWithSalt :: Int -> StartQuery -> Int
hashWithSalt Int
_salt StartQuery' {Natural
Maybe Natural
Maybe [Text]
Maybe Text
Text
queryString :: Text
endTime :: Natural
startTime :: Natural
logGroupNames :: Maybe [Text]
logGroupName :: Maybe Text
logGroupIdentifiers :: Maybe [Text]
limit :: Maybe Natural
$sel:queryString:StartQuery' :: StartQuery -> Text
$sel:endTime:StartQuery' :: StartQuery -> Natural
$sel:startTime:StartQuery' :: StartQuery -> Natural
$sel:logGroupNames:StartQuery' :: StartQuery -> Maybe [Text]
$sel:logGroupName:StartQuery' :: StartQuery -> Maybe Text
$sel:logGroupIdentifiers:StartQuery' :: StartQuery -> Maybe [Text]
$sel:limit:StartQuery' :: StartQuery -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
logGroupIdentifiers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
logGroupNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queryString

instance Prelude.NFData StartQuery where
  rnf :: StartQuery -> ()
rnf StartQuery' {Natural
Maybe Natural
Maybe [Text]
Maybe Text
Text
queryString :: Text
endTime :: Natural
startTime :: Natural
logGroupNames :: Maybe [Text]
logGroupName :: Maybe Text
logGroupIdentifiers :: Maybe [Text]
limit :: Maybe Natural
$sel:queryString:StartQuery' :: StartQuery -> Text
$sel:endTime:StartQuery' :: StartQuery -> Natural
$sel:startTime:StartQuery' :: StartQuery -> Natural
$sel:logGroupNames:StartQuery' :: StartQuery -> Maybe [Text]
$sel:logGroupName:StartQuery' :: StartQuery -> Maybe Text
$sel:logGroupIdentifiers:StartQuery' :: StartQuery -> Maybe [Text]
$sel:limit:StartQuery' :: StartQuery -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
logGroupIdentifiers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
logGroupNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
queryString

instance Data.ToHeaders StartQuery where
  toHeaders :: StartQuery -> 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.StartQuery" :: 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 StartQuery where
  toJSON :: StartQuery -> Value
toJSON StartQuery' {Natural
Maybe Natural
Maybe [Text]
Maybe Text
Text
queryString :: Text
endTime :: Natural
startTime :: Natural
logGroupNames :: Maybe [Text]
logGroupName :: Maybe Text
logGroupIdentifiers :: Maybe [Text]
limit :: Maybe Natural
$sel:queryString:StartQuery' :: StartQuery -> Text
$sel:endTime:StartQuery' :: StartQuery -> Natural
$sel:startTime:StartQuery' :: StartQuery -> Natural
$sel:logGroupNames:StartQuery' :: StartQuery -> Maybe [Text]
$sel:logGroupName:StartQuery' :: StartQuery -> Maybe Text
$sel:logGroupIdentifiers:StartQuery' :: StartQuery -> Maybe [Text]
$sel:limit:StartQuery' :: StartQuery -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"limit" 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 Natural
limit,
            (Key
"logGroupIdentifiers" 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]
logGroupIdentifiers,
            (Key
"logGroupName" 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
logGroupName,
            (Key
"logGroupNames" 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]
logGroupNames,
            forall a. a -> Maybe a
Prelude.Just (Key
"startTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
startTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"endTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
endTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"queryString" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
queryString)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartQueryResponse' 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', 'startQueryResponse_queryId' - The unique ID of the query.
--
-- 'httpStatus', 'startQueryResponse_httpStatus' - The response's http status code.
newStartQueryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartQueryResponse
newStartQueryResponse :: Int -> StartQueryResponse
newStartQueryResponse Int
pHttpStatus_ =
  StartQueryResponse'
    { $sel:queryId:StartQueryResponse' :: Maybe Text
queryId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartQueryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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