{-# 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.Kendra.DeleteAccessControlConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes an access control configuration that you created for your
-- documents in an index. This includes user and group access information
-- for your documents. This is useful for user context filtering, where
-- search results are filtered based on the user or their group access to
-- documents.
module Amazonka.Kendra.DeleteAccessControlConfiguration
  ( -- * Creating a Request
    DeleteAccessControlConfiguration (..),
    newDeleteAccessControlConfiguration,

    -- * Request Lenses
    deleteAccessControlConfiguration_indexId,
    deleteAccessControlConfiguration_id,

    -- * Destructuring the Response
    DeleteAccessControlConfigurationResponse (..),
    newDeleteAccessControlConfigurationResponse,

    -- * Response Lenses
    deleteAccessControlConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteAccessControlConfiguration' smart constructor.
data DeleteAccessControlConfiguration = DeleteAccessControlConfiguration'
  { -- | The identifier of the index for an access control configuration.
    DeleteAccessControlConfiguration -> Text
indexId :: Prelude.Text,
    -- | The identifier of the access control configuration you want to delete.
    DeleteAccessControlConfiguration -> Text
id :: Prelude.Text
  }
  deriving (DeleteAccessControlConfiguration
-> DeleteAccessControlConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAccessControlConfiguration
-> DeleteAccessControlConfiguration -> Bool
$c/= :: DeleteAccessControlConfiguration
-> DeleteAccessControlConfiguration -> Bool
== :: DeleteAccessControlConfiguration
-> DeleteAccessControlConfiguration -> Bool
$c== :: DeleteAccessControlConfiguration
-> DeleteAccessControlConfiguration -> Bool
Prelude.Eq, ReadPrec [DeleteAccessControlConfiguration]
ReadPrec DeleteAccessControlConfiguration
Int -> ReadS DeleteAccessControlConfiguration
ReadS [DeleteAccessControlConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAccessControlConfiguration]
$creadListPrec :: ReadPrec [DeleteAccessControlConfiguration]
readPrec :: ReadPrec DeleteAccessControlConfiguration
$creadPrec :: ReadPrec DeleteAccessControlConfiguration
readList :: ReadS [DeleteAccessControlConfiguration]
$creadList :: ReadS [DeleteAccessControlConfiguration]
readsPrec :: Int -> ReadS DeleteAccessControlConfiguration
$creadsPrec :: Int -> ReadS DeleteAccessControlConfiguration
Prelude.Read, Int -> DeleteAccessControlConfiguration -> ShowS
[DeleteAccessControlConfiguration] -> ShowS
DeleteAccessControlConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAccessControlConfiguration] -> ShowS
$cshowList :: [DeleteAccessControlConfiguration] -> ShowS
show :: DeleteAccessControlConfiguration -> String
$cshow :: DeleteAccessControlConfiguration -> String
showsPrec :: Int -> DeleteAccessControlConfiguration -> ShowS
$cshowsPrec :: Int -> DeleteAccessControlConfiguration -> ShowS
Prelude.Show, forall x.
Rep DeleteAccessControlConfiguration x
-> DeleteAccessControlConfiguration
forall x.
DeleteAccessControlConfiguration
-> Rep DeleteAccessControlConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteAccessControlConfiguration x
-> DeleteAccessControlConfiguration
$cfrom :: forall x.
DeleteAccessControlConfiguration
-> Rep DeleteAccessControlConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAccessControlConfiguration' 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:
--
-- 'indexId', 'deleteAccessControlConfiguration_indexId' - The identifier of the index for an access control configuration.
--
-- 'id', 'deleteAccessControlConfiguration_id' - The identifier of the access control configuration you want to delete.
newDeleteAccessControlConfiguration ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  DeleteAccessControlConfiguration
newDeleteAccessControlConfiguration :: Text -> Text -> DeleteAccessControlConfiguration
newDeleteAccessControlConfiguration Text
pIndexId_ Text
pId_ =
  DeleteAccessControlConfiguration'
    { $sel:indexId:DeleteAccessControlConfiguration' :: Text
indexId =
        Text
pIndexId_,
      $sel:id:DeleteAccessControlConfiguration' :: Text
id = Text
pId_
    }

-- | The identifier of the index for an access control configuration.
deleteAccessControlConfiguration_indexId :: Lens.Lens' DeleteAccessControlConfiguration Prelude.Text
deleteAccessControlConfiguration_indexId :: Lens' DeleteAccessControlConfiguration Text
deleteAccessControlConfiguration_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAccessControlConfiguration' {Text
indexId :: Text
$sel:indexId:DeleteAccessControlConfiguration' :: DeleteAccessControlConfiguration -> Text
indexId} -> Text
indexId) (\s :: DeleteAccessControlConfiguration
s@DeleteAccessControlConfiguration' {} Text
a -> DeleteAccessControlConfiguration
s {$sel:indexId:DeleteAccessControlConfiguration' :: Text
indexId = Text
a} :: DeleteAccessControlConfiguration)

-- | The identifier of the access control configuration you want to delete.
deleteAccessControlConfiguration_id :: Lens.Lens' DeleteAccessControlConfiguration Prelude.Text
deleteAccessControlConfiguration_id :: Lens' DeleteAccessControlConfiguration Text
deleteAccessControlConfiguration_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAccessControlConfiguration' {Text
id :: Text
$sel:id:DeleteAccessControlConfiguration' :: DeleteAccessControlConfiguration -> Text
id} -> Text
id) (\s :: DeleteAccessControlConfiguration
s@DeleteAccessControlConfiguration' {} Text
a -> DeleteAccessControlConfiguration
s {$sel:id:DeleteAccessControlConfiguration' :: Text
id = Text
a} :: DeleteAccessControlConfiguration)

instance
  Core.AWSRequest
    DeleteAccessControlConfiguration
  where
  type
    AWSResponse DeleteAccessControlConfiguration =
      DeleteAccessControlConfigurationResponse
  request :: (Service -> Service)
-> DeleteAccessControlConfiguration
-> Request DeleteAccessControlConfiguration
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 DeleteAccessControlConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DeleteAccessControlConfiguration)))
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 -> DeleteAccessControlConfigurationResponse
DeleteAccessControlConfigurationResponse'
            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
    DeleteAccessControlConfiguration
  where
  hashWithSalt :: Int -> DeleteAccessControlConfiguration -> Int
hashWithSalt
    Int
_salt
    DeleteAccessControlConfiguration' {Text
id :: Text
indexId :: Text
$sel:id:DeleteAccessControlConfiguration' :: DeleteAccessControlConfiguration -> Text
$sel:indexId:DeleteAccessControlConfiguration' :: DeleteAccessControlConfiguration -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance
  Prelude.NFData
    DeleteAccessControlConfiguration
  where
  rnf :: DeleteAccessControlConfiguration -> ()
rnf DeleteAccessControlConfiguration' {Text
id :: Text
indexId :: Text
$sel:id:DeleteAccessControlConfiguration' :: DeleteAccessControlConfiguration -> Text
$sel:indexId:DeleteAccessControlConfiguration' :: DeleteAccessControlConfiguration -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
indexId seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

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

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

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

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

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

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

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