{-# 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.DescribeAccessControlConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about 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.DescribeAccessControlConfiguration
  ( -- * Creating a Request
    DescribeAccessControlConfiguration (..),
    newDescribeAccessControlConfiguration,

    -- * Request Lenses
    describeAccessControlConfiguration_indexId,
    describeAccessControlConfiguration_id,

    -- * Destructuring the Response
    DescribeAccessControlConfigurationResponse (..),
    newDescribeAccessControlConfigurationResponse,

    -- * Response Lenses
    describeAccessControlConfigurationResponse_accessControlList,
    describeAccessControlConfigurationResponse_description,
    describeAccessControlConfigurationResponse_errorMessage,
    describeAccessControlConfigurationResponse_hierarchicalAccessControlList,
    describeAccessControlConfigurationResponse_httpStatus,
    describeAccessControlConfigurationResponse_name,
  )
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:/ 'newDescribeAccessControlConfiguration' smart constructor.
data DescribeAccessControlConfiguration = DescribeAccessControlConfiguration'
  { -- | The identifier of the index for an access control configuration.
    DescribeAccessControlConfiguration -> Text
indexId :: Prelude.Text,
    -- | The identifier of the access control configuration you want to get
    -- information on.
    DescribeAccessControlConfiguration -> Text
id :: Prelude.Text
  }
  deriving (DescribeAccessControlConfiguration
-> DescribeAccessControlConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAccessControlConfiguration
-> DescribeAccessControlConfiguration -> Bool
$c/= :: DescribeAccessControlConfiguration
-> DescribeAccessControlConfiguration -> Bool
== :: DescribeAccessControlConfiguration
-> DescribeAccessControlConfiguration -> Bool
$c== :: DescribeAccessControlConfiguration
-> DescribeAccessControlConfiguration -> Bool
Prelude.Eq, ReadPrec [DescribeAccessControlConfiguration]
ReadPrec DescribeAccessControlConfiguration
Int -> ReadS DescribeAccessControlConfiguration
ReadS [DescribeAccessControlConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAccessControlConfiguration]
$creadListPrec :: ReadPrec [DescribeAccessControlConfiguration]
readPrec :: ReadPrec DescribeAccessControlConfiguration
$creadPrec :: ReadPrec DescribeAccessControlConfiguration
readList :: ReadS [DescribeAccessControlConfiguration]
$creadList :: ReadS [DescribeAccessControlConfiguration]
readsPrec :: Int -> ReadS DescribeAccessControlConfiguration
$creadsPrec :: Int -> ReadS DescribeAccessControlConfiguration
Prelude.Read, Int -> DescribeAccessControlConfiguration -> ShowS
[DescribeAccessControlConfiguration] -> ShowS
DescribeAccessControlConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAccessControlConfiguration] -> ShowS
$cshowList :: [DescribeAccessControlConfiguration] -> ShowS
show :: DescribeAccessControlConfiguration -> String
$cshow :: DescribeAccessControlConfiguration -> String
showsPrec :: Int -> DescribeAccessControlConfiguration -> ShowS
$cshowsPrec :: Int -> DescribeAccessControlConfiguration -> ShowS
Prelude.Show, forall x.
Rep DescribeAccessControlConfiguration x
-> DescribeAccessControlConfiguration
forall x.
DescribeAccessControlConfiguration
-> Rep DescribeAccessControlConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeAccessControlConfiguration x
-> DescribeAccessControlConfiguration
$cfrom :: forall x.
DescribeAccessControlConfiguration
-> Rep DescribeAccessControlConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAccessControlConfiguration' 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', 'describeAccessControlConfiguration_indexId' - The identifier of the index for an access control configuration.
--
-- 'id', 'describeAccessControlConfiguration_id' - The identifier of the access control configuration you want to get
-- information on.
newDescribeAccessControlConfiguration ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  DescribeAccessControlConfiguration
newDescribeAccessControlConfiguration :: Text -> Text -> DescribeAccessControlConfiguration
newDescribeAccessControlConfiguration Text
pIndexId_ Text
pId_ =
  DescribeAccessControlConfiguration'
    { $sel:indexId:DescribeAccessControlConfiguration' :: Text
indexId =
        Text
pIndexId_,
      $sel:id:DescribeAccessControlConfiguration' :: Text
id = Text
pId_
    }

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

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

instance
  Core.AWSRequest
    DescribeAccessControlConfiguration
  where
  type
    AWSResponse DescribeAccessControlConfiguration =
      DescribeAccessControlConfigurationResponse
  request :: (Service -> Service)
-> DescribeAccessControlConfiguration
-> Request DescribeAccessControlConfiguration
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 DescribeAccessControlConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeAccessControlConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [Principal]
-> Maybe Text
-> Maybe Text
-> Maybe (NonEmpty HierarchicalPrincipal)
-> Int
-> Text
-> DescribeAccessControlConfigurationResponse
DescribeAccessControlConfigurationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AccessControlList"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ErrorMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"HierarchicalAccessControlList")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"Name")
      )

instance
  Prelude.Hashable
    DescribeAccessControlConfiguration
  where
  hashWithSalt :: Int -> DescribeAccessControlConfiguration -> Int
hashWithSalt
    Int
_salt
    DescribeAccessControlConfiguration' {Text
id :: Text
indexId :: Text
$sel:id:DescribeAccessControlConfiguration' :: DescribeAccessControlConfiguration -> Text
$sel:indexId:DescribeAccessControlConfiguration' :: DescribeAccessControlConfiguration -> 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
    DescribeAccessControlConfiguration
  where
  rnf :: DescribeAccessControlConfiguration -> ()
rnf DescribeAccessControlConfiguration' {Text
id :: Text
indexId :: Text
$sel:id:DescribeAccessControlConfiguration' :: DescribeAccessControlConfiguration -> Text
$sel:indexId:DescribeAccessControlConfiguration' :: DescribeAccessControlConfiguration -> 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
    DescribeAccessControlConfiguration
  where
  toHeaders :: DescribeAccessControlConfiguration -> 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.DescribeAccessControlConfiguration" ::
                          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
    DescribeAccessControlConfiguration
  where
  toJSON :: DescribeAccessControlConfiguration -> Value
toJSON DescribeAccessControlConfiguration' {Text
id :: Text
indexId :: Text
$sel:id:DescribeAccessControlConfiguration' :: DescribeAccessControlConfiguration -> Text
$sel:indexId:DescribeAccessControlConfiguration' :: DescribeAccessControlConfiguration -> 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
    DescribeAccessControlConfiguration
  where
  toPath :: DescribeAccessControlConfiguration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeAccessControlConfigurationResponse' smart constructor.
data DescribeAccessControlConfigurationResponse = DescribeAccessControlConfigurationResponse'
  { -- | 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.
    DescribeAccessControlConfigurationResponse -> Maybe [Principal]
accessControlList :: Prelude.Maybe [Principal],
    -- | The description for the access control configuration.
    DescribeAccessControlConfigurationResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The error message containing details if there are issues processing the
    -- access control configuration.
    DescribeAccessControlConfigurationResponse -> Maybe Text
errorMessage :: 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.
    DescribeAccessControlConfigurationResponse
-> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal),
    -- | The response's http status code.
    DescribeAccessControlConfigurationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name for the access control configuration.
    DescribeAccessControlConfigurationResponse -> Text
name :: Prelude.Text
  }
  deriving (DescribeAccessControlConfigurationResponse
-> DescribeAccessControlConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAccessControlConfigurationResponse
-> DescribeAccessControlConfigurationResponse -> Bool
$c/= :: DescribeAccessControlConfigurationResponse
-> DescribeAccessControlConfigurationResponse -> Bool
== :: DescribeAccessControlConfigurationResponse
-> DescribeAccessControlConfigurationResponse -> Bool
$c== :: DescribeAccessControlConfigurationResponse
-> DescribeAccessControlConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAccessControlConfigurationResponse]
ReadPrec DescribeAccessControlConfigurationResponse
Int -> ReadS DescribeAccessControlConfigurationResponse
ReadS [DescribeAccessControlConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAccessControlConfigurationResponse]
$creadListPrec :: ReadPrec [DescribeAccessControlConfigurationResponse]
readPrec :: ReadPrec DescribeAccessControlConfigurationResponse
$creadPrec :: ReadPrec DescribeAccessControlConfigurationResponse
readList :: ReadS [DescribeAccessControlConfigurationResponse]
$creadList :: ReadS [DescribeAccessControlConfigurationResponse]
readsPrec :: Int -> ReadS DescribeAccessControlConfigurationResponse
$creadsPrec :: Int -> ReadS DescribeAccessControlConfigurationResponse
Prelude.Read, Int -> DescribeAccessControlConfigurationResponse -> ShowS
[DescribeAccessControlConfigurationResponse] -> ShowS
DescribeAccessControlConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAccessControlConfigurationResponse] -> ShowS
$cshowList :: [DescribeAccessControlConfigurationResponse] -> ShowS
show :: DescribeAccessControlConfigurationResponse -> String
$cshow :: DescribeAccessControlConfigurationResponse -> String
showsPrec :: Int -> DescribeAccessControlConfigurationResponse -> ShowS
$cshowsPrec :: Int -> DescribeAccessControlConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeAccessControlConfigurationResponse x
-> DescribeAccessControlConfigurationResponse
forall x.
DescribeAccessControlConfigurationResponse
-> Rep DescribeAccessControlConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeAccessControlConfigurationResponse x
-> DescribeAccessControlConfigurationResponse
$cfrom :: forall x.
DescribeAccessControlConfigurationResponse
-> Rep DescribeAccessControlConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAccessControlConfigurationResponse' 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', 'describeAccessControlConfigurationResponse_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.
--
-- 'description', 'describeAccessControlConfigurationResponse_description' - The description for the access control configuration.
--
-- 'errorMessage', 'describeAccessControlConfigurationResponse_errorMessage' - The error message containing details if there are issues processing the
-- access control configuration.
--
-- 'hierarchicalAccessControlList', 'describeAccessControlConfigurationResponse_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.
--
-- 'httpStatus', 'describeAccessControlConfigurationResponse_httpStatus' - The response's http status code.
--
-- 'name', 'describeAccessControlConfigurationResponse_name' - The name for the access control configuration.
newDescribeAccessControlConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  DescribeAccessControlConfigurationResponse
newDescribeAccessControlConfigurationResponse :: Int -> Text -> DescribeAccessControlConfigurationResponse
newDescribeAccessControlConfigurationResponse
  Int
pHttpStatus_
  Text
pName_ =
    DescribeAccessControlConfigurationResponse'
      { $sel:accessControlList:DescribeAccessControlConfigurationResponse' :: Maybe [Principal]
accessControlList =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:DescribeAccessControlConfigurationResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:errorMessage:DescribeAccessControlConfigurationResponse' :: Maybe Text
errorMessage = forall a. Maybe a
Prelude.Nothing,
        $sel:hierarchicalAccessControlList:DescribeAccessControlConfigurationResponse' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeAccessControlConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:name:DescribeAccessControlConfigurationResponse' :: 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.
describeAccessControlConfigurationResponse_accessControlList :: Lens.Lens' DescribeAccessControlConfigurationResponse (Prelude.Maybe [Principal])
describeAccessControlConfigurationResponse_accessControlList :: Lens'
  DescribeAccessControlConfigurationResponse (Maybe [Principal])
describeAccessControlConfigurationResponse_accessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccessControlConfigurationResponse' {Maybe [Principal]
accessControlList :: Maybe [Principal]
$sel:accessControlList:DescribeAccessControlConfigurationResponse' :: DescribeAccessControlConfigurationResponse -> Maybe [Principal]
accessControlList} -> Maybe [Principal]
accessControlList) (\s :: DescribeAccessControlConfigurationResponse
s@DescribeAccessControlConfigurationResponse' {} Maybe [Principal]
a -> DescribeAccessControlConfigurationResponse
s {$sel:accessControlList:DescribeAccessControlConfigurationResponse' :: Maybe [Principal]
accessControlList = Maybe [Principal]
a} :: DescribeAccessControlConfigurationResponse) 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 description for the access control configuration.
describeAccessControlConfigurationResponse_description :: Lens.Lens' DescribeAccessControlConfigurationResponse (Prelude.Maybe Prelude.Text)
describeAccessControlConfigurationResponse_description :: Lens' DescribeAccessControlConfigurationResponse (Maybe Text)
describeAccessControlConfigurationResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccessControlConfigurationResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeAccessControlConfigurationResponse' :: DescribeAccessControlConfigurationResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeAccessControlConfigurationResponse
s@DescribeAccessControlConfigurationResponse' {} Maybe Text
a -> DescribeAccessControlConfigurationResponse
s {$sel:description:DescribeAccessControlConfigurationResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeAccessControlConfigurationResponse)

-- | The error message containing details if there are issues processing the
-- access control configuration.
describeAccessControlConfigurationResponse_errorMessage :: Lens.Lens' DescribeAccessControlConfigurationResponse (Prelude.Maybe Prelude.Text)
describeAccessControlConfigurationResponse_errorMessage :: Lens' DescribeAccessControlConfigurationResponse (Maybe Text)
describeAccessControlConfigurationResponse_errorMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccessControlConfigurationResponse' {Maybe Text
errorMessage :: Maybe Text
$sel:errorMessage:DescribeAccessControlConfigurationResponse' :: DescribeAccessControlConfigurationResponse -> Maybe Text
errorMessage} -> Maybe Text
errorMessage) (\s :: DescribeAccessControlConfigurationResponse
s@DescribeAccessControlConfigurationResponse' {} Maybe Text
a -> DescribeAccessControlConfigurationResponse
s {$sel:errorMessage:DescribeAccessControlConfigurationResponse' :: Maybe Text
errorMessage = Maybe Text
a} :: DescribeAccessControlConfigurationResponse)

-- | 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.
describeAccessControlConfigurationResponse_hierarchicalAccessControlList :: Lens.Lens' DescribeAccessControlConfigurationResponse (Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal))
describeAccessControlConfigurationResponse_hierarchicalAccessControlList :: Lens'
  DescribeAccessControlConfigurationResponse
  (Maybe (NonEmpty HierarchicalPrincipal))
describeAccessControlConfigurationResponse_hierarchicalAccessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccessControlConfigurationResponse' {Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
$sel:hierarchicalAccessControlList:DescribeAccessControlConfigurationResponse' :: DescribeAccessControlConfigurationResponse
-> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList} -> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList) (\s :: DescribeAccessControlConfigurationResponse
s@DescribeAccessControlConfigurationResponse' {} Maybe (NonEmpty HierarchicalPrincipal)
a -> DescribeAccessControlConfigurationResponse
s {$sel:hierarchicalAccessControlList:DescribeAccessControlConfigurationResponse' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList = Maybe (NonEmpty HierarchicalPrincipal)
a} :: DescribeAccessControlConfigurationResponse) 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 response's http status code.
describeAccessControlConfigurationResponse_httpStatus :: Lens.Lens' DescribeAccessControlConfigurationResponse Prelude.Int
describeAccessControlConfigurationResponse_httpStatus :: Lens' DescribeAccessControlConfigurationResponse Int
describeAccessControlConfigurationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccessControlConfigurationResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeAccessControlConfigurationResponse' :: DescribeAccessControlConfigurationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeAccessControlConfigurationResponse
s@DescribeAccessControlConfigurationResponse' {} Int
a -> DescribeAccessControlConfigurationResponse
s {$sel:httpStatus:DescribeAccessControlConfigurationResponse' :: Int
httpStatus = Int
a} :: DescribeAccessControlConfigurationResponse)

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

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