{-# 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.Macie.DisassociateS3Resources
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- (Discontinued) Removes specified S3 resources from being monitored by
-- Amazon Macie Classic. If @memberAccountId@ isn\'t specified, the action
-- removes specified S3 resources from Macie Classic for the current Macie
-- Classic administrator account. If @memberAccountId@ is specified, the
-- action removes specified S3 resources from Macie Classic for the
-- specified member account.
module Amazonka.Macie.DisassociateS3Resources
  ( -- * Creating a Request
    DisassociateS3Resources (..),
    newDisassociateS3Resources,

    -- * Request Lenses
    disassociateS3Resources_memberAccountId,
    disassociateS3Resources_associatedS3Resources,

    -- * Destructuring the Response
    DisassociateS3ResourcesResponse (..),
    newDisassociateS3ResourcesResponse,

    -- * Response Lenses
    disassociateS3ResourcesResponse_failedS3Resources,
    disassociateS3ResourcesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDisassociateS3Resources' smart constructor.
data DisassociateS3Resources = DisassociateS3Resources'
  { -- | (Discontinued) The ID of the Amazon Macie Classic member account whose
    -- resources you want to remove from being monitored by Macie Classic.
    DisassociateS3Resources -> Maybe Text
memberAccountId :: Prelude.Maybe Prelude.Text,
    -- | (Discontinued) The S3 resources (buckets or prefixes) that you want to
    -- remove from being monitored and classified by Amazon Macie Classic.
    DisassociateS3Resources -> [S3Resource]
associatedS3Resources :: [S3Resource]
  }
  deriving (DisassociateS3Resources -> DisassociateS3Resources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateS3Resources -> DisassociateS3Resources -> Bool
$c/= :: DisassociateS3Resources -> DisassociateS3Resources -> Bool
== :: DisassociateS3Resources -> DisassociateS3Resources -> Bool
$c== :: DisassociateS3Resources -> DisassociateS3Resources -> Bool
Prelude.Eq, ReadPrec [DisassociateS3Resources]
ReadPrec DisassociateS3Resources
Int -> ReadS DisassociateS3Resources
ReadS [DisassociateS3Resources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateS3Resources]
$creadListPrec :: ReadPrec [DisassociateS3Resources]
readPrec :: ReadPrec DisassociateS3Resources
$creadPrec :: ReadPrec DisassociateS3Resources
readList :: ReadS [DisassociateS3Resources]
$creadList :: ReadS [DisassociateS3Resources]
readsPrec :: Int -> ReadS DisassociateS3Resources
$creadsPrec :: Int -> ReadS DisassociateS3Resources
Prelude.Read, Int -> DisassociateS3Resources -> ShowS
[DisassociateS3Resources] -> ShowS
DisassociateS3Resources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateS3Resources] -> ShowS
$cshowList :: [DisassociateS3Resources] -> ShowS
show :: DisassociateS3Resources -> String
$cshow :: DisassociateS3Resources -> String
showsPrec :: Int -> DisassociateS3Resources -> ShowS
$cshowsPrec :: Int -> DisassociateS3Resources -> ShowS
Prelude.Show, forall x. Rep DisassociateS3Resources x -> DisassociateS3Resources
forall x. DisassociateS3Resources -> Rep DisassociateS3Resources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisassociateS3Resources x -> DisassociateS3Resources
$cfrom :: forall x. DisassociateS3Resources -> Rep DisassociateS3Resources x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateS3Resources' 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:
--
-- 'memberAccountId', 'disassociateS3Resources_memberAccountId' - (Discontinued) The ID of the Amazon Macie Classic member account whose
-- resources you want to remove from being monitored by Macie Classic.
--
-- 'associatedS3Resources', 'disassociateS3Resources_associatedS3Resources' - (Discontinued) The S3 resources (buckets or prefixes) that you want to
-- remove from being monitored and classified by Amazon Macie Classic.
newDisassociateS3Resources ::
  DisassociateS3Resources
newDisassociateS3Resources :: DisassociateS3Resources
newDisassociateS3Resources =
  DisassociateS3Resources'
    { $sel:memberAccountId:DisassociateS3Resources' :: Maybe Text
memberAccountId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:associatedS3Resources:DisassociateS3Resources' :: [S3Resource]
associatedS3Resources = forall a. Monoid a => a
Prelude.mempty
    }

-- | (Discontinued) The ID of the Amazon Macie Classic member account whose
-- resources you want to remove from being monitored by Macie Classic.
disassociateS3Resources_memberAccountId :: Lens.Lens' DisassociateS3Resources (Prelude.Maybe Prelude.Text)
disassociateS3Resources_memberAccountId :: Lens' DisassociateS3Resources (Maybe Text)
disassociateS3Resources_memberAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateS3Resources' {Maybe Text
memberAccountId :: Maybe Text
$sel:memberAccountId:DisassociateS3Resources' :: DisassociateS3Resources -> Maybe Text
memberAccountId} -> Maybe Text
memberAccountId) (\s :: DisassociateS3Resources
s@DisassociateS3Resources' {} Maybe Text
a -> DisassociateS3Resources
s {$sel:memberAccountId:DisassociateS3Resources' :: Maybe Text
memberAccountId = Maybe Text
a} :: DisassociateS3Resources)

