{-# 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.GetCardinality
-- 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 approximate count of unique values that match the query.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions GetCardinality>
-- action.
module Amazonka.IoT.GetCardinality
  ( -- * Creating a Request
    GetCardinality (..),
    newGetCardinality,

    -- * Request Lenses
    getCardinality_aggregationField,
    getCardinality_indexName,
    getCardinality_queryVersion,
    getCardinality_queryString,

    -- * Destructuring the Response
    GetCardinalityResponse (..),
    newGetCardinalityResponse,

    -- * Response Lenses
    getCardinalityResponse_cardinality,
    getCardinalityResponse_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:/ 'newGetCardinality' smart constructor.
data GetCardinality = GetCardinality'
  { -- | The field to aggregate.
    GetCardinality -> Maybe Text
aggregationField :: Prelude.Maybe Prelude.Text,
    -- | The name of the index to search.
    GetCardinality -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The query version.
    GetCardinality -> Maybe Text
queryVersion :: Prelude.Maybe Prelude.Text,
    -- | The search query string.
    GetCardinality -> Text
queryString :: Prelude.Text
  }
  deriving (GetCardinality -> GetCardinality -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCardinality -> GetCardinality -> Bool
$c/= :: GetCardinality -> GetCardinality -> Bool
== :: GetCardinality -> GetCardinality -> Bool
$c== :: GetCardinality -> GetCardinality -> Bool
Prelude.Eq, ReadPrec [GetCardinality]
ReadPrec GetCardinality
Int -> ReadS GetCardinality
ReadS [GetCardinality]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCardinality]
$creadListPrec :: ReadPrec [GetCardinality]
readPrec :: ReadPrec GetCardinality
$creadPrec :: ReadPrec GetCardinality
readList :: ReadS [GetCardinality]
$creadList :: ReadS [GetCardinality]
readsPrec :: Int -> ReadS GetCardinality
$creadsPrec :: Int -> ReadS GetCardinality
Prelude.Read, Int -> GetCardinality -> ShowS
[GetCardinality] -> ShowS
GetCardinality -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCardinality] -> ShowS
$cshowList :: [GetCardinality] -> ShowS
show :: GetCardinality -> String
$cshow :: GetCardinality -> String
showsPrec :: Int -> GetCardinality -> ShowS
$cshowsPrec :: Int -> GetCardinality -> ShowS
Prelude.Show, forall x. Rep GetCardinality x -> GetCardinality
forall x. GetCardinality -> Rep GetCardinality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCardinality x -> GetCardinality
$cfrom :: forall x. GetCardinality -> Rep GetCardinality x
Prelude.Generic)

-- |
-- Create a value of 'GetCardinality' 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', 'getCardinality_aggregationField' - The field to aggregate.
--
-- 'indexName', 'getCardinality_indexName' - The name of the index to search.
--
-- 'queryVersion', 'getCardinality_queryVersion' - The query version.
--
-- 'queryString', 'getCardinality_queryString' - The search query string.
newGetCardinality ::
  -- | 'queryString'
  Prelude.Text ->
  GetCardinality
newGetCardinality :: Text -> GetCardinality
newGetCardinality Text
pQueryString_ =
  GetCardinality'
    { $sel:aggregationField:GetCardinality' :: Maybe Text
aggregationField = forall a. Maybe a
Prelude.Nothing,
      $sel:indexName:GetCardinality' :: Maybe Text
indexName = forall a. Maybe a
Prelude.Nothing,
      $sel:queryVersion:GetCardinality' :: Maybe Text
queryVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:queryString:GetCardinality' :: Text
queryString = Text
pQueryString_
    }

-- | The field to aggregate.
getCardinality_aggregationField :: Lens.Lens' GetCardinality (Prelude.Maybe Prelude.Text)
getCardinality_aggregationField :: Lens' GetCardinality (Maybe Text)
getCardinality_aggregationField = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCardinality' {Maybe Text
aggregationField :: Maybe Text
$sel:aggregationField:GetCardinality' :: GetCardinality -> Maybe Text
aggregationField} -> Maybe Text
aggregationField) (\s :: GetCardinality
s@GetCardinality' {} Maybe Text
a -> GetCardinality
s {$sel:aggregationField:GetCardinality' :: Maybe Text
aggregationField = Maybe Text
a} :: GetCardinality)

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

-- | The query version.
getCardinality_queryVersion :: Lens.Lens' GetCardinality (Prelude.Maybe Prelude.Text)
getCardinality_queryVersion :: Lens' GetCardinality (Maybe Text)
getCardinality_queryVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCardinality' {Maybe Text
queryVersion :: Maybe Text
$sel:queryVersion:GetCardinality' :: GetCardinality -> Maybe Text
queryVersion} -> Maybe Text
queryVersion) (\s :: GetCardinality
s@GetCardinality' {} Maybe Text
a -> GetCardinality
s {$sel:queryVersion:GetCardinality' :: Maybe Text
queryVersion = Maybe Text
a} :: GetCardinality)

-- | The search query string.
getCardinality_queryString :: Lens.Lens' GetCardinality Prelude.Text
getCardinality_queryString :: Lens' GetCardinality Text
getCardinality_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCardinality' {Text
queryString :: Text
$sel:queryString:GetCardinality' :: GetCardinality -> Text
queryString} -> Text
queryString) (\s :: GetCardinality
s@GetCardinality' {} Text
a -> GetCardinality
s {$sel:queryString:GetCardinality' :: Text
queryString = Text
a} :: GetCardinality)

instance Core.AWSRequest GetCardinality where
  type
    AWSResponse GetCardinality =
      GetCardinalityResponse
  request :: (Service -> Service) -> GetCardinality -> Request GetCardinality
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 GetCardinality
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCardinality)))
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 Int -> Int -> GetCardinalityResponse
GetCardinalityResponse'
            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
"cardinality")
            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 GetCardinality where
  hashWithSalt :: Int -> GetCardinality -> Int
hashWithSalt Int
_salt GetCardinality' {Maybe Text
Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
aggregationField :: Maybe Text
$sel:queryString:GetCardinality' :: GetCardinality -> Text
$sel:queryVersion:GetCardinality' :: GetCardinality -> Maybe Text
$sel:indexName:GetCardinality' :: GetCardinality -> Maybe Text
$sel:aggregationField:GetCardinality' :: GetCardinality -> 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 GetCardinality where
  rnf :: GetCardinality -> ()
rnf GetCardinality' {Maybe Text
Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
aggregationField :: Maybe Text
$sel:queryString:GetCardinality' :: GetCardinality -> Text
$sel:queryVersion:GetCardinality' :: GetCardinality -> Maybe Text
$sel:indexName:GetCardinality' :: GetCardinality -> Maybe Text
$sel:aggregationField:GetCardinality' :: GetCardinality -> 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 GetCardinality where
  toHeaders :: GetCardinality -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetCardinality where
  toJSON :: GetCardinality -> Value
toJSON GetCardinality' {Maybe Text
Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
aggregationField :: Maybe Text
$sel:queryString:GetCardinality' :: GetCardinality -> Text
$sel:queryVersion:GetCardinality' :: GetCardinality -> Maybe Text
$sel:indexName:GetCardinality' :: GetCardinality -> Maybe Text
$sel:aggregationField:GetCardinality' :: GetCardinality -> 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 GetCardinality where
  toPath :: GetCardinality -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/indices/cardinality"

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

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

-- |
-- Create a value of 'GetCardinalityResponse' 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:
--
-- 'cardinality', 'getCardinalityResponse_cardinality' - The approximate count of unique values that match the query.
--
-- 'httpStatus', 'getCardinalityResponse_httpStatus' - The response's http status code.
newGetCardinalityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCardinalityResponse
newGetCardinalityResponse :: Int -> GetCardinalityResponse
newGetCardinalityResponse Int
pHttpStatus_ =
  GetCardinalityResponse'
    { $sel:cardinality:GetCardinalityResponse' :: Maybe Int
cardinality =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCardinalityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The approximate count of unique values that match the query.
getCardinalityResponse_cardinality :: Lens.Lens' GetCardinalityResponse (Prelude.Maybe Prelude.Int)
getCardinalityResponse_cardinality :: Lens' GetCardinalityResponse (Maybe Int)
getCardinalityResponse_cardinality = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCardinalityResponse' {Maybe Int
cardinality :: Maybe Int
$sel:cardinality:GetCardinalityResponse' :: GetCardinalityResponse -> Maybe Int
cardinality} -> Maybe Int
cardinality) (\s :: GetCardinalityResponse
s@GetCardinalityResponse' {} Maybe Int
a -> GetCardinalityResponse
s {$sel:cardinality:GetCardinalityResponse' :: Maybe Int
cardinality = Maybe Int
a} :: GetCardinalityResponse)

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

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