{-# 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.CertificateManager.AddTagsToCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds one or more tags to an ACM certificate. Tags are labels that you
-- can use to identify and organize your Amazon Web Services resources.
-- Each tag consists of a @key@ and an optional @value@. You specify the
-- certificate on input by its Amazon Resource Name (ARN). You specify the
-- tag by using a key-value pair.
--
-- You can apply a tag to just one certificate if you want to identify a
-- specific characteristic of that certificate, or you can apply the same
-- tag to multiple certificates if you want to filter for a common
-- relationship among those certificates. Similarly, you can apply the same
-- tag to multiple resources if you want to specify a relationship among
-- those resources. For example, you can add the same tag to an ACM
-- certificate and an Elastic Load Balancing load balancer to indicate that
-- they are both used by the same website. For more information, see
-- <https://docs.aws.amazon.com/acm/latest/userguide/tags.html Tagging ACM certificates>.
--
-- To remove one or more tags, use the RemoveTagsFromCertificate action. To
-- view all of the tags that have been applied to the certificate, use the
-- ListTagsForCertificate action.
module Amazonka.CertificateManager.AddTagsToCertificate
  ( -- * Creating a Request
    AddTagsToCertificate (..),
    newAddTagsToCertificate,

    -- * Request Lenses
    addTagsToCertificate_certificateArn,
    addTagsToCertificate_tags,

    -- * Destructuring the Response
    AddTagsToCertificateResponse (..),
    newAddTagsToCertificateResponse,
  )
where

import Amazonka.CertificateManager.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:/ 'newAddTagsToCertificate' smart constructor.
data AddTagsToCertificate = AddTagsToCertificate'
  { -- | String that contains the ARN of the ACM certificate to which the tag is
    -- to be applied. This must be of the form:
    --
    -- @arn:aws:acm:region:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
    --
    -- For more information about ARNs, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>.
    AddTagsToCertificate -> Text
certificateArn :: Prelude.Text,
    -- | The key-value pair that defines the tag. The tag value is optional.
    AddTagsToCertificate -> NonEmpty Tag
tags :: Prelude.NonEmpty Tag
  }
  deriving (AddTagsToCertificate -> AddTagsToCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddTagsToCertificate -> AddTagsToCertificate -> Bool
$c/= :: AddTagsToCertificate -> AddTagsToCertificate -> Bool
== :: AddTagsToCertificate -> AddTagsToCertificate -> Bool
$c== :: AddTagsToCertificate -> AddTagsToCertificate -> Bool
Prelude.Eq, ReadPrec [AddTagsToCertificate]
ReadPrec AddTagsToCertificate
Int -> ReadS AddTagsToCertificate
ReadS [AddTagsToCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddTagsToCertificate]
$creadListPrec :: ReadPrec [AddTagsToCertificate]
readPrec :: ReadPrec AddTagsToCertificate
$creadPrec :: ReadPrec AddTagsToCertificate
readList :: ReadS [AddTagsToCertificate]
$creadList :: ReadS [AddTagsToCertificate]
readsPrec :: Int -> ReadS AddTagsToCertificate
$creadsPrec :: Int -> ReadS AddTagsToCertificate
Prelude.Read, Int -> AddTagsToCertificate -> ShowS
[AddTagsToCertificate] -> ShowS
AddTagsToCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddTagsToCertificate] -> ShowS
$cshowList :: [AddTagsToCertificate] -> ShowS
show :: AddTagsToCertificate -> String
$cshow :: AddTagsToCertificate -> String
showsPrec :: Int -> AddTagsToCertificate -> ShowS
$cshowsPrec :: Int -> AddTagsToCertificate -> ShowS
Prelude.Show, forall x. Rep AddTagsToCertificate x -> AddTagsToCertificate
forall x. AddTagsToCertificate -> Rep AddTagsToCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddTagsToCertificate x -> AddTagsToCertificate
$cfrom :: forall x. AddTagsToCertificate -> Rep AddTagsToCertificate x
Prelude.Generic)

-- |
-- Create a value of 'AddTagsToCertificate' 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:
--
-- 'certificateArn', 'addTagsToCertificate_certificateArn' - String that contains the ARN of the ACM certificate to which the tag is
-- to be applied. This must be of the form:
--
-- @arn:aws:acm:region:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
--
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>.
--
-- 'tags', 'addTagsToCertificate_tags' - The key-value pair that defines the tag. The tag value is optional.
newAddTagsToCertificate ::
  -- | 'certificateArn'
  Prelude.Text ->
  -- | 'tags'
  Prelude.NonEmpty Tag ->
  AddTagsToCertificate
newAddTagsToCertificate :: Text -> NonEmpty Tag -> AddTagsToCertificate
newAddTagsToCertificate Text
pCertificateArn_ NonEmpty Tag
pTags_ =
  AddTagsToCertificate'
    { $sel:certificateArn:AddTagsToCertificate' :: Text
certificateArn =
        Text
pCertificateArn_,
      $sel:tags:AddTagsToCertificate' :: NonEmpty Tag
tags = 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 Tag
pTags_
    }

-- | String that contains the ARN of the ACM certificate to which the tag is
-- to be applied. This must be of the form:
--
-- @arn:aws:acm:region:123456789012:certificate\/12345678-1234-1234-1234-123456789012@
--
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>.
addTagsToCertificate_certificateArn :: Lens.Lens' AddTagsToCertificate Prelude.Text
addTagsToCertificate_certificateArn :: Lens' AddTagsToCertificate Text
addTagsToCertificate_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddTagsToCertificate' {Text
certificateArn :: Text
$sel:certificateArn:AddTagsToCertificate' :: AddTagsToCertificate -> Text
certificateArn} -> Text
certificateArn) (\s :: AddTagsToCertificate
s@AddTagsToCertificate' {} Text
a -> AddTagsToCertificate
s {$sel:certificateArn:AddTagsToCertificate' :: Text
certificateArn = Text
a} :: AddTagsToCertificate)

-- | The key-value pair that defines the tag. The tag value is optional.
addTagsToCertificate_tags :: Lens.Lens' AddTagsToCertificate (Prelude.NonEmpty Tag)
addTagsToCertificate_tags :: Lens' AddTagsToCertificate (NonEmpty Tag)
addTagsToCertificate_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddTagsToCertificate' {NonEmpty Tag
tags :: NonEmpty Tag
$sel:tags:AddTagsToCertificate' :: AddTagsToCertificate -> NonEmpty Tag
tags} -> NonEmpty Tag
tags) (\s :: AddTagsToCertificate
s@AddTagsToCertificate' {} NonEmpty Tag
a -> AddTagsToCertificate
s {$sel:tags:AddTagsToCertificate' :: NonEmpty Tag
tags = NonEmpty Tag
a} :: AddTagsToCertificate) 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 AddTagsToCertificate where
  type
    AWSResponse AddTagsToCertificate =
      AddTagsToCertificateResponse
  request :: (Service -> Service)
-> AddTagsToCertificate -> Request AddTagsToCertificate
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 AddTagsToCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddTagsToCertificate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull AddTagsToCertificateResponse
AddTagsToCertificateResponse'

instance Prelude.Hashable AddTagsToCertificate where
  hashWithSalt :: Int -> AddTagsToCertificate -> Int
hashWithSalt Int
_salt AddTagsToCertificate' {NonEmpty Tag
Text
tags :: NonEmpty Tag
certificateArn :: Text
$sel:tags:AddTagsToCertificate' :: AddTagsToCertificate -> NonEmpty Tag
$sel:certificateArn:AddTagsToCertificate' :: AddTagsToCertificate -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Tag
tags

instance Prelude.NFData AddTagsToCertificate where
  rnf :: AddTagsToCertificate -> ()
rnf AddTagsToCertificate' {NonEmpty Tag
Text
tags :: NonEmpty Tag
certificateArn :: Text
$sel:tags:AddTagsToCertificate' :: AddTagsToCertificate -> NonEmpty Tag
$sel:certificateArn:AddTagsToCertificate' :: AddTagsToCertificate -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
certificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Tag
tags

instance Data.ToHeaders AddTagsToCertificate where
  toHeaders :: AddTagsToCertificate -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"CertificateManager.AddTagsToCertificate" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AddTagsToCertificate where
  toJSON :: AddTagsToCertificate -> Value
toJSON AddTagsToCertificate' {NonEmpty Tag
Text
tags :: NonEmpty Tag
certificateArn :: Text
$sel:tags:AddTagsToCertificate' :: AddTagsToCertificate -> NonEmpty Tag
$sel:certificateArn:AddTagsToCertificate' :: AddTagsToCertificate -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"CertificateArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Tag
tags)
          ]
      )

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

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

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

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

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