{-# 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.UpdateIndexingConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the search configuration.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions UpdateIndexingConfiguration>
-- action.
module Amazonka.IoT.UpdateIndexingConfiguration
  ( -- * Creating a Request
    UpdateIndexingConfiguration (..),
    newUpdateIndexingConfiguration,

    -- * Request Lenses
    updateIndexingConfiguration_thingGroupIndexingConfiguration,
    updateIndexingConfiguration_thingIndexingConfiguration,

    -- * Destructuring the Response
    UpdateIndexingConfigurationResponse (..),
    newUpdateIndexingConfigurationResponse,

    -- * Response Lenses
    updateIndexingConfigurationResponse_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:/ 'newUpdateIndexingConfiguration' smart constructor.
data UpdateIndexingConfiguration = UpdateIndexingConfiguration'
  { -- | Thing group indexing configuration.
    UpdateIndexingConfiguration
-> Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration :: Prelude.Maybe ThingGroupIndexingConfiguration,
    -- | Thing indexing configuration.
    UpdateIndexingConfiguration -> Maybe ThingIndexingConfiguration
thingIndexingConfiguration :: Prelude.Maybe ThingIndexingConfiguration
  }
  deriving (UpdateIndexingConfiguration -> UpdateIndexingConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIndexingConfiguration -> UpdateIndexingConfiguration -> Bool
$c/= :: UpdateIndexingConfiguration -> UpdateIndexingConfiguration -> Bool
== :: UpdateIndexingConfiguration -> UpdateIndexingConfiguration -> Bool
$c== :: UpdateIndexingConfiguration -> UpdateIndexingConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateIndexingConfiguration]
ReadPrec UpdateIndexingConfiguration
Int -> ReadS UpdateIndexingConfiguration
ReadS [UpdateIndexingConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateIndexingConfiguration]
$creadListPrec :: ReadPrec [UpdateIndexingConfiguration]
readPrec :: ReadPrec UpdateIndexingConfiguration
$creadPrec :: ReadPrec UpdateIndexingConfiguration
readList :: ReadS [UpdateIndexingConfiguration]
$creadList :: ReadS [UpdateIndexingConfiguration]
readsPrec :: Int -> ReadS UpdateIndexingConfiguration
$creadsPrec :: Int -> ReadS UpdateIndexingConfiguration
Prelude.Read, Int -> UpdateIndexingConfiguration -> ShowS
[UpdateIndexingConfiguration] -> ShowS
UpdateIndexingConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIndexingConfiguration] -> ShowS
$cshowList :: [UpdateIndexingConfiguration] -> ShowS
show :: UpdateIndexingConfiguration -> String
$cshow :: UpdateIndexingConfiguration -> String
showsPrec :: Int -> UpdateIndexingConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateIndexingConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateIndexingConfiguration x -> UpdateIndexingConfiguration
forall x.
UpdateIndexingConfiguration -> Rep UpdateIndexingConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateIndexingConfiguration x -> UpdateIndexingConfiguration
$cfrom :: forall x.
UpdateIndexingConfiguration -> Rep UpdateIndexingConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateIndexingConfiguration' 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:
--
-- 'thingGroupIndexingConfiguration', 'updateIndexingConfiguration_thingGroupIndexingConfiguration' - Thing group indexing configuration.
--
-- 'thingIndexingConfiguration', 'updateIndexingConfiguration_thingIndexingConfiguration' - Thing indexing configuration.
newUpdateIndexingConfiguration ::
  UpdateIndexingConfiguration
newUpdateIndexingConfiguration :: UpdateIndexingConfiguration
newUpdateIndexingConfiguration =
  UpdateIndexingConfiguration'
    { $sel:thingGroupIndexingConfiguration:UpdateIndexingConfiguration' :: Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:thingIndexingConfiguration:UpdateIndexingConfiguration' :: Maybe ThingIndexingConfiguration
thingIndexingConfiguration = forall a. Maybe a
Prelude.Nothing
    }

-- | Thing group indexing configuration.
updateIndexingConfiguration_thingGroupIndexingConfiguration :: Lens.Lens' UpdateIndexingConfiguration (Prelude.Maybe ThingGroupIndexingConfiguration)
updateIndexingConfiguration_thingGroupIndexingConfiguration :: Lens'
  UpdateIndexingConfiguration (Maybe ThingGroupIndexingConfiguration)
updateIndexingConfiguration_thingGroupIndexingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndexingConfiguration' {Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration :: Maybe ThingGroupIndexingConfiguration
$sel:thingGroupIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration
-> Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration} -> Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration) (\s :: UpdateIndexingConfiguration
s@UpdateIndexingConfiguration' {} Maybe ThingGroupIndexingConfiguration
a -> UpdateIndexingConfiguration
s {$sel:thingGroupIndexingConfiguration:UpdateIndexingConfiguration' :: Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration = Maybe ThingGroupIndexingConfiguration
a} :: UpdateIndexingConfiguration)

-- | Thing indexing configuration.
updateIndexingConfiguration_thingIndexingConfiguration :: Lens.Lens' UpdateIndexingConfiguration (Prelude.Maybe ThingIndexingConfiguration)
updateIndexingConfiguration_thingIndexingConfiguration :: Lens'
  UpdateIndexingConfiguration (Maybe ThingIndexingConfiguration)
updateIndexingConfiguration_thingIndexingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndexingConfiguration' {Maybe ThingIndexingConfiguration
thingIndexingConfiguration :: Maybe ThingIndexingConfiguration
$sel:thingIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration -> Maybe ThingIndexingConfiguration
thingIndexingConfiguration} -> Maybe ThingIndexingConfiguration
thingIndexingConfiguration) (\s :: UpdateIndexingConfiguration
s@UpdateIndexingConfiguration' {} Maybe ThingIndexingConfiguration
a -> UpdateIndexingConfiguration
s {$sel:thingIndexingConfiguration:UpdateIndexingConfiguration' :: Maybe ThingIndexingConfiguration
thingIndexingConfiguration = Maybe ThingIndexingConfiguration
a} :: UpdateIndexingConfiguration)

instance Core.AWSRequest UpdateIndexingConfiguration where
  type
    AWSResponse UpdateIndexingConfiguration =
      UpdateIndexingConfigurationResponse
  request :: (Service -> Service)
-> UpdateIndexingConfiguration
-> Request UpdateIndexingConfiguration
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 UpdateIndexingConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateIndexingConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateIndexingConfigurationResponse
UpdateIndexingConfigurationResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateIndexingConfiguration where
  hashWithSalt :: Int -> UpdateIndexingConfiguration -> Int
hashWithSalt Int
_salt UpdateIndexingConfiguration' {Maybe ThingGroupIndexingConfiguration
Maybe ThingIndexingConfiguration
thingIndexingConfiguration :: Maybe ThingIndexingConfiguration
thingGroupIndexingConfiguration :: Maybe ThingGroupIndexingConfiguration
$sel:thingIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration -> Maybe ThingIndexingConfiguration
$sel:thingGroupIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration
-> Maybe ThingGroupIndexingConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThingIndexingConfiguration
thingIndexingConfiguration

instance Prelude.NFData UpdateIndexingConfiguration where
  rnf :: UpdateIndexingConfiguration -> ()
rnf UpdateIndexingConfiguration' {Maybe ThingGroupIndexingConfiguration
Maybe ThingIndexingConfiguration
thingIndexingConfiguration :: Maybe ThingIndexingConfiguration
thingGroupIndexingConfiguration :: Maybe ThingGroupIndexingConfiguration
$sel:thingIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration -> Maybe ThingIndexingConfiguration
$sel:thingGroupIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration
-> Maybe ThingGroupIndexingConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ThingIndexingConfiguration
thingIndexingConfiguration

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

instance Data.ToJSON UpdateIndexingConfiguration where
  toJSON :: UpdateIndexingConfiguration -> Value
toJSON UpdateIndexingConfiguration' {Maybe ThingGroupIndexingConfiguration
Maybe ThingIndexingConfiguration
thingIndexingConfiguration :: Maybe ThingIndexingConfiguration
thingGroupIndexingConfiguration :: Maybe ThingGroupIndexingConfiguration
$sel:thingIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration -> Maybe ThingIndexingConfiguration
$sel:thingGroupIndexingConfiguration:UpdateIndexingConfiguration' :: UpdateIndexingConfiguration
-> Maybe ThingGroupIndexingConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"thingGroupIndexingConfiguration" 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 ThingGroupIndexingConfiguration
thingGroupIndexingConfiguration,
            (Key
"thingIndexingConfiguration" 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 ThingIndexingConfiguration
thingIndexingConfiguration
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateIndexingConfigurationResponse' 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:
--
-- 'httpStatus', 'updateIndexingConfigurationResponse_httpStatus' - The response's http status code.
newUpdateIndexingConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateIndexingConfigurationResponse
newUpdateIndexingConfigurationResponse :: Int -> UpdateIndexingConfigurationResponse
newUpdateIndexingConfigurationResponse Int
pHttpStatus_ =
  UpdateIndexingConfigurationResponse'
    { $sel:httpStatus:UpdateIndexingConfigurationResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    UpdateIndexingConfigurationResponse
  where
  rnf :: UpdateIndexingConfigurationResponse -> ()
rnf UpdateIndexingConfigurationResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateIndexingConfigurationResponse' :: UpdateIndexingConfigurationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus