{-# 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.UpdateAccessControlConfiguration
-- 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 an access control configuration 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.
--
-- You can update an access control configuration you created without
-- indexing all of your documents again. For example, your index contains
-- top-secret company documents that only certain employees or users should
-- access. You created an \'allow\' access control configuration for one
-- user who recently joined the \'top-secret\' team, switching from a team
-- with \'deny\' access to top-secret documents. However, the user suddenly
-- returns to their previous team and should no longer have access to top
-- secret documents. You can update the access control configuration to
-- re-configure access control for your documents as circumstances change.
--
-- You call the
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_BatchPutDocument.html BatchPutDocument>
-- API to apply the updated access control configuration, with the
-- @AccessControlConfigurationId@ included in the
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_Document.html Document>
-- object. If you use an S3 bucket as a data source, you synchronize your
-- data source to apply the @AccessControlConfigurationId@ in the
-- @.metadata.json@ file. Amazon Kendra currently only supports access
-- control configuration for S3 data sources and documents indexed using
-- the @BatchPutDocument@ API.
module Amazonka.Kendra.UpdateAccessControlConfiguration
  ( -- * Creating a Request
    UpdateAccessControlConfiguration (..),
    newUpdateAccessControlConfiguration,

    -- * Request Lenses
    updateAccessControlConfiguration_accessControlList,
    updateAccessControlConfiguration_description,
    updateAccessControlConfiguration_hierarchicalAccessControlList,
    updateAccessControlConfiguration_name,
    updateAccessControlConfiguration_indexId,
    updateAccessControlConfiguration_id,

    -- * Destructuring the Response
    UpdateAccessControlConfigurationResponse (..),
    newUpdateAccessControlConfigurationResponse,

    -- * Response Lenses
    updateAccessControlConfigurationResponse_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:/ 'newUpdateAccessControlConfiguration' smart constructor.
data UpdateAccessControlConfiguration = UpdateAccessControlConfiguration'
  { -- | Information you want to update on principals (users and\/or groups) and
    -- which documents they should have access to. This is useful for user
    -- context filtering, where search results are filtered based on the user
    -- or their group access to documents.
    UpdateAccessControlConfiguration -> Maybe [Principal]
accessControlList :: Prelude.Maybe [Principal],
    -- | A new description for the access control configuration.
    UpdateAccessControlConfiguration -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The updated list of
    -- <https://docs.aws.amazon.com/kendra/latest/dg/API_Principal.html principal>
    -- lists that define the hierarchy for which documents users should have
    -- access to.
    UpdateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal),
    -- | A new name for the access control configuration.
    UpdateAccessControlConfiguration -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the index for an access control configuration.
    UpdateAccessControlConfiguration -> Text
indexId :: Prelude.Text,
    -- | The identifier of the access control configuration you want to update.
    UpdateAccessControlConfiguration -> Text
id :: Prelude.Text
  }
  deriving (UpdateAccessControlConfiguration
-> UpdateAccessControlConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAccessControlConfiguration
-> UpdateAccessControlConfiguration -> Bool
$c/= :: UpdateAccessControlConfiguration
-> UpdateAccessControlConfiguration -> Bool
== :: UpdateAccessControlConfiguration
-> UpdateAccessControlConfiguration -> Bool
$c== :: UpdateAccessControlConfiguration
-> UpdateAccessControlConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateAccessControlConfiguration]
ReadPrec UpdateAccessControlConfiguration
Int -> ReadS UpdateAccessControlConfiguration
ReadS [UpdateAccessControlConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAccessControlConfiguration]
$creadListPrec :: ReadPrec [UpdateAccessControlConfiguration]
readPrec :: ReadPrec UpdateAccessControlConfiguration
$creadPrec :: ReadPrec UpdateAccessControlConfiguration
readList :: ReadS [UpdateAccessControlConfiguration]
$creadList :: ReadS [UpdateAccessControlConfiguration]
readsPrec :: Int -> ReadS UpdateAccessControlConfiguration
$creadsPrec :: Int -> ReadS UpdateAccessControlConfiguration
Prelude.Read, Int -> UpdateAccessControlConfiguration -> ShowS
[UpdateAccessControlConfiguration] -> ShowS
UpdateAccessControlConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAccessControlConfiguration] -> ShowS
$cshowList :: [UpdateAccessControlConfiguration] -> ShowS
show :: UpdateAccessControlConfiguration -> String
$cshow :: UpdateAccessControlConfiguration -> String
showsPrec :: Int -> UpdateAccessControlConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateAccessControlConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateAccessControlConfiguration x
-> UpdateAccessControlConfiguration
forall x.
UpdateAccessControlConfiguration
-> Rep UpdateAccessControlConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAccessControlConfiguration x
-> UpdateAccessControlConfiguration
$cfrom :: forall x.
UpdateAccessControlConfiguration
-> Rep UpdateAccessControlConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAccessControlConfiguration' 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:
--
-- 'accessControlList', 'updateAccessControlConfiguration_accessControlList' - Information you want to update on principals (users and\/or groups) and
-- which documents they should have access to. This is useful for user
-- context filtering, where search results are filtered based on the user
-- or their group access to documents.
--
-- 'description', 'updateAccessControlConfiguration_description' - A new description for the access control configuration.
--
-- 'hierarchicalAccessControlList', 'updateAccessControlConfiguration_hierarchicalAccessControlList' - The updated list of
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_Principal.html principal>
-- lists that define the hierarchy for which documents users should have
-- access to.
--
-- 'name', 'updateAccessControlConfiguration_name' - A new name for the access control configuration.
--
-- 'indexId', 'updateAccessControlConfiguration_indexId' - The identifier of the index for an access control configuration.
--
-- 'id', 'updateAccessControlConfiguration_id' - The identifier of the access control configuration you want to update.
newUpdateAccessControlConfiguration ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  UpdateAccessControlConfiguration
newUpdateAccessControlConfiguration :: Text -> Text -> UpdateAccessControlConfiguration
newUpdateAccessControlConfiguration Text
pIndexId_ Text
pId_ =
  UpdateAccessControlConfiguration'
    { $sel:accessControlList:UpdateAccessControlConfiguration' :: Maybe [Principal]
accessControlList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateAccessControlConfiguration' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:hierarchicalAccessControlList:UpdateAccessControlConfiguration' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateAccessControlConfiguration' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:UpdateAccessControlConfiguration' :: Text
indexId = Text
pIndexId_,
      $sel:id:UpdateAccessControlConfiguration' :: Text
id = Text
pId_
    }

-- | Information you want to update on principals (users and\/or groups) and
-- which documents they should have access to. This is useful for user
-- context filtering, where search results are filtered based on the user
-- or their group access to documents.
updateAccessControlConfiguration_accessControlList :: Lens.Lens' UpdateAccessControlConfiguration (Prelude.Maybe [Principal])
updateAccessControlConfiguration_accessControlList :: Lens' UpdateAccessControlConfiguration (Maybe [Principal])
updateAccessControlConfiguration_accessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccessControlConfiguration' {Maybe [Principal]
accessControlList :: Maybe [Principal]
$sel:accessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe [Principal]
accessControlList} -> Maybe [Principal]
accessControlList) (\s :: UpdateAccessControlConfiguration
s@UpdateAccessControlConfiguration' {} Maybe [Principal]
a -> UpdateAccessControlConfiguration
s {$sel:accessControlList:UpdateAccessControlConfiguration' :: Maybe [Principal]
accessControlList = Maybe [Principal]
a} :: UpdateAccessControlConfiguration) 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

-- | A new description for the access control configuration.
updateAccessControlConfiguration_description :: Lens.Lens' UpdateAccessControlConfiguration (Prelude.Maybe Prelude.Text)
updateAccessControlConfiguration_description :: Lens' UpdateAccessControlConfiguration (Maybe Text)
updateAccessControlConfiguration_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccessControlConfiguration' {Maybe Text
description :: Maybe Text
$sel:description:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateAccessControlConfiguration
s@UpdateAccessControlConfiguration' {} Maybe Text
a -> UpdateAccessControlConfiguration
s {$sel:description:UpdateAccessControlConfiguration' :: Maybe Text
description = Maybe Text
a} :: UpdateAccessControlConfiguration)

-- | The updated list of
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_Principal.html principal>
-- lists that define the hierarchy for which documents users should have
-- access to.
updateAccessControlConfiguration_hierarchicalAccessControlList :: Lens.Lens' UpdateAccessControlConfiguration (Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal))
updateAccessControlConfiguration_hierarchicalAccessControlList :: Lens'
  UpdateAccessControlConfiguration
  (Maybe (NonEmpty HierarchicalPrincipal))
updateAccessControlConfiguration_hierarchicalAccessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccessControlConfiguration' {Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
$sel:hierarchicalAccessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList} -> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList) (\s :: UpdateAccessControlConfiguration
s@UpdateAccessControlConfiguration' {} Maybe (NonEmpty HierarchicalPrincipal)
a -> UpdateAccessControlConfiguration
s {$sel:hierarchicalAccessControlList:UpdateAccessControlConfiguration' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList = Maybe (NonEmpty HierarchicalPrincipal)
a} :: UpdateAccessControlConfiguration) 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

-- | A new name for the access control configuration.
updateAccessControlConfiguration_name :: Lens.Lens' UpdateAccessControlConfiguration (Prelude.Maybe Prelude.Text)
updateAccessControlConfiguration_name :: Lens' UpdateAccessControlConfiguration (Maybe Text)
updateAccessControlConfiguration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccessControlConfiguration' {Maybe Text
name :: Maybe Text
$sel:name:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateAccessControlConfiguration
s@UpdateAccessControlConfiguration' {} Maybe Text
a -> UpdateAccessControlConfiguration
s {$sel:name:UpdateAccessControlConfiguration' :: Maybe Text
name = Maybe Text
a} :: UpdateAccessControlConfiguration)

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

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

instance
  Core.AWSRequest
    UpdateAccessControlConfiguration
  where
  type
    AWSResponse UpdateAccessControlConfiguration =
      UpdateAccessControlConfigurationResponse
  request :: (Service -> Service)
-> UpdateAccessControlConfiguration
-> Request UpdateAccessControlConfiguration
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 UpdateAccessControlConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateAccessControlConfiguration)))
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 -> UpdateAccessControlConfigurationResponse
UpdateAccessControlConfigurationResponse'
            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
    UpdateAccessControlConfiguration
  where
  hashWithSalt :: Int -> UpdateAccessControlConfiguration -> Int
hashWithSalt
    Int
_salt
    UpdateAccessControlConfiguration' {Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Text
id :: Text
indexId :: Text
name :: Maybe Text
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
description :: Maybe Text
accessControlList :: Maybe [Principal]
$sel:id:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Text
$sel:indexId:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Text
$sel:name:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
$sel:hierarchicalAccessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
$sel:description:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
$sel:accessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe [Principal]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Principal]
accessControlList
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
        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
    UpdateAccessControlConfiguration
  where
  rnf :: UpdateAccessControlConfiguration -> ()
rnf UpdateAccessControlConfiguration' {Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Text
id :: Text
indexId :: Text
name :: Maybe Text
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
description :: Maybe Text
accessControlList :: Maybe [Principal]
$sel:id:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Text
$sel:indexId:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Text
$sel:name:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
$sel:hierarchicalAccessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
$sel:description:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
$sel:accessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe [Principal]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Principal]
accessControlList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
    UpdateAccessControlConfiguration
  where
  toHeaders :: UpdateAccessControlConfiguration -> 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.UpdateAccessControlConfiguration" ::
                          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 UpdateAccessControlConfiguration where
  toJSON :: UpdateAccessControlConfiguration -> Value
toJSON UpdateAccessControlConfiguration' {Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Text
id :: Text
indexId :: Text
name :: Maybe Text
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
description :: Maybe Text
accessControlList :: Maybe [Principal]
$sel:id:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Text
$sel:indexId:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Text
$sel:name:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
$sel:hierarchicalAccessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
$sel:description:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe Text
$sel:accessControlList:UpdateAccessControlConfiguration' :: UpdateAccessControlConfiguration -> Maybe [Principal]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessControlList" 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 [Principal]
accessControlList,
            (Key
"Description" 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
description,
            (Key
"HierarchicalAccessControlList" 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 (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList,
            (Key
"Name" 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
name,
            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 UpdateAccessControlConfiguration where
  toPath :: UpdateAccessControlConfiguration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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