{-# 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.UngroupResources
-- 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 resources from the specified group.
--
-- __Minimum permissions__
--
-- To run this command, you must have the following permissions:
--
-- -   @resource-groups:UngroupResources@
module Amazonka.ResourceGroups.UngroupResources
  ( -- * Creating a Request
    UngroupResources (..),
    newUngroupResources,

    -- * Request Lenses
    ungroupResources_group,
    ungroupResources_resourceArns,

    -- * Destructuring the Response
    UngroupResourcesResponse (..),
    newUngroupResourcesResponse,

    -- * Response Lenses
    ungroupResourcesResponse_failed,
    ungroupResourcesResponse_pending,
    ungroupResourcesResponse_succeeded,
    ungroupResourcesResponse_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:/ 'newUngroupResources' smart constructor.
data UngroupResources = UngroupResources'
  { -- | The name or the ARN of the resource group from which to remove the
    -- resources.
    UngroupResources -> Text
group' :: Prelude.Text,
    -- | The ARNs of the resources to be removed from the group.
    UngroupResources -> NonEmpty Text
resourceArns :: Prelude.NonEmpty Prelude.Text
  }
  deriving (UngroupResources -> UngroupResources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UngroupResources -> UngroupResources -> Bool
$c/= :: UngroupResources -> UngroupResources -> Bool
== :: UngroupResources -> UngroupResources -> Bool
$c== :: UngroupResources -> UngroupResources -> Bool
Prelude.Eq, ReadPrec [UngroupResources]
ReadPrec UngroupResources
Int -> ReadS UngroupResources
ReadS [UngroupResources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UngroupResources]
$creadListPrec :: ReadPrec [UngroupResources]
readPrec :: ReadPrec UngroupResources
$creadPrec :: ReadPrec UngroupResources
readList :: ReadS [UngroupResources]
$creadList :: ReadS [UngroupResources]
readsPrec :: Int -> ReadS UngroupResources
$creadsPrec :: Int -> ReadS UngroupResources
Prelude.Read, Int -> UngroupResources -> ShowS
[UngroupResources] -> ShowS
UngroupResources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UngroupResources] -> ShowS
$cshowList :: [UngroupResources] -> ShowS
show :: UngroupResources -> String
$cshow :: UngroupResources -> String
showsPrec :: Int -> UngroupResources -> ShowS
$cshowsPrec :: Int -> UngroupResources -> ShowS
Prelude.Show, forall x. Rep UngroupResources x -> UngroupResources
forall x. UngroupResources -> Rep UngroupResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UngroupResources x -> UngroupResources
$cfrom :: forall x. UngroupResources -> Rep UngroupResources x
Prelude.Generic)

-- |
-- Create a value of 'UngroupResources' 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:
--
-- 'group'', 'ungroupResources_group' - The name or the ARN of the resource group from which to remove the
-- resources.
--
-- 'resourceArns', 'ungroupResources_resourceArns' - The ARNs of the resources to be removed from the group.
newUngroupResources ::
  -- | 'group''
  Prelude.Text ->
  -- | 'resourceArns'
  Prelude.NonEmpty Prelude.Text ->
  UngroupResources
newUngroupResources :: Text -> NonEmpty Text -> UngroupResources
newUngroupResources Text
pGroup_ NonEmpty Text
pResourceArns_ =
  UngroupResources'
    { $sel:group':UngroupResources' :: Text
group' = Text
pGroup_,
      $sel:resourceArns:UngroupResources' :: NonEmpty Text
resourceArns = 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
pResourceArns_
    }

-- | The name or the ARN of the resource group from which to remove the
-- resources.
ungroupResources_group :: Lens.Lens' UngroupResources Prelude.Text
ungroupResources_group :: Lens' UngroupResources Text
ungroupResources_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UngroupResources' {Text
group' :: Text
$sel:group':UngroupResources' :: UngroupResources -> Text
group'} -> Text
group') (\s :: UngroupResources
s@UngroupResources' {} Text
a -> UngroupResources
s {$sel:group':UngroupResources' :: Text
group' = Text
a} :: UngroupResources)

-- | The ARNs of the resources to be removed from the group.
ungroupResources_resourceArns :: Lens.Lens' UngroupResources (Prelude.NonEmpty Prelude.Text)
ungroupResources_resourceArns :: Lens' UngroupResources (NonEmpty Text)
ungroupResources_resourceArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UngroupResources' {NonEmpty Text
resourceArns :: NonEmpty Text
$sel:resourceArns:UngroupResources' :: UngroupResources -> NonEmpty Text
resourceArns} -> NonEmpty Text
resourceArns) (\s :: UngroupResources
s@UngroupResources' {} NonEmpty Text
a -> UngroupResources
s {$sel:resourceArns:UngroupResources' :: NonEmpty Text
resourceArns = NonEmpty Text
a} :: UngroupResources) 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 UngroupResources where
  type
    AWSResponse UngroupResources =
      UngroupResourcesResponse
  request :: (Service -> Service)
-> UngroupResources -> Request UngroupResources
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 UngroupResources
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UngroupResources)))
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 [FailedResource]
-> Maybe [PendingResource]
-> Maybe (NonEmpty Text)
-> Int
-> UngroupResourcesResponse
UngroupResourcesResponse'
            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
"Failed" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Pending" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Succeeded")
            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 UngroupResources where
  hashWithSalt :: Int -> UngroupResources -> Int
hashWithSalt Int
_salt UngroupResources' {NonEmpty Text
Text
resourceArns :: NonEmpty Text
group' :: Text
$sel:resourceArns:UngroupResources' :: UngroupResources -> NonEmpty Text
$sel:group':UngroupResources' :: UngroupResources -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
group'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
resourceArns

instance Prelude.NFData UngroupResources where
  rnf :: UngroupResources -> ()
rnf UngroupResources' {NonEmpty Text
Text
resourceArns :: NonEmpty Text
group' :: Text
$sel:resourceArns:UngroupResources' :: UngroupResources -> NonEmpty Text
$sel:group':UngroupResources' :: UngroupResources -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
group'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
resourceArns

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

instance Data.ToJSON UngroupResources where
  toJSON :: UngroupResources -> Value
toJSON UngroupResources' {NonEmpty Text
Text
resourceArns :: NonEmpty Text
group' :: Text
$sel:resourceArns:UngroupResources' :: UngroupResources -> NonEmpty Text
$sel:group':UngroupResources' :: UngroupResources -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Group" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
group'),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
resourceArns)
          ]
      )

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

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

-- | /See:/ 'newUngroupResourcesResponse' smart constructor.
data UngroupResourcesResponse = UngroupResourcesResponse'
  { -- | A list of any resources that failed to be removed from the group by this
    -- operation.
    UngroupResourcesResponse -> Maybe [FailedResource]
failed :: Prelude.Maybe [FailedResource],
    -- | A list of any resources that are still in the process of being removed
    -- from the group by this operation. These pending removals continue
    -- asynchronously. You can check the status of pending removals by using
    -- the @ @@ListGroupResources@@ @ operation. After the resource is
    -- successfully removed, it no longer appears in the response.
    UngroupResourcesResponse -> Maybe [PendingResource]
pending :: Prelude.Maybe [PendingResource],
    -- | A list of resources that were successfully removed from the group by
    -- this operation.
    UngroupResourcesResponse -> Maybe (NonEmpty Text)
succeeded :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    UngroupResourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UngroupResourcesResponse -> UngroupResourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UngroupResourcesResponse -> UngroupResourcesResponse -> Bool
$c/= :: UngroupResourcesResponse -> UngroupResourcesResponse -> Bool
== :: UngroupResourcesResponse -> UngroupResourcesResponse -> Bool
$c== :: UngroupResourcesResponse -> UngroupResourcesResponse -> Bool
Prelude.Eq, ReadPrec [UngroupResourcesResponse]
ReadPrec UngroupResourcesResponse
Int -> ReadS UngroupResourcesResponse
ReadS [UngroupResourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UngroupResourcesResponse]
$creadListPrec :: ReadPrec [UngroupResourcesResponse]
readPrec :: ReadPrec UngroupResourcesResponse
$creadPrec :: ReadPrec UngroupResourcesResponse
readList :: ReadS [UngroupResourcesResponse]
$creadList :: ReadS [UngroupResourcesResponse]
readsPrec :: Int -> ReadS UngroupResourcesResponse
$creadsPrec :: Int -> ReadS UngroupResourcesResponse
Prelude.Read, Int -> UngroupResourcesResponse -> ShowS
[UngroupResourcesResponse] -> ShowS
UngroupResourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UngroupResourcesResponse] -> ShowS
$cshowList :: [UngroupResourcesResponse] -> ShowS
show :: UngroupResourcesResponse -> String
$cshow :: UngroupResourcesResponse -> String
showsPrec :: Int -> UngroupResourcesResponse -> ShowS
$cshowsPrec :: Int -> UngroupResourcesResponse -> ShowS
Prelude.Show, forall x.
Rep UngroupResourcesResponse x -> UngroupResourcesResponse
forall x.
UngroupResourcesResponse -> Rep UngroupResourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UngroupResourcesResponse x -> UngroupResourcesResponse
$cfrom :: forall x.
UngroupResourcesResponse -> Rep UngroupResourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'UngroupResourcesResponse' 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:
--
-- 'failed', 'ungroupResourcesResponse_failed' - A list of any resources that failed to be removed from the group by this
-- operation.
--
-- 'pending', 'ungroupResourcesResponse_pending' - A list of any resources that are still in the process of being removed
-- from the group by this operation. These pending removals continue
-- asynchronously. You can check the status of pending removals by using
-- the @ @@ListGroupResources@@ @ operation. After the resource is
-- successfully removed, it no longer appears in the response.
--
-- 'succeeded', 'ungroupResourcesResponse_succeeded' - A list of resources that were successfully removed from the group by
-- this operation.
--
-- 'httpStatus', 'ungroupResourcesResponse_httpStatus' - The response's http status code.
newUngroupResourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UngroupResourcesResponse
newUngroupResourcesResponse :: Int -> UngroupResourcesResponse
newUngroupResourcesResponse Int
pHttpStatus_ =
  UngroupResourcesResponse'
    { $sel:failed:UngroupResourcesResponse' :: Maybe [FailedResource]
failed = forall a. Maybe a
Prelude.Nothing,
      $sel:pending:UngroupResourcesResponse' :: Maybe [PendingResource]
pending = forall a. Maybe a
Prelude.Nothing,
      $sel:succeeded:UngroupResourcesResponse' :: Maybe (NonEmpty Text)
succeeded = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UngroupResourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of any resources that failed to be removed from the group by this
-- operation.
ungroupResourcesResponse_failed :: Lens.Lens' UngroupResourcesResponse (Prelude.Maybe [FailedResource])
ungroupResourcesResponse_failed :: Lens' UngroupResourcesResponse (Maybe [FailedResource])
ungroupResourcesResponse_failed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UngroupResourcesResponse' {Maybe [FailedResource]
failed :: Maybe [FailedResource]
$sel:failed:UngroupResourcesResponse' :: UngroupResourcesResponse -> Maybe [FailedResource]
failed} -> Maybe [FailedResource]
failed) (\s :: UngroupResourcesResponse
s@UngroupResourcesResponse' {} Maybe [FailedResource]
a -> UngroupResourcesResponse
s {$sel:failed:UngroupResourcesResponse' :: Maybe [FailedResource]
failed = Maybe [FailedResource]
a} :: UngroupResourcesResponse) 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

-- | A list of any resources that are still in the process of being removed
-- from the group by this operation. These pending removals continue
-- asynchronously. You can check the status of pending removals by using
-- the @ @@ListGroupResources@@ @ operation. After the resource is
-- successfully removed, it no longer appears in the response.
ungroupResourcesResponse_pending :: Lens.Lens' UngroupResourcesResponse (Prelude.Maybe [PendingResource])
ungroupResourcesResponse_pending :: Lens' UngroupResourcesResponse (Maybe [PendingResource])
ungroupResourcesResponse_pending = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UngroupResourcesResponse' {Maybe [PendingResource]
pending :: Maybe [PendingResource]
$sel:pending:UngroupResourcesResponse' :: UngroupResourcesResponse -> Maybe [PendingResource]
pending} -> Maybe [PendingResource]
pending) (\s :: UngroupResourcesResponse
s@UngroupResourcesResponse' {} Maybe [PendingResource]
a -> UngroupResourcesResponse
s {$sel:pending:UngroupResourcesResponse' :: Maybe [PendingResource]
pending = Maybe [PendingResource]
a} :: UngroupResourcesResponse) 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

-- | A list of resources that were successfully removed from the group by
-- this operation.
ungroupResourcesResponse_succeeded :: Lens.Lens' UngroupResourcesResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
ungroupResourcesResponse_succeeded :: Lens' UngroupResourcesResponse (Maybe (NonEmpty Text))
ungroupResourcesResponse_succeeded = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UngroupResourcesResponse' {Maybe (NonEmpty Text)
succeeded :: Maybe (NonEmpty Text)
$sel:succeeded:UngroupResourcesResponse' :: UngroupResourcesResponse -> Maybe (NonEmpty Text)
succeeded} -> Maybe (NonEmpty Text)
succeeded) (\s :: UngroupResourcesResponse
s@UngroupResourcesResponse' {} Maybe (NonEmpty Text)
a -> UngroupResourcesResponse
s {$sel:succeeded:UngroupResourcesResponse' :: Maybe (NonEmpty Text)
succeeded = Maybe (NonEmpty Text)
a} :: UngroupResourcesResponse) 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.
ungroupResourcesResponse_httpStatus :: Lens.Lens' UngroupResourcesResponse Prelude.Int
ungroupResourcesResponse_httpStatus :: Lens' UngroupResourcesResponse Int
ungroupResourcesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UngroupResourcesResponse' {Int
httpStatus :: Int
$sel:httpStatus:UngroupResourcesResponse' :: UngroupResourcesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UngroupResourcesResponse
s@UngroupResourcesResponse' {} Int
a -> UngroupResourcesResponse
s {$sel:httpStatus:UngroupResourcesResponse' :: Int
httpStatus = Int
a} :: UngroupResourcesResponse)

instance Prelude.NFData UngroupResourcesResponse where
  rnf :: UngroupResourcesResponse -> ()
rnf UngroupResourcesResponse' {Int
Maybe [FailedResource]
Maybe [PendingResource]
Maybe (NonEmpty Text)
httpStatus :: Int
succeeded :: Maybe (NonEmpty Text)
pending :: Maybe [PendingResource]
failed :: Maybe [FailedResource]
$sel:httpStatus:UngroupResourcesResponse' :: UngroupResourcesResponse -> Int
$sel:succeeded:UngroupResourcesResponse' :: UngroupResourcesResponse -> Maybe (NonEmpty Text)
$sel:pending:UngroupResourcesResponse' :: UngroupResourcesResponse -> Maybe [PendingResource]
$sel:failed:UngroupResourcesResponse' :: UngroupResourcesResponse -> Maybe [FailedResource]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FailedResource]
failed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PendingResource]
pending
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
succeeded
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus