{-# 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.UpdateMemberSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables an Amazon Macie administrator to suspend or re-enable Macie for
-- a member account.
module Amazonka.MacieV2.UpdateMemberSession
  ( -- * Creating a Request
    UpdateMemberSession (..),
    newUpdateMemberSession,

    -- * Request Lenses
    updateMemberSession_id,
    updateMemberSession_status,

    -- * Destructuring the Response
    UpdateMemberSessionResponse (..),
    newUpdateMemberSessionResponse,

    -- * Response Lenses
    updateMemberSessionResponse_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:/ 'newUpdateMemberSession' smart constructor.
data UpdateMemberSession = UpdateMemberSession'
  { -- | The unique identifier for the Amazon Macie resource that the request
    -- applies to.
    UpdateMemberSession -> Text
id :: Prelude.Text,
    -- | Specifies the new status for the account. Valid values are: ENABLED,
    -- resume all Amazon Macie activities for the account; and, PAUSED, suspend
    -- all Macie activities for the account.
    UpdateMemberSession -> MacieStatus
status :: MacieStatus
  }
  deriving (UpdateMemberSession -> UpdateMemberSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMemberSession -> UpdateMemberSession -> Bool
$c/= :: UpdateMemberSession -> UpdateMemberSession -> Bool
== :: UpdateMemberSession -> UpdateMemberSession -> Bool
$c== :: UpdateMemberSession -> UpdateMemberSession -> Bool
Prelude.Eq, ReadPrec [UpdateMemberSession]
ReadPrec UpdateMemberSession
Int -> ReadS UpdateMemberSession
ReadS [UpdateMemberSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMemberSession]
$creadListPrec :: ReadPrec [UpdateMemberSession]
readPrec :: ReadPrec UpdateMemberSession
$creadPrec :: ReadPrec UpdateMemberSession
readList :: ReadS [UpdateMemberSession]
$creadList :: ReadS [UpdateMemberSession]
readsPrec :: Int -> ReadS UpdateMemberSession
$creadsPrec :: Int -> ReadS UpdateMemberSession
Prelude.Read, Int -> UpdateMemberSession -> ShowS
[UpdateMemberSession] -> ShowS
UpdateMemberSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMemberSession] -> ShowS
$cshowList :: [UpdateMemberSession] -> ShowS
show :: UpdateMemberSession -> String
$cshow :: UpdateMemberSession -> String
showsPrec :: Int -> UpdateMemberSession -> ShowS
$cshowsPrec :: Int -> UpdateMemberSession -> ShowS
Prelude.Show, forall x. Rep UpdateMemberSession x -> UpdateMemberSession
forall x. UpdateMemberSession -> Rep UpdateMemberSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMemberSession x -> UpdateMemberSession
$cfrom :: forall x. UpdateMemberSession -> Rep UpdateMemberSession x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMemberSession' 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:
--
-- 'id', 'updateMemberSession_id' - The unique identifier for the Amazon Macie resource that the request
-- applies to.
--
-- 'status', 'updateMemberSession_status' - Specifies the new status for the account. Valid values are: ENABLED,
-- resume all Amazon Macie activities for the account; and, PAUSED, suspend
-- all Macie activities for the account.
newUpdateMemberSession ::
  -- | 'id'
  Prelude.Text ->
  -- | 'status'
  MacieStatus ->
  UpdateMemberSession
newUpdateMemberSession :: Text -> MacieStatus -> UpdateMemberSession
newUpdateMemberSession Text
pId_ MacieStatus
pStatus_ =
  UpdateMemberSession' {$sel:id:UpdateMemberSession' :: Text
id = Text
pId_, $sel:status:UpdateMemberSession' :: MacieStatus
status = MacieStatus
pStatus_}

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

-- | Specifies the new status for the account. Valid values are: ENABLED,
-- resume all Amazon Macie activities for the account; and, PAUSED, suspend
-- all Macie activities for the account.
updateMemberSession_status :: Lens.Lens' UpdateMemberSession MacieStatus
updateMemberSession_status :: Lens' UpdateMemberSession MacieStatus
updateMemberSession_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMemberSession' {MacieStatus
status :: MacieStatus
$sel:status:UpdateMemberSession' :: UpdateMemberSession -> MacieStatus
status} -> MacieStatus
status) (\s :: UpdateMemberSession
s@UpdateMemberSession' {} MacieStatus
a -> UpdateMemberSession
s {$sel:status:UpdateMemberSession' :: MacieStatus
status = MacieStatus
a} :: UpdateMemberSession)

instance Core.AWSRequest UpdateMemberSession where
  type
    AWSResponse UpdateMemberSession =
      UpdateMemberSessionResponse
  request :: (Service -> Service)
-> UpdateMemberSession -> Request UpdateMemberSession
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 UpdateMemberSession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateMemberSession)))
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 -> UpdateMemberSessionResponse
UpdateMemberSessionResponse'
            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 UpdateMemberSession where
  hashWithSalt :: Int -> UpdateMemberSession -> Int
hashWithSalt Int
_salt UpdateMemberSession' {Text
MacieStatus
status :: MacieStatus
id :: Text
$sel:status:UpdateMemberSession' :: UpdateMemberSession -> MacieStatus
$sel:id:UpdateMemberSession' :: UpdateMemberSession -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MacieStatus
status

instance Prelude.NFData UpdateMemberSession where
  rnf :: UpdateMemberSession -> ()
rnf UpdateMemberSession' {Text
MacieStatus
status :: MacieStatus
id :: Text
$sel:status:UpdateMemberSession' :: UpdateMemberSession -> MacieStatus
$sel:id:UpdateMemberSession' :: UpdateMemberSession -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
id seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MacieStatus
status

instance Data.ToHeaders UpdateMemberSession where
  toHeaders :: UpdateMemberSession -> 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 UpdateMemberSession where
  toJSON :: UpdateMemberSession -> Value
toJSON UpdateMemberSession' {Text
MacieStatus
status :: MacieStatus
id :: Text
$sel:status:UpdateMemberSession' :: UpdateMemberSession -> MacieStatus
$sel:id:UpdateMemberSession' :: UpdateMemberSession -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MacieStatus
status)]
      )

instance Data.ToPath UpdateMemberSession where
  toPath :: UpdateMemberSession -> ByteString
toPath UpdateMemberSession' {Text
MacieStatus
status :: MacieStatus
id :: Text
$sel:status:UpdateMemberSession' :: UpdateMemberSession -> MacieStatus
$sel:id:UpdateMemberSession' :: UpdateMemberSession -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/macie/members/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

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

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

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

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