{-# 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.UntagResources
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes the specified tags from the specified resources. When you
-- specify a tag key, the action removes both that key and its associated
-- value. The operation succeeds even if you attempt to remove tags from a
-- resource that were already removed. Note the following:
--
-- -   To remove tags from a resource, you need the necessary permissions
--     for the service that the resource belongs to as well as permissions
--     for removing tags. For more information, see the documentation for
--     the service whose resource you want to untag.
--
-- -   You can only tag resources that are located in the specified Amazon
--     Web Services Region for the calling Amazon Web Services account.
--
-- __Minimum permissions__
--
-- In addition to the @tag:UntagResources@ permission required by this
-- operation, you must also have the remove tags permission defined by the
-- service that created the resource. For example, to remove the tags from
-- an Amazon EC2 instance using the @UntagResources@ operation, you must
-- have both of the following permissions:
--
-- -   @tag:UntagResource@
--
-- -   @ec2:DeleteTags@
module Amazonka.ResourceGroupsTagging.UntagResources
  ( -- * Creating a Request
    UntagResources (..),
    newUntagResources,

    -- * Request Lenses
    untagResources_resourceARNList,
    untagResources_tagKeys,

    -- * Destructuring the Response
    UntagResourcesResponse (..),
    newUntagResourcesResponse,

    -- * Response Lenses
    untagResourcesResponse_failedResourcesMap,
    untagResourcesResponse_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:/ 'newUntagResources' smart constructor.
data UntagResources = UntagResources'
  { -- | Specifies a list of ARNs of the resources that you want to remove tags
    -- from.
    --
    -- 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/.
    UntagResources -> NonEmpty Text
resourceARNList :: Prelude.NonEmpty Prelude.Text,
    -- | Specifies a list of tag keys that you want to remove from the specified
    -- resources.
    UntagResources -> NonEmpty Text
tagKeys :: Prelude.NonEmpty Prelude.Text
  }
  deriving (UntagResources -> UntagResources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntagResources -> UntagResources -> Bool
$c/= :: UntagResources -> UntagResources -> Bool
== :: UntagResources -> UntagResources -> Bool
$c== :: UntagResources -> UntagResources -> Bool
Prelude.Eq, ReadPrec [UntagResources]
ReadPrec UntagResources
Int -> ReadS UntagResources
ReadS [UntagResources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UntagResources]
$creadListPrec :: ReadPrec [UntagResources]
readPrec :: ReadPrec UntagResources
$creadPrec :: ReadPrec UntagResources
readList :: ReadS [UntagResources]
$creadList :: ReadS [UntagResources]
readsPrec :: Int -> ReadS UntagResources
$creadsPrec :: Int -> ReadS UntagResources
Prelude.Read, Int -> UntagResources -> ShowS
[UntagResources] -> ShowS
UntagResources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntagResources] -> ShowS
$cshowList :: [UntagResources] -> ShowS
show :: UntagResources -> String
$cshow :: UntagResources -> String
showsPrec :: Int -> UntagResources -> ShowS
$cshowsPrec :: Int -> UntagResources -> ShowS
Prelude.Show, forall x. Rep UntagResources x -> UntagResources
forall x. UntagResources -> Rep UntagResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UntagResources x -> UntagResources
$cfrom :: forall x. UntagResources -> Rep UntagResources x
Prelude.Generic)

-- |
-- Create a value of 'UntagResources' 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', 'untagResources_resourceARNList' - Specifies a list of ARNs of the resources that you want to remove tags
-- from.
--
-- 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/.
--
-- 'tagKeys', 'untagResources_tagKeys' - Specifies a list of tag keys that you want to remove from the specified
-- resources.
newUntagResources ::
  -- | 'resourceARNList'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'tagKeys'
  Prelude.NonEmpty Prelude.Text ->
  UntagResources
newUntagResources :: NonEmpty Text -> NonEmpty Text -> UntagResources
newUntagResources NonEmpty Text
pResourceARNList_ NonEmpty Text
pTagKeys_ =
  UntagResources'
    { $sel:resourceARNList:UntagResources' :: 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:tagKeys:UntagResources' :: NonEmpty Text
tagKeys = 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
pTagKeys_
    }

-- | Specifies a list of ARNs of the resources that you want to remove tags
-- from.
--
-- 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/.
untagResources_resourceARNList :: Lens.Lens' UntagResources (Prelude.NonEmpty Prelude.Text)
untagResources_resourceARNList :: Lens' UntagResources (NonEmpty Text)
untagResources_resourceARNList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagResources' {NonEmpty Text
resourceARNList :: NonEmpty Text
$sel:resourceARNList:UntagResources' :: UntagResources -> NonEmpty Text
resourceARNList} -> NonEmpty Text
resourceARNList) (\s :: UntagResources
s@UntagResources' {} NonEmpty Text
a -> UntagResources
s {$sel:resourceARNList:UntagResources' :: NonEmpty Text
resourceARNList = NonEmpty Text
a} :: UntagResources) 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 tag keys that you want to remove from the specified
-- resources.
untagResources_tagKeys :: Lens.Lens' UntagResources (Prelude.NonEmpty Prelude.Text)
untagResources_tagKeys :: Lens' UntagResources (NonEmpty Text)
untagResources_tagKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagResources' {NonEmpty Text
tagKeys :: NonEmpty Text
$sel:tagKeys:UntagResources' :: UntagResources -> NonEmpty Text
tagKeys} -> NonEmpty Text
tagKeys) (\s :: UntagResources
s@UntagResources' {} NonEmpty Text
a -> UntagResources
s {$sel:tagKeys:UntagResources' :: NonEmpty Text
tagKeys = NonEmpty Text
a} :: UntagResources) 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 UntagResources where
  type
    AWSResponse UntagResources =
      UntagResourcesResponse
  request :: (Service -> Service) -> UntagResources -> Request UntagResources
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 UntagResources
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UntagResources)))
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 -> UntagResourcesResponse
UntagResourcesResponse'
            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 UntagResources where
  hashWithSalt :: Int -> UntagResources -> Int
hashWithSalt Int
_salt UntagResources' {NonEmpty Text
tagKeys :: NonEmpty Text
resourceARNList :: NonEmpty Text
$sel:tagKeys:UntagResources' :: UntagResources -> NonEmpty Text
$sel:resourceARNList:UntagResources' :: UntagResources -> 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` NonEmpty Text
tagKeys

instance Prelude.NFData UntagResources where
  rnf :: UntagResources -> ()
rnf UntagResources' {NonEmpty Text
tagKeys :: NonEmpty Text
resourceARNList :: NonEmpty Text
$sel:tagKeys:UntagResources' :: UntagResources -> NonEmpty Text
$sel:resourceARNList:UntagResources' :: UntagResources -> 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 NonEmpty Text
tagKeys

instance Data.ToHeaders UntagResources where
  toHeaders :: UntagResources -> 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.UntagResources" ::
                          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 UntagResources where
  toJSON :: UntagResources -> Value
toJSON UntagResources' {NonEmpty Text
tagKeys :: NonEmpty Text
resourceARNList :: NonEmpty Text
$sel:tagKeys:UntagResources' :: UntagResources -> NonEmpty Text
$sel:resourceARNList:UntagResources' :: UntagResources -> 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
"TagKeys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
tagKeys)
          ]
      )

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

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

-- | /See:/ 'newUntagResourcesResponse' smart constructor.
data UntagResourcesResponse = UntagResourcesResponse'
  { -- | A map containing a key-value pair for each failed item that couldn\'t be
    -- untagged. 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.
    UntagResourcesResponse -> Maybe (HashMap Text FailureInfo)
failedResourcesMap :: Prelude.Maybe (Prelude.HashMap Prelude.Text FailureInfo),
    -- | The response's http status code.
    UntagResourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UntagResourcesResponse -> UntagResourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntagResourcesResponse -> UntagResourcesResponse -> Bool
$c/= :: UntagResourcesResponse -> UntagResourcesResponse -> Bool
== :: UntagResourcesResponse -> UntagResourcesResponse -> Bool
$c== :: UntagResourcesResponse -> UntagResourcesResponse -> Bool
Prelude.Eq, ReadPrec [UntagResourcesResponse]
ReadPrec UntagResourcesResponse
Int -> ReadS UntagResourcesResponse
ReadS [UntagResourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UntagResourcesResponse]
$creadListPrec :: ReadPrec [UntagResourcesResponse]
readPrec :: ReadPrec UntagResourcesResponse
$creadPrec :: ReadPrec UntagResourcesResponse
readList :: ReadS [UntagResourcesResponse]
$creadList :: ReadS [UntagResourcesResponse]
readsPrec :: Int -> ReadS UntagResourcesResponse
$creadsPrec :: Int -> ReadS UntagResourcesResponse
Prelude.Read, Int -> UntagResourcesResponse -> ShowS
[UntagResourcesResponse] -> ShowS
UntagResourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntagResourcesResponse] -> ShowS
$cshowList :: [UntagResourcesResponse] -> ShowS
show :: UntagResourcesResponse -> String
$cshow :: UntagResourcesResponse -> String
showsPrec :: Int -> UntagResourcesResponse -> ShowS
$cshowsPrec :: Int -> UntagResourcesResponse -> ShowS
Prelude.Show, forall x. Rep UntagResourcesResponse x -> UntagResourcesResponse
forall x. UntagResourcesResponse -> Rep UntagResourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UntagResourcesResponse x -> UntagResourcesResponse
$cfrom :: forall x. UntagResourcesResponse -> Rep UntagResourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'UntagResourcesResponse' 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', 'untagResourcesResponse_failedResourcesMap' - A map containing a key-value pair for each failed item that couldn\'t be
-- untagged. 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', 'untagResourcesResponse_httpStatus' - The response's http status code.
newUntagResourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UntagResourcesResponse
newUntagResourcesResponse :: Int -> UntagResourcesResponse
newUntagResourcesResponse Int
pHttpStatus_ =
  UntagResourcesResponse'
    { $sel:failedResourcesMap:UntagResourcesResponse' :: Maybe (HashMap Text FailureInfo)
failedResourcesMap =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UntagResourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A map containing a key-value pair for each failed item that couldn\'t be
-- untagged. 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.
untagResourcesResponse_failedResourcesMap :: Lens.Lens' UntagResourcesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text FailureInfo))
untagResourcesResponse_failedResourcesMap :: Lens' UntagResourcesResponse (Maybe (HashMap Text FailureInfo))
untagResourcesResponse_failedResourcesMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagResourcesResponse' {Maybe (HashMap Text FailureInfo)
failedResourcesMap :: Maybe (HashMap Text FailureInfo)
$sel:failedResourcesMap:UntagResourcesResponse' :: UntagResourcesResponse -> Maybe (HashMap Text FailureInfo)
failedResourcesMap} -> Maybe (HashMap Text FailureInfo)
failedResourcesMap) (\s :: UntagResourcesResponse
s@UntagResourcesResponse' {} Maybe (HashMap Text FailureInfo)
a -> UntagResourcesResponse
s {$sel:failedResourcesMap:UntagResourcesResponse' :: Maybe (HashMap Text FailureInfo)
failedResourcesMap = Maybe (HashMap Text FailureInfo)
a} :: UntagResourcesResponse) 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.
untagResourcesResponse_httpStatus :: Lens.Lens' UntagResourcesResponse Prelude.Int
untagResourcesResponse_httpStatus :: Lens' UntagResourcesResponse Int
untagResourcesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagResourcesResponse' {Int
httpStatus :: Int
$sel:httpStatus:UntagResourcesResponse' :: UntagResourcesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UntagResourcesResponse
s@UntagResourcesResponse' {} Int
a -> UntagResourcesResponse
s {$sel:httpStatus:UntagResourcesResponse' :: Int
httpStatus = Int
a} :: UntagResourcesResponse)

instance Prelude.NFData UntagResourcesResponse where
  rnf :: UntagResourcesResponse -> ()
rnf UntagResourcesResponse' {Int
Maybe (HashMap Text FailureInfo)
httpStatus :: Int
failedResourcesMap :: Maybe (HashMap Text FailureInfo)
$sel:httpStatus:UntagResourcesResponse' :: UntagResourcesResponse -> Int
$sel:failedResourcesMap:UntagResourcesResponse' :: UntagResourcesResponse -> 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