{-# 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.MacieV2.UpdateClassificationScope
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the classification scope settings for an account.
module Amazonka.MacieV2.UpdateClassificationScope
  ( -- * Creating a Request
    UpdateClassificationScope (..),
    newUpdateClassificationScope,

    -- * Request Lenses
    updateClassificationScope_s3,
    updateClassificationScope_id,

    -- * Destructuring the Response
    UpdateClassificationScopeResponse (..),
    newUpdateClassificationScopeResponse,

    -- * Response Lenses
    updateClassificationScopeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateClassificationScope' smart constructor.
data UpdateClassificationScope = UpdateClassificationScope'
  { -- | The S3 buckets to add or remove from the exclusion list defined by the
    -- classification scope.
    UpdateClassificationScope -> Maybe S3ClassificationScopeUpdate
s3 :: Prelude.Maybe S3ClassificationScopeUpdate,
    -- | The unique identifier for the Amazon Macie resource that the request
    -- applies to.
    UpdateClassificationScope -> Text
id :: Prelude.Text
  }
  deriving (UpdateClassificationScope -> UpdateClassificationScope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateClassificationScope -> UpdateClassificationScope -> Bool
$c/= :: UpdateClassificationScope -> UpdateClassificationScope -> Bool
== :: UpdateClassificationScope -> UpdateClassificationScope -> Bool
$c== :: UpdateClassificationScope -> UpdateClassificationScope -> Bool
Prelude.Eq, ReadPrec [UpdateClassificationScope]
ReadPrec UpdateClassificationScope
Int -> ReadS UpdateClassificationScope
ReadS [UpdateClassificationScope]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateClassificationScope]
$creadListPrec :: ReadPrec [UpdateClassificationScope]
readPrec :: ReadPrec UpdateClassificationScope
$creadPrec :: ReadPrec UpdateClassificationScope
readList :: ReadS [UpdateClassificationScope]
$creadList :: ReadS [UpdateClassificationScope]
readsPrec :: Int -> ReadS UpdateClassificationScope
$creadsPrec :: Int -> ReadS UpdateClassificationScope
Prelude.Read, Int -> UpdateClassificationScope -> ShowS
[UpdateClassificationScope] -> ShowS
UpdateClassificationScope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateClassificationScope] -> ShowS
$cshowList :: [UpdateClassificationScope] -> ShowS
show :: UpdateClassificationScope -> String
$cshow :: UpdateClassificationScope -> String
showsPrec :: Int -> UpdateClassificationScope -> ShowS
$cshowsPrec :: Int -> UpdateClassificationScope -> ShowS
Prelude.Show, forall x.
Rep UpdateClassificationScope x -> UpdateClassificationScope
forall x.
UpdateClassificationScope -> Rep UpdateClassificationScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateClassificationScope x -> UpdateClassificationScope
$cfrom :: forall x.
UpdateClassificationScope -> Rep UpdateClassificationScope x
Prelude.Generic)

-- |
-- Create a value of 'UpdateClassificationScope' 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:
--
-- 's3', 'updateClassificationScope_s3' - The S3 buckets to add or remove from the exclusion list defined by the
-- classification scope.
--
-- 'id', 'updateClassificationScope_id' - The unique identifier for the Amazon Macie resource that the request
-- applies to.
newUpdateClassificationScope ::
  -- | 'id'
  Prelude.Text ->
  UpdateClassificationScope
newUpdateClassificationScope :: Text -> UpdateClassificationScope
newUpdateClassificationScope Text
pId_ =
  UpdateClassificationScope'
    { $sel:s3:UpdateClassificationScope' :: Maybe S3ClassificationScopeUpdate
s3 = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateClassificationScope' :: Text
id = Text
pId_
    }

