{-# 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.ResourceGroups.Untag
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes tags from a specified resource group.
--
-- __Minimum permissions__
--
-- To run this command, you must have the following permissions:
--
-- -   @resource-groups:Untag@
module Amazonka.ResourceGroups.Untag
  ( -- * Creating a Request
    Untag (..),
    newUntag,

    -- * Request Lenses
    untag_arn,
    untag_keys,

    -- * Destructuring the Response
    UntagResponse (..),
    newUntagResponse,

    -- * Response Lenses
    untagResponse_arn,
    untagResponse_keys,
    untagResponse_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.ResourceGroups.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newUntag' smart constructor.
data Untag = Untag'
  { -- | The ARN of the resource group from which to remove tags. The command
    -- removed both the specified keys and any values associated with those
    -- keys.
    Untag -> Text
arn :: Prelude.Text,
    -- | The keys of the tags to be removed.
    Untag -> [Text]
keys :: [Prelude.Text]
  }
  deriving (Untag -> Untag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Untag -> Untag -> Bool
$c/= :: Untag -> Untag -> Bool
== :: Untag -> Untag -> Bool
$c== :: Untag -> Untag -> Bool
Prelude.Eq, ReadPrec [Untag]
ReadPrec Untag
Int -> ReadS Untag
ReadS [Untag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Untag]
$creadListPrec :: ReadPrec [Untag]
readPrec :: ReadPrec Untag
$creadPrec :: ReadPrec Untag
readList :: ReadS [Untag]
$creadList :: ReadS [Untag]
readsPrec :: Int -> ReadS Untag
$creadsPrec :: Int -> ReadS Untag
Prelude.Read, Int -> Untag -> ShowS
[Untag] -> ShowS
Untag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Untag] -> ShowS
$cshowList :: [Untag] -> ShowS
show :: Untag -> String
$cshow :: Untag -> String
showsPrec :: Int -> Untag -> ShowS
$cshowsPrec :: Int -> Untag -> ShowS
Prelude.Show, forall x. Rep Untag x -> Untag
forall x. Untag -> Rep Untag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Untag x -> Untag
$cfrom :: forall x. Untag -> Rep Untag x
Prelude.Generic)

-- |
-- Create a value of 'Untag' 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:
--
-- 'arn', 'untag_arn' - The ARN of the resource group from which to remove tags. The command
-- removed both the specified keys and any values associated with those
-- keys.
--
-- 'keys', 'untag_keys' - The keys of the tags to be removed.
newUntag ::
  -- | 'arn'
  Prelude.Text ->
  Untag
newUntag :: Text -> Untag
newUntag Text
pArn_ =
  Untag' {$sel:arn:Untag' :: Text
arn = Text
pArn_, $sel:keys:Untag' :: [Text]
keys = forall a. Monoid a => a
Prelude.mempty}

-- | The ARN of the resource group from which to remove tags. The command
-- removed both the specified keys and any values associated with those
-- keys.
untag_arn :: Lens.Lens' Untag Prelude.Text
untag_arn :: Lens' Untag Text
untag_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Untag' {Text
arn :: Text
$sel:arn:Untag' :: Untag -> Text
arn} -> Text
arn) (\s :: Untag
s@Untag' {} Text
a -> Untag
s {$sel:arn:Untag' :: Text
arn = Text
a} :: Untag)

-- | The keys of the tags to be removed.
untag_keys :: Lens.Lens' Untag [Prelude.Text]
untag_keys :: Lens' Untag [Text]
untag_keys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Untag' {[Text]
keys :: [Text]
$sel:keys:Untag' :: Untag -> [Text]
keys} -> [Text]
keys) (\s :: Untag
s@Untag' {} [Text]
a -> Untag
s {$sel:keys:Untag' :: [Text]
keys = [Text]
a} :: Untag) 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 Untag where
  type AWSResponse Untag = UntagResponse
  request :: (Service -> Service) -> Untag -> Request Untag
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy Untag
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Untag)))
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 Text -> Maybe [Text] -> Int -> UntagResponse
UntagResponse'
            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
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Keys" 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 Untag where
  hashWithSalt :: Int -> Untag -> Int
hashWithSalt Int
_salt Untag' {[Text]
Text
keys :: [Text]
arn :: Text
$sel:keys:Untag' :: Untag -> [Text]
$sel:arn:Untag' :: Untag -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
keys

instance Prelude.NFData Untag where
  rnf :: Untag -> ()
rnf Untag' {[Text]
Text
keys :: [Text]
arn :: Text
$sel:keys:Untag' :: Untag -> [Text]
$sel:arn:Untag' :: Untag -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
arn seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
keys

instance Data.ToHeaders Untag where
  toHeaders :: Untag -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON Untag where
  toJSON :: Untag -> Value
toJSON Untag' {[Text]
Text
keys :: [Text]
arn :: Text
$sel:keys:Untag' :: Untag -> [Text]
$sel:arn:Untag' :: Untag -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Keys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
keys)]
      )

instance Data.ToPath Untag where
  toPath :: Untag -> ByteString
toPath Untag' {[Text]
Text
keys :: [Text]
arn :: Text
$sel:keys:Untag' :: Untag -> [Text]
$sel:arn:Untag' :: Untag -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/resources/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
arn, ByteString
"/tags"]

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

-- | /See:/ 'newUntagResponse' smart constructor.
data UntagResponse = UntagResponse'
  { -- | The ARN of the resource group from which tags have been removed.
    UntagResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The keys of the tags that were removed.
    UntagResponse -> Maybe [Text]
keys :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    UntagResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UntagResponse -> UntagResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntagResponse -> UntagResponse -> Bool
$c/= :: UntagResponse -> UntagResponse -> Bool
== :: UntagResponse -> UntagResponse -> Bool
$c== :: UntagResponse -> UntagResponse -> Bool
Prelude.Eq, ReadPrec [UntagResponse]
ReadPrec UntagResponse
Int -> ReadS UntagResponse
ReadS [UntagResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UntagResponse]
$creadListPrec :: ReadPrec [UntagResponse]
readPrec :: ReadPrec UntagResponse
$creadPrec :: ReadPrec UntagResponse
readList :: ReadS [UntagResponse]
$creadList :: ReadS [UntagResponse]
readsPrec :: Int -> ReadS UntagResponse
$creadsPrec :: Int -> ReadS UntagResponse
Prelude.Read, Int -> UntagResponse -> ShowS
[UntagResponse] -> ShowS
UntagResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntagResponse] -> ShowS
$cshowList :: [UntagResponse] -> ShowS
show :: UntagResponse -> String
$cshow :: UntagResponse -> String
showsPrec :: Int -> UntagResponse -> ShowS
$cshowsPrec :: Int -> UntagResponse -> ShowS
Prelude.Show, forall x. Rep UntagResponse x -> UntagResponse
forall x. UntagResponse -> Rep UntagResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UntagResponse x -> UntagResponse
$cfrom :: forall x. UntagResponse -> Rep UntagResponse x
Prelude.Generic)

-- |
-- Create a value of 'UntagResponse' 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:
--
-- 'arn', 'untagResponse_arn' - The ARN of the resource group from which tags have been removed.
--
-- 'keys', 'untagResponse_keys' - The keys of the tags that were removed.
--
-- 'httpStatus', 'untagResponse_httpStatus' - The response's http status code.
newUntagResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UntagResponse
newUntagResponse :: Int -> UntagResponse
newUntagResponse Int
pHttpStatus_ =
  UntagResponse'
    { $sel:arn:UntagResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:keys:UntagResponse' :: Maybe [Text]
keys = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UntagResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the resource group from which tags have been removed.
untagResponse_arn :: Lens.Lens' UntagResponse (Prelude.Maybe Prelude.Text)
untagResponse_arn :: Lens' UntagResponse (Maybe Text)
untagResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:UntagResponse' :: UntagResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: UntagResponse
s@UntagResponse' {} Maybe Text
a -> UntagResponse
s {$sel:arn:UntagResponse' :: Maybe Text
arn = Maybe Text
a} :: UntagResponse)

-- | The keys of the tags that were removed.
untagResponse_keys :: Lens.Lens' UntagResponse (Prelude.Maybe [Prelude.Text])
untagResponse_keys :: Lens' UntagResponse (Maybe [Text])
untagResponse_keys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagResponse' {Maybe [Text]
keys :: Maybe [Text]
$sel:keys:UntagResponse' :: UntagResponse -> Maybe [Text]
keys} -> Maybe [Text]
keys) (\s :: UntagResponse
s@UntagResponse' {} Maybe [Text]
a -> UntagResponse
s {$sel:keys:UntagResponse' :: Maybe [Text]
keys = Maybe [Text]
a} :: UntagResponse) 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.
untagResponse_httpStatus :: Lens.Lens' UntagResponse Prelude.Int
untagResponse_httpStatus :: Lens' UntagResponse Int
untagResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagResponse' {Int
httpStatus :: Int
$sel:httpStatus:UntagResponse' :: UntagResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UntagResponse
s@UntagResponse' {} Int
a -> UntagResponse
s {$sel:httpStatus:UntagResponse' :: Int
httpStatus = Int
a} :: UntagResponse)

instance Prelude.NFData UntagResponse where
  rnf :: UntagResponse -> ()
rnf UntagResponse' {Int
Maybe [Text]
Maybe Text
httpStatus :: Int
keys :: Maybe [Text]
arn :: Maybe Text
$sel:httpStatus:UntagResponse' :: UntagResponse -> Int
$sel:keys:UntagResponse' :: UntagResponse -> Maybe [Text]
$sel:arn:UntagResponse' :: UntagResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
keys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus