{-# 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.IoT.GetStatistics
-- 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 count, average, sum, minimum, maximum, sum of squares,
-- variance, and standard deviation for the specified aggregated field. If
-- the aggregation field is of type @String@, only the count statistic is
-- returned.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions GetStatistics>
-- action.
module Amazonka.IoT.GetStatistics
  ( -- * Creating a Request
    GetStatistics (..),
    newGetStatistics,

    -- * Request Lenses
    getStatistics_aggregationField,
    getStatistics_indexName,
    getStatistics_queryVersion,
    getStatistics_queryString,

    -- * Destructuring the Response
    GetStatisticsResponse (..),
    newGetStatisticsResponse,

    -- * Response Lenses
    getStatisticsResponse_statistics,
    getStatisticsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetStatistics' smart constructor.
data GetStatistics = GetStatistics'
  { -- | The aggregation field name.
    GetStatistics -> Maybe Text
aggregationField :: Prelude.Maybe Prelude.Text,
    -- | The name of the index to search. The default value is @AWS_Things@.
    GetStatistics -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The version of the query used to search.
    GetStatistics -> Maybe Text
queryVersion :: Prelude.Maybe Prelude.Text,
    -- | The query used to search. You can specify \"*\" for the query string to
    -- get the count of all indexed things in your Amazon Web Services account.
    GetStatistics -> Text
queryString :: Prelude.Text
  }
  deriving (GetStatistics -> GetStatistics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStatistics -> GetStatistics -> Bool
$c/= :: GetStatistics -> GetStatistics -> Bool
== :: GetStatistics -> GetStatistics -> Bool
$c== :: GetStatistics -> GetStatistics -> Bool
Prelude.Eq, ReadPrec [GetStatistics]
ReadPrec GetStatistics
Int -> ReadS GetStatistics
ReadS [GetStatistics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStatistics]
$creadListPrec :: ReadPrec [GetStatistics]
readPrec :: ReadPrec GetStatistics
$creadPrec :: ReadPrec GetStatistics
readList :: ReadS [GetStatistics]
$creadList :: ReadS [GetStatistics]
readsPrec :: Int -> ReadS GetStatistics
$creadsPrec :: Int -> ReadS GetStatistics
Prelude.Read, Int -> GetStatistics -> ShowS
[GetStatistics] -> ShowS
GetStatistics -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStatistics] -> ShowS
$cshowList :: [GetStatistics] -> ShowS
show :: GetStatistics -> String
$cshow :: GetStatistics -> String
showsPrec :: Int -> GetStatistics -> ShowS
$cshowsPrec :: Int -> GetStatistics -> ShowS
Prelude.Show, forall x. Rep GetStatistics x -> GetStatistics
forall x. GetStatistics -> Rep GetStatistics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStatistics x -> GetStatistics
$cfrom :: forall x. GetStatistics -> Rep GetStatistics x
Prelude.Generic)

-- |
-- Create a value of 'GetStatistics' 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:
--
-- 'aggregationField', 'getStatistics_aggregationField' - The aggregation field name.
--
-- 'indexName', 'getStatistics_indexName' - The name of the index to search. The default value is @AWS_Things@.
--
-- 'queryVersion', 'getStatistics_queryVersion' - The version of the query used to search.
--
-- 'queryString', 'getStatistics_queryString' - The query used to search. You can specify \"*\" for the query string to
-- get the count of all indexed things in your Amazon Web Services account.
newGetStatistics ::
  -- | 'queryString'
  Prelude.Text ->
  GetStatistics
newGetStatistics :: Text -> GetStatistics
newGetStatistics Text
pQueryString_ =
  GetStatistics'
    { $sel:aggregationField:GetStatistics' :: Maybe Text
aggregationField = forall a. Maybe a
Prelude.Nothing,
      $sel:indexName:GetStatistics' :: Maybe Text
indexName = forall a. Maybe a
Prelude.Nothing,
      $sel:queryVersion:GetStatistics' :: Maybe Text
queryVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:queryString:GetStatistics' :: Text
queryString = Text
pQueryString_
    }

-- | The aggregation field name.
getStatistics_aggregationField :: Lens.Lens' GetStatistics (Prelude.Maybe Prelude.Text)
getStatistics_aggregationField :: Lens' GetStatistics (Maybe Text)
getStatistics_aggregationField = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatistics' {Maybe Text
aggregationField :: Maybe Text
$sel:aggregationField:GetStatistics' :: GetStatistics -> Maybe Text
aggregationField} -> Maybe Text
aggregationField) (\s :: GetStatistics
s@GetStatistics' {} Maybe Text
a -> GetStatistics
s {$sel:aggregationField:GetStatistics' :: Maybe Text
aggregationField = Maybe Text
a} :: GetStatistics)

-- | The name of the index to search. The default value is @AWS_Things@.
getStatistics_indexName :: Lens.Lens' GetStatistics (Prelude.Maybe Prelude.Text)
getStatistics_indexName :: Lens' GetStatistics (Maybe Text)
getStatistics_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatistics' {Maybe Text
indexName :: Maybe Text
$sel:indexName:GetStatistics' :: GetStatistics -> Maybe Text
indexName} -> Maybe Text
indexName) (\s :: GetStatistics
s@GetStatistics' {} Maybe Text
a -> GetStatistics
s {$sel:indexName:GetStatistics' :: Maybe Text
indexName = Maybe Text
a} :: GetStatistics)

-- | The version of the query used to search.
getStatistics_queryVersion :: Lens.Lens' GetStatistics (Prelude.Maybe Prelude.Text)
getStatistics_queryVersion :: Lens' GetStatistics (Maybe Text)
getStatistics_queryVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatistics' {Maybe Text
queryVersion :: Maybe Text
$sel:queryVersion:GetStatistics' :: GetStatistics -> Maybe Text
queryVersion} -> Maybe Text
queryVersion) (\s :: GetStatistics
s@GetStatistics' {} Maybe Text
a -> GetStatistics
s {$sel:queryVersion:GetStatistics' :: Maybe Text
queryVersion = Maybe Text
a} :: GetStatistics)

-- | The query used to search. You can specify \"*\" for the query string to
-- get the count of all indexed things in your Amazon Web Services account.
getStatistics_queryString :: Lens.Lens' GetStatistics Prelude.Text
getStatistics_queryString :: Lens' GetStatistics Text
getStatistics_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatistics' {Text
queryString :: Text
$sel:queryString:GetStatistics' :: GetStatistics -> Text
queryString} -> Text
queryString) (\s :: GetStatistics
s@GetStatistics' {} Text
a -> GetStatistics
s {$sel:queryString:GetStatistics' :: Text
queryString = Text
a} :: GetStatistics)

instance Core.AWSRequest GetStatistics where
  type
    AWSResponse GetStatistics =
      GetStatisticsResponse
  request :: (Service -> Service) -> GetStatistics -> Request GetStatistics
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 GetStatistics
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetStatistics)))
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 Statistics -> Int -> GetStatisticsResponse
GetStatisticsResponse'
            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
"statistics")
            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 GetStatistics where
  hashWithSalt :: Int -> GetStatistics -> Int
hashWithSalt Int
_salt GetStatistics' {Maybe Text
Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
aggregationField :: Maybe Text
$sel:queryString:GetStatistics' :: GetStatistics -> Text
$sel:queryVersion:GetStatistics' :: GetStatistics -> Maybe Text
$sel:indexName:GetStatistics' :: GetStatistics -> Maybe Text
$sel:aggregationField:GetStatistics' :: GetStatistics -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
aggregationField
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
queryVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queryString

instance Prelude.NFData GetStatistics where
  rnf :: GetStatistics -> ()
rnf GetStatistics' {Maybe Text
Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
aggregationField :: Maybe Text
$sel:queryString:GetStatistics' :: GetStatistics -> Text
$sel:queryVersion:GetStatistics' :: GetStatistics -> Maybe Text
$sel:indexName:GetStatistics' :: GetStatistics -> Maybe Text
$sel:aggregationField:GetStatistics' :: GetStatistics -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
aggregationField
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
indexName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queryVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
queryString

instance Data.ToHeaders GetStatistics where
  toHeaders :: GetStatistics -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetStatistics where
  toJSON :: GetStatistics -> Value
toJSON GetStatistics' {Maybe Text
Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
aggregationField :: Maybe Text
$sel:queryString:GetStatistics' :: GetStatistics -> Text
$sel:queryVersion:GetStatistics' :: GetStatistics -> Maybe Text
$sel:indexName:GetStatistics' :: GetStatistics -> Maybe Text
$sel:aggregationField:GetStatistics' :: GetStatistics -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"aggregationField" 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
aggregationField,
            (Key
"indexName" 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
indexName,
            (Key
"queryVersion" 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
queryVersion,
            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 GetStatistics where
  toPath :: GetStatistics -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/indices/statistics"

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

-- | /See:/ 'newGetStatisticsResponse' smart constructor.
data GetStatisticsResponse = GetStatisticsResponse'
  { -- | The statistics returned by the Fleet Indexing service based on the query
    -- and aggregation field.
    GetStatisticsResponse -> Maybe Statistics
statistics :: Prelude.Maybe Statistics,
    -- | The response's http status code.
    GetStatisticsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetStatisticsResponse -> GetStatisticsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStatisticsResponse -> GetStatisticsResponse -> Bool
$c/= :: GetStatisticsResponse -> GetStatisticsResponse -> Bool
== :: GetStatisticsResponse -> GetStatisticsResponse -> Bool
$c== :: GetStatisticsResponse -> GetStatisticsResponse -> Bool
Prelude.Eq, ReadPrec [GetStatisticsResponse]
ReadPrec GetStatisticsResponse
Int -> ReadS GetStatisticsResponse
ReadS [GetStatisticsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStatisticsResponse]
$creadListPrec :: ReadPrec [GetStatisticsResponse]
readPrec :: ReadPrec GetStatisticsResponse
$creadPrec :: ReadPrec GetStatisticsResponse
readList :: ReadS [GetStatisticsResponse]
$creadList :: ReadS [GetStatisticsResponse]
readsPrec :: Int -> ReadS GetStatisticsResponse
$creadsPrec :: Int -> ReadS GetStatisticsResponse
Prelude.Read, Int -> GetStatisticsResponse -> ShowS
[GetStatisticsResponse] -> ShowS
GetStatisticsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStatisticsResponse] -> ShowS
$cshowList :: [GetStatisticsResponse] -> ShowS
show :: GetStatisticsResponse -> String
$cshow :: GetStatisticsResponse -> String
showsPrec :: Int -> GetStatisticsResponse -> ShowS
$cshowsPrec :: Int -> GetStatisticsResponse -> ShowS
Prelude.Show, forall x. Rep GetStatisticsResponse x -> GetStatisticsResponse
forall x. GetStatisticsResponse -> Rep GetStatisticsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStatisticsResponse x -> GetStatisticsResponse
$cfrom :: forall x. GetStatisticsResponse -> Rep GetStatisticsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetStatisticsResponse' 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:
--
-- 'statistics', 'getStatisticsResponse_statistics' - The statistics returned by the Fleet Indexing service based on the query
-- and aggregation field.
--
-- 'httpStatus', 'getStatisticsResponse_httpStatus' - The response's http status code.
newGetStatisticsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetStatisticsResponse
newGetStatisticsResponse :: Int -> GetStatisticsResponse
newGetStatisticsResponse Int
pHttpStatus_ =
  GetStatisticsResponse'
    { $sel:statistics:GetStatisticsResponse' :: Maybe Statistics
statistics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetStatisticsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The statistics returned by the Fleet Indexing service based on the query
-- and aggregation field.
getStatisticsResponse_statistics :: Lens.Lens' GetStatisticsResponse (Prelude.Maybe Statistics)
getStatisticsResponse_statistics :: Lens' GetStatisticsResponse (Maybe Statistics)
getStatisticsResponse_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatisticsResponse' {Maybe Statistics
statistics :: Maybe Statistics
$sel:statistics:GetStatisticsResponse' :: GetStatisticsResponse -> Maybe Statistics
statistics} -> Maybe Statistics
statistics) (\s :: GetStatisticsResponse
s@GetStatisticsResponse' {} Maybe Statistics
a -> GetStatisticsResponse
s {$sel:statistics:GetStatisticsResponse' :: Maybe Statistics
statistics = Maybe Statistics
a} :: GetStatisticsResponse)

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

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