{-# 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.UpdateMacieSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Suspends or re-enables Amazon Macie, or updates the configuration
-- settings for a Macie account.
module Amazonka.MacieV2.UpdateMacieSession
  ( -- * Creating a Request
    UpdateMacieSession (..),
    newUpdateMacieSession,

    -- * Request Lenses
    updateMacieSession_findingPublishingFrequency,
    updateMacieSession_status,

    -- * Destructuring the Response
    UpdateMacieSessionResponse (..),
    newUpdateMacieSessionResponse,

    -- * Response Lenses
    updateMacieSessionResponse_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:/ 'newUpdateMacieSession' smart constructor.
data UpdateMacieSession = UpdateMacieSession'
  { -- | Specifies how often to publish updates to policy findings for the
    -- account. This includes publishing updates to Security Hub and Amazon
    -- EventBridge (formerly Amazon CloudWatch Events).
    UpdateMacieSession -> Maybe FindingPublishingFrequency
findingPublishingFrequency :: Prelude.Maybe FindingPublishingFrequency,
    -- | Specifies a 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.
    UpdateMacieSession -> Maybe MacieStatus
status :: Prelude.Maybe MacieStatus
  }
  deriving (UpdateMacieSession -> UpdateMacieSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMacieSession -> UpdateMacieSession -> Bool
$c/= :: UpdateMacieSession -> UpdateMacieSession -> Bool
== :: UpdateMacieSession -> UpdateMacieSession -> Bool
$c== :: UpdateMacieSession -> UpdateMacieSession -> Bool
Prelude.Eq, ReadPrec [UpdateMacieSession]
ReadPrec UpdateMacieSession
Int -> ReadS UpdateMacieSession
ReadS [UpdateMacieSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMacieSession]
$creadListPrec :: ReadPrec [UpdateMacieSession]
readPrec :: ReadPrec UpdateMacieSession
$creadPrec :: ReadPrec UpdateMacieSession
readList :: ReadS [UpdateMacieSession]
$creadList :: ReadS [UpdateMacieSession]
readsPrec :: Int -> ReadS UpdateMacieSession
$creadsPrec :: Int -> ReadS UpdateMacieSession
Prelude.Read, Int -> UpdateMacieSession -> ShowS
[UpdateMacieSession] -> ShowS
UpdateMacieSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMacieSession] -> ShowS
$cshowList :: [UpdateMacieSession] -> ShowS
show :: UpdateMacieSession -> String
$cshow :: UpdateMacieSession -> String
showsPrec :: Int -> UpdateMacieSession -> ShowS
$cshowsPrec :: Int -> UpdateMacieSession -> ShowS
Prelude.Show, forall x. Rep UpdateMacieSession x -> UpdateMacieSession
forall x. UpdateMacieSession -> Rep UpdateMacieSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMacieSession x -> UpdateMacieSession
$cfrom :: forall x. UpdateMacieSession -> Rep UpdateMacieSession x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMacieSession' 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:
--
-- 'findingPublishingFrequency', 'updateMacieSession_findingPublishingFrequency' - Specifies how often to publish updates to policy findings for the
-- account. This includes publishing updates to Security Hub and Amazon
-- EventBridge (formerly Amazon CloudWatch Events).
--
-- 'status', 'updateMacieSession_status' - Specifies a 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.
newUpdateMacieSession ::
  UpdateMacieSession
newUpdateMacieSession :: UpdateMacieSession
newUpdateMacieSession =
  UpdateMacieSession'
    { $sel:findingPublishingFrequency:UpdateMacieSession' :: Maybe FindingPublishingFrequency
findingPublishingFrequency =
        forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateMacieSession' :: Maybe MacieStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies how often to publish updates to policy findings for the
-- account. This includes publishing updates to Security Hub and Amazon
-- EventBridge (formerly Amazon CloudWatch Events).
updateMacieSession_findingPublishingFrequency :: Lens.Lens' UpdateMacieSession (Prelude.Maybe FindingPublishingFrequency)
updateMacieSession_findingPublishingFrequency :: Lens' UpdateMacieSession (Maybe FindingPublishingFrequency)
updateMacieSession_findingPublishingFrequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMacieSession' {Maybe FindingPublishingFrequency
findingPublishingFrequency :: Maybe FindingPublishingFrequency
$sel:findingPublishingFrequency:UpdateMacieSession' :: UpdateMacieSession -> Maybe FindingPublishingFrequency
findingPublishingFrequency} -> Maybe FindingPublishingFrequency
findingPublishingFrequency) (\s :: UpdateMacieSession
s@UpdateMacieSession' {} Maybe FindingPublishingFrequency
a -> UpdateMacieSession
s {$sel:findingPublishingFrequency:UpdateMacieSession' :: Maybe FindingPublishingFrequency
findingPublishingFrequency = Maybe FindingPublishingFrequency
a} :: UpdateMacieSession)

-- | Specifies a 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.
updateMacieSession_status :: Lens.Lens' UpdateMacieSession (Prelude.Maybe MacieStatus)
updateMacieSession_status :: Lens' UpdateMacieSession (Maybe MacieStatus)
updateMacieSession_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMacieSession' {Maybe MacieStatus
status :: Maybe MacieStatus
$sel:status:UpdateMacieSession' :: UpdateMacieSession -> Maybe MacieStatus
status} -> Maybe MacieStatus
status) (\s :: UpdateMacieSession
s@UpdateMacieSession' {} Maybe MacieStatus
a -> UpdateMacieSession
s {$sel:status:UpdateMacieSession' :: Maybe MacieStatus
status = Maybe MacieStatus
a} :: UpdateMacieSession)

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

instance Prelude.NFData UpdateMacieSession where
  rnf :: UpdateMacieSession -> ()
rnf UpdateMacieSession' {Maybe FindingPublishingFrequency
Maybe MacieStatus
status :: Maybe MacieStatus
findingPublishingFrequency :: Maybe FindingPublishingFrequency
$sel:status:UpdateMacieSession' :: UpdateMacieSession -> Maybe MacieStatus
$sel:findingPublishingFrequency:UpdateMacieSession' :: UpdateMacieSession -> Maybe FindingPublishingFrequency
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FindingPublishingFrequency
findingPublishingFrequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MacieStatus
status

instance Data.ToHeaders UpdateMacieSession where
  toHeaders :: UpdateMacieSession -> 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 UpdateMacieSession where
  toJSON :: UpdateMacieSession -> Value
toJSON UpdateMacieSession' {Maybe FindingPublishingFrequency
Maybe MacieStatus
status :: Maybe MacieStatus
findingPublishingFrequency :: Maybe FindingPublishingFrequency
$sel:status:UpdateMacieSession' :: UpdateMacieSession -> Maybe MacieStatus
$sel:findingPublishingFrequency:UpdateMacieSession' :: UpdateMacieSession -> Maybe FindingPublishingFrequency
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"findingPublishingFrequency" 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 FindingPublishingFrequency
findingPublishingFrequency,
            (Key
"status" 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 MacieStatus
status
          ]
      )

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

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

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

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

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

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