{-# 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.Connect.PutUserStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes the current status of a user or agent in Amazon Connect. If the
-- agent is currently handling a contact, this sets the agent\'s next
-- status.
--
-- For more information, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/metrics-agent-status.html Agent status>
-- and
-- <https://docs.aws.amazon.com/connect/latest/adminguide/set-next-status.html Set your next status>
-- in the /Amazon Connect Administrator Guide/.
module Amazonka.Connect.PutUserStatus
  ( -- * Creating a Request
    PutUserStatus (..),
    newPutUserStatus,

    -- * Request Lenses
    putUserStatus_userId,
    putUserStatus_instanceId,
    putUserStatus_agentStatusId,

    -- * Destructuring the Response
    PutUserStatusResponse (..),
    newPutUserStatusResponse,

    -- * Response Lenses
    putUserStatusResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutUserStatus' smart constructor.
data PutUserStatus = PutUserStatus'
  { -- | The identifier of the user.
    PutUserStatus -> Text
userId :: Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    PutUserStatus -> Text
instanceId :: Prelude.Text,
    -- | The identifier of the agent status.
    PutUserStatus -> Text
agentStatusId :: Prelude.Text
  }
  deriving (PutUserStatus -> PutUserStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutUserStatus -> PutUserStatus -> Bool
$c/= :: PutUserStatus -> PutUserStatus -> Bool
== :: PutUserStatus -> PutUserStatus -> Bool
$c== :: PutUserStatus -> PutUserStatus -> Bool
Prelude.Eq, ReadPrec [PutUserStatus]
ReadPrec PutUserStatus
Int -> ReadS PutUserStatus
ReadS [PutUserStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutUserStatus]
$creadListPrec :: ReadPrec [PutUserStatus]
readPrec :: ReadPrec PutUserStatus
$creadPrec :: ReadPrec PutUserStatus
readList :: ReadS [PutUserStatus]
$creadList :: ReadS [PutUserStatus]
readsPrec :: Int -> ReadS PutUserStatus
$creadsPrec :: Int -> ReadS PutUserStatus
Prelude.Read, Int -> PutUserStatus -> ShowS
[PutUserStatus] -> ShowS
PutUserStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutUserStatus] -> ShowS
$cshowList :: [PutUserStatus] -> ShowS
show :: PutUserStatus -> String
$cshow :: PutUserStatus -> String
showsPrec :: Int -> PutUserStatus -> ShowS
$cshowsPrec :: Int -> PutUserStatus -> ShowS
Prelude.Show, forall x. Rep PutUserStatus x -> PutUserStatus
forall x. PutUserStatus -> Rep PutUserStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutUserStatus x -> PutUserStatus
$cfrom :: forall x. PutUserStatus -> Rep PutUserStatus x
Prelude.Generic)

-- |
-- Create a value of 'PutUserStatus' 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:
--
-- 'userId', 'putUserStatus_userId' - The identifier of the user.
--
-- 'instanceId', 'putUserStatus_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'agentStatusId', 'putUserStatus_agentStatusId' - The identifier of the agent status.
newPutUserStatus ::
  -- | 'userId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'agentStatusId'
  Prelude.Text ->
  PutUserStatus
newPutUserStatus :: Text -> Text -> Text -> PutUserStatus
newPutUserStatus
  Text
pUserId_
  Text
pInstanceId_
  Text
pAgentStatusId_ =
    PutUserStatus'
      { $sel:userId:PutUserStatus' :: Text
userId = Text
pUserId_,
        $sel:instanceId:PutUserStatus' :: Text
instanceId = Text
pInstanceId_,
        $sel:agentStatusId:PutUserStatus' :: Text
agentStatusId = Text
pAgentStatusId_
      }

-- | The identifier of the user.
putUserStatus_userId :: Lens.Lens' PutUserStatus Prelude.Text
putUserStatus_userId :: Lens' PutUserStatus Text
putUserStatus_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutUserStatus' {Text
userId :: Text
$sel:userId:PutUserStatus' :: PutUserStatus -> Text
userId} -> Text
userId) (\s :: PutUserStatus
s@PutUserStatus' {} Text
a -> PutUserStatus
s {$sel:userId:PutUserStatus' :: Text
userId = Text
a} :: PutUserStatus)

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
putUserStatus_instanceId :: Lens.Lens' PutUserStatus Prelude.Text
putUserStatus_instanceId :: Lens' PutUserStatus Text
putUserStatus_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutUserStatus' {Text
instanceId :: Text
$sel:instanceId:PutUserStatus' :: PutUserStatus -> Text
instanceId} -> Text
instanceId) (\s :: PutUserStatus
s@PutUserStatus' {} Text
a -> PutUserStatus
s {$sel:instanceId:PutUserStatus' :: Text
instanceId = Text
a} :: PutUserStatus)

-- | The identifier of the agent status.
putUserStatus_agentStatusId :: Lens.Lens' PutUserStatus Prelude.Text
putUserStatus_agentStatusId :: Lens' PutUserStatus Text
putUserStatus_agentStatusId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutUserStatus' {Text
agentStatusId :: Text
$sel:agentStatusId:PutUserStatus' :: PutUserStatus -> Text
agentStatusId} -> Text
agentStatusId) (\s :: PutUserStatus
s@PutUserStatus' {} Text
a -> PutUserStatus
s {$sel:agentStatusId:PutUserStatus' :: Text
agentStatusId = Text
a} :: PutUserStatus)

instance Core.AWSRequest PutUserStatus where
  type
    AWSResponse PutUserStatus =
      PutUserStatusResponse
  request :: (Service -> Service) -> PutUserStatus -> Request PutUserStatus
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutUserStatus
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutUserStatus)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> PutUserStatusResponse
PutUserStatusResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable PutUserStatus where
  hashWithSalt :: Int -> PutUserStatus -> Int
hashWithSalt Int
_salt PutUserStatus' {Text
agentStatusId :: Text
instanceId :: Text
userId :: Text
$sel:agentStatusId:PutUserStatus' :: PutUserStatus -> Text
$sel:instanceId:PutUserStatus' :: PutUserStatus -> Text
$sel:userId:PutUserStatus' :: PutUserStatus -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
agentStatusId

instance Prelude.NFData PutUserStatus where
  rnf :: PutUserStatus -> ()
rnf PutUserStatus' {Text
agentStatusId :: Text
instanceId :: Text
userId :: Text
$sel:agentStatusId:PutUserStatus' :: PutUserStatus -> Text
$sel:instanceId:PutUserStatus' :: PutUserStatus -> Text
$sel:userId:PutUserStatus' :: PutUserStatus -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
userId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
agentStatusId

instance Data.ToHeaders PutUserStatus where
  toHeaders :: PutUserStatus -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutUserStatus where
  toJSON :: PutUserStatus -> Value
toJSON PutUserStatus' {Text
agentStatusId :: Text
instanceId :: Text
userId :: Text
$sel:agentStatusId:PutUserStatus' :: PutUserStatus -> Text
$sel:instanceId:PutUserStatus' :: PutUserStatus -> Text
$sel:userId:PutUserStatus' :: PutUserStatus -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"AgentStatusId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
agentStatusId)
          ]
      )

instance Data.ToPath PutUserStatus where
  toPath :: PutUserStatus -> ByteString
toPath PutUserStatus' {Text
agentStatusId :: Text
instanceId :: Text
userId :: Text
$sel:agentStatusId:PutUserStatus' :: PutUserStatus -> Text
$sel:instanceId:PutUserStatus' :: PutUserStatus -> Text
$sel:userId:PutUserStatus' :: PutUserStatus -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/users/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId,
        ByteString
"/status"
      ]

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

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

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

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

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