{-# 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.CreateQueue
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This API is in preview release for Amazon Connect and is subject to
-- change.
--
-- Creates a new queue for the specified Amazon Connect instance.
--
-- If the number being used in the input is claimed to a traffic
-- distribution group, and you are calling this API using an instance in
-- the Amazon Web Services Region where the traffic distribution group was
-- created, you can use either a full phone number ARN or UUID value for
-- the @OutboundCallerIdNumberId@ value of the
-- <https://docs.aws.amazon.com/connect/latest/APIReference/API_OutboundCallerConfig OutboundCallerConfig>
-- request body parameter. However, if the number is claimed to a traffic
-- distribution group and you are calling this API using an instance in the
-- alternate Amazon Web Services Region associated with the traffic
-- distribution group, you must provide a full phone number ARN. If a UUID
-- is provided in this scenario, you will receive a
-- @ResourceNotFoundException@.
module Amazonka.Connect.CreateQueue
  ( -- * Creating a Request
    CreateQueue (..),
    newCreateQueue,

    -- * Request Lenses
    createQueue_description,
    createQueue_maxContacts,
    createQueue_outboundCallerConfig,
    createQueue_quickConnectIds,
    createQueue_tags,
    createQueue_instanceId,
    createQueue_name,
    createQueue_hoursOfOperationId,

    -- * Destructuring the Response
    CreateQueueResponse (..),
    newCreateQueueResponse,

    -- * Response Lenses
    createQueueResponse_queueArn,
    createQueueResponse_queueId,
    createQueueResponse_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:/ 'newCreateQueue' smart constructor.
data CreateQueue = CreateQueue'
  { -- | The description of the queue.
    CreateQueue -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of contacts that can be in the queue before it is
    -- considered full.
    CreateQueue -> Maybe Natural
maxContacts :: Prelude.Maybe Prelude.Natural,
    -- | The outbound caller ID name, number, and outbound whisper flow.
    CreateQueue -> Maybe OutboundCallerConfig
outboundCallerConfig :: Prelude.Maybe OutboundCallerConfig,
    -- | The quick connects available to agents who are working the queue.
    CreateQueue -> Maybe (NonEmpty Text)
quickConnectIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The tags used to organize, track, or control access for this resource.
    -- For example, { \"tags\": {\"key1\":\"value1\", \"key2\":\"value2\"} }.
    CreateQueue -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    CreateQueue -> Text
instanceId :: Prelude.Text,
    -- | The name of the queue.
    CreateQueue -> Text
name :: Prelude.Text,
    -- | The identifier for the hours of operation.
    CreateQueue -> Text
hoursOfOperationId :: Prelude.Text
  }
  deriving (CreateQueue -> CreateQueue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateQueue -> CreateQueue -> Bool
$c/= :: CreateQueue -> CreateQueue -> Bool
== :: CreateQueue -> CreateQueue -> Bool
$c== :: CreateQueue -> CreateQueue -> Bool
Prelude.Eq, ReadPrec [CreateQueue]
ReadPrec CreateQueue
Int -> ReadS CreateQueue
ReadS [CreateQueue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateQueue]
$creadListPrec :: ReadPrec [CreateQueue]
readPrec :: ReadPrec CreateQueue
$creadPrec :: ReadPrec CreateQueue
readList :: ReadS [CreateQueue]
$creadList :: ReadS [CreateQueue]
readsPrec :: Int -> ReadS CreateQueue
$creadsPrec :: Int -> ReadS CreateQueue
Prelude.Read, Int -> CreateQueue -> ShowS
[CreateQueue] -> ShowS
CreateQueue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateQueue] -> ShowS
$cshowList :: [CreateQueue] -> ShowS
show :: CreateQueue -> String
$cshow :: CreateQueue -> String
showsPrec :: Int -> CreateQueue -> ShowS
$cshowsPrec :: Int -> CreateQueue -> ShowS
Prelude.Show, forall x. Rep CreateQueue x -> CreateQueue
forall x. CreateQueue -> Rep CreateQueue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateQueue x -> CreateQueue
$cfrom :: forall x. CreateQueue -> Rep CreateQueue x
Prelude.Generic)

-- |
-- Create a value of 'CreateQueue' 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:
--
-- 'description', 'createQueue_description' - The description of the queue.
--
-- 'maxContacts', 'createQueue_maxContacts' - The maximum number of contacts that can be in the queue before it is
-- considered full.
--
-- 'outboundCallerConfig', 'createQueue_outboundCallerConfig' - The outbound caller ID name, number, and outbound whisper flow.
--
-- 'quickConnectIds', 'createQueue_quickConnectIds' - The quick connects available to agents who are working the queue.
--
-- 'tags', 'createQueue_tags' - The tags used to organize, track, or control access for this resource.
-- For example, { \"tags\": {\"key1\":\"value1\", \"key2\":\"value2\"} }.
--
-- 'instanceId', 'createQueue_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'name', 'createQueue_name' - The name of the queue.
--
-- 'hoursOfOperationId', 'createQueue_hoursOfOperationId' - The identifier for the hours of operation.
newCreateQueue ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'hoursOfOperationId'
  Prelude.Text ->
  CreateQueue
newCreateQueue :: Text -> Text -> Text -> CreateQueue
newCreateQueue
  Text
pInstanceId_
  Text
pName_
  Text
pHoursOfOperationId_ =
    CreateQueue'
      { $sel:description:CreateQueue' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:maxContacts:CreateQueue' :: Maybe Natural
maxContacts = forall a. Maybe a
Prelude.Nothing,
        $sel:outboundCallerConfig:CreateQueue' :: Maybe OutboundCallerConfig
outboundCallerConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:quickConnectIds:CreateQueue' :: Maybe (NonEmpty Text)
quickConnectIds = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateQueue' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:instanceId:CreateQueue' :: Text
instanceId = Text
pInstanceId_,
        $sel:name:CreateQueue' :: Text
name = Text
pName_,
        $sel:hoursOfOperationId:CreateQueue' :: Text
hoursOfOperationId = Text
pHoursOfOperationId_
      }

-- | The description of the queue.
createQueue_description :: Lens.Lens' CreateQueue (Prelude.Maybe Prelude.Text)
createQueue_description :: Lens' CreateQueue (Maybe Text)
createQueue_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Maybe Text
description :: Maybe Text
$sel:description:CreateQueue' :: CreateQueue -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateQueue
s@CreateQueue' {} Maybe Text
a -> CreateQueue
s {$sel:description:CreateQueue' :: Maybe Text
description = Maybe Text
a} :: CreateQueue)

-- | The maximum number of contacts that can be in the queue before it is
-- considered full.
createQueue_maxContacts :: Lens.Lens' CreateQueue (Prelude.Maybe Prelude.Natural)
createQueue_maxContacts :: Lens' CreateQueue (Maybe Natural)
createQueue_maxContacts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Maybe Natural
maxContacts :: Maybe Natural
$sel:maxContacts:CreateQueue' :: CreateQueue -> Maybe Natural
maxContacts} -> Maybe Natural
maxContacts) (\s :: CreateQueue
s@CreateQueue' {} Maybe Natural
a -> CreateQueue
s {$sel:maxContacts:CreateQueue' :: Maybe Natural
maxContacts = Maybe Natural
a} :: CreateQueue)

-- | The outbound caller ID name, number, and outbound whisper flow.
createQueue_outboundCallerConfig :: Lens.Lens' CreateQueue (Prelude.Maybe OutboundCallerConfig)
createQueue_outboundCallerConfig :: Lens' CreateQueue (Maybe OutboundCallerConfig)
createQueue_outboundCallerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Maybe OutboundCallerConfig
outboundCallerConfig :: Maybe OutboundCallerConfig
$sel:outboundCallerConfig:CreateQueue' :: CreateQueue -> Maybe OutboundCallerConfig
outboundCallerConfig} -> Maybe OutboundCallerConfig
outboundCallerConfig) (\s :: CreateQueue
s@CreateQueue' {} Maybe OutboundCallerConfig
a -> CreateQueue
s {$sel:outboundCallerConfig:CreateQueue' :: Maybe OutboundCallerConfig
outboundCallerConfig = Maybe OutboundCallerConfig
a} :: CreateQueue)

-- | The quick connects available to agents who are working the queue.
createQueue_quickConnectIds :: Lens.Lens' CreateQueue (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createQueue_quickConnectIds :: Lens' CreateQueue (Maybe (NonEmpty Text))
createQueue_quickConnectIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Maybe (NonEmpty Text)
quickConnectIds :: Maybe (NonEmpty Text)
$sel:quickConnectIds:CreateQueue' :: CreateQueue -> Maybe (NonEmpty Text)
quickConnectIds} -> Maybe (NonEmpty Text)
quickConnectIds) (\s :: CreateQueue
s@CreateQueue' {} Maybe (NonEmpty Text)
a -> CreateQueue
s {$sel:quickConnectIds:CreateQueue' :: Maybe (NonEmpty Text)
quickConnectIds = Maybe (NonEmpty Text)
a} :: CreateQueue) 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 tags used to organize, track, or control access for this resource.
-- For example, { \"tags\": {\"key1\":\"value1\", \"key2\":\"value2\"} }.
createQueue_tags :: Lens.Lens' CreateQueue (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createQueue_tags :: Lens' CreateQueue (Maybe (HashMap Text Text))
createQueue_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateQueue' :: CreateQueue -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateQueue
s@CreateQueue' {} Maybe (HashMap Text Text)
a -> CreateQueue
s {$sel:tags:CreateQueue' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateQueue) 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 identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
createQueue_instanceId :: Lens.Lens' CreateQueue Prelude.Text
createQueue_instanceId :: Lens' CreateQueue Text
createQueue_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Text
instanceId :: Text
$sel:instanceId:CreateQueue' :: CreateQueue -> Text
instanceId} -> Text
instanceId) (\s :: CreateQueue
s@CreateQueue' {} Text
a -> CreateQueue
s {$sel:instanceId:CreateQueue' :: Text
instanceId = Text
a} :: CreateQueue)

-- | The name of the queue.
createQueue_name :: Lens.Lens' CreateQueue Prelude.Text
createQueue_name :: Lens' CreateQueue Text
createQueue_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Text
name :: Text
$sel:name:CreateQueue' :: CreateQueue -> Text
name} -> Text
name) (\s :: CreateQueue
s@CreateQueue' {} Text
a -> CreateQueue
s {$sel:name:CreateQueue' :: Text
name = Text
a} :: CreateQueue)

-- | The identifier for the hours of operation.
createQueue_hoursOfOperationId :: Lens.Lens' CreateQueue Prelude.Text
createQueue_hoursOfOperationId :: Lens' CreateQueue Text
createQueue_hoursOfOperationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueue' {Text
hoursOfOperationId :: Text
$sel:hoursOfOperationId:CreateQueue' :: CreateQueue -> Text
hoursOfOperationId} -> Text
hoursOfOperationId) (\s :: CreateQueue
s@CreateQueue' {} Text
a -> CreateQueue
s {$sel:hoursOfOperationId:CreateQueue' :: Text
hoursOfOperationId = Text
a} :: CreateQueue)

instance Core.AWSRequest CreateQueue where
  type AWSResponse CreateQueue = CreateQueueResponse
  request :: (Service -> Service) -> CreateQueue -> Request CreateQueue
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 CreateQueue
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateQueue)))
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 Text -> Maybe Text -> Int -> CreateQueueResponse
CreateQueueResponse'
            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
"QueueArn")
            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
"QueueId")
            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))
      )

instance Prelude.Hashable CreateQueue where
  hashWithSalt :: Int -> CreateQueue -> Int
hashWithSalt Int
_salt CreateQueue' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe OutboundCallerConfig
Text
hoursOfOperationId :: Text
name :: Text
instanceId :: Text
tags :: Maybe (HashMap Text Text)
quickConnectIds :: Maybe (NonEmpty Text)
outboundCallerConfig :: Maybe OutboundCallerConfig
maxContacts :: Maybe Natural
description :: Maybe Text
$sel:hoursOfOperationId:CreateQueue' :: CreateQueue -> Text
$sel:name:CreateQueue' :: CreateQueue -> Text
$sel:instanceId:CreateQueue' :: CreateQueue -> Text
$sel:tags:CreateQueue' :: CreateQueue -> Maybe (HashMap Text Text)
$sel:quickConnectIds:CreateQueue' :: CreateQueue -> Maybe (NonEmpty Text)
$sel:outboundCallerConfig:CreateQueue' :: CreateQueue -> Maybe OutboundCallerConfig
$sel:maxContacts:CreateQueue' :: CreateQueue -> Maybe Natural
$sel:description:CreateQueue' :: CreateQueue -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxContacts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutboundCallerConfig
outboundCallerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
quickConnectIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hoursOfOperationId

instance Prelude.NFData CreateQueue where
  rnf :: CreateQueue -> ()
rnf CreateQueue' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe OutboundCallerConfig
Text
hoursOfOperationId :: Text
name :: Text
instanceId :: Text
tags :: Maybe (HashMap Text Text)
quickConnectIds :: Maybe (NonEmpty Text)
outboundCallerConfig :: Maybe OutboundCallerConfig
maxContacts :: Maybe Natural
description :: Maybe Text
$sel:hoursOfOperationId:CreateQueue' :: CreateQueue -> Text
$sel:name:CreateQueue' :: CreateQueue -> Text
$sel:instanceId:CreateQueue' :: CreateQueue -> Text
$sel:tags:CreateQueue' :: CreateQueue -> Maybe (HashMap Text Text)
$sel:quickConnectIds:CreateQueue' :: CreateQueue -> Maybe (NonEmpty Text)
$sel:outboundCallerConfig:CreateQueue' :: CreateQueue -> Maybe OutboundCallerConfig
$sel:maxContacts:CreateQueue' :: CreateQueue -> Maybe Natural
$sel:description:CreateQueue' :: CreateQueue -> Maybe Text
..} =
    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 Natural
maxContacts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutboundCallerConfig
outboundCallerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
quickConnectIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hoursOfOperationId

instance Data.ToHeaders CreateQueue where
  toHeaders :: CreateQueue -> 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 CreateQueue where
  toJSON :: CreateQueue -> Value
toJSON CreateQueue' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe OutboundCallerConfig
Text
hoursOfOperationId :: Text
name :: Text
instanceId :: Text
tags :: Maybe (HashMap Text Text)
quickConnectIds :: Maybe (NonEmpty Text)
outboundCallerConfig :: Maybe OutboundCallerConfig
maxContacts :: Maybe Natural
description :: Maybe Text
$sel:hoursOfOperationId:CreateQueue' :: CreateQueue -> Text
$sel:name:CreateQueue' :: CreateQueue -> Text
$sel:instanceId:CreateQueue' :: CreateQueue -> Text
$sel:tags:CreateQueue' :: CreateQueue -> Maybe (HashMap Text Text)
$sel:quickConnectIds:CreateQueue' :: CreateQueue -> Maybe (NonEmpty Text)
$sel:outboundCallerConfig:CreateQueue' :: CreateQueue -> Maybe OutboundCallerConfig
$sel:maxContacts:CreateQueue' :: CreateQueue -> Maybe Natural
$sel:description:CreateQueue' :: CreateQueue -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"MaxContacts" 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
maxContacts,
            (Key
"OutboundCallerConfig" 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 OutboundCallerConfig
outboundCallerConfig,
            (Key
"QuickConnectIds" 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 (NonEmpty Text)
quickConnectIds,
            (Key
"Tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HoursOfOperationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hoursOfOperationId)
          ]
      )

instance Data.ToPath CreateQueue where
  toPath :: CreateQueue -> ByteString
toPath CreateQueue' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe OutboundCallerConfig
Text
hoursOfOperationId :: Text
name :: Text
instanceId :: Text
tags :: Maybe (HashMap Text Text)
quickConnectIds :: Maybe (NonEmpty Text)
outboundCallerConfig :: Maybe OutboundCallerConfig
maxContacts :: Maybe Natural
description :: Maybe Text
$sel:hoursOfOperationId:CreateQueue' :: CreateQueue -> Text
$sel:name:CreateQueue' :: CreateQueue -> Text
$sel:instanceId:CreateQueue' :: CreateQueue -> Text
$sel:tags:CreateQueue' :: CreateQueue -> Maybe (HashMap Text Text)
$sel:quickConnectIds:CreateQueue' :: CreateQueue -> Maybe (NonEmpty Text)
$sel:outboundCallerConfig:CreateQueue' :: CreateQueue -> Maybe OutboundCallerConfig
$sel:maxContacts:CreateQueue' :: CreateQueue -> Maybe Natural
$sel:description:CreateQueue' :: CreateQueue -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/queues/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId]

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

-- | /See:/ 'newCreateQueueResponse' smart constructor.
data CreateQueueResponse = CreateQueueResponse'
  { -- | The Amazon Resource Name (ARN) of the queue.
    CreateQueueResponse -> Maybe Text
queueArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the queue.
    CreateQueueResponse -> Maybe Text
queueId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateQueueResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateQueueResponse -> CreateQueueResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateQueueResponse -> CreateQueueResponse -> Bool
$c/= :: CreateQueueResponse -> CreateQueueResponse -> Bool
== :: CreateQueueResponse -> CreateQueueResponse -> Bool
$c== :: CreateQueueResponse -> CreateQueueResponse -> Bool
Prelude.Eq, ReadPrec [CreateQueueResponse]
ReadPrec CreateQueueResponse
Int -> ReadS CreateQueueResponse
ReadS [CreateQueueResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateQueueResponse]
$creadListPrec :: ReadPrec [CreateQueueResponse]
readPrec :: ReadPrec CreateQueueResponse
$creadPrec :: ReadPrec CreateQueueResponse
readList :: ReadS [CreateQueueResponse]
$creadList :: ReadS [CreateQueueResponse]
readsPrec :: Int -> ReadS CreateQueueResponse
$creadsPrec :: Int -> ReadS CreateQueueResponse
Prelude.Read, Int -> CreateQueueResponse -> ShowS
[CreateQueueResponse] -> ShowS
CreateQueueResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateQueueResponse] -> ShowS
$cshowList :: [CreateQueueResponse] -> ShowS
show :: CreateQueueResponse -> String
$cshow :: CreateQueueResponse -> String
showsPrec :: Int -> CreateQueueResponse -> ShowS
$cshowsPrec :: Int -> CreateQueueResponse -> ShowS
Prelude.Show, forall x. Rep CreateQueueResponse x -> CreateQueueResponse
forall x. CreateQueueResponse -> Rep CreateQueueResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateQueueResponse x -> CreateQueueResponse
$cfrom :: forall x. CreateQueueResponse -> Rep CreateQueueResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateQueueResponse' 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:
--
-- 'queueArn', 'createQueueResponse_queueArn' - The Amazon Resource Name (ARN) of the queue.
--
-- 'queueId', 'createQueueResponse_queueId' - The identifier for the queue.
--
-- 'httpStatus', 'createQueueResponse_httpStatus' - The response's http status code.
newCreateQueueResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateQueueResponse
newCreateQueueResponse :: Int -> CreateQueueResponse
newCreateQueueResponse Int
pHttpStatus_ =
  CreateQueueResponse'
    { $sel:queueArn:CreateQueueResponse' :: Maybe Text
queueArn = forall a. Maybe a
Prelude.Nothing,
      $sel:queueId:CreateQueueResponse' :: Maybe Text
queueId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateQueueResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the queue.
createQueueResponse_queueArn :: Lens.Lens' CreateQueueResponse (Prelude.Maybe Prelude.Text)
createQueueResponse_queueArn :: Lens' CreateQueueResponse (Maybe Text)
createQueueResponse_queueArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueueResponse' {Maybe Text
queueArn :: Maybe Text
$sel:queueArn:CreateQueueResponse' :: CreateQueueResponse -> Maybe Text
queueArn} -> Maybe Text
queueArn) (\s :: CreateQueueResponse
s@CreateQueueResponse' {} Maybe Text
a -> CreateQueueResponse
s {$sel:queueArn:CreateQueueResponse' :: Maybe Text
queueArn = Maybe Text
a} :: CreateQueueResponse)

-- | The identifier for the queue.
createQueueResponse_queueId :: Lens.Lens' CreateQueueResponse (Prelude.Maybe Prelude.Text)
createQueueResponse_queueId :: Lens' CreateQueueResponse (Maybe Text)
createQueueResponse_queueId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQueueResponse' {Maybe Text
queueId :: Maybe Text
$sel:queueId:CreateQueueResponse' :: CreateQueueResponse -> Maybe Text
queueId} -> Maybe Text
queueId) (\s :: CreateQueueResponse
s@CreateQueueResponse' {} Maybe Text
a -> CreateQueueResponse
s {$sel:queueId:CreateQueueResponse' :: Maybe Text
queueId = Maybe Text
a} :: CreateQueueResponse)

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

instance Prelude.NFData CreateQueueResponse where
  rnf :: CreateQueueResponse -> ()
rnf CreateQueueResponse' {Int
Maybe Text
httpStatus :: Int
queueId :: Maybe Text
queueArn :: Maybe Text
$sel:httpStatus:CreateQueueResponse' :: CreateQueueResponse -> Int
$sel:queueId:CreateQueueResponse' :: CreateQueueResponse -> Maybe Text
$sel:queueArn:CreateQueueResponse' :: CreateQueueResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queueArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queueId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus