{-# 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.PersonalizeEvents.PutUsers
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds one or more users to a Users dataset. For more information see
-- <https://docs.aws.amazon.com/personalize/latest/dg/importing-users.html Importing Users Incrementally>.
module Amazonka.PersonalizeEvents.PutUsers
  ( -- * Creating a Request
    PutUsers (..),
    newPutUsers,

    -- * Request Lenses
    putUsers_datasetArn,
    putUsers_users,

    -- * Destructuring the Response
    PutUsersResponse (..),
    newPutUsersResponse,
  )
where

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

-- | /See:/ 'newPutUsers' smart constructor.
data PutUsers = PutUsers'
  { -- | The Amazon Resource Name (ARN) of the Users dataset you are adding the
    -- user or users to.
    PutUsers -> Text
datasetArn :: Prelude.Text,
    -- | A list of user data.
    PutUsers -> NonEmpty User
users :: Prelude.NonEmpty User
  }
  deriving (PutUsers -> PutUsers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutUsers -> PutUsers -> Bool
$c/= :: PutUsers -> PutUsers -> Bool
== :: PutUsers -> PutUsers -> Bool
$c== :: PutUsers -> PutUsers -> Bool
Prelude.Eq, Int -> PutUsers -> ShowS
[PutUsers] -> ShowS
PutUsers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutUsers] -> ShowS
$cshowList :: [PutUsers] -> ShowS
show :: PutUsers -> String
$cshow :: PutUsers -> String
showsPrec :: Int -> PutUsers -> ShowS
$cshowsPrec :: Int -> PutUsers -> ShowS
Prelude.Show, forall x. Rep PutUsers x -> PutUsers
forall x. PutUsers -> Rep PutUsers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutUsers x -> PutUsers
$cfrom :: forall x. PutUsers -> Rep PutUsers x
Prelude.Generic)

-- |
-- Create a value of 'PutUsers' 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:
--
-- 'datasetArn', 'putUsers_datasetArn' - The Amazon Resource Name (ARN) of the Users dataset you are adding the
-- user or users to.
--
-- 'users', 'putUsers_users' - A list of user data.
newPutUsers ::
  -- | 'datasetArn'
  Prelude.Text ->
  -- | 'users'
  Prelude.NonEmpty User ->
  PutUsers
newPutUsers :: Text -> NonEmpty User -> PutUsers
newPutUsers Text
pDatasetArn_ NonEmpty User
pUsers_ =
  PutUsers'
    { $sel:datasetArn:PutUsers' :: Text
datasetArn = Text
pDatasetArn_,
      $sel:users:PutUsers' :: NonEmpty User
users = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty User
pUsers_
    }

-- | The Amazon Resource Name (ARN) of the Users dataset you are adding the
-- user or users to.
putUsers_datasetArn :: Lens.Lens' PutUsers Prelude.Text
putUsers_datasetArn :: Lens' PutUsers Text
putUsers_datasetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutUsers' {Text
datasetArn :: Text
$sel:datasetArn:PutUsers' :: PutUsers -> Text
datasetArn} -> Text
datasetArn) (\s :: PutUsers
s@PutUsers' {} Text
a -> PutUsers
s {$sel:datasetArn:PutUsers' :: Text
datasetArn = Text
a} :: PutUsers)

-- | A list of user data.
putUsers_users :: Lens.Lens' PutUsers (Prelude.NonEmpty User)
putUsers_users :: Lens' PutUsers (NonEmpty User)
putUsers_users = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutUsers' {NonEmpty User
users :: NonEmpty User
$sel:users:PutUsers' :: PutUsers -> NonEmpty User
users} -> NonEmpty User
users) (\s :: PutUsers
s@PutUsers' {} NonEmpty User
a -> PutUsers
s {$sel:users:PutUsers' :: NonEmpty User
users = NonEmpty User
a} :: PutUsers) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.Hashable PutUsers where
  hashWithSalt :: Int -> PutUsers -> Int
hashWithSalt Int
_salt PutUsers' {NonEmpty User
Text
users :: NonEmpty User
datasetArn :: Text
$sel:users:PutUsers' :: PutUsers -> NonEmpty User
$sel:datasetArn:PutUsers' :: PutUsers -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty User
users

instance Prelude.NFData PutUsers where
  rnf :: PutUsers -> ()
rnf PutUsers' {NonEmpty User
Text
users :: NonEmpty User
datasetArn :: Text
$sel:users:PutUsers' :: PutUsers -> NonEmpty User
$sel:datasetArn:PutUsers' :: PutUsers -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
datasetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty User
users

instance Data.ToHeaders PutUsers where
  toHeaders :: PutUsers -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutUsers where
  toJSON :: PutUsers -> Value
toJSON PutUsers' {NonEmpty User
Text
users :: NonEmpty User
datasetArn :: Text
$sel:users:PutUsers' :: PutUsers -> NonEmpty User
$sel:datasetArn:PutUsers' :: PutUsers -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"datasetArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
datasetArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"users" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty User
users)
          ]
      )

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

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

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

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

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