{-# 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.IAM.TagServerCertificate
-- 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 IAM server certificate. If a tag with the
-- same key name already exists, then that tag is overwritten with the new
-- value.
--
-- For certificates in a Region supported by Certificate Manager (ACM), we
-- recommend that you don\'t use IAM server certificates. Instead, use ACM
-- to provision, manage, and deploy your server certificates. For more
-- information about IAM server certificates,
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_server-certs.html Working with server certificates>
-- in the /IAM User Guide/.
--
-- A tag consists of a key name and an associated value. By assigning tags
-- to your resources, you can do the following:
--
-- -   __Administrative grouping and discovery__ - Attach tags to resources
--     to aid in organization and search. For example, you could search for
--     all resources with the key name /Project/ and the value
--     /MyImportantProject/. Or search for all resources with the key name
--     /Cost Center/ and the value /41200/.
--
-- -   __Access control__ - Include tags in IAM user-based and
--     resource-based policies. You can use tags to restrict access to only
--     a server certificate that has a specified tag attached. For examples
--     of policies that show how to use tags to control access, see
--     <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_tags.html Control access using IAM tags>
--     in the /IAM User Guide/.
--
-- -   __Cost allocation__ - Use tags to help track which individuals and
--     teams are using which Amazon Web Services resources.
--
-- -   If any one of the tags is invalid or if you exceed the allowed
--     maximum number of tags, then the entire request fails and the
--     resource is not created. For more information about tagging, see
--     <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
--     in the /IAM User Guide/.
--
-- -   Amazon Web Services always interprets the tag @Value@ as a single
--     string. If you need to store an array, you can store comma-separated
--     values in the string. However, you must interpret the value in your
--     code.
module Amazonka.IAM.TagServerCertificate
  ( -- * Creating a Request
    TagServerCertificate (..),
    newTagServerCertificate,

    -- * Request Lenses
    tagServerCertificate_serverCertificateName,
    tagServerCertificate_tags,

    -- * Destructuring the Response
    TagServerCertificateResponse (..),
    newTagServerCertificateResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IAM.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newTagServerCertificate' smart constructor.
data TagServerCertificate = TagServerCertificate'
  { -- | The name of the IAM server certificate to which you want to add tags.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    TagServerCertificate -> Text
serverCertificateName :: Prelude.Text,
    -- | The list of tags that you want to attach to the IAM server certificate.
    -- Each tag consists of a key name and an associated value.
    TagServerCertificate -> [Tag]
tags :: [Tag]
  }
  deriving (TagServerCertificate -> TagServerCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagServerCertificate -> TagServerCertificate -> Bool
$c/= :: TagServerCertificate -> TagServerCertificate -> Bool
== :: TagServerCertificate -> TagServerCertificate -> Bool
$c== :: TagServerCertificate -> TagServerCertificate -> Bool
Prelude.Eq, ReadPrec [TagServerCertificate]
ReadPrec TagServerCertificate
Int -> ReadS TagServerCertificate
ReadS [TagServerCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagServerCertificate]
$creadListPrec :: ReadPrec [TagServerCertificate]
readPrec :: ReadPrec TagServerCertificate
$creadPrec :: ReadPrec TagServerCertificate
readList :: ReadS [TagServerCertificate]
$creadList :: ReadS [TagServerCertificate]
readsPrec :: Int -> ReadS TagServerCertificate
$creadsPrec :: Int -> ReadS TagServerCertificate
Prelude.Read, Int -> TagServerCertificate -> ShowS
[TagServerCertificate] -> ShowS
TagServerCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagServerCertificate] -> ShowS
$cshowList :: [TagServerCertificate] -> ShowS
show :: TagServerCertificate -> String
$cshow :: TagServerCertificate -> String
showsPrec :: Int -> TagServerCertificate -> ShowS
$cshowsPrec :: Int -> TagServerCertificate -> ShowS
Prelude.Show, forall x. Rep TagServerCertificate x -> TagServerCertificate
forall x. TagServerCertificate -> Rep TagServerCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagServerCertificate x -> TagServerCertificate
$cfrom :: forall x. TagServerCertificate -> Rep TagServerCertificate x
Prelude.Generic)

-- |
-- Create a value of 'TagServerCertificate' 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:
--
-- 'serverCertificateName', 'tagServerCertificate_serverCertificateName' - The name of the IAM server certificate to which you want to add tags.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
--
-- 'tags', 'tagServerCertificate_tags' - The list of tags that you want to attach to the IAM server certificate.
-- Each tag consists of a key name and an associated value.
newTagServerCertificate ::
  -- | 'serverCertificateName'
  Prelude.Text ->
  TagServerCertificate
newTagServerCertificate :: Text -> TagServerCertificate
newTagServerCertificate Text
pServerCertificateName_ =
  TagServerCertificate'
    { $sel:serverCertificateName:TagServerCertificate' :: Text
serverCertificateName =
        Text
pServerCertificateName_,
      $sel:tags:TagServerCertificate' :: [Tag]
tags = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of the IAM server certificate to which you want to add tags.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
tagServerCertificate_serverCertificateName :: Lens.Lens' TagServerCertificate Prelude.Text
tagServerCertificate_serverCertificateName :: Lens' TagServerCertificate Text
tagServerCertificate_serverCertificateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagServerCertificate' {Text
serverCertificateName :: Text
$sel:serverCertificateName:TagServerCertificate' :: TagServerCertificate -> Text
serverCertificateName} -> Text
serverCertificateName) (\s :: TagServerCertificate
s@TagServerCertificate' {} Text
a -> TagServerCertificate
s {$sel:serverCertificateName:TagServerCertificate' :: Text
serverCertificateName = Text
a} :: TagServerCertificate)

-- | The list of tags that you want to attach to the IAM server certificate.
-- Each tag consists of a key name and an associated value.
tagServerCertificate_tags :: Lens.Lens' TagServerCertificate [Tag]
tagServerCertificate_tags :: Lens' TagServerCertificate [Tag]
tagServerCertificate_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagServerCertificate' {[Tag]
tags :: [Tag]
$sel:tags:TagServerCertificate' :: TagServerCertificate -> [Tag]
tags} -> [Tag]
tags) (\s :: TagServerCertificate
s@TagServerCertificate' {} [Tag]
a -> TagServerCertificate
s {$sel:tags:TagServerCertificate' :: [Tag]
tags = [Tag]
a} :: TagServerCertificate) 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 TagServerCertificate where
  type
    AWSResponse TagServerCertificate =
      TagServerCertificateResponse
  request :: (Service -> Service)
-> TagServerCertificate -> Request TagServerCertificate
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 TagServerCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse TagServerCertificate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull TagServerCertificateResponse
TagServerCertificateResponse'

instance Prelude.Hashable TagServerCertificate where
  hashWithSalt :: Int -> TagServerCertificate -> Int
hashWithSalt Int
_salt TagServerCertificate' {[Tag]
Text
tags :: [Tag]
serverCertificateName :: Text
$sel:tags:TagServerCertificate' :: TagServerCertificate -> [Tag]
$sel:serverCertificateName:TagServerCertificate' :: TagServerCertificate -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverCertificateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Tag]
tags

instance Prelude.NFData TagServerCertificate where
  rnf :: TagServerCertificate -> ()
rnf TagServerCertificate' {[Tag]
Text
tags :: [Tag]
serverCertificateName :: Text
$sel:tags:TagServerCertificate' :: TagServerCertificate -> [Tag]
$sel:serverCertificateName:TagServerCertificate' :: TagServerCertificate -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
serverCertificateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Tag]
tags

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

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

instance Data.ToQuery TagServerCertificate where
  toQuery :: TagServerCertificate -> QueryString
toQuery TagServerCertificate' {[Tag]
Text
tags :: [Tag]
serverCertificateName :: Text
$sel:tags:TagServerCertificate' :: TagServerCertificate -> [Tag]
$sel:serverCertificateName:TagServerCertificate' :: TagServerCertificate -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"TagServerCertificate" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"ServerCertificateName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serverCertificateName,
        ByteString
"Tags" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Tag]
tags
      ]

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

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

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