-- | The S3 buckets to add or remove from the exclusion list defined by the
-- classification scope.
updateClassificationScope_s3 :: Lens.Lens' UpdateClassificationScope (Prelude.Maybe S3ClassificationScopeUpdate)
updateClassificationScope_s3 :: Lens' UpdateClassificationScope (Maybe S3ClassificationScopeUpdate)
updateClassificationScope_s3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClassificationScope' {Maybe S3ClassificationScopeUpdate
s3 :: Maybe S3ClassificationScopeUpdate
$sel:s3:UpdateClassificationScope' :: UpdateClassificationScope -> Maybe S3ClassificationScopeUpdate
s3} -> Maybe S3ClassificationScopeUpdate
s3) (\s :: UpdateClassificationScope
s@UpdateClassificationScope' {} Maybe S3ClassificationScopeUpdate
a -> UpdateClassificationScope
s {$sel:s3:UpdateClassificationScope' :: Maybe S3ClassificationScopeUpdate
s3 = Maybe S3ClassificationScopeUpdate
a} :: UpdateClassificationScope)

-- | The unique identifier for the Amazon Macie resource that the request
-- applies to.
updateClassificationScope_id :: Lens.Lens' UpdateClassificationScope Prelude.Text
updateClassificationScope_id :: Lens' UpdateClassificationScope Text
updateClassificationScope_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClassificationScope' {Text
id :: Text
$sel:id:UpdateClassificationScope' :: UpdateClassificationScope -> Text
id} -> Text
id) (\s :: UpdateClassificationScope
s@UpdateClassificationScope' {} Text
a -> UpdateClassificationScope
s {$sel:id:UpdateClassificationScope' :: Text
id = Text
a} :: UpdateClassificationScope)

instance Core.AWSRequest UpdateClassificationScope where
  type
    AWSResponse UpdateClassificationScope =
      UpdateClassificationScopeResponse
  request :: (Service -> Service)
-> UpdateClassificationScope -> Request UpdateClassificationScope
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 UpdateClassificationScope
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateClassificationScope)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateClassificationScopeResponse
UpdateClassificationScopeResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateClassificationScope where
  hashWithSalt :: Int -> UpdateClassificationScope -> Int
hashWithSalt Int
_salt UpdateClassificationScope' {Maybe S3ClassificationScopeUpdate
Text
id :: Text
s3 :: Maybe S3ClassificationScopeUpdate
$sel:id:UpdateClassificationScope' :: UpdateClassificationScope -> Text
$sel:s3:UpdateClassificationScope' :: UpdateClassificationScope -> Maybe S3ClassificationScopeUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3ClassificationScopeUpdate
s3
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData UpdateClassificationScope where
  rnf :: UpdateClassificationScope -> ()
rnf UpdateClassificationScope' {Maybe S3ClassificationScopeUpdate
Text
id :: Text
s3 :: Maybe S3ClassificationScopeUpdate
$sel:id:UpdateClassificationScope' :: UpdateClassificationScope -> Text
$sel:s3:UpdateClassificationScope' :: UpdateClassificationScope -> Maybe S3ClassificationScopeUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe S3ClassificationScopeUpdate
s3 seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders UpdateClassificationScope where
  toHeaders :: UpdateClassificationScope -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateClassificationScope where
  toJSON :: UpdateClassificationScope -> Value
toJSON UpdateClassificationScope' {Maybe S3ClassificationScopeUpdate
Text
id :: Text
s3 :: Maybe S3ClassificationScopeUpdate
$sel:id:UpdateClassificationScope' :: UpdateClassificationScope -> Text
$sel:s3:UpdateClassificationScope' :: UpdateClassificationScope -> Maybe S3ClassificationScopeUpdate
..} =
    [Pair] -> Value
Data.object
      (forall a. [Maybe a] -> [a]
Prelude.catMaybes [(Key
"s3" 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 S3ClassificationScopeUpdate
s3])

instance Data.ToPath UpdateClassificationScope where
  toPath :: UpdateClassificationScope -> ByteString
toPath UpdateClassificationScope' {Maybe S3ClassificationScopeUpdate
Text
id :: Text
s3 :: Maybe S3ClassificationScopeUpdate
$sel:id:UpdateClassificationScope' :: UpdateClassificationScope -> Text
$sel:s3:UpdateClassificationScope' :: UpdateClassificationScope -> Maybe S3ClassificationScopeUpdate
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/classification-scopes/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

-- | /See:/ 'newUpdateClassificationScopeResponse' smart constructor.
data UpdateClassificationScopeResponse = UpdateClassificationScopeResponse'
  { -- | The response's http status code.
    UpdateClassificationScopeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateClassificationScopeResponse
-> UpdateClassificationScopeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateClassificationScopeResponse
-> UpdateClassificationScopeResponse -> Bool
$c/= :: UpdateClassificationScopeResponse
-> UpdateClassificationScopeResponse -> Bool
== :: UpdateClassificationScopeResponse
-> UpdateClassificationScopeResponse -> Bool
$c== :: UpdateClassificationScopeResponse
-> UpdateClassificationScopeResponse -> Bool
Prelude.Eq, ReadPrec [UpdateClassificationScopeResponse]
ReadPrec UpdateClassificationScopeResponse
Int -> ReadS UpdateClassificationScopeResponse
ReadS [UpdateClassificationScopeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateClassificationScopeResponse]
$creadListPrec :: ReadPrec [UpdateClassificationScopeResponse]
readPrec :: ReadPrec UpdateClassificationScopeResponse
$creadPrec :: ReadPrec UpdateClassificationScopeResponse
readList :: ReadS [UpdateClassificationScopeResponse]
$creadList :: ReadS [UpdateClassificationScopeResponse]
readsPrec :: Int -> ReadS UpdateClassificationScopeResponse
$creadsPrec :: Int -> ReadS UpdateClassificationScopeResponse
Prelude.Read, Int -> UpdateClassificationScopeResponse -> ShowS
[UpdateClassificationScopeResponse] -> ShowS
UpdateClassificationScopeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateClassificationScopeResponse] -> ShowS
$cshowList :: [UpdateClassificationScopeResponse] -> ShowS
show :: UpdateClassificationScopeResponse -> String
$cshow :: UpdateClassificationScopeResponse -> String
showsPrec :: Int -> UpdateClassificationScopeResponse -> ShowS
$cshowsPrec :: Int -> UpdateClassificationScopeResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateClassificationScopeResponse x
-> UpdateClassificationScopeResponse
forall x.
UpdateClassificationScopeResponse
-> Rep UpdateClassificationScopeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateClassificationScopeResponse x
-> UpdateClassificationScopeResponse
$cfrom :: forall x.
UpdateClassificationScopeResponse
-> Rep UpdateClassificationScopeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateClassificationScopeResponse' 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:
--
-- 'httpStatus', 'updateClassificationScopeResponse_httpStatus' - The response's http status code.
newUpdateClassificationScopeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateClassificationScopeResponse
newUpdateClassificationScopeResponse :: Int -> UpdateClassificationScopeResponse
newUpdateClassificationScopeResponse Int
pHttpStatus_ =
  UpdateClassificationScopeResponse'
    { $sel:httpStatus:UpdateClassificationScopeResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | The response's http status code.
updateClassificationScopeResponse_httpStatus :: Lens.Lens' UpdateClassificationScopeResponse Prelude.Int
updateClassificationScopeResponse_httpStatus :: Lens' UpdateClassificationScopeResponse Int
updateClassificationScopeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClassificationScopeResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateClassificationScopeResponse' :: UpdateClassificationScopeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateClassificationScopeResponse
s@UpdateClassificationScopeResponse' {} Int
a -> UpdateClassificationScopeResponse
s {$sel:httpStatus:UpdateClassificationScopeResponse' :: Int
httpStatus = Int
a} :: UpdateClassificationScopeResponse)

instance
  Prelude.NFData
    UpdateClassificationScopeResponse
  where
  rnf :: UpdateClassificationScopeResponse -> ()
rnf UpdateClassificationScopeResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateClassificationScopeResponse' :: UpdateClassificationScopeResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus