{-# 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.RemoveTagsFromCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Remove one or more tags from an ACM certificate. A tag consists of a
-- key-value pair. If you do not specify the value portion of the tag when
-- calling this function, the tag will be removed regardless of value. If
-- you specify a value, the tag is removed only if it is associated with
-- the specified value.
--
-- To add tags to a certificate, use the AddTagsToCertificate action. To
-- view all of the tags that have been applied to a specific ACM
-- certificate, use the ListTagsForCertificate action.
module Amazonka.CertificateManager.RemoveTagsFromCertificate
  ( -- * Creating a Request
    RemoveTagsFromCertificate (..),
    newRemoveTagsFromCertificate,

    -- * Request Lenses
    removeTagsFromCertificate_certificateArn,
    removeTagsFromCertificate_tags,

    -- * Destructuring the Response
    RemoveTagsFromCertificateResponse (..),
    newRemoveTagsFromCertificateResponse,
  )
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:/ 'newRemoveTagsFromCertificate' smart constructor.
data RemoveTagsFromCertificate = RemoveTagsFromCertificate'
  { -- | String that contains the ARN of the ACM Certificate with one or more
    -- tags that you want to remove. 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)>.
    RemoveTagsFromCertificate -> Text
certificateArn :: Prelude.Text,
    -- | The key-value pair that defines the tag to remove.
    RemoveTagsFromCertificate -> NonEmpty Tag
tags :: Prelude.NonEmpty Tag
  }
  deriving (RemoveTagsFromCertificate -> RemoveTagsFromCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveTagsFromCertificate -> RemoveTagsFromCertificate -> Bool
$c/= :: RemoveTagsFromCertificate -> RemoveTagsFromCertificate -> Bool
== :: RemoveTagsFromCertificate -> RemoveTagsFromCertificate -> Bool
$c== :: RemoveTagsFromCertificate -> RemoveTagsFromCertificate -> Bool
Prelude.Eq, ReadPrec [RemoveTagsFromCertificate]
ReadPrec RemoveTagsFromCertificate
Int -> ReadS RemoveTagsFromCertificate
ReadS [RemoveTagsFromCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveTagsFromCertificate]
$creadListPrec :: ReadPrec [RemoveTagsFromCertificate]
readPrec :: ReadPrec RemoveTagsFromCertificate
$creadPrec :: ReadPrec RemoveTagsFromCertificate
readList :: ReadS [RemoveTagsFromCertificate]
$creadList :: ReadS [RemoveTagsFromCertificate]
readsPrec :: Int -> ReadS RemoveTagsFromCertificate
$creadsPrec :: Int -> ReadS RemoveTagsFromCertificate
Prelude.Read, Int -> RemoveTagsFromCertificate -> ShowS
[RemoveTagsFromCertificate] -> ShowS
RemoveTagsFromCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveTagsFromCertificate] -> ShowS
$cshowList :: [RemoveTagsFromCertificate] -> ShowS
show :: RemoveTagsFromCertificate -> String
$cshow :: RemoveTagsFromCertificate -> String
showsPrec :: Int -> RemoveTagsFromCertificate -> ShowS
$cshowsPrec :: Int -> RemoveTagsFromCertificate -> ShowS
Prelude.Show, forall x.
Rep RemoveTagsFromCertificate x -> RemoveTagsFromCertificate
forall x.
RemoveTagsFromCertificate -> Rep RemoveTagsFromCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RemoveTagsFromCertificate x -> RemoveTagsFromCertificate
$cfrom :: forall x.
RemoveTagsFromCertificate -> Rep RemoveTagsFromCertificate x
Prelude.Generic)

-- |
-- Create a value of 'RemoveTagsFromCertificate' 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', 'removeTagsFromCertificate_certificateArn' - String that contains the ARN of the ACM Certificate with one or more
-- tags that you want to remove. 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', 'removeTagsFromCertificate_tags' - The key-value pair that defines the tag to remove.
newRemoveTagsFromCertificate ::
  -- | 'certificateArn'
  Prelude.Text ->
  -- | 'tags'
  Prelude.NonEmpty Tag ->
  RemoveTagsFromCertificate
newRemoveTagsFromCertificate :: Text -> NonEmpty Tag -> RemoveTagsFromCertificate
newRemoveTagsFromCertificate Text
pCertificateArn_ NonEmpty Tag
pTags_ =
  RemoveTagsFromCertificate'
    { $sel:certificateArn:RemoveTagsFromCertificate' :: Text
certificateArn =
        Text
pCertificateArn_,
      $sel:tags:RemoveTagsFromCertificate' :: 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 with one or more
-- tags that you want to remove. 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)>.
removeTagsFromCertificate_certificateArn :: Lens.Lens' RemoveTagsFromCertificate Prelude.Text
removeTagsFromCertificate_certificateArn :: Lens' RemoveTagsFromCertificate Text
removeTagsFromCertificate_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveTagsFromCertificate' {Text
certificateArn :: Text
$sel:certificateArn:RemoveTagsFromCertificate' :: RemoveTagsFromCertificate -> Text
certificateArn} -> Text
certificateArn) (\s :: RemoveTagsFromCertificate
s@RemoveTagsFromCertificate' {} Text
a -> RemoveTagsFromCertificate
s {$sel:certificateArn:RemoveTagsFromCertificate' :: Text
certificateArn = Text
a} :: RemoveTagsFromCertificate)

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

instance Prelude.Hashable RemoveTagsFromCertificate where
  hashWithSalt :: Int -> RemoveTagsFromCertificate -> Int
hashWithSalt Int
_salt RemoveTagsFromCertificate' {NonEmpty Tag
Text
tags :: NonEmpty Tag
certificateArn :: Text
$sel:tags:RemoveTagsFromCertificate' :: RemoveTagsFromCertificate -> NonEmpty Tag
$sel:certificateArn:RemoveTagsFromCertificate' :: RemoveTagsFromCertificate -> 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 RemoveTagsFromCertificate where
  rnf :: RemoveTagsFromCertificate -> ()
rnf RemoveTagsFromCertificate' {NonEmpty Tag
Text
tags :: NonEmpty Tag
certificateArn :: Text
$sel:tags:RemoveTagsFromCertificate' :: RemoveTagsFromCertificate -> NonEmpty Tag
$sel:certificateArn:RemoveTagsFromCertificate' :: RemoveTagsFromCertificate -> 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 RemoveTagsFromCertificate where
  toHeaders :: RemoveTagsFromCertificate -> [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.RemoveTagsFromCertificate" ::
                          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 RemoveTagsFromCertificate where
  toJSON :: RemoveTagsFromCertificate -> Value
toJSON RemoveTagsFromCertificate' {NonEmpty Tag
Text
tags :: NonEmpty Tag
certificateArn :: Text
$sel:tags:RemoveTagsFromCertificate' :: RemoveTagsFromCertificate -> NonEmpty Tag
$sel:certificateArn:RemoveTagsFromCertificate' :: RemoveTagsFromCertificate -> 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 RemoveTagsFromCertificate where
  toPath :: RemoveTagsFromCertificate -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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