{-# 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.GetMacieSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the status and configuration settings for an Amazon Macie
-- account.
module Amazonka.MacieV2.GetMacieSession
  ( -- * Creating a Request
    GetMacieSession (..),
    newGetMacieSession,

    -- * Destructuring the Response
    GetMacieSessionResponse (..),
    newGetMacieSessionResponse,

    -- * Response Lenses
    getMacieSessionResponse_createdAt,
    getMacieSessionResponse_findingPublishingFrequency,
    getMacieSessionResponse_serviceRole,
    getMacieSessionResponse_status,
    getMacieSessionResponse_updatedAt,
    getMacieSessionResponse_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:/ 'newGetMacieSession' smart constructor.
data GetMacieSession = GetMacieSession'
  {
  }
  deriving (GetMacieSession -> GetMacieSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMacieSession -> GetMacieSession -> Bool
$c/= :: GetMacieSession -> GetMacieSession -> Bool
== :: GetMacieSession -> GetMacieSession -> Bool
$c== :: GetMacieSession -> GetMacieSession -> Bool
Prelude.Eq, ReadPrec [GetMacieSession]
ReadPrec GetMacieSession
Int -> ReadS GetMacieSession
ReadS [GetMacieSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMacieSession]
$creadListPrec :: ReadPrec [GetMacieSession]
readPrec :: ReadPrec GetMacieSession
$creadPrec :: ReadPrec GetMacieSession
readList :: ReadS [GetMacieSession]
$creadList :: ReadS [GetMacieSession]
readsPrec :: Int -> ReadS GetMacieSession
$creadsPrec :: Int -> ReadS GetMacieSession
Prelude.Read, Int -> GetMacieSession -> ShowS
[GetMacieSession] -> ShowS
GetMacieSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMacieSession] -> ShowS
$cshowList :: [GetMacieSession] -> ShowS
show :: GetMacieSession -> String
$cshow :: GetMacieSession -> String
showsPrec :: Int -> GetMacieSession -> ShowS
$cshowsPrec :: Int -> GetMacieSession -> ShowS
Prelude.Show, forall x. Rep GetMacieSession x -> GetMacieSession
forall x. GetMacieSession -> Rep GetMacieSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMacieSession x -> GetMacieSession
$cfrom :: forall x. GetMacieSession -> Rep GetMacieSession x
Prelude.Generic)

-- |
-- Create a value of 'GetMacieSession' 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.
newGetMacieSession ::
  GetMacieSession
newGetMacieSession :: GetMacieSession
newGetMacieSession = GetMacieSession
GetMacieSession'

instance Core.AWSRequest GetMacieSession where
  type
    AWSResponse GetMacieSession =
      GetMacieSessionResponse
  request :: (Service -> Service) -> GetMacieSession -> Request GetMacieSession
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetMacieSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMacieSession)))
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 ISO8601
-> Maybe FindingPublishingFrequency
-> Maybe Text
-> Maybe MacieStatus
-> Maybe ISO8601
-> Int
-> GetMacieSessionResponse
GetMacieSessionResponse'
            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
"createdAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"findingPublishingFrequency")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"serviceRole")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"updatedAt")
            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 GetMacieSession where
  hashWithSalt :: Int -> GetMacieSession -> Int
hashWithSalt Int
_salt GetMacieSession
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData GetMacieSession where
  rnf :: GetMacieSession -> ()
rnf GetMacieSession
_ = ()

instance Data.ToHeaders GetMacieSession where
  toHeaders :: GetMacieSession -> 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.ToPath GetMacieSession where
  toPath :: GetMacieSession -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/macie"

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

-- | /See:/ 'newGetMacieSessionResponse' smart constructor.
data GetMacieSessionResponse = GetMacieSessionResponse'
  { -- | The date and time, in UTC and extended ISO 8601 format, when the Amazon
    -- Macie account was created.
    GetMacieSessionResponse -> Maybe ISO8601
createdAt :: Prelude.Maybe Data.ISO8601,
    -- | The frequency with which Amazon Macie publishes updates to policy
    -- findings for the account. This includes publishing updates to Security
    -- Hub and Amazon EventBridge (formerly Amazon CloudWatch Events).
    GetMacieSessionResponse -> Maybe FindingPublishingFrequency
findingPublishingFrequency :: Prelude.Maybe FindingPublishingFrequency,
    -- | The Amazon Resource Name (ARN) of the service-linked role that allows
    -- Amazon Macie to monitor and analyze data in Amazon Web Services
    -- resources for the account.
    GetMacieSessionResponse -> Maybe Text
serviceRole :: Prelude.Maybe Prelude.Text,
    -- | The current status of the Amazon Macie account. Possible values are:
    -- PAUSED, the account is enabled but all Macie activities are suspended
    -- (paused) for the account; and, ENABLED, the account is enabled and all
    -- Macie activities are enabled for the account.
    GetMacieSessionResponse -> Maybe MacieStatus
status :: Prelude.Maybe MacieStatus,
    -- | The date and time, in UTC and extended ISO 8601 format, of the most
    -- recent change to the status of the Amazon Macie account.
    GetMacieSessionResponse -> Maybe ISO8601
updatedAt :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    GetMacieSessionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMacieSessionResponse -> GetMacieSessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMacieSessionResponse -> GetMacieSessionResponse -> Bool
$c/= :: GetMacieSessionResponse -> GetMacieSessionResponse -> Bool
== :: GetMacieSessionResponse -> GetMacieSessionResponse -> Bool
$c== :: GetMacieSessionResponse -> GetMacieSessionResponse -> Bool
Prelude.Eq, ReadPrec [GetMacieSessionResponse]
ReadPrec GetMacieSessionResponse
Int -> ReadS GetMacieSessionResponse
ReadS [GetMacieSessionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMacieSessionResponse]
$creadListPrec :: ReadPrec [GetMacieSessionResponse]
readPrec :: ReadPrec GetMacieSessionResponse
$creadPrec :: ReadPrec GetMacieSessionResponse
readList :: ReadS [GetMacieSessionResponse]
$creadList :: ReadS [GetMacieSessionResponse]
readsPrec :: Int -> ReadS GetMacieSessionResponse
$creadsPrec :: Int -> ReadS GetMacieSessionResponse
Prelude.Read, Int -> GetMacieSessionResponse -> ShowS
[GetMacieSessionResponse] -> ShowS
GetMacieSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMacieSessionResponse] -> ShowS
$cshowList :: [GetMacieSessionResponse] -> ShowS
show :: GetMacieSessionResponse -> String
$cshow :: GetMacieSessionResponse -> String
showsPrec :: Int -> GetMacieSessionResponse -> ShowS
$cshowsPrec :: Int -> GetMacieSessionResponse -> ShowS
Prelude.Show, forall x. Rep GetMacieSessionResponse x -> GetMacieSessionResponse
forall x. GetMacieSessionResponse -> Rep GetMacieSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMacieSessionResponse x -> GetMacieSessionResponse
$cfrom :: forall x. GetMacieSessionResponse -> Rep GetMacieSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMacieSessionResponse' 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:
--
-- 'createdAt', 'getMacieSessionResponse_createdAt' - The date and time, in UTC and extended ISO 8601 format, when the Amazon
-- Macie account was created.
--
-- 'findingPublishingFrequency', 'getMacieSessionResponse_findingPublishingFrequency' - The frequency with which Amazon Macie publishes updates to policy
-- findings for the account. This includes publishing updates to Security
-- Hub and Amazon EventBridge (formerly Amazon CloudWatch Events).
--
-- 'serviceRole', 'getMacieSessionResponse_serviceRole' - The Amazon Resource Name (ARN) of the service-linked role that allows
-- Amazon Macie to monitor and analyze data in Amazon Web Services
-- resources for the account.
--
-- 'status', 'getMacieSessionResponse_status' - The current status of the Amazon Macie account. Possible values are:
-- PAUSED, the account is enabled but all Macie activities are suspended
-- (paused) for the account; and, ENABLED, the account is enabled and all
-- Macie activities are enabled for the account.
--
-- 'updatedAt', 'getMacieSessionResponse_updatedAt' - The date and time, in UTC and extended ISO 8601 format, of the most
-- recent change to the status of the Amazon Macie account.
--
-- 'httpStatus', 'getMacieSessionResponse_httpStatus' - The response's http status code.
newGetMacieSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMacieSessionResponse
newGetMacieSessionResponse :: Int -> GetMacieSessionResponse
newGetMacieSessionResponse Int
pHttpStatus_ =
  GetMacieSessionResponse'
    { $sel:createdAt:GetMacieSessionResponse' :: Maybe ISO8601
createdAt =
        forall a. Maybe a
Prelude.Nothing,
      $sel:findingPublishingFrequency:GetMacieSessionResponse' :: Maybe FindingPublishingFrequency
findingPublishingFrequency = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRole:GetMacieSessionResponse' :: Maybe Text
serviceRole = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetMacieSessionResponse' :: Maybe MacieStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedAt:GetMacieSessionResponse' :: Maybe ISO8601
updatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMacieSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time, in UTC and extended ISO 8601 format, when the Amazon
-- Macie account was created.
getMacieSessionResponse_createdAt :: Lens.Lens' GetMacieSessionResponse (Prelude.Maybe Prelude.UTCTime)
getMacieSessionResponse_createdAt :: Lens' GetMacieSessionResponse (Maybe UTCTime)
getMacieSessionResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMacieSessionResponse' {Maybe ISO8601
createdAt :: Maybe ISO8601
$sel:createdAt:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe ISO8601
createdAt} -> Maybe ISO8601
createdAt) (\s :: GetMacieSessionResponse
s@GetMacieSessionResponse' {} Maybe ISO8601
a -> GetMacieSessionResponse
s {$sel:createdAt:GetMacieSessionResponse' :: Maybe ISO8601
createdAt = Maybe ISO8601
a} :: GetMacieSessionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The frequency with which Amazon Macie publishes updates to policy
-- findings for the account. This includes publishing updates to Security
-- Hub and Amazon EventBridge (formerly Amazon CloudWatch Events).
getMacieSessionResponse_findingPublishingFrequency :: Lens.Lens' GetMacieSessionResponse (Prelude.Maybe FindingPublishingFrequency)
getMacieSessionResponse_findingPublishingFrequency :: Lens' GetMacieSessionResponse (Maybe FindingPublishingFrequency)
getMacieSessionResponse_findingPublishingFrequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMacieSessionResponse' {Maybe FindingPublishingFrequency
findingPublishingFrequency :: Maybe FindingPublishingFrequency
$sel:findingPublishingFrequency:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe FindingPublishingFrequency
findingPublishingFrequency} -> Maybe FindingPublishingFrequency
findingPublishingFrequency) (\s :: GetMacieSessionResponse
s@GetMacieSessionResponse' {} Maybe FindingPublishingFrequency
a -> GetMacieSessionResponse
s {$sel:findingPublishingFrequency:GetMacieSessionResponse' :: Maybe FindingPublishingFrequency
findingPublishingFrequency = Maybe FindingPublishingFrequency
a} :: GetMacieSessionResponse)

-- | The Amazon Resource Name (ARN) of the service-linked role that allows
-- Amazon Macie to monitor and analyze data in Amazon Web Services
-- resources for the account.
getMacieSessionResponse_serviceRole :: Lens.Lens' GetMacieSessionResponse (Prelude.Maybe Prelude.Text)
getMacieSessionResponse_serviceRole :: Lens' GetMacieSessionResponse (Maybe Text)
getMacieSessionResponse_serviceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMacieSessionResponse' {Maybe Text
serviceRole :: Maybe Text
$sel:serviceRole:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe Text
serviceRole} -> Maybe Text
serviceRole) (\s :: GetMacieSessionResponse
s@GetMacieSessionResponse' {} Maybe Text
a -> GetMacieSessionResponse
s {$sel:serviceRole:GetMacieSessionResponse' :: Maybe Text
serviceRole = Maybe Text
a} :: GetMacieSessionResponse)

-- | The current status of the Amazon Macie account. Possible values are:
-- PAUSED, the account is enabled but all Macie activities are suspended
-- (paused) for the account; and, ENABLED, the account is enabled and all
-- Macie activities are enabled for the account.
getMacieSessionResponse_status :: Lens.Lens' GetMacieSessionResponse (Prelude.Maybe MacieStatus)
getMacieSessionResponse_status :: Lens' GetMacieSessionResponse (Maybe MacieStatus)
getMacieSessionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMacieSessionResponse' {Maybe MacieStatus
status :: Maybe MacieStatus
$sel:status:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe MacieStatus
status} -> Maybe MacieStatus
status) (\s :: GetMacieSessionResponse
s@GetMacieSessionResponse' {} Maybe MacieStatus
a -> GetMacieSessionResponse
s {$sel:status:GetMacieSessionResponse' :: Maybe MacieStatus
status = Maybe MacieStatus
a} :: GetMacieSessionResponse)

-- | The date and time, in UTC and extended ISO 8601 format, of the most
-- recent change to the status of the Amazon Macie account.
getMacieSessionResponse_updatedAt :: Lens.Lens' GetMacieSessionResponse (Prelude.Maybe Prelude.UTCTime)
getMacieSessionResponse_updatedAt :: Lens' GetMacieSessionResponse (Maybe UTCTime)
getMacieSessionResponse_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMacieSessionResponse' {Maybe ISO8601
updatedAt :: Maybe ISO8601
$sel:updatedAt:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe ISO8601
updatedAt} -> Maybe ISO8601
updatedAt) (\s :: GetMacieSessionResponse
s@GetMacieSessionResponse' {} Maybe ISO8601
a -> GetMacieSessionResponse
s {$sel:updatedAt:GetMacieSessionResponse' :: Maybe ISO8601
updatedAt = Maybe ISO8601
a} :: GetMacieSessionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData GetMacieSessionResponse where
  rnf :: GetMacieSessionResponse -> ()
rnf GetMacieSessionResponse' {Int
Maybe Text
Maybe ISO8601
Maybe FindingPublishingFrequency
Maybe MacieStatus
httpStatus :: Int
updatedAt :: Maybe ISO8601
status :: Maybe MacieStatus
serviceRole :: Maybe Text
findingPublishingFrequency :: Maybe FindingPublishingFrequency
createdAt :: Maybe ISO8601
$sel:httpStatus:GetMacieSessionResponse' :: GetMacieSessionResponse -> Int
$sel:updatedAt:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe ISO8601
$sel:status:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe MacieStatus
$sel:serviceRole:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe Text
$sel:findingPublishingFrequency:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe FindingPublishingFrequency
$sel:createdAt:GetMacieSessionResponse' :: GetMacieSessionResponse -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
serviceRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MacieStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
updatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus