{-# 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.PutPrincipalMapping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Maps users to their groups so that you only need to provide the user ID
-- when you issue the query.
--
-- You can also map sub groups to groups. For example, the group \"Company
-- Intellectual Property Teams\" includes sub groups \"Research\" and
-- \"Engineering\". These sub groups include their own list of users or
-- people who work in these teams. Only users who work in research and
-- engineering, and therefore belong in the intellectual property group,
-- can see top-secret company documents in their search results.
--
-- This is useful for user context filtering, where search results are
-- filtered based on the user or their group access to documents. For more
-- information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/user-context-filter.html Filtering on user context>.
--
-- If more than five @PUT@ actions for a group are currently processing, a
-- validation exception is thrown.
--
-- @PutPrincipalMapping@ is currently not supported in the Amazon Web
-- Services GovCloud (US-West) region.
module Amazonka.Kendra.PutPrincipalMapping
  ( -- * Creating a Request
    PutPrincipalMapping (..),
    newPutPrincipalMapping,

    -- * Request Lenses
    putPrincipalMapping_dataSourceId,
    putPrincipalMapping_orderingId,
    putPrincipalMapping_roleArn,
    putPrincipalMapping_indexId,
    putPrincipalMapping_groupId,
    putPrincipalMapping_groupMembers,

    -- * Destructuring the Response
    PutPrincipalMappingResponse (..),
    newPutPrincipalMappingResponse,
  )
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:/ 'newPutPrincipalMapping' smart constructor.
data PutPrincipalMapping = PutPrincipalMapping'
  { -- | The identifier of the data source you want to map users to their groups.
    --
    -- This is useful if a group is tied to multiple data sources, but you only
    -- want the group to access documents of a certain data source. For
    -- example, the groups \"Research\", \"Engineering\", and \"Sales and
    -- Marketing\" are all tied to the company\'s documents stored in the data
    -- sources Confluence and Salesforce. However, \"Sales and Marketing\" team
    -- only needs access to customer-related documents stored in Salesforce.
    PutPrincipalMapping -> Maybe Text
dataSourceId :: Prelude.Maybe Prelude.Text,
    -- | The timestamp identifier you specify to ensure Amazon Kendra does not
    -- override the latest @PUT@ action with previous actions. The highest
    -- number ID, which is the ordering ID, is the latest action you want to
    -- process and apply on top of other actions with lower number IDs. This
    -- prevents previous actions with lower number IDs from possibly overriding
    -- the latest action.
    --
    -- The ordering ID can be the UNIX time of the last update you made to a
    -- group members list. You would then provide this list when calling
    -- @PutPrincipalMapping@. This ensures your @PUT@ action for that updated
    -- group with the latest members list doesn\'t get overwritten by earlier
    -- @PUT@ actions for the same group which are yet to be processed.
    --
    -- The default ordering ID is the current UNIX time in milliseconds that
    -- the action was received by Amazon Kendra.
    PutPrincipalMapping -> Maybe Natural
orderingId :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) of a role that has access to the S3 file
    -- that contains your list of users or sub groups that belong to a group.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html#iam-roles-ds IAM roles for Amazon Kendra>.
    PutPrincipalMapping -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the index you want to map users to their groups.
    PutPrincipalMapping -> Text
indexId :: Prelude.Text,
    -- | The identifier of the group you want to map its users to.
    PutPrincipalMapping -> Text
groupId :: Prelude.Text,
    -- | The list that contains your users or sub groups that belong the same
    -- group.
    --
    -- For example, the group \"Company\" includes the user \"CEO\" and the sub
    -- groups \"Research\", \"Engineering\", and \"Sales and Marketing\".
    --
    -- If you have more than 1000 users and\/or sub groups for a single group,
    -- you need to provide the path to the S3 file that lists your users and
    -- sub groups for a group. Your sub groups can contain more than 1000
    -- users, but the list of sub groups that belong to a group (and\/or users)
    -- must be no more than 1000.
    PutPrincipalMapping -> GroupMembers
groupMembers :: GroupMembers
  }
  deriving (PutPrincipalMapping -> PutPrincipalMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutPrincipalMapping -> PutPrincipalMapping -> Bool
$c/= :: PutPrincipalMapping -> PutPrincipalMapping -> Bool
== :: PutPrincipalMapping -> PutPrincipalMapping -> Bool
$c== :: PutPrincipalMapping -> PutPrincipalMapping -> Bool
Prelude.Eq, ReadPrec [PutPrincipalMapping]
ReadPrec PutPrincipalMapping
Int -> ReadS PutPrincipalMapping
ReadS [PutPrincipalMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutPrincipalMapping]
$creadListPrec :: ReadPrec [PutPrincipalMapping]
readPrec :: ReadPrec PutPrincipalMapping
$creadPrec :: ReadPrec PutPrincipalMapping
readList :: ReadS [PutPrincipalMapping]
$creadList :: ReadS [PutPrincipalMapping]
readsPrec :: Int -> ReadS PutPrincipalMapping
$creadsPrec :: Int -> ReadS PutPrincipalMapping
Prelude.Read, Int -> PutPrincipalMapping -> ShowS
[PutPrincipalMapping] -> ShowS
PutPrincipalMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutPrincipalMapping] -> ShowS
$cshowList :: [PutPrincipalMapping] -> ShowS
show :: PutPrincipalMapping -> String
$cshow :: PutPrincipalMapping -> String
showsPrec :: Int -> PutPrincipalMapping -> ShowS
$cshowsPrec :: Int -> PutPrincipalMapping -> ShowS
Prelude.Show, forall x. Rep PutPrincipalMapping x -> PutPrincipalMapping
forall x. PutPrincipalMapping -> Rep PutPrincipalMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutPrincipalMapping x -> PutPrincipalMapping
$cfrom :: forall x. PutPrincipalMapping -> Rep PutPrincipalMapping x
Prelude.Generic)

-- |
-- Create a value of 'PutPrincipalMapping' 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:
--
-- 'dataSourceId', 'putPrincipalMapping_dataSourceId' - The identifier of the data source you want to map users to their groups.
--
-- This is useful if a group is tied to multiple data sources, but you only
-- want the group to access documents of a certain data source. For
-- example, the groups \"Research\", \"Engineering\", and \"Sales and
-- Marketing\" are all tied to the company\'s documents stored in the data
-- sources Confluence and Salesforce. However, \"Sales and Marketing\" team
-- only needs access to customer-related documents stored in Salesforce.
--
-- 'orderingId', 'putPrincipalMapping_orderingId' - The timestamp identifier you specify to ensure Amazon Kendra does not
-- override the latest @PUT@ action with previous actions. The highest
-- number ID, which is the ordering ID, is the latest action you want to
-- process and apply on top of other actions with lower number IDs. This
-- prevents previous actions with lower number IDs from possibly overriding
-- the latest action.
--
-- The ordering ID can be the UNIX time of the last update you made to a
-- group members list. You would then provide this list when calling
-- @PutPrincipalMapping@. This ensures your @PUT@ action for that updated
-- group with the latest members list doesn\'t get overwritten by earlier
-- @PUT@ actions for the same group which are yet to be processed.
--
-- The default ordering ID is the current UNIX time in milliseconds that
-- the action was received by Amazon Kendra.
--
-- 'roleArn', 'putPrincipalMapping_roleArn' - The Amazon Resource Name (ARN) of a role that has access to the S3 file
-- that contains your list of users or sub groups that belong to a group.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html#iam-roles-ds IAM roles for Amazon Kendra>.
--
-- 'indexId', 'putPrincipalMapping_indexId' - The identifier of the index you want to map users to their groups.
--
-- 'groupId', 'putPrincipalMapping_groupId' - The identifier of the group you want to map its users to.
--
-- 'groupMembers', 'putPrincipalMapping_groupMembers' - The list that contains your users or sub groups that belong the same
-- group.
--
-- For example, the group \"Company\" includes the user \"CEO\" and the sub
-- groups \"Research\", \"Engineering\", and \"Sales and Marketing\".
--
-- If you have more than 1000 users and\/or sub groups for a single group,
-- you need to provide the path to the S3 file that lists your users and
-- sub groups for a group. Your sub groups can contain more than 1000
-- users, but the list of sub groups that belong to a group (and\/or users)
-- must be no more than 1000.
newPutPrincipalMapping ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'groupId'
  Prelude.Text ->
  -- | 'groupMembers'
  GroupMembers ->
  PutPrincipalMapping
newPutPrincipalMapping :: Text -> Text -> GroupMembers -> PutPrincipalMapping
newPutPrincipalMapping
  Text
pIndexId_
  Text
pGroupId_
  GroupMembers
pGroupMembers_ =
    PutPrincipalMapping'
      { $sel:dataSourceId:PutPrincipalMapping' :: Maybe Text
dataSourceId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:orderingId:PutPrincipalMapping' :: Maybe Natural
orderingId = forall a. Maybe a
Prelude.Nothing,
        $sel:roleArn:PutPrincipalMapping' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:indexId:PutPrincipalMapping' :: Text
indexId = Text
pIndexId_,
        $sel:groupId:PutPrincipalMapping' :: Text
groupId = Text
pGroupId_,
        $sel:groupMembers:PutPrincipalMapping' :: GroupMembers
groupMembers = GroupMembers
pGroupMembers_
      }

-- | The identifier of the data source you want to map users to their groups.
--
-- This is useful if a group is tied to multiple data sources, but you only
-- want the group to access documents of a certain data source. For
-- example, the groups \"Research\", \"Engineering\", and \"Sales and
-- Marketing\" are all tied to the company\'s documents stored in the data
-- sources Confluence and Salesforce. However, \"Sales and Marketing\" team
-- only needs access to customer-related documents stored in Salesforce.
putPrincipalMapping_dataSourceId :: Lens.Lens' PutPrincipalMapping (Prelude.Maybe Prelude.Text)
putPrincipalMapping_dataSourceId :: Lens' PutPrincipalMapping (Maybe Text)
putPrincipalMapping_dataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPrincipalMapping' {Maybe Text
dataSourceId :: Maybe Text
$sel:dataSourceId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
dataSourceId} -> Maybe Text
dataSourceId) (\s :: PutPrincipalMapping
s@PutPrincipalMapping' {} Maybe Text
a -> PutPrincipalMapping
s {$sel:dataSourceId:PutPrincipalMapping' :: Maybe Text
dataSourceId = Maybe Text
a} :: PutPrincipalMapping)

-- | The timestamp identifier you specify to ensure Amazon Kendra does not
-- override the latest @PUT@ action with previous actions. The highest
-- number ID, which is the ordering ID, is the latest action you want to
-- process and apply on top of other actions with lower number IDs. This
-- prevents previous actions with lower number IDs from possibly overriding
-- the latest action.
--
-- The ordering ID can be the UNIX time of the last update you made to a
-- group members list. You would then provide this list when calling
-- @PutPrincipalMapping@. This ensures your @PUT@ action for that updated
-- group with the latest members list doesn\'t get overwritten by earlier
-- @PUT@ actions for the same group which are yet to be processed.
--
-- The default ordering ID is the current UNIX time in milliseconds that
-- the action was received by Amazon Kendra.
putPrincipalMapping_orderingId :: Lens.Lens' PutPrincipalMapping (Prelude.Maybe Prelude.Natural)
putPrincipalMapping_orderingId :: Lens' PutPrincipalMapping (Maybe Natural)
putPrincipalMapping_orderingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPrincipalMapping' {Maybe Natural
orderingId :: Maybe Natural
$sel:orderingId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Natural
orderingId} -> Maybe Natural
orderingId) (\s :: PutPrincipalMapping
s@PutPrincipalMapping' {} Maybe Natural
a -> PutPrincipalMapping
s {$sel:orderingId:PutPrincipalMapping' :: Maybe Natural
orderingId = Maybe Natural
a} :: PutPrincipalMapping)

-- | The Amazon Resource Name (ARN) of a role that has access to the S3 file
-- that contains your list of users or sub groups that belong to a group.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html#iam-roles-ds IAM roles for Amazon Kendra>.
putPrincipalMapping_roleArn :: Lens.Lens' PutPrincipalMapping (Prelude.Maybe Prelude.Text)
putPrincipalMapping_roleArn :: Lens' PutPrincipalMapping (Maybe Text)
putPrincipalMapping_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPrincipalMapping' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: PutPrincipalMapping
s@PutPrincipalMapping' {} Maybe Text
a -> PutPrincipalMapping
s {$sel:roleArn:PutPrincipalMapping' :: Maybe Text
roleArn = Maybe Text
a} :: PutPrincipalMapping)

-- | The identifier of the index you want to map users to their groups.
putPrincipalMapping_indexId :: Lens.Lens' PutPrincipalMapping Prelude.Text
putPrincipalMapping_indexId :: Lens' PutPrincipalMapping Text
putPrincipalMapping_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPrincipalMapping' {Text
indexId :: Text
$sel:indexId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
indexId} -> Text
indexId) (\s :: PutPrincipalMapping
s@PutPrincipalMapping' {} Text
a -> PutPrincipalMapping
s {$sel:indexId:PutPrincipalMapping' :: Text
indexId = Text
a} :: PutPrincipalMapping)

-- | The identifier of the group you want to map its users to.
putPrincipalMapping_groupId :: Lens.Lens' PutPrincipalMapping Prelude.Text
putPrincipalMapping_groupId :: Lens' PutPrincipalMapping Text
putPrincipalMapping_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPrincipalMapping' {Text
groupId :: Text
$sel:groupId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
groupId} -> Text
groupId) (\s :: PutPrincipalMapping
s@PutPrincipalMapping' {} Text
a -> PutPrincipalMapping
s {$sel:groupId:PutPrincipalMapping' :: Text
groupId = Text
a} :: PutPrincipalMapping)

-- | The list that contains your users or sub groups that belong the same
-- group.
--
-- For example, the group \"Company\" includes the user \"CEO\" and the sub
-- groups \"Research\", \"Engineering\", and \"Sales and Marketing\".
--
-- If you have more than 1000 users and\/or sub groups for a single group,
-- you need to provide the path to the S3 file that lists your users and
-- sub groups for a group. Your sub groups can contain more than 1000
-- users, but the list of sub groups that belong to a group (and\/or users)
-- must be no more than 1000.
putPrincipalMapping_groupMembers :: Lens.Lens' PutPrincipalMapping GroupMembers
putPrincipalMapping_groupMembers :: Lens' PutPrincipalMapping GroupMembers
putPrincipalMapping_groupMembers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPrincipalMapping' {GroupMembers
groupMembers :: GroupMembers
$sel:groupMembers:PutPrincipalMapping' :: PutPrincipalMapping -> GroupMembers
groupMembers} -> GroupMembers
groupMembers) (\s :: PutPrincipalMapping
s@PutPrincipalMapping' {} GroupMembers
a -> PutPrincipalMapping
s {$sel:groupMembers:PutPrincipalMapping' :: GroupMembers
groupMembers = GroupMembers
a} :: PutPrincipalMapping)

instance Core.AWSRequest PutPrincipalMapping where
  type
    AWSResponse PutPrincipalMapping =
      PutPrincipalMappingResponse
  request :: (Service -> Service)
-> PutPrincipalMapping -> Request PutPrincipalMapping
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 PutPrincipalMapping
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutPrincipalMapping)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutPrincipalMappingResponse
PutPrincipalMappingResponse'

instance Prelude.Hashable PutPrincipalMapping where
  hashWithSalt :: Int -> PutPrincipalMapping -> Int
hashWithSalt Int
_salt PutPrincipalMapping' {Maybe Natural
Maybe Text
Text
GroupMembers
groupMembers :: GroupMembers
groupId :: Text
indexId :: Text
roleArn :: Maybe Text
orderingId :: Maybe Natural
dataSourceId :: Maybe Text
$sel:groupMembers:PutPrincipalMapping' :: PutPrincipalMapping -> GroupMembers
$sel:groupId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
$sel:indexId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
$sel:roleArn:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
$sel:orderingId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Natural
$sel:dataSourceId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dataSourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
orderingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
groupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` GroupMembers
groupMembers

instance Prelude.NFData PutPrincipalMapping where
  rnf :: PutPrincipalMapping -> ()
rnf PutPrincipalMapping' {Maybe Natural
Maybe Text
Text
GroupMembers
groupMembers :: GroupMembers
groupId :: Text
indexId :: Text
roleArn :: Maybe Text
orderingId :: Maybe Natural
dataSourceId :: Maybe Text
$sel:groupMembers:PutPrincipalMapping' :: PutPrincipalMapping -> GroupMembers
$sel:groupId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
$sel:indexId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
$sel:roleArn:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
$sel:orderingId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Natural
$sel:dataSourceId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataSourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
orderingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      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
groupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf GroupMembers
groupMembers

instance Data.ToHeaders PutPrincipalMapping where
  toHeaders :: PutPrincipalMapping -> [Header]
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 -> [Header]
Data.=# ( ByteString
"AWSKendraFrontendService.PutPrincipalMapping" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutPrincipalMapping where
  toJSON :: PutPrincipalMapping -> Value
toJSON PutPrincipalMapping' {Maybe Natural
Maybe Text
Text
GroupMembers
groupMembers :: GroupMembers
groupId :: Text
indexId :: Text
roleArn :: Maybe Text
orderingId :: Maybe Natural
dataSourceId :: Maybe Text
$sel:groupMembers:PutPrincipalMapping' :: PutPrincipalMapping -> GroupMembers
$sel:groupId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
$sel:indexId:PutPrincipalMapping' :: PutPrincipalMapping -> Text
$sel:roleArn:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
$sel:orderingId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Natural
$sel:dataSourceId:PutPrincipalMapping' :: PutPrincipalMapping -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataSourceId" 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
dataSourceId,
            (Key
"OrderingId" 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 Natural
orderingId,
            (Key
"RoleArn" 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
roleArn,
            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
"GroupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
groupId),
            forall a. a -> Maybe a
Prelude.Just (Key
"GroupMembers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= GroupMembers
groupMembers)
          ]
      )

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

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

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

-- |
-- Create a value of 'PutPrincipalMappingResponse' 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.
newPutPrincipalMappingResponse ::
  PutPrincipalMappingResponse
newPutPrincipalMappingResponse :: PutPrincipalMappingResponse
newPutPrincipalMappingResponse =
  PutPrincipalMappingResponse
PutPrincipalMappingResponse'

instance Prelude.NFData PutPrincipalMappingResponse where
  rnf :: PutPrincipalMappingResponse -> ()
rnf PutPrincipalMappingResponse
_ = ()