{-# 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.AssociateS3Resources
-- 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) Associates specified S3 resources with Amazon Macie
-- Classic for monitoring and data classification. If @memberAccountId@
-- isn\'t specified, the action associates specified S3 resources with
-- Macie Classic for the current Macie Classic administrator account. If
-- @memberAccountId@ is specified, the action associates specified S3
-- resources with Macie Classic for the specified member account.
module Amazonka.Macie.AssociateS3Resources
  ( -- * Creating a Request
    AssociateS3Resources (..),
    newAssociateS3Resources,

    -- * Request Lenses
    associateS3Resources_memberAccountId,
    associateS3Resources_s3Resources,

    -- * Destructuring the Response
    AssociateS3ResourcesResponse (..),
    newAssociateS3ResourcesResponse,

    -- * Response Lenses
    associateS3ResourcesResponse_failedS3Resources,
    associateS3ResourcesResponse_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:/ 'newAssociateS3Resources' smart constructor.
data AssociateS3Resources = AssociateS3Resources'
  { -- | (Discontinued) The ID of the Amazon Macie Classic member account whose
    -- resources you want to associate with Macie Classic.
    AssociateS3Resources -> Maybe Text
memberAccountId :: Prelude.Maybe Prelude.Text,
    -- | (Discontinued) The S3 resources that you want to associate with Amazon
    -- Macie Classic for monitoring and data classification.
    AssociateS3Resources -> [S3ResourceClassification]
s3Resources :: [S3ResourceClassification]
  }
  deriving (AssociateS3Resources -> AssociateS3Resources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateS3Resources -> AssociateS3Resources -> Bool
$c/= :: AssociateS3Resources -> AssociateS3Resources -> Bool
== :: AssociateS3Resources -> AssociateS3Resources -> Bool
$c== :: AssociateS3Resources -> AssociateS3Resources -> Bool
Prelude.Eq, ReadPrec [AssociateS3Resources]
ReadPrec AssociateS3Resources
Int -> ReadS AssociateS3Resources
ReadS [AssociateS3Resources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateS3Resources]
$creadListPrec :: ReadPrec [AssociateS3Resources]
readPrec :: ReadPrec AssociateS3Resources
$creadPrec :: ReadPrec AssociateS3Resources
readList :: ReadS [AssociateS3Resources]
$creadList :: ReadS [AssociateS3Resources]
readsPrec :: Int -> ReadS AssociateS3Resources
$creadsPrec :: Int -> ReadS AssociateS3Resources
Prelude.Read, Int -> AssociateS3Resources -> ShowS
[AssociateS3Resources] -> ShowS
AssociateS3Resources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateS3Resources] -> ShowS
$cshowList :: [AssociateS3Resources] -> ShowS
show :: AssociateS3Resources -> String
$cshow :: AssociateS3Resources -> String
showsPrec :: Int -> AssociateS3Resources -> ShowS
$cshowsPrec :: Int -> AssociateS3Resources -> ShowS
Prelude.Show, forall x. Rep AssociateS3Resources x -> AssociateS3Resources
forall x. AssociateS3Resources -> Rep AssociateS3Resources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateS3Resources x -> AssociateS3Resources
$cfrom :: forall x. AssociateS3Resources -> Rep AssociateS3Resources x
Prelude.Generic)

-- |
-- Create a value of 'AssociateS3Resources' 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', 'associateS3Resources_memberAccountId' - (Discontinued) The ID of the Amazon Macie Classic member account whose
-- resources you want to associate with Macie Classic.
--
-- 's3Resources', 'associateS3Resources_s3Resources' - (Discontinued) The S3 resources that you want to associate with Amazon
-- Macie Classic for monitoring and data classification.
newAssociateS3Resources ::
  AssociateS3Resources
newAssociateS3Resources :: AssociateS3Resources
newAssociateS3Resources =
  AssociateS3Resources'
    { $sel:memberAccountId:AssociateS3Resources' :: Maybe Text
memberAccountId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:s3Resources:AssociateS3Resources' :: [S3ResourceClassification]
s3Resources = forall a. Monoid a => a
Prelude.mempty
    }

-- | (Discontinued) The ID of the Amazon Macie Classic member account whose
-- resources you want to associate with Macie Classic.
associateS3Resources_memberAccountId :: Lens.Lens' AssociateS3Resources (Prelude.Maybe Prelude.Text)
associateS3Resources_memberAccountId :: Lens' AssociateS3Resources (Maybe Text)
associateS3Resources_memberAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateS3Resources' {Maybe Text
memberAccountId :: Maybe Text
$sel:memberAccountId:AssociateS3Resources' :: AssociateS3Resources -> Maybe Text
memberAccountId} -> Maybe Text
memberAccountId) (\s :: AssociateS3Resources
s@AssociateS3Resources' {} Maybe Text
a -> AssociateS3Resources
s {$sel:memberAccountId:AssociateS3Resources' :: Maybe Text
memberAccountId = Maybe Text
a} :: AssociateS3Resources)

-- | (Discontinued) The S3 resources that you want to associate with Amazon
-- Macie Classic for monitoring and data classification.
associateS3Resources_s3Resources :: Lens.Lens' AssociateS3Resources [S3ResourceClassification]
associateS3Resources_s3Resources :: Lens' AssociateS3Resources [S3ResourceClassification]
associateS3Resources_s3Resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateS3Resources' {[S3ResourceClassification]
s3Resources :: [S3ResourceClassification]
$sel:s3Resources:AssociateS3Resources' :: AssociateS3Resources -> [S3ResourceClassification]
s3Resources} -> [S3ResourceClassification]
s3Resources) (\s :: AssociateS3Resources
s@AssociateS3Resources' {} [S3ResourceClassification]
a -> AssociateS3Resources
s {$sel:s3Resources:AssociateS3Resources' :: [S3ResourceClassification]
s3Resources = [S3ResourceClassification]
a} :: AssociateS3Resources) 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 AssociateS3Resources where
  type
    AWSResponse AssociateS3Resources =
      AssociateS3ResourcesResponse
  request :: (Service -> Service)
-> AssociateS3Resources -> Request AssociateS3Resources
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 AssociateS3Resources
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateS3Resources)))
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 -> AssociateS3ResourcesResponse
AssociateS3ResourcesResponse'
            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 AssociateS3Resources where
  hashWithSalt :: Int -> AssociateS3Resources -> Int
hashWithSalt Int
_salt AssociateS3Resources' {[S3ResourceClassification]
Maybe Text
s3Resources :: [S3ResourceClassification]
memberAccountId :: Maybe Text
$sel:s3Resources:AssociateS3Resources' :: AssociateS3Resources -> [S3ResourceClassification]
$sel:memberAccountId:AssociateS3Resources' :: AssociateS3Resources -> 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` [S3ResourceClassification]
s3Resources

instance Prelude.NFData AssociateS3Resources where
  rnf :: AssociateS3Resources -> ()
rnf AssociateS3Resources' {[S3ResourceClassification]
Maybe Text
s3Resources :: [S3ResourceClassification]
memberAccountId :: Maybe Text
$sel:s3Resources:AssociateS3Resources' :: AssociateS3Resources -> [S3ResourceClassification]
$sel:memberAccountId:AssociateS3Resources' :: AssociateS3Resources -> 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 [S3ResourceClassification]
s3Resources

instance Data.ToHeaders AssociateS3Resources where
  toHeaders :: AssociateS3Resources -> 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.AssociateS3Resources" ::
                          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 AssociateS3Resources where
  toJSON :: AssociateS3Resources -> Value
toJSON AssociateS3Resources' {[S3ResourceClassification]
Maybe Text
s3Resources :: [S3ResourceClassification]
memberAccountId :: Maybe Text
$sel:s3Resources:AssociateS3Resources' :: AssociateS3Resources -> [S3ResourceClassification]
$sel:memberAccountId:AssociateS3Resources' :: AssociateS3Resources -> 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
"s3Resources" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [S3ResourceClassification]
s3Resources)
          ]
      )

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

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

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

-- |
-- Create a value of 'AssociateS3ResourcesResponse' 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', 'associateS3ResourcesResponse_failedS3Resources' - (Discontinued) S3 resources that couldn\'t be associated with Amazon
-- Macie Classic. An error code and an error message are provided for each
-- failed item.
--
-- 'httpStatus', 'associateS3ResourcesResponse_httpStatus' - The response's http status code.
newAssociateS3ResourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateS3ResourcesResponse
newAssociateS3ResourcesResponse :: Int -> AssociateS3ResourcesResponse
newAssociateS3ResourcesResponse Int
pHttpStatus_ =
  AssociateS3ResourcesResponse'
    { $sel:failedS3Resources:AssociateS3ResourcesResponse' :: Maybe [FailedS3Resource]
failedS3Resources =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateS3ResourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

instance Prelude.NFData AssociateS3ResourcesResponse where
  rnf :: AssociateS3ResourcesResponse -> ()
rnf AssociateS3ResourcesResponse' {Int
Maybe [FailedS3Resource]
httpStatus :: Int
failedS3Resources :: Maybe [FailedS3Resource]
$sel:httpStatus:AssociateS3ResourcesResponse' :: AssociateS3ResourcesResponse -> Int
$sel:failedS3Resources:AssociateS3ResourcesResponse' :: AssociateS3ResourcesResponse -> 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