{-# 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.CreateAccessControlConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an access configuration for your documents. 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 use this to re-configure your existing document level access
-- control without indexing all of your documents again. For example, your
-- index contains top-secret company documents that only certain employees
-- or users should access. One of these users leaves the company or
-- switches to a team that should be blocked from accessing top-secret
-- documents. The user still has access to top-secret documents because the
-- user had access when your documents were previously indexed. You can
-- create a specific access control configuration for the user with deny
-- access. You can later update the access control configuration to allow
-- access if the user returns to the company and re-joins the
-- \'top-secret\' team. You can re-configure access control for your
-- documents as circumstances change.
--
-- To apply your access control configuration to certain documents, you
-- call the
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_BatchPutDocument.html BatchPutDocument>
-- API 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 update the
-- @.metadata.json@ with the @AccessControlConfigurationId@ and synchronize
-- your data source. Amazon Kendra currently only supports access control
-- configuration for S3 data sources and documents indexed using the
-- @BatchPutDocument@ API.
module Amazonka.Kendra.CreateAccessControlConfiguration
  ( -- * Creating a Request
    CreateAccessControlConfiguration (..),
    newCreateAccessControlConfiguration,

    -- * Request Lenses
    createAccessControlConfiguration_accessControlList,
    createAccessControlConfiguration_clientToken,
    createAccessControlConfiguration_description,
    createAccessControlConfiguration_hierarchicalAccessControlList,
    createAccessControlConfiguration_indexId,
    createAccessControlConfiguration_name,

    -- * Destructuring the Response
    CreateAccessControlConfigurationResponse (..),
    newCreateAccessControlConfigurationResponse,

    -- * Response Lenses
    createAccessControlConfigurationResponse_httpStatus,
    createAccessControlConfigurationResponse_id,
  )
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:/ 'newCreateAccessControlConfiguration' smart constructor.
data CreateAccessControlConfiguration = CreateAccessControlConfiguration'
  { -- | Information 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.
    CreateAccessControlConfiguration -> Maybe [Principal]
accessControlList :: Prelude.Maybe [Principal],
    -- | A token that you provide to identify the request to create an access
    -- control configuration. Multiple calls to the
    -- @CreateAccessControlConfiguration@ API with the same client token will
    -- create only one access control configuration.
    CreateAccessControlConfiguration -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the access control configuration.
    CreateAccessControlConfiguration -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The 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.
    CreateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal),
    -- | The identifier of the index to create an access control configuration
    -- for your documents.
    CreateAccessControlConfiguration -> Text
indexId :: Prelude.Text,
    -- | A name for the access control configuration.
    CreateAccessControlConfiguration -> Text
name :: Prelude.Text
  }
  deriving (CreateAccessControlConfiguration
-> CreateAccessControlConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccessControlConfiguration
-> CreateAccessControlConfiguration -> Bool
$c/= :: CreateAccessControlConfiguration
-> CreateAccessControlConfiguration -> Bool
== :: CreateAccessControlConfiguration
-> CreateAccessControlConfiguration -> Bool
$c== :: CreateAccessControlConfiguration
-> CreateAccessControlConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateAccessControlConfiguration]
ReadPrec CreateAccessControlConfiguration
Int -> ReadS CreateAccessControlConfiguration
ReadS [CreateAccessControlConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAccessControlConfiguration]
$creadListPrec :: ReadPrec [CreateAccessControlConfiguration]
readPrec :: ReadPrec CreateAccessControlConfiguration
$creadPrec :: ReadPrec CreateAccessControlConfiguration
readList :: ReadS [CreateAccessControlConfiguration]
$creadList :: ReadS [CreateAccessControlConfiguration]
readsPrec :: Int -> ReadS CreateAccessControlConfiguration
$creadsPrec :: Int -> ReadS CreateAccessControlConfiguration
Prelude.Read, Int -> CreateAccessControlConfiguration -> ShowS
[CreateAccessControlConfiguration] -> ShowS
CreateAccessControlConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccessControlConfiguration] -> ShowS
$cshowList :: [CreateAccessControlConfiguration] -> ShowS
show :: CreateAccessControlConfiguration -> String
$cshow :: CreateAccessControlConfiguration -> String
showsPrec :: Int -> CreateAccessControlConfiguration -> ShowS
$cshowsPrec :: Int -> CreateAccessControlConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateAccessControlConfiguration x
-> CreateAccessControlConfiguration
forall x.
CreateAccessControlConfiguration
-> Rep CreateAccessControlConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAccessControlConfiguration x
-> CreateAccessControlConfiguration
$cfrom :: forall x.
CreateAccessControlConfiguration
-> Rep CreateAccessControlConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccessControlConfiguration' 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', 'createAccessControlConfiguration_accessControlList' - Information 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.
--
-- 'clientToken', 'createAccessControlConfiguration_clientToken' - A token that you provide to identify the request to create an access
-- control configuration. Multiple calls to the
-- @CreateAccessControlConfiguration@ API with the same client token will
-- create only one access control configuration.
--
-- 'description', 'createAccessControlConfiguration_description' - A description for the access control configuration.
--
-- 'hierarchicalAccessControlList', 'createAccessControlConfiguration_hierarchicalAccessControlList' - The 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.
--
-- 'indexId', 'createAccessControlConfiguration_indexId' - The identifier of the index to create an access control configuration
-- for your documents.
--
-- 'name', 'createAccessControlConfiguration_name' - A name for the access control configuration.
newCreateAccessControlConfiguration ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateAccessControlConfiguration
newCreateAccessControlConfiguration :: Text -> Text -> CreateAccessControlConfiguration
newCreateAccessControlConfiguration Text
pIndexId_ Text
pName_ =
  CreateAccessControlConfiguration'
    { $sel:accessControlList:CreateAccessControlConfiguration' :: Maybe [Principal]
accessControlList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateAccessControlConfiguration' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateAccessControlConfiguration' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:hierarchicalAccessControlList:CreateAccessControlConfiguration' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:CreateAccessControlConfiguration' :: Text
indexId = Text
pIndexId_,
      $sel:name:CreateAccessControlConfiguration' :: Text
name = Text
pName_
    }

-- | Information 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.
createAccessControlConfiguration_accessControlList :: Lens.Lens' CreateAccessControlConfiguration (Prelude.Maybe [Principal])
createAccessControlConfiguration_accessControlList :: Lens' CreateAccessControlConfiguration (Maybe [Principal])
createAccessControlConfiguration_accessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessControlConfiguration' {Maybe [Principal]
accessControlList :: Maybe [Principal]
$sel:accessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe [Principal]
accessControlList} -> Maybe [Principal]
accessControlList) (\s :: CreateAccessControlConfiguration
s@CreateAccessControlConfiguration' {} Maybe [Principal]
a -> CreateAccessControlConfiguration
s {$sel:accessControlList:CreateAccessControlConfiguration' :: Maybe [Principal]
accessControlList = Maybe [Principal]
a} :: CreateAccessControlConfiguration) 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 token that you provide to identify the request to create an access
-- control configuration. Multiple calls to the
-- @CreateAccessControlConfiguration@ API with the same client token will
-- create only one access control configuration.
createAccessControlConfiguration_clientToken :: Lens.Lens' CreateAccessControlConfiguration (Prelude.Maybe Prelude.Text)
createAccessControlConfiguration_clientToken :: Lens' CreateAccessControlConfiguration (Maybe Text)
createAccessControlConfiguration_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessControlConfiguration' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateAccessControlConfiguration
s@CreateAccessControlConfiguration' {} Maybe Text
a -> CreateAccessControlConfiguration
s {$sel:clientToken:CreateAccessControlConfiguration' :: Maybe Text
clientToken = Maybe Text
a} :: CreateAccessControlConfiguration)

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

-- | The 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.
createAccessControlConfiguration_hierarchicalAccessControlList :: Lens.Lens' CreateAccessControlConfiguration (Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal))
createAccessControlConfiguration_hierarchicalAccessControlList :: Lens'
  CreateAccessControlConfiguration
  (Maybe (NonEmpty HierarchicalPrincipal))
createAccessControlConfiguration_hierarchicalAccessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessControlConfiguration' {Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
$sel:hierarchicalAccessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList} -> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList) (\s :: CreateAccessControlConfiguration
s@CreateAccessControlConfiguration' {} Maybe (NonEmpty HierarchicalPrincipal)
a -> CreateAccessControlConfiguration
s {$sel:hierarchicalAccessControlList:CreateAccessControlConfiguration' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList = Maybe (NonEmpty HierarchicalPrincipal)
a} :: CreateAccessControlConfiguration) 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

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

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

instance
  Core.AWSRequest
    CreateAccessControlConfiguration
  where
  type
    AWSResponse CreateAccessControlConfiguration =
      CreateAccessControlConfigurationResponse
  request :: (Service -> Service)
-> CreateAccessControlConfiguration
-> Request CreateAccessControlConfiguration
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 CreateAccessControlConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateAccessControlConfiguration)))
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 ->
          Int -> Text -> CreateAccessControlConfigurationResponse
CreateAccessControlConfigurationResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Id")
      )

instance
  Prelude.Hashable
    CreateAccessControlConfiguration
  where
  hashWithSalt :: Int -> CreateAccessControlConfiguration -> Int
hashWithSalt
    Int
_salt
    CreateAccessControlConfiguration' {Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Text
name :: Text
indexId :: Text
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
description :: Maybe Text
clientToken :: Maybe Text
accessControlList :: Maybe [Principal]
$sel:name:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Text
$sel:indexId:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Text
$sel:hierarchicalAccessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
$sel:description:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe Text
$sel:clientToken:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe Text
$sel:accessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> 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
clientToken
        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` Text
indexId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance
  Prelude.NFData
    CreateAccessControlConfiguration
  where
  rnf :: CreateAccessControlConfiguration -> ()
rnf CreateAccessControlConfiguration' {Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Text
name :: Text
indexId :: Text
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
description :: Maybe Text
clientToken :: Maybe Text
accessControlList :: Maybe [Principal]
$sel:name:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Text
$sel:indexId:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Text
$sel:hierarchicalAccessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
$sel:description:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe Text
$sel:clientToken:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe Text
$sel:accessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> 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
clientToken
      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 Text
indexId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance
  Data.ToHeaders
    CreateAccessControlConfiguration
  where
  toHeaders :: CreateAccessControlConfiguration -> 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.CreateAccessControlConfiguration" ::
                          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 CreateAccessControlConfiguration where
  toJSON :: CreateAccessControlConfiguration -> Value
toJSON CreateAccessControlConfiguration' {Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Text
name :: Text
indexId :: Text
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
description :: Maybe Text
clientToken :: Maybe Text
accessControlList :: Maybe [Principal]
$sel:name:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Text
$sel:indexId:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Text
$sel:hierarchicalAccessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration
-> Maybe (NonEmpty HierarchicalPrincipal)
$sel:description:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe Text
$sel:clientToken:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> Maybe Text
$sel:accessControlList:CreateAccessControlConfiguration' :: CreateAccessControlConfiguration -> 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
"ClientToken" 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
clientToken,
            (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,
            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
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateAccessControlConfigurationResponse' smart constructor.
data CreateAccessControlConfigurationResponse = CreateAccessControlConfigurationResponse'
  { -- | The response's http status code.
    CreateAccessControlConfigurationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The identifier of the access control configuration for your documents in
    -- an index.
    CreateAccessControlConfigurationResponse -> Text
id :: Prelude.Text
  }
  deriving (CreateAccessControlConfigurationResponse
-> CreateAccessControlConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccessControlConfigurationResponse
-> CreateAccessControlConfigurationResponse -> Bool
$c/= :: CreateAccessControlConfigurationResponse
-> CreateAccessControlConfigurationResponse -> Bool
== :: CreateAccessControlConfigurationResponse
-> CreateAccessControlConfigurationResponse -> Bool
$c== :: CreateAccessControlConfigurationResponse
-> CreateAccessControlConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [CreateAccessControlConfigurationResponse]
ReadPrec CreateAccessControlConfigurationResponse
Int -> ReadS CreateAccessControlConfigurationResponse
ReadS [CreateAccessControlConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAccessControlConfigurationResponse]
$creadListPrec :: ReadPrec [CreateAccessControlConfigurationResponse]
readPrec :: ReadPrec CreateAccessControlConfigurationResponse
$creadPrec :: ReadPrec CreateAccessControlConfigurationResponse
readList :: ReadS [CreateAccessControlConfigurationResponse]
$creadList :: ReadS [CreateAccessControlConfigurationResponse]
readsPrec :: Int -> ReadS CreateAccessControlConfigurationResponse
$creadsPrec :: Int -> ReadS CreateAccessControlConfigurationResponse
Prelude.Read, Int -> CreateAccessControlConfigurationResponse -> ShowS
[CreateAccessControlConfigurationResponse] -> ShowS
CreateAccessControlConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccessControlConfigurationResponse] -> ShowS
$cshowList :: [CreateAccessControlConfigurationResponse] -> ShowS
show :: CreateAccessControlConfigurationResponse -> String
$cshow :: CreateAccessControlConfigurationResponse -> String
showsPrec :: Int -> CreateAccessControlConfigurationResponse -> ShowS
$cshowsPrec :: Int -> CreateAccessControlConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateAccessControlConfigurationResponse x
-> CreateAccessControlConfigurationResponse
forall x.
CreateAccessControlConfigurationResponse
-> Rep CreateAccessControlConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAccessControlConfigurationResponse x
-> CreateAccessControlConfigurationResponse
$cfrom :: forall x.
CreateAccessControlConfigurationResponse
-> Rep CreateAccessControlConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccessControlConfigurationResponse' 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', 'createAccessControlConfigurationResponse_httpStatus' - The response's http status code.
--
-- 'id', 'createAccessControlConfigurationResponse_id' - The identifier of the access control configuration for your documents in
-- an index.
newCreateAccessControlConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'id'
  Prelude.Text ->
  CreateAccessControlConfigurationResponse
newCreateAccessControlConfigurationResponse :: Int -> Text -> CreateAccessControlConfigurationResponse
newCreateAccessControlConfigurationResponse
  Int
pHttpStatus_
  Text
pId_ =
    CreateAccessControlConfigurationResponse'
      { $sel:httpStatus:CreateAccessControlConfigurationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:id:CreateAccessControlConfigurationResponse' :: Text
id = Text
pId_
      }

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

-- | The identifier of the access control configuration for your documents in
-- an index.
createAccessControlConfigurationResponse_id :: Lens.Lens' CreateAccessControlConfigurationResponse Prelude.Text
createAccessControlConfigurationResponse_id :: Lens' CreateAccessControlConfigurationResponse Text
createAccessControlConfigurationResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessControlConfigurationResponse' {Text
id :: Text
$sel:id:CreateAccessControlConfigurationResponse' :: CreateAccessControlConfigurationResponse -> Text
id} -> Text
id) (\s :: CreateAccessControlConfigurationResponse
s@CreateAccessControlConfigurationResponse' {} Text
a -> CreateAccessControlConfigurationResponse
s {$sel:id:CreateAccessControlConfigurationResponse' :: Text
id = Text
a} :: CreateAccessControlConfigurationResponse)

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