{-# 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.ResourceGroupsTagging.TagResources
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Applies one or more tags to the specified resources. Note the following:
--
-- -   Not all resources can have tags. For a list of services with
--     resources that support tagging using this operation, see
--     <https://docs.aws.amazon.com/resourcegroupstagging/latest/APIReference/supported-services.html Services that support the Resource Groups Tagging API>.
--     If the resource doesn\'t yet support this operation, the resource\'s
--     service might support tagging using its own API operations. For more
--     information, refer to the documentation for that service.
--
-- -   Each resource can have up to 50 tags. For other limits, see
--     <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html#tag-conventions Tag Naming and Usage Conventions>
--     in the /Amazon Web Services General Reference./
--
-- -   You can only tag resources that are located in the specified Amazon
--     Web Services Region for the Amazon Web Services account.
--
-- -   To add tags to a resource, you need the necessary permissions for
--     the service that the resource belongs to as well as permissions for
--     adding tags. For more information, see the documentation for each
--     service.
--
-- Do not store personally identifiable information (PII) or other
-- confidential or sensitive information in tags. We use tags to provide
-- you with billing and administration services. Tags are not intended to
-- be used for private or sensitive data.
--
-- __Minimum permissions__
--
-- In addition to the @tag:TagResources@ permission required by this
-- operation, you must also have the tagging permission defined by the
-- service that created the resource. For example, to tag an Amazon EC2
-- instance using the @TagResources@ operation, you must have both of the
-- following permissions:
--
-- -   @tag:TagResource@
--
-- -   @ec2:CreateTags@
module Amazonka.ResourceGroupsTagging.TagResources
  ( -- * Creating a Request
    TagResources (..),
    newTagResources,

    -- * Request Lenses
    tagResources_resourceARNList,
    tagResources_tags,

    -- * Destructuring the Response
    TagResourcesResponse (..),
    newTagResourcesResponse,

    -- * Response Lenses
    tagResourcesResponse_failedResourcesMap,
    tagResourcesResponse_httpStatus,
  )
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 Amazonka.ResourceGroupsTagging.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newTagResources' smart constructor.
data TagResources = TagResources'
  { -- | Specifies the list of ARNs of the resources that you want to apply tags
    -- to.
    --
    -- An ARN (Amazon Resource Name) uniquely identifies a resource. For more
    -- information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>
    -- in the /Amazon Web Services General Reference/.
    TagResources -> NonEmpty Text
resourceARNList :: Prelude.NonEmpty Prelude.Text,
    -- | Specifies a list of tags that you want to add to the specified
    -- resources. A tag consists of a key and a value that you define.
    TagResources -> HashMap Text Text
tags :: Prelude.HashMap Prelude.Text Prelude.Text
  }
  deriving (TagResources -> TagResources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagResources -> TagResources -> Bool
$c/= :: TagResources -> TagResources -> Bool
== :: TagResources -> TagResources -> Bool
$c== :: TagResources -> TagResources -> Bool
Prelude.Eq, ReadPrec [TagResources]
ReadPrec TagResources
Int -> ReadS TagResources
ReadS [TagResources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagResources]
$creadListPrec :: ReadPrec [TagResources]
readPrec :: ReadPrec TagResources
$creadPrec :: ReadPrec TagResources
readList :: ReadS [TagResources]
$creadList :: ReadS [TagResources]
readsPrec :: Int -> ReadS TagResources
$creadsPrec :: Int -> ReadS TagResources
Prelude.Read, Int -> TagResources -> ShowS
[TagResources] -> ShowS
TagResources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagResources] -> ShowS
$cshowList :: [TagResources] -> ShowS
show :: TagResources -> String
$cshow :: TagResources -> String
showsPrec :: Int -> TagResources -> ShowS
$cshowsPrec :: Int -> TagResources -> ShowS
Prelude.Show, forall x. Rep TagResources x -> TagResources
forall x. TagResources -> Rep TagResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagResources x -> TagResources
$cfrom :: forall x. TagResources -> Rep TagResources x
Prelude.Generic)

-- |
-- Create a value of 'TagResources' 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:
--
-- 'resourceARNList', 'tagResources_resourceARNList' - Specifies the list of ARNs of the resources that you want to apply tags
-- to.
--
-- An ARN (Amazon Resource Name) uniquely identifies a resource. For more
-- information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>
-- in the /Amazon Web Services General Reference/.
--
-- 'tags', 'tagResources_tags' - Specifies a list of tags that you want to add to the specified
-- resources. A tag consists of a key and a value that you define.
newTagResources ::
  -- | 'resourceARNList'
  Prelude.NonEmpty Prelude.Text ->
  TagResources
newTagResources :: NonEmpty Text -> TagResources
newTagResources NonEmpty Text
pResourceARNList_ =
  TagResources'
    { $sel:resourceARNList:TagResources' :: NonEmpty Text
resourceARNList =
        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 Text
pResourceARNList_,
      $sel:tags:TagResources' :: HashMap Text Text
tags = forall a. Monoid a => a
Prelude.mempty
    }

-- | Specifies the list of ARNs of the resources that you want to apply tags
-- to.
--
-- An ARN (Amazon Resource Name) uniquely identifies a resource. For more
-- information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>
-- in the /Amazon Web Services General Reference/.
tagResources_resourceARNList :: Lens.Lens' TagResources (Prelude.NonEmpty Prelude.Text)
tagResources_resourceARNList :: Lens' TagResources (NonEmpty Text)
tagResources_resourceARNList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResources' {NonEmpty Text
resourceARNList :: NonEmpty Text
$sel:resourceARNList:TagResources' :: TagResources -> NonEmpty Text
resourceARNList} -> NonEmpty Text
resourceARNList) (\s :: TagResources
s@TagResources' {} NonEmpty Text
a -> TagResources
s {$sel:resourceARNList:TagResources' :: NonEmpty Text
resourceARNList = NonEmpty Text
a} :: TagResources) 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

-- | Specifies a list of tags that you want to add to the specified
-- resources. A tag consists of a key and a value that you define.
tagResources_tags :: Lens.Lens' TagResources (Prelude.HashMap Prelude.Text Prelude.Text)
tagResources_tags :: Lens' TagResources (HashMap Text Text)
tagResources_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResources' {HashMap Text Text
tags :: HashMap Text Text
$sel:tags:TagResources' :: TagResources -> HashMap Text Text
tags} -> HashMap Text Text
tags) (\s :: TagResources
s@TagResources' {} HashMap Text Text
a -> TagResources
s {$sel:tags:TagResources' :: HashMap Text Text
tags = HashMap Text Text
a} :: TagResources) 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 TagResources where
  type AWSResponse TagResources = TagResourcesResponse
  request :: (Service -> Service) -> TagResources -> Request TagResources
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 TagResources
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TagResources)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe (HashMap Text FailureInfo) -> Int -> TagResourcesResponse
TagResourcesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FailedResourcesMap"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable TagResources where
  hashWithSalt :: Int -> TagResources -> Int
hashWithSalt Int
_salt TagResources' {NonEmpty Text
HashMap Text Text
tags :: HashMap Text Text
resourceARNList :: NonEmpty Text
$sel:tags:TagResources' :: TagResources -> HashMap Text Text
$sel:resourceARNList:TagResources' :: TagResources -> NonEmpty Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
resourceARNList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
tags

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

instance Data.ToHeaders TagResources where
  toHeaders :: TagResources -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"ResourceGroupsTaggingAPI_20170126.TagResources" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | /See:/ 'newTagResourcesResponse' smart constructor.
data TagResourcesResponse = TagResourcesResponse'
  { -- | A map containing a key-value pair for each failed item that couldn\'t be
    -- tagged. The key is the ARN of the failed resource. The value is a
    -- @FailureInfo@ object that contains an error code, a status code, and an
    -- error message. If there are no errors, the @FailedResourcesMap@ is
    -- empty.
    TagResourcesResponse -> Maybe (HashMap Text FailureInfo)
failedResourcesMap :: Prelude.Maybe (Prelude.HashMap Prelude.Text FailureInfo),
    -- | The response's http status code.
    TagResourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TagResourcesResponse -> TagResourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagResourcesResponse -> TagResourcesResponse -> Bool
$c/= :: TagResourcesResponse -> TagResourcesResponse -> Bool
== :: TagResourcesResponse -> TagResourcesResponse -> Bool
$c== :: TagResourcesResponse -> TagResourcesResponse -> Bool
Prelude.Eq, ReadPrec [TagResourcesResponse]
ReadPrec TagResourcesResponse
Int -> ReadS TagResourcesResponse
ReadS [TagResourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagResourcesResponse]
$creadListPrec :: ReadPrec [TagResourcesResponse]
readPrec :: ReadPrec TagResourcesResponse
$creadPrec :: ReadPrec TagResourcesResponse
readList :: ReadS [TagResourcesResponse]
$creadList :: ReadS [TagResourcesResponse]
readsPrec :: Int -> ReadS TagResourcesResponse
$creadsPrec :: Int -> ReadS TagResourcesResponse
Prelude.Read, Int -> TagResourcesResponse -> ShowS
[TagResourcesResponse] -> ShowS
TagResourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagResourcesResponse] -> ShowS
$cshowList :: [TagResourcesResponse] -> ShowS
show :: TagResourcesResponse -> String
$cshow :: TagResourcesResponse -> String
showsPrec :: Int -> TagResourcesResponse -> ShowS
$cshowsPrec :: Int -> TagResourcesResponse -> ShowS
Prelude.Show, forall x. Rep TagResourcesResponse x -> TagResourcesResponse
forall x. TagResourcesResponse -> Rep TagResourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagResourcesResponse x -> TagResourcesResponse
$cfrom :: forall x. TagResourcesResponse -> Rep TagResourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'TagResourcesResponse' 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:
--
-- 'failedResourcesMap', 'tagResourcesResponse_failedResourcesMap' - A map containing a key-value pair for each failed item that couldn\'t be
-- tagged. The key is the ARN of the failed resource. The value is a
-- @FailureInfo@ object that contains an error code, a status code, and an
-- error message. If there are no errors, the @FailedResourcesMap@ is
-- empty.
--
-- 'httpStatus', 'tagResourcesResponse_httpStatus' - The response's http status code.
newTagResourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TagResourcesResponse
newTagResourcesResponse :: Int -> TagResourcesResponse
newTagResourcesResponse Int
pHttpStatus_ =
  TagResourcesResponse'
    { $sel:failedResourcesMap:TagResourcesResponse' :: Maybe (HashMap Text FailureInfo)
failedResourcesMap =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TagResourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A map containing a key-value pair for each failed item that couldn\'t be
-- tagged. The key is the ARN of the failed resource. The value is a
-- @FailureInfo@ object that contains an error code, a status code, and an
-- error message. If there are no errors, the @FailedResourcesMap@ is
-- empty.
tagResourcesResponse_failedResourcesMap :: Lens.Lens' TagResourcesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text FailureInfo))
tagResourcesResponse_failedResourcesMap :: Lens' TagResourcesResponse (Maybe (HashMap Text FailureInfo))
tagResourcesResponse_failedResourcesMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagResourcesResponse' {Maybe (HashMap Text FailureInfo)
failedResourcesMap :: Maybe (HashMap Text FailureInfo)
$sel:failedResourcesMap:TagResourcesResponse' :: TagResourcesResponse -> Maybe (HashMap Text FailureInfo)
failedResourcesMap} -> Maybe (HashMap Text FailureInfo)
failedResourcesMap) (\s :: TagResourcesResponse
s@TagResourcesResponse' {} Maybe (HashMap Text FailureInfo)
a -> TagResourcesResponse
s {$sel:failedResourcesMap:TagResourcesResponse' :: Maybe (HashMap Text FailureInfo)
failedResourcesMap = Maybe (HashMap Text FailureInfo)
a} :: TagResourcesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData TagResourcesResponse where
  rnf :: TagResourcesResponse -> ()
rnf TagResourcesResponse' {Int
Maybe (HashMap Text FailureInfo)
httpStatus :: Int
failedResourcesMap :: Maybe (HashMap Text FailureInfo)
$sel:httpStatus:TagResourcesResponse' :: TagResourcesResponse -> Int
$sel:failedResourcesMap:TagResourcesResponse' :: TagResourcesResponse -> Maybe (HashMap Text FailureInfo)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text FailureInfo)
failedResourcesMap
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus