{-# 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.CloudFront.TagResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Add tags to a CloudFront resource.
module Amazonka.CloudFront.TagResource
  ( -- * Creating a Request
    TagResource (..),
    newTagResource,

    -- * Request Lenses
    tagResource_resource,
    tagResource_tags,

    -- * Destructuring the Response
    TagResourceResponse (..),
    newTagResourceResponse,
  )
where

import Amazonka.CloudFront.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

-- | The request to add tags to a CloudFront resource.
--
-- /See:/ 'newTagResource' smart constructor.
data TagResource = TagResource'
  { -- | An ARN of a CloudFront resource.
    TagResource -> Text
resource :: Prelude.Text,
    -- | A complex type that contains zero or more @Tag@ elements.
    TagResource -> Tags
tags :: Tags
  }
  deriving (TagResource -> TagResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagResource -> TagResource -> Bool
$c/= :: TagResource -> TagResource -> Bool
== :: TagResource -> TagResource -> Bool
$c== :: TagResource -> TagResource -> Bool
Prelude.Eq, ReadPrec [TagResource]
ReadPrec TagResource
Int -> ReadS TagResource
ReadS [TagResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagResource]
$creadListPrec :: ReadPrec [TagResource]
readPrec :: ReadPrec TagResource
$creadPrec :: ReadPrec TagResource
readList :: ReadS [TagResource]
$creadList :: ReadS [TagResource]
readsPrec :: Int -> ReadS TagResource
$creadsPrec :: Int -> ReadS TagResource
Prelude.Read, Int -> TagResource -> ShowS
[TagResource] -> ShowS
TagResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagResource] -> ShowS
$cshowList :: [TagResource] -> ShowS
show :: TagResource -> String
$cshow :: TagResource -> String
showsPrec :: Int -> TagResource -> ShowS
$cshowsPrec :: Int -> TagResource -> ShowS
Prelude.Show, forall x. Rep TagResource x -> TagResource
forall x. TagResource -> Rep TagResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagResource x -> TagResource
$cfrom :: forall x. TagResource -> Rep TagResource x
Prelude.Generic)

-- |
-- Create a value of 'TagResource' 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:
--
-- 'resource', 'tagResource_resource' - An ARN of a CloudFront resource.
--
-- 'tags', 'tagResource_tags' - A complex type that contains zero or more @Tag@ elements.
newTagResource ::
  -- | 'resource'
  Prelude.Text ->
  -- | 'tags'
  Tags ->
  TagResource
newTagResource :: Text -> Tags -> TagResource
newTagResource Text
pResource_ Tags
pTags_ =
  TagResource' {$sel:resource:TagResource' :: Text
resource = Text
pResource_, $sel:tags:TagResource' :: Tags
tags = Tags
pTags_}

-- | An ARN of a CloudFront resource.
tagResource_resource :: Lens.Lens' TagResource Prelude.Text
tagResource_resource :: Lens' TagResource Text
tagResource_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResource' {Text
resource :: Text
$sel:resource:TagResource' :: TagResource -> Text
resource} -> Text
resource) (\s :: TagResource
s@TagResource' {} Text
a -> TagResource
s {$sel:resource:TagResource' :: Text
resource = Text
a} :: TagResource)

-- | A complex type that contains zero or more @Tag@ elements.
tagResource_tags :: Lens.Lens' TagResource Tags
tagResource_tags :: Lens' TagResource Tags
tagResource_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResource' {Tags
tags :: Tags
$sel:tags:TagResource' :: TagResource -> Tags
tags} -> Tags
tags) (\s :: TagResource
s@TagResource' {} Tags
a -> TagResource
s {$sel:tags:TagResource' :: Tags
tags = Tags
a} :: TagResource)

instance Core.AWSRequest TagResource where
  type AWSResponse TagResource = TagResourceResponse
  request :: (Service -> Service) -> TagResource -> Request TagResource
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.postXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy TagResource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TagResource)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull TagResourceResponse
TagResourceResponse'

instance Prelude.Hashable TagResource where
  hashWithSalt :: Int -> TagResource -> Int
hashWithSalt Int
_salt TagResource' {Text
Tags
tags :: Tags
resource :: Text
$sel:tags:TagResource' :: TagResource -> Tags
$sel:resource:TagResource' :: TagResource -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Tags
tags

instance Prelude.NFData TagResource where
  rnf :: TagResource -> ()
rnf TagResource' {Text
Tags
tags :: Tags
resource :: Text
$sel:tags:TagResource' :: TagResource -> Tags
$sel:resource:TagResource' :: TagResource -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resource seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Tags
tags

instance Data.ToElement TagResource where
  toElement :: TagResource -> Element
toElement TagResource' {Text
Tags
tags :: Tags
resource :: Text
$sel:tags:TagResource' :: TagResource -> Tags
$sel:resource:TagResource' :: TagResource -> Text
..} =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://cloudfront.amazonaws.com/doc/2020-05-31/}Tags"
      Tags
tags

instance Data.ToHeaders TagResource where
  toHeaders :: TagResource -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath TagResource where
  toPath :: TagResource -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2020-05-31/tagging"

instance Data.ToQuery TagResource where
  toQuery :: TagResource -> QueryString
toQuery TagResource' {Text
Tags
tags :: Tags
resource :: Text
$sel:tags:TagResource' :: TagResource -> Tags
$sel:resource:TagResource' :: TagResource -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"Resource" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
resource, QueryString
"Operation=Tag"]

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

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

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