-- | (Discontinued) The S3 resources (buckets or prefixes) that you want to
-- remove from being monitored and classified by Amazon Macie Classic.
disassociateS3Resources_associatedS3Resources :: Lens.Lens' DisassociateS3Resources [S3Resource]
disassociateS3Resources_associatedS3Resources :: Lens' DisassociateS3Resources [S3Resource]
disassociateS3Resources_associatedS3Resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateS3Resources' {[S3Resource]
associatedS3Resources :: [S3Resource]
$sel:associatedS3Resources:DisassociateS3Resources' :: DisassociateS3Resources -> [S3Resource]
associatedS3Resources} -> [S3Resource]
associatedS3Resources) (\s :: DisassociateS3Resources
s@DisassociateS3Resources' {} [S3Resource]
a -> DisassociateS3Resources
s {$sel:associatedS3Resources:DisassociateS3Resources' :: [S3Resource]
associatedS3Resources = [S3Resource]
a} :: DisassociateS3Resources) 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 DisassociateS3Resources where
  type
    AWSResponse DisassociateS3Resources =
      DisassociateS3ResourcesResponse
  request :: (Service -> Service)
-> DisassociateS3Resources -> Request DisassociateS3Resources
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 DisassociateS3Resources
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DisassociateS3Resources)))
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 [FailedS3Resource] -> Int -> DisassociateS3ResourcesResponse
DisassociateS3ResourcesResponse'
            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
"failedS3Resources"
                            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 DisassociateS3Resources where
  hashWithSalt :: Int -> DisassociateS3Resources -> Int
hashWithSalt Int
_salt DisassociateS3Resources' {[S3Resource]
Maybe Text
associatedS3Resources :: [S3Resource]
memberAccountId :: Maybe Text
$sel:associatedS3Resources:DisassociateS3Resources' :: DisassociateS3Resources -> [S3Resource]
$sel:memberAccountId:DisassociateS3Resources' :: DisassociateS3Resources -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
memberAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [S3Resource]
associatedS3Resources

instance Prelude.NFData DisassociateS3Resources where
  rnf :: DisassociateS3Resources -> ()
rnf DisassociateS3Resources' {[S3Resource]
Maybe Text
associatedS3Resources :: [S3Resource]
memberAccountId :: Maybe Text
$sel:associatedS3Resources:DisassociateS3Resources' :: DisassociateS3Resources -> [S3Resource]
$sel:memberAccountId:DisassociateS3Resources' :: DisassociateS3Resources -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
memberAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [S3Resource]
associatedS3Resources

instance Data.ToHeaders DisassociateS3Resources where
  toHeaders :: DisassociateS3Resources -> 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
"MacieService.DisassociateS3Resources" ::
                          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 DisassociateS3Resources where
  toJSON :: DisassociateS3Resources -> Value
toJSON DisassociateS3Resources' {[S3Resource]
Maybe Text
associatedS3Resources :: [S3Resource]
memberAccountId :: Maybe Text
$sel:associatedS3Resources:DisassociateS3Resources' :: DisassociateS3Resources -> [S3Resource]
$sel:memberAccountId:DisassociateS3Resources' :: DisassociateS3Resources -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"memberAccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
memberAccountId,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"associatedS3Resources"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [S3Resource]
associatedS3Resources
              )
          ]
      )

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

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

-- | /See:/ 'newDisassociateS3ResourcesResponse' smart constructor.
data DisassociateS3ResourcesResponse = DisassociateS3ResourcesResponse'
  { -- | (Discontinued) S3 resources that couldn\'t be removed from being
    -- monitored and classified by Amazon Macie Classic. An error code and an
    -- error message are provided for each failed item.
    DisassociateS3ResourcesResponse -> Maybe [FailedS3Resource]
failedS3Resources :: Prelude.Maybe [FailedS3Resource],
    -- | The response's http status code.
    DisassociateS3ResourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DisassociateS3ResourcesResponse
-> DisassociateS3ResourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateS3ResourcesResponse
-> DisassociateS3ResourcesResponse -> Bool
$c/= :: DisassociateS3ResourcesResponse
-> DisassociateS3ResourcesResponse -> Bool
== :: DisassociateS3ResourcesResponse
-> DisassociateS3ResourcesResponse -> Bool
$c== :: DisassociateS3ResourcesResponse
-> DisassociateS3ResourcesResponse -> Bool
Prelude.Eq, ReadPrec [DisassociateS3ResourcesResponse]
ReadPrec DisassociateS3ResourcesResponse
Int -> ReadS DisassociateS3ResourcesResponse
ReadS [DisassociateS3ResourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateS3ResourcesResponse]
$creadListPrec :: ReadPrec [DisassociateS3ResourcesResponse]
readPrec :: ReadPrec DisassociateS3ResourcesResponse
$creadPrec :: ReadPrec DisassociateS3ResourcesResponse
readList :: ReadS [DisassociateS3ResourcesResponse]
$creadList :: ReadS [DisassociateS3ResourcesResponse]
readsPrec :: Int -> ReadS DisassociateS3ResourcesResponse
$creadsPrec :: Int -> ReadS DisassociateS3ResourcesResponse
Prelude.Read, Int -> DisassociateS3ResourcesResponse -> ShowS
[DisassociateS3ResourcesResponse] -> ShowS
DisassociateS3ResourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateS3ResourcesResponse] -> ShowS
$cshowList :: [DisassociateS3ResourcesResponse] -> ShowS
show :: DisassociateS3ResourcesResponse -> String
$cshow :: DisassociateS3ResourcesResponse -> String
showsPrec :: Int -> DisassociateS3ResourcesResponse -> ShowS
$cshowsPrec :: Int -> DisassociateS3ResourcesResponse -> ShowS
Prelude.Show, forall x.
Rep DisassociateS3ResourcesResponse x
-> DisassociateS3ResourcesResponse
forall x.
DisassociateS3ResourcesResponse
-> Rep DisassociateS3ResourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateS3ResourcesResponse x
-> DisassociateS3ResourcesResponse
$cfrom :: forall x.
DisassociateS3ResourcesResponse
-> Rep DisassociateS3ResourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateS3ResourcesResponse' 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:
--
-- 'failedS3Resources', 'disassociateS3ResourcesResponse_failedS3Resources' - (Discontinued) S3 resources that couldn\'t be removed from being
-- monitored and classified by Amazon Macie Classic. An error code and an
-- error message are provided for each failed item.
--
-- 'httpStatus', 'disassociateS3ResourcesResponse_httpStatus' - The response's http status code.
newDisassociateS3ResourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DisassociateS3ResourcesResponse
newDisassociateS3ResourcesResponse :: Int -> DisassociateS3ResourcesResponse
newDisassociateS3ResourcesResponse Int
pHttpStatus_ =
  DisassociateS3ResourcesResponse'
    { $sel:failedS3Resources:DisassociateS3ResourcesResponse' :: Maybe [FailedS3Resource]
failedS3Resources =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DisassociateS3ResourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | (Discontinued) S3 resources that couldn\'t be removed from being
-- monitored and classified by Amazon Macie Classic. An error code and an
-- error message are provided for each failed item.
disassociateS3ResourcesResponse_failedS3Resources :: Lens.Lens' DisassociateS3ResourcesResponse (Prelude.Maybe [FailedS3Resource])
disassociateS3ResourcesResponse_failedS3Resources :: Lens' DisassociateS3ResourcesResponse (Maybe [FailedS3Resource])
disassociateS3ResourcesResponse_failedS3Resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateS3ResourcesResponse' {Maybe [FailedS3Resource]
failedS3Resources :: Maybe [FailedS3Resource]
$sel:failedS3Resources:DisassociateS3ResourcesResponse' :: DisassociateS3ResourcesResponse -> Maybe [FailedS3Resource]
failedS3Resources} -> Maybe [FailedS3Resource]
failedS3Resources) (\s :: DisassociateS3ResourcesResponse
s@DisassociateS3ResourcesResponse' {} Maybe [FailedS3Resource]
a -> DisassociateS3ResourcesResponse
s {$sel:failedS3Resources:DisassociateS3ResourcesResponse' :: Maybe [FailedS3Resource]
failedS3Resources = Maybe [FailedS3Resource]
a} :: DisassociateS3ResourcesResponse) 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.
disassociateS3ResourcesResponse_httpStatus :: Lens.Lens' DisassociateS3ResourcesResponse Prelude.Int
disassociateS3ResourcesResponse_httpStatus :: Lens' DisassociateS3ResourcesResponse Int
disassociateS3ResourcesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateS3ResourcesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DisassociateS3ResourcesResponse' :: DisassociateS3ResourcesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DisassociateS3ResourcesResponse
s@DisassociateS3ResourcesResponse' {} Int
a -> DisassociateS3ResourcesResponse
s {$sel:httpStatus:DisassociateS3ResourcesResponse' :: Int
httpStatus = Int
a} :: DisassociateS3ResourcesResponse)

instance
  Prelude.NFData
    DisassociateS3ResourcesResponse
  where
  rnf :: DisassociateS3ResourcesResponse -> ()
rnf DisassociateS3ResourcesResponse' {Int
Maybe [FailedS3Resource]
httpStatus :: Int
failedS3Resources :: Maybe [FailedS3Resource]
$sel:httpStatus:DisassociateS3ResourcesResponse' :: DisassociateS3ResourcesResponse -> Int
$sel:failedS3Resources:DisassociateS3ResourcesResponse' :: DisassociateS3ResourcesResponse -> Maybe [FailedS3Resource]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FailedS3Resource]
failedS3Resources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus