{-# 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.SQS.GetQueueUrl
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the URL of an existing Amazon SQS queue.
--
-- To access a queue that belongs to another AWS account, use the
-- @QueueOwnerAWSAccountId@ parameter to specify the account ID of the
-- queue\'s owner. The queue\'s owner must grant you permission to access
-- the queue. For more information about shared queue access, see
-- @ @@AddPermission@@ @ or see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-writing-an-sqs-policy.html#write-messages-to-shared-queue Allow Developers to Write Messages to a Shared Queue>
-- in the /Amazon SQS Developer Guide/.
module Amazonka.SQS.GetQueueUrl
  ( -- * Creating a Request
    GetQueueUrl (..),
    newGetQueueUrl,

    -- * Request Lenses
    getQueueUrl_queueOwnerAWSAccountId,
    getQueueUrl_queueName,

    -- * Destructuring the Response
    GetQueueUrlResponse (..),
    newGetQueueUrlResponse,

    -- * Response Lenses
    getQueueUrlResponse_httpStatus,
    getQueueUrlResponse_queueUrl,
  )
where

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
import Amazonka.SQS.Types

-- |
--
-- /See:/ 'newGetQueueUrl' smart constructor.
data GetQueueUrl = GetQueueUrl'
  { -- | The Amazon Web Services account ID of the account that created the
    -- queue.
    GetQueueUrl -> Maybe Text
queueOwnerAWSAccountId :: Prelude.Maybe Prelude.Text,
    -- | The name of the queue whose URL must be fetched. Maximum 80 characters.
    -- Valid values: alphanumeric characters, hyphens (@-@), and underscores
    -- (@_@).
    --
    -- Queue URLs and names are case-sensitive.
    GetQueueUrl -> Text
queueName :: Prelude.Text
  }
  deriving (GetQueueUrl -> GetQueueUrl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQueueUrl -> GetQueueUrl -> Bool
$c/= :: GetQueueUrl -> GetQueueUrl -> Bool
== :: GetQueueUrl -> GetQueueUrl -> Bool
$c== :: GetQueueUrl -> GetQueueUrl -> Bool
Prelude.Eq, ReadPrec [GetQueueUrl]
ReadPrec GetQueueUrl
Int -> ReadS GetQueueUrl
ReadS [GetQueueUrl]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQueueUrl]
$creadListPrec :: ReadPrec [GetQueueUrl]
readPrec :: ReadPrec GetQueueUrl
$creadPrec :: ReadPrec GetQueueUrl
readList :: ReadS [GetQueueUrl]
$creadList :: ReadS [GetQueueUrl]
readsPrec :: Int -> ReadS GetQueueUrl
$creadsPrec :: Int -> ReadS GetQueueUrl
Prelude.Read, Int -> GetQueueUrl -> ShowS
[GetQueueUrl] -> ShowS
GetQueueUrl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQueueUrl] -> ShowS
$cshowList :: [GetQueueUrl] -> ShowS
show :: GetQueueUrl -> String
$cshow :: GetQueueUrl -> String
showsPrec :: Int -> GetQueueUrl -> ShowS
$cshowsPrec :: Int -> GetQueueUrl -> ShowS
Prelude.Show, forall x. Rep GetQueueUrl x -> GetQueueUrl
forall x. GetQueueUrl -> Rep GetQueueUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetQueueUrl x -> GetQueueUrl
$cfrom :: forall x. GetQueueUrl -> Rep GetQueueUrl x
Prelude.Generic)

-- |
-- Create a value of 'GetQueueUrl' 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:
--
-- 'queueOwnerAWSAccountId', 'getQueueUrl_queueOwnerAWSAccountId' - The Amazon Web Services account ID of the account that created the
-- queue.
--
-- 'queueName', 'getQueueUrl_queueName' - The name of the queue whose URL must be fetched. Maximum 80 characters.
-- Valid values: alphanumeric characters, hyphens (@-@), and underscores
-- (@_@).
--
-- Queue URLs and names are case-sensitive.
newGetQueueUrl ::
  -- | 'queueName'
  Prelude.Text ->
  GetQueueUrl
newGetQueueUrl :: Text -> GetQueueUrl
newGetQueueUrl Text
pQueueName_ =
  GetQueueUrl'
    { $sel:queueOwnerAWSAccountId:GetQueueUrl' :: Maybe Text
queueOwnerAWSAccountId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:queueName:GetQueueUrl' :: Text
queueName = Text
pQueueName_
    }

-- | The Amazon Web Services account ID of the account that created the
-- queue.
getQueueUrl_queueOwnerAWSAccountId :: Lens.Lens' GetQueueUrl (Prelude.Maybe Prelude.Text)
getQueueUrl_queueOwnerAWSAccountId :: Lens' GetQueueUrl (Maybe Text)
getQueueUrl_queueOwnerAWSAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQueueUrl' {Maybe Text
queueOwnerAWSAccountId :: Maybe Text
$sel:queueOwnerAWSAccountId:GetQueueUrl' :: GetQueueUrl -> Maybe Text
queueOwnerAWSAccountId} -> Maybe Text
queueOwnerAWSAccountId) (\s :: GetQueueUrl
s@GetQueueUrl' {} Maybe Text
a -> GetQueueUrl
s {$sel:queueOwnerAWSAccountId:GetQueueUrl' :: Maybe Text
queueOwnerAWSAccountId = Maybe Text
a} :: GetQueueUrl)

-- | The name of the queue whose URL must be fetched. Maximum 80 characters.
-- Valid values: alphanumeric characters, hyphens (@-@), and underscores
-- (@_@).
--
-- Queue URLs and names are case-sensitive.
getQueueUrl_queueName :: Lens.Lens' GetQueueUrl Prelude.Text
getQueueUrl_queueName :: Lens' GetQueueUrl Text
getQueueUrl_queueName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQueueUrl' {Text
queueName :: Text
$sel:queueName:GetQueueUrl' :: GetQueueUrl -> Text
queueName} -> Text
queueName) (\s :: GetQueueUrl
s@GetQueueUrl' {} Text
a -> GetQueueUrl
s {$sel:queueName:GetQueueUrl' :: Text
queueName = Text
a} :: GetQueueUrl)

instance Core.AWSRequest GetQueueUrl where
  type AWSResponse GetQueueUrl = GetQueueUrlResponse
  request :: (Service -> Service) -> GetQueueUrl -> Request GetQueueUrl
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetQueueUrl
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetQueueUrl)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetQueueUrlResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> Text -> GetQueueUrlResponse
GetQueueUrlResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"QueueUrl")
      )

instance Prelude.Hashable GetQueueUrl where
  hashWithSalt :: Int -> GetQueueUrl -> Int
hashWithSalt Int
_salt GetQueueUrl' {Maybe Text
Text
queueName :: Text
queueOwnerAWSAccountId :: Maybe Text
$sel:queueName:GetQueueUrl' :: GetQueueUrl -> Text
$sel:queueOwnerAWSAccountId:GetQueueUrl' :: GetQueueUrl -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
queueOwnerAWSAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queueName

instance Prelude.NFData GetQueueUrl where
  rnf :: GetQueueUrl -> ()
rnf GetQueueUrl' {Maybe Text
Text
queueName :: Text
queueOwnerAWSAccountId :: Maybe Text
$sel:queueName:GetQueueUrl' :: GetQueueUrl -> Text
$sel:queueOwnerAWSAccountId:GetQueueUrl' :: GetQueueUrl -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queueOwnerAWSAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
queueName

instance Data.ToHeaders GetQueueUrl where
  toHeaders :: GetQueueUrl -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetQueueUrl where
  toQuery :: GetQueueUrl -> QueryString
toQuery GetQueueUrl' {Maybe Text
Text
queueName :: Text
queueOwnerAWSAccountId :: Maybe Text
$sel:queueName:GetQueueUrl' :: GetQueueUrl -> Text
$sel:queueOwnerAWSAccountId:GetQueueUrl' :: GetQueueUrl -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetQueueUrl" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-11-05" :: Prelude.ByteString),
        ByteString
"QueueOwnerAWSAccountId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
queueOwnerAWSAccountId,
        ByteString
"QueueName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
queueName
      ]

-- | For more information, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-api-responses.html Interpreting Responses>
-- in the /Amazon SQS Developer Guide/.
--
-- /See:/ 'newGetQueueUrlResponse' smart constructor.
data GetQueueUrlResponse = GetQueueUrlResponse'
  { -- | The response's http status code.
    GetQueueUrlResponse -> Int
httpStatus :: Prelude.Int,
    -- | The URL of the queue.
    GetQueueUrlResponse -> Text
queueUrl :: Prelude.Text
  }
  deriving (GetQueueUrlResponse -> GetQueueUrlResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQueueUrlResponse -> GetQueueUrlResponse -> Bool
$c/= :: GetQueueUrlResponse -> GetQueueUrlResponse -> Bool
== :: GetQueueUrlResponse -> GetQueueUrlResponse -> Bool
$c== :: GetQueueUrlResponse -> GetQueueUrlResponse -> Bool
Prelude.Eq, ReadPrec [GetQueueUrlResponse]
ReadPrec GetQueueUrlResponse
Int -> ReadS GetQueueUrlResponse
ReadS [GetQueueUrlResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQueueUrlResponse]
$creadListPrec :: ReadPrec [GetQueueUrlResponse]
readPrec :: ReadPrec GetQueueUrlResponse
$creadPrec :: ReadPrec GetQueueUrlResponse
readList :: ReadS [GetQueueUrlResponse]
$creadList :: ReadS [GetQueueUrlResponse]
readsPrec :: Int -> ReadS GetQueueUrlResponse
$creadsPrec :: Int -> ReadS GetQueueUrlResponse
Prelude.Read, Int -> GetQueueUrlResponse -> ShowS
[GetQueueUrlResponse] -> ShowS
GetQueueUrlResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQueueUrlResponse] -> ShowS
$cshowList :: [GetQueueUrlResponse] -> ShowS
show :: GetQueueUrlResponse -> String
$cshow :: GetQueueUrlResponse -> String
showsPrec :: Int -> GetQueueUrlResponse -> ShowS
$cshowsPrec :: Int -> GetQueueUrlResponse -> ShowS
Prelude.Show, forall x. Rep GetQueueUrlResponse x -> GetQueueUrlResponse
forall x. GetQueueUrlResponse -> Rep GetQueueUrlResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetQueueUrlResponse x -> GetQueueUrlResponse
$cfrom :: forall x. GetQueueUrlResponse -> Rep GetQueueUrlResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetQueueUrlResponse' 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', 'getQueueUrlResponse_httpStatus' - The response's http status code.
--
-- 'queueUrl', 'getQueueUrlResponse_queueUrl' - The URL of the queue.
newGetQueueUrlResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'queueUrl'
  Prelude.Text ->
  GetQueueUrlResponse
newGetQueueUrlResponse :: Int -> Text -> GetQueueUrlResponse
newGetQueueUrlResponse Int
pHttpStatus_ Text
pQueueUrl_ =
  GetQueueUrlResponse'
    { $sel:httpStatus:GetQueueUrlResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:queueUrl:GetQueueUrlResponse' :: Text
queueUrl = Text
pQueueUrl_
    }

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

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

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