{-# 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.Route53.ListTagsForResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists tags for one health check or hosted zone.
--
-- For information about using tags for cost allocation, see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/cost-alloc-tags.html Using Cost Allocation Tags>
-- in the /Billing and Cost Management User Guide/.
module Amazonka.Route53.ListTagsForResource
  ( -- * Creating a Request
    ListTagsForResource (..),
    newListTagsForResource,

    -- * Request Lenses
    listTagsForResource_resourceType,
    listTagsForResource_resourceId,

    -- * Destructuring the Response
    ListTagsForResourceResponse (..),
    newListTagsForResourceResponse,

    -- * Response Lenses
    listTagsForResourceResponse_httpStatus,
    listTagsForResourceResponse_resourceTagSet,
  )
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.Route53.Types

-- | A complex type containing information about a request for a list of the
-- tags that are associated with an individual resource.
--
-- /See:/ 'newListTagsForResource' smart constructor.
data ListTagsForResource = ListTagsForResource'
  { -- | The type of the resource.
    --
    -- -   The resource type for health checks is @healthcheck@.
    --
    -- -   The resource type for hosted zones is @hostedzone@.
    ListTagsForResource -> TagResourceType
resourceType :: TagResourceType,
    -- | The ID of the resource for which you want to retrieve tags.
    ListTagsForResource -> Text
resourceId :: Prelude.Text
  }
  deriving (ListTagsForResource -> ListTagsForResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTagsForResource -> ListTagsForResource -> Bool
$c/= :: ListTagsForResource -> ListTagsForResource -> Bool
== :: ListTagsForResource -> ListTagsForResource -> Bool
$c== :: ListTagsForResource -> ListTagsForResource -> Bool
Prelude.Eq, ReadPrec [ListTagsForResource]
ReadPrec ListTagsForResource
Int -> ReadS ListTagsForResource
ReadS [ListTagsForResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTagsForResource]
$creadListPrec :: ReadPrec [ListTagsForResource]
readPrec :: ReadPrec ListTagsForResource
$creadPrec :: ReadPrec ListTagsForResource
readList :: ReadS [ListTagsForResource]
$creadList :: ReadS [ListTagsForResource]
readsPrec :: Int -> ReadS ListTagsForResource
$creadsPrec :: Int -> ReadS ListTagsForResource
Prelude.Read, Int -> ListTagsForResource -> ShowS
[ListTagsForResource] -> ShowS
ListTagsForResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTagsForResource] -> ShowS
$cshowList :: [ListTagsForResource] -> ShowS
show :: ListTagsForResource -> String
$cshow :: ListTagsForResource -> String
showsPrec :: Int -> ListTagsForResource -> ShowS
$cshowsPrec :: Int -> ListTagsForResource -> ShowS
Prelude.Show, forall x. Rep ListTagsForResource x -> ListTagsForResource
forall x. ListTagsForResource -> Rep ListTagsForResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTagsForResource x -> ListTagsForResource
$cfrom :: forall x. ListTagsForResource -> Rep ListTagsForResource x
Prelude.Generic)

-- |
-- Create a value of 'ListTagsForResource' 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:
--
-- 'resourceType', 'listTagsForResource_resourceType' - The type of the resource.
--
-- -   The resource type for health checks is @healthcheck@.
--
-- -   The resource type for hosted zones is @hostedzone@.
--
-- 'resourceId', 'listTagsForResource_resourceId' - The ID of the resource for which you want to retrieve tags.
newListTagsForResource ::
  -- | 'resourceType'
  TagResourceType ->
  -- | 'resourceId'
  Prelude.Text ->
  ListTagsForResource
newListTagsForResource :: TagResourceType -> Text -> ListTagsForResource
newListTagsForResource TagResourceType
pResourceType_ Text
pResourceId_ =
  ListTagsForResource'
    { $sel:resourceType:ListTagsForResource' :: TagResourceType
resourceType = TagResourceType
pResourceType_,
      $sel:resourceId:ListTagsForResource' :: Text
resourceId = Text
pResourceId_
    }

-- | The type of the resource.
--
-- -   The resource type for health checks is @healthcheck@.
--
-- -   The resource type for hosted zones is @hostedzone@.
listTagsForResource_resourceType :: Lens.Lens' ListTagsForResource TagResourceType
listTagsForResource_resourceType :: Lens' ListTagsForResource TagResourceType
listTagsForResource_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForResource' {TagResourceType
resourceType :: TagResourceType
$sel:resourceType:ListTagsForResource' :: ListTagsForResource -> TagResourceType
resourceType} -> TagResourceType
resourceType) (\s :: ListTagsForResource
s@ListTagsForResource' {} TagResourceType
a -> ListTagsForResource
s {$sel:resourceType:ListTagsForResource' :: TagResourceType
resourceType = TagResourceType
a} :: ListTagsForResource)

-- | The ID of the resource for which you want to retrieve tags.
listTagsForResource_resourceId :: Lens.Lens' ListTagsForResource Prelude.Text
listTagsForResource_resourceId :: Lens' ListTagsForResource Text
listTagsForResource_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForResource' {Text
resourceId :: Text
$sel:resourceId:ListTagsForResource' :: ListTagsForResource -> Text
resourceId} -> Text
resourceId) (\s :: ListTagsForResource
s@ListTagsForResource' {} Text
a -> ListTagsForResource
s {$sel:resourceId:ListTagsForResource' :: Text
resourceId = Text
a} :: ListTagsForResource)

instance Core.AWSRequest ListTagsForResource where
  type
    AWSResponse ListTagsForResource =
      ListTagsForResourceResponse
  request :: (Service -> Service)
-> ListTagsForResource -> Request ListTagsForResource
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListTagsForResource
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTagsForResource)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> ResourceTagSet -> ListTagsForResourceResponse
ListTagsForResourceResponse'
            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
"ResourceTagSet")
      )

instance Prelude.Hashable ListTagsForResource where
  hashWithSalt :: Int -> ListTagsForResource -> Int
hashWithSalt Int
_salt ListTagsForResource' {Text
TagResourceType
resourceId :: Text
resourceType :: TagResourceType
$sel:resourceId:ListTagsForResource' :: ListTagsForResource -> Text
$sel:resourceType:ListTagsForResource' :: ListTagsForResource -> TagResourceType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TagResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance Prelude.NFData ListTagsForResource where
  rnf :: ListTagsForResource -> ()
rnf ListTagsForResource' {Text
TagResourceType
resourceId :: Text
resourceType :: TagResourceType
$sel:resourceId:ListTagsForResource' :: ListTagsForResource -> Text
$sel:resourceType:ListTagsForResource' :: ListTagsForResource -> TagResourceType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf TagResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

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

instance Data.ToPath ListTagsForResource where
  toPath :: ListTagsForResource -> ByteString
toPath ListTagsForResource' {Text
TagResourceType
resourceId :: Text
resourceType :: TagResourceType
$sel:resourceId:ListTagsForResource' :: ListTagsForResource -> Text
$sel:resourceType:ListTagsForResource' :: ListTagsForResource -> TagResourceType
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2013-04-01/tags/",
        forall a. ToByteString a => a -> ByteString
Data.toBS TagResourceType
resourceType,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
resourceId
      ]

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

-- | A complex type that contains information about the health checks or
-- hosted zones for which you want to list tags.
--
-- /See:/ 'newListTagsForResourceResponse' smart constructor.
data ListTagsForResourceResponse = ListTagsForResourceResponse'
  { -- | The response's http status code.
    ListTagsForResourceResponse -> Int
httpStatus :: Prelude.Int,
    -- | A @ResourceTagSet@ containing tags associated with the specified
    -- resource.
    ListTagsForResourceResponse -> ResourceTagSet
resourceTagSet :: ResourceTagSet
  }
  deriving (ListTagsForResourceResponse -> ListTagsForResourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTagsForResourceResponse -> ListTagsForResourceResponse -> Bool
$c/= :: ListTagsForResourceResponse -> ListTagsForResourceResponse -> Bool
== :: ListTagsForResourceResponse -> ListTagsForResourceResponse -> Bool
$c== :: ListTagsForResourceResponse -> ListTagsForResourceResponse -> Bool
Prelude.Eq, ReadPrec [ListTagsForResourceResponse]
ReadPrec ListTagsForResourceResponse
Int -> ReadS ListTagsForResourceResponse
ReadS [ListTagsForResourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTagsForResourceResponse]
$creadListPrec :: ReadPrec [ListTagsForResourceResponse]
readPrec :: ReadPrec ListTagsForResourceResponse
$creadPrec :: ReadPrec ListTagsForResourceResponse
readList :: ReadS [ListTagsForResourceResponse]
$creadList :: ReadS [ListTagsForResourceResponse]
readsPrec :: Int -> ReadS ListTagsForResourceResponse
$creadsPrec :: Int -> ReadS ListTagsForResourceResponse
Prelude.Read, Int -> ListTagsForResourceResponse -> ShowS
[ListTagsForResourceResponse] -> ShowS
ListTagsForResourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTagsForResourceResponse] -> ShowS
$cshowList :: [ListTagsForResourceResponse] -> ShowS
show :: ListTagsForResourceResponse -> String
$cshow :: ListTagsForResourceResponse -> String
showsPrec :: Int -> ListTagsForResourceResponse -> ShowS
$cshowsPrec :: Int -> ListTagsForResourceResponse -> ShowS
Prelude.Show, forall x.
Rep ListTagsForResourceResponse x -> ListTagsForResourceResponse
forall x.
ListTagsForResourceResponse -> Rep ListTagsForResourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTagsForResourceResponse x -> ListTagsForResourceResponse
$cfrom :: forall x.
ListTagsForResourceResponse -> Rep ListTagsForResourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTagsForResourceResponse' 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', 'listTagsForResourceResponse_httpStatus' - The response's http status code.
--
-- 'resourceTagSet', 'listTagsForResourceResponse_resourceTagSet' - A @ResourceTagSet@ containing tags associated with the specified
-- resource.
newListTagsForResourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'resourceTagSet'
  ResourceTagSet ->
  ListTagsForResourceResponse
newListTagsForResourceResponse :: Int -> ResourceTagSet -> ListTagsForResourceResponse
newListTagsForResourceResponse
  Int
pHttpStatus_
  ResourceTagSet
pResourceTagSet_ =
    ListTagsForResourceResponse'
      { $sel:httpStatus:ListTagsForResourceResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:resourceTagSet:ListTagsForResourceResponse' :: ResourceTagSet
resourceTagSet = ResourceTagSet
pResourceTagSet_
      }

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

-- | A @ResourceTagSet@ containing tags associated with the specified
-- resource.
listTagsForResourceResponse_resourceTagSet :: Lens.Lens' ListTagsForResourceResponse ResourceTagSet
listTagsForResourceResponse_resourceTagSet :: Lens' ListTagsForResourceResponse ResourceTagSet
listTagsForResourceResponse_resourceTagSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForResourceResponse' {ResourceTagSet
resourceTagSet :: ResourceTagSet
$sel:resourceTagSet:ListTagsForResourceResponse' :: ListTagsForResourceResponse -> ResourceTagSet
resourceTagSet} -> ResourceTagSet
resourceTagSet) (\s :: ListTagsForResourceResponse
s@ListTagsForResourceResponse' {} ResourceTagSet
a -> ListTagsForResourceResponse
s {$sel:resourceTagSet:ListTagsForResourceResponse' :: ResourceTagSet
resourceTagSet = ResourceTagSet
a} :: ListTagsForResourceResponse)

instance Prelude.NFData ListTagsForResourceResponse where
  rnf :: ListTagsForResourceResponse -> ()
rnf ListTagsForResourceResponse' {Int
ResourceTagSet
resourceTagSet :: ResourceTagSet
httpStatus :: Int
$sel:resourceTagSet:ListTagsForResourceResponse' :: ListTagsForResourceResponse -> ResourceTagSet
$sel:httpStatus:ListTagsForResourceResponse' :: ListTagsForResourceResponse -> 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 ResourceTagSet
resourceTagSet