{-# 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.UpdateRoutingProfileQueues
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the properties associated with a set of queues for a routing
-- profile.
module Amazonka.Connect.UpdateRoutingProfileQueues
  ( -- * Creating a Request
    UpdateRoutingProfileQueues (..),
    newUpdateRoutingProfileQueues,

    -- * Request Lenses
    updateRoutingProfileQueues_instanceId,
    updateRoutingProfileQueues_routingProfileId,
    updateRoutingProfileQueues_queueConfigs,

    -- * Destructuring the Response
    UpdateRoutingProfileQueuesResponse (..),
    newUpdateRoutingProfileQueuesResponse,
  )
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:/ 'newUpdateRoutingProfileQueues' smart constructor.
data UpdateRoutingProfileQueues = UpdateRoutingProfileQueues'
  { -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    UpdateRoutingProfileQueues -> Text
instanceId :: Prelude.Text,
    -- | The identifier of the routing profile.
    UpdateRoutingProfileQueues -> Text
routingProfileId :: Prelude.Text,
    -- | The queues to be updated for this routing profile. Queues must first be
    -- associated to the routing profile. You can do this using
    -- AssociateRoutingProfileQueues.
    UpdateRoutingProfileQueues -> NonEmpty RoutingProfileQueueConfig
queueConfigs :: Prelude.NonEmpty RoutingProfileQueueConfig
  }
  deriving (UpdateRoutingProfileQueues -> UpdateRoutingProfileQueues -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoutingProfileQueues -> UpdateRoutingProfileQueues -> Bool
$c/= :: UpdateRoutingProfileQueues -> UpdateRoutingProfileQueues -> Bool
== :: UpdateRoutingProfileQueues -> UpdateRoutingProfileQueues -> Bool
$c== :: UpdateRoutingProfileQueues -> UpdateRoutingProfileQueues -> Bool
Prelude.Eq, ReadPrec [UpdateRoutingProfileQueues]
ReadPrec UpdateRoutingProfileQueues
Int -> ReadS UpdateRoutingProfileQueues
ReadS [UpdateRoutingProfileQueues]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoutingProfileQueues]
$creadListPrec :: ReadPrec [UpdateRoutingProfileQueues]
readPrec :: ReadPrec UpdateRoutingProfileQueues
$creadPrec :: ReadPrec UpdateRoutingProfileQueues
readList :: ReadS [UpdateRoutingProfileQueues]
$creadList :: ReadS [UpdateRoutingProfileQueues]
readsPrec :: Int -> ReadS UpdateRoutingProfileQueues
$creadsPrec :: Int -> ReadS UpdateRoutingProfileQueues
Prelude.Read, Int -> UpdateRoutingProfileQueues -> ShowS
[UpdateRoutingProfileQueues] -> ShowS
UpdateRoutingProfileQueues -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoutingProfileQueues] -> ShowS
$cshowList :: [UpdateRoutingProfileQueues] -> ShowS
show :: UpdateRoutingProfileQueues -> String
$cshow :: UpdateRoutingProfileQueues -> String
showsPrec :: Int -> UpdateRoutingProfileQueues -> ShowS
$cshowsPrec :: Int -> UpdateRoutingProfileQueues -> ShowS
Prelude.Show, forall x.
Rep UpdateRoutingProfileQueues x -> UpdateRoutingProfileQueues
forall x.
UpdateRoutingProfileQueues -> Rep UpdateRoutingProfileQueues x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRoutingProfileQueues x -> UpdateRoutingProfileQueues
$cfrom :: forall x.
UpdateRoutingProfileQueues -> Rep UpdateRoutingProfileQueues x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoutingProfileQueues' 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:
--
-- 'instanceId', 'updateRoutingProfileQueues_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'routingProfileId', 'updateRoutingProfileQueues_routingProfileId' - The identifier of the routing profile.
--
-- 'queueConfigs', 'updateRoutingProfileQueues_queueConfigs' - The queues to be updated for this routing profile. Queues must first be
-- associated to the routing profile. You can do this using
-- AssociateRoutingProfileQueues.
newUpdateRoutingProfileQueues ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'routingProfileId'
  Prelude.Text ->
  -- | 'queueConfigs'
  Prelude.NonEmpty RoutingProfileQueueConfig ->
  UpdateRoutingProfileQueues
newUpdateRoutingProfileQueues :: Text
-> Text
-> NonEmpty RoutingProfileQueueConfig
-> UpdateRoutingProfileQueues
newUpdateRoutingProfileQueues
  Text
pInstanceId_
  Text
pRoutingProfileId_
  NonEmpty RoutingProfileQueueConfig
pQueueConfigs_ =
    UpdateRoutingProfileQueues'
      { $sel:instanceId:UpdateRoutingProfileQueues' :: Text
instanceId =
          Text
pInstanceId_,
        $sel:routingProfileId:UpdateRoutingProfileQueues' :: Text
routingProfileId = Text
pRoutingProfileId_,
        $sel:queueConfigs:UpdateRoutingProfileQueues' :: NonEmpty RoutingProfileQueueConfig
queueConfigs =
          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 RoutingProfileQueueConfig
pQueueConfigs_
      }

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

-- | The identifier of the routing profile.
updateRoutingProfileQueues_routingProfileId :: Lens.Lens' UpdateRoutingProfileQueues Prelude.Text
updateRoutingProfileQueues_routingProfileId :: Lens' UpdateRoutingProfileQueues Text
updateRoutingProfileQueues_routingProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoutingProfileQueues' {Text
routingProfileId :: Text
$sel:routingProfileId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
routingProfileId} -> Text
routingProfileId) (\s :: UpdateRoutingProfileQueues
s@UpdateRoutingProfileQueues' {} Text
a -> UpdateRoutingProfileQueues
s {$sel:routingProfileId:UpdateRoutingProfileQueues' :: Text
routingProfileId = Text
a} :: UpdateRoutingProfileQueues)

-- | The queues to be updated for this routing profile. Queues must first be
-- associated to the routing profile. You can do this using
-- AssociateRoutingProfileQueues.
updateRoutingProfileQueues_queueConfigs :: Lens.Lens' UpdateRoutingProfileQueues (Prelude.NonEmpty RoutingProfileQueueConfig)
updateRoutingProfileQueues_queueConfigs :: Lens'
  UpdateRoutingProfileQueues (NonEmpty RoutingProfileQueueConfig)
updateRoutingProfileQueues_queueConfigs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoutingProfileQueues' {NonEmpty RoutingProfileQueueConfig
queueConfigs :: NonEmpty RoutingProfileQueueConfig
$sel:queueConfigs:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> NonEmpty RoutingProfileQueueConfig
queueConfigs} -> NonEmpty RoutingProfileQueueConfig
queueConfigs) (\s :: UpdateRoutingProfileQueues
s@UpdateRoutingProfileQueues' {} NonEmpty RoutingProfileQueueConfig
a -> UpdateRoutingProfileQueues
s {$sel:queueConfigs:UpdateRoutingProfileQueues' :: NonEmpty RoutingProfileQueueConfig
queueConfigs = NonEmpty RoutingProfileQueueConfig
a} :: UpdateRoutingProfileQueues) 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 UpdateRoutingProfileQueues where
  type
    AWSResponse UpdateRoutingProfileQueues =
      UpdateRoutingProfileQueuesResponse
  request :: (Service -> Service)
-> UpdateRoutingProfileQueues -> Request UpdateRoutingProfileQueues
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 UpdateRoutingProfileQueues
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateRoutingProfileQueues)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      UpdateRoutingProfileQueuesResponse
UpdateRoutingProfileQueuesResponse'

instance Prelude.Hashable UpdateRoutingProfileQueues where
  hashWithSalt :: Int -> UpdateRoutingProfileQueues -> Int
hashWithSalt Int
_salt UpdateRoutingProfileQueues' {NonEmpty RoutingProfileQueueConfig
Text
queueConfigs :: NonEmpty RoutingProfileQueueConfig
routingProfileId :: Text
instanceId :: Text
$sel:queueConfigs:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> NonEmpty RoutingProfileQueueConfig
$sel:routingProfileId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
$sel:instanceId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
routingProfileId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty RoutingProfileQueueConfig
queueConfigs

instance Prelude.NFData UpdateRoutingProfileQueues where
  rnf :: UpdateRoutingProfileQueues -> ()
rnf UpdateRoutingProfileQueues' {NonEmpty RoutingProfileQueueConfig
Text
queueConfigs :: NonEmpty RoutingProfileQueueConfig
routingProfileId :: Text
instanceId :: Text
$sel:queueConfigs:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> NonEmpty RoutingProfileQueueConfig
$sel:routingProfileId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
$sel:instanceId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
..} =
    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
routingProfileId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty RoutingProfileQueueConfig
queueConfigs

instance Data.ToHeaders UpdateRoutingProfileQueues where
  toHeaders :: UpdateRoutingProfileQueues -> [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 UpdateRoutingProfileQueues where
  toJSON :: UpdateRoutingProfileQueues -> Value
toJSON UpdateRoutingProfileQueues' {NonEmpty RoutingProfileQueueConfig
Text
queueConfigs :: NonEmpty RoutingProfileQueueConfig
routingProfileId :: Text
instanceId :: Text
$sel:queueConfigs:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> NonEmpty RoutingProfileQueueConfig
$sel:routingProfileId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
$sel:instanceId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"QueueConfigs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty RoutingProfileQueueConfig
queueConfigs)]
      )

instance Data.ToPath UpdateRoutingProfileQueues where
  toPath :: UpdateRoutingProfileQueues -> ByteString
toPath UpdateRoutingProfileQueues' {NonEmpty RoutingProfileQueueConfig
Text
queueConfigs :: NonEmpty RoutingProfileQueueConfig
routingProfileId :: Text
instanceId :: Text
$sel:queueConfigs:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> NonEmpty RoutingProfileQueueConfig
$sel:routingProfileId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
$sel:instanceId:UpdateRoutingProfileQueues' :: UpdateRoutingProfileQueues -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/routing-profiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
routingProfileId,
        ByteString
"/queues"
      ]

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

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

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

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