{-# 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.GetAllowList
-- 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 settings and status of an allow list.
module Amazonka.MacieV2.GetAllowList
  ( -- * Creating a Request
    GetAllowList (..),
    newGetAllowList,

    -- * Request Lenses
    getAllowList_id,

    -- * Destructuring the Response
    GetAllowListResponse (..),
    newGetAllowListResponse,

    -- * Response Lenses
    getAllowListResponse_arn,
    getAllowListResponse_createdAt,
    getAllowListResponse_criteria,
    getAllowListResponse_description,
    getAllowListResponse_id,
    getAllowListResponse_name,
    getAllowListResponse_status,
    getAllowListResponse_tags,
    getAllowListResponse_updatedAt,
    getAllowListResponse_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:/ 'newGetAllowList' smart constructor.
data GetAllowList = GetAllowList'
  { -- | The unique identifier for the Amazon Macie resource that the request
    -- applies to.
    GetAllowList -> Text
id :: Prelude.Text
  }
  deriving (GetAllowList -> GetAllowList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAllowList -> GetAllowList -> Bool
$c/= :: GetAllowList -> GetAllowList -> Bool
== :: GetAllowList -> GetAllowList -> Bool
$c== :: GetAllowList -> GetAllowList -> Bool
Prelude.Eq, ReadPrec [GetAllowList]
ReadPrec GetAllowList
Int -> ReadS GetAllowList
ReadS [GetAllowList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAllowList]
$creadListPrec :: ReadPrec [GetAllowList]
readPrec :: ReadPrec GetAllowList
$creadPrec :: ReadPrec GetAllowList
readList :: ReadS [GetAllowList]
$creadList :: ReadS [GetAllowList]
readsPrec :: Int -> ReadS GetAllowList
$creadsPrec :: Int -> ReadS GetAllowList
Prelude.Read, Int -> GetAllowList -> ShowS
[GetAllowList] -> ShowS
GetAllowList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAllowList] -> ShowS
$cshowList :: [GetAllowList] -> ShowS
show :: GetAllowList -> String
$cshow :: GetAllowList -> String
showsPrec :: Int -> GetAllowList -> ShowS
$cshowsPrec :: Int -> GetAllowList -> ShowS
Prelude.Show, forall x. Rep GetAllowList x -> GetAllowList
forall x. GetAllowList -> Rep GetAllowList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAllowList x -> GetAllowList
$cfrom :: forall x. GetAllowList -> Rep GetAllowList x
Prelude.Generic)

-- |
-- Create a value of 'GetAllowList' 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', 'getAllowList_id' - The unique identifier for the Amazon Macie resource that the request
-- applies to.
newGetAllowList ::
  -- | 'id'
  Prelude.Text ->
  GetAllowList
newGetAllowList :: Text -> GetAllowList
newGetAllowList Text
pId_ = GetAllowList' {$sel:id:GetAllowList' :: Text
id = Text
pId_}

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

instance Core.AWSRequest GetAllowList where
  type AWSResponse GetAllowList = GetAllowListResponse
  request :: (Service -> Service) -> GetAllowList -> Request GetAllowList
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 GetAllowList
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetAllowList)))
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 Text
-> Maybe ISO8601
-> Maybe AllowListCriteria
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe AllowListStatus
-> Maybe (HashMap Text Text)
-> Maybe ISO8601
-> Int
-> GetAllowListResponse
GetAllowListResponse'
            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
"arn")
            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
"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
"criteria")
            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
"description")
            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
"id")
            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
"name")
            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
"tags" 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.<*> (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 GetAllowList where
  hashWithSalt :: Int -> GetAllowList -> Int
hashWithSalt Int
_salt GetAllowList' {Text
id :: Text
$sel:id:GetAllowList' :: GetAllowList -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData GetAllowList where
  rnf :: GetAllowList -> ()
rnf GetAllowList' {Text
id :: Text
$sel:id:GetAllowList' :: GetAllowList -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders GetAllowList where
  toHeaders :: GetAllowList -> 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 GetAllowList where
  toPath :: GetAllowList -> ByteString
toPath GetAllowList' {Text
id :: Text
$sel:id:GetAllowList' :: GetAllowList -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/allow-lists/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

-- | /See:/ 'newGetAllowListResponse' smart constructor.
data GetAllowListResponse = GetAllowListResponse'
  { -- | The Amazon Resource Name (ARN) of the allow list.
    GetAllowListResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The date and time, in UTC and extended ISO 8601 format, when the allow
    -- list was created in Amazon Macie.
    GetAllowListResponse -> Maybe ISO8601
createdAt :: Prelude.Maybe Data.ISO8601,
    -- | The criteria that specify the text or text pattern to ignore. The
    -- criteria can be the location and name of an S3 object that lists
    -- specific text to ignore (s3WordsList), or a regular expression (regex)
    -- that defines a text pattern to ignore.
    GetAllowListResponse -> Maybe AllowListCriteria
criteria :: Prelude.Maybe AllowListCriteria,
    -- | The custom description of the allow list.
    GetAllowListResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the allow list.
    GetAllowListResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The custom name of the allow list.
    GetAllowListResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The current status of the allow list, which indicates whether Amazon
    -- Macie can access and use the list\'s criteria.
    GetAllowListResponse -> Maybe AllowListStatus
status :: Prelude.Maybe AllowListStatus,
    -- | A map of key-value pairs that specifies which tags (keys and values) are
    -- associated with the allow list.
    GetAllowListResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The date and time, in UTC and extended ISO 8601 format, when the allow
    -- list\'s settings were most recently changed in Amazon Macie.
    GetAllowListResponse -> Maybe ISO8601
updatedAt :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    GetAllowListResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetAllowListResponse -> GetAllowListResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAllowListResponse -> GetAllowListResponse -> Bool
$c/= :: GetAllowListResponse -> GetAllowListResponse -> Bool
== :: GetAllowListResponse -> GetAllowListResponse -> Bool
$c== :: GetAllowListResponse -> GetAllowListResponse -> Bool
Prelude.Eq, ReadPrec [GetAllowListResponse]
ReadPrec GetAllowListResponse
Int -> ReadS GetAllowListResponse
ReadS [GetAllowListResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAllowListResponse]
$creadListPrec :: ReadPrec [GetAllowListResponse]
readPrec :: ReadPrec GetAllowListResponse
$creadPrec :: ReadPrec GetAllowListResponse
readList :: ReadS [GetAllowListResponse]
$creadList :: ReadS [GetAllowListResponse]
readsPrec :: Int -> ReadS GetAllowListResponse
$creadsPrec :: Int -> ReadS GetAllowListResponse
Prelude.Read, Int -> GetAllowListResponse -> ShowS
[GetAllowListResponse] -> ShowS
GetAllowListResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAllowListResponse] -> ShowS
$cshowList :: [GetAllowListResponse] -> ShowS
show :: GetAllowListResponse -> String
$cshow :: GetAllowListResponse -> String
showsPrec :: Int -> GetAllowListResponse -> ShowS
$cshowsPrec :: Int -> GetAllowListResponse -> ShowS
Prelude.Show, forall x. Rep GetAllowListResponse x -> GetAllowListResponse
forall x. GetAllowListResponse -> Rep GetAllowListResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAllowListResponse x -> GetAllowListResponse
$cfrom :: forall x. GetAllowListResponse -> Rep GetAllowListResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAllowListResponse' 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:
--
-- 'arn', 'getAllowListResponse_arn' - The Amazon Resource Name (ARN) of the allow list.
--
-- 'createdAt', 'getAllowListResponse_createdAt' - The date and time, in UTC and extended ISO 8601 format, when the allow
-- list was created in Amazon Macie.
--
-- 'criteria', 'getAllowListResponse_criteria' - The criteria that specify the text or text pattern to ignore. The
-- criteria can be the location and name of an S3 object that lists
-- specific text to ignore (s3WordsList), or a regular expression (regex)
-- that defines a text pattern to ignore.
--
-- 'description', 'getAllowListResponse_description' - The custom description of the allow list.
--
-- 'id', 'getAllowListResponse_id' - The unique identifier for the allow list.
--
-- 'name', 'getAllowListResponse_name' - The custom name of the allow list.
--
-- 'status', 'getAllowListResponse_status' - The current status of the allow list, which indicates whether Amazon
-- Macie can access and use the list\'s criteria.
--
-- 'tags', 'getAllowListResponse_tags' - A map of key-value pairs that specifies which tags (keys and values) are
-- associated with the allow list.
--
-- 'updatedAt', 'getAllowListResponse_updatedAt' - The date and time, in UTC and extended ISO 8601 format, when the allow
-- list\'s settings were most recently changed in Amazon Macie.
--
-- 'httpStatus', 'getAllowListResponse_httpStatus' - The response's http status code.
newGetAllowListResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAllowListResponse
newGetAllowListResponse :: Int -> GetAllowListResponse
newGetAllowListResponse Int
pHttpStatus_ =
  GetAllowListResponse'
    { $sel:arn:GetAllowListResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:GetAllowListResponse' :: Maybe ISO8601
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:criteria:GetAllowListResponse' :: Maybe AllowListCriteria
criteria = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetAllowListResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetAllowListResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetAllowListResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetAllowListResponse' :: Maybe AllowListStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetAllowListResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedAt:GetAllowListResponse' :: Maybe ISO8601
updatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAllowListResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the allow list.
getAllowListResponse_arn :: Lens.Lens' GetAllowListResponse (Prelude.Maybe Prelude.Text)
getAllowListResponse_arn :: Lens' GetAllowListResponse (Maybe Text)
getAllowListResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe Text
a -> GetAllowListResponse
s {$sel:arn:GetAllowListResponse' :: Maybe Text
arn = Maybe Text
a} :: GetAllowListResponse)

-- | The date and time, in UTC and extended ISO 8601 format, when the allow
-- list was created in Amazon Macie.
getAllowListResponse_createdAt :: Lens.Lens' GetAllowListResponse (Prelude.Maybe Prelude.UTCTime)
getAllowListResponse_createdAt :: Lens' GetAllowListResponse (Maybe UTCTime)
getAllowListResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe ISO8601
createdAt :: Maybe ISO8601
$sel:createdAt:GetAllowListResponse' :: GetAllowListResponse -> Maybe ISO8601
createdAt} -> Maybe ISO8601
createdAt) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe ISO8601
a -> GetAllowListResponse
s {$sel:createdAt:GetAllowListResponse' :: Maybe ISO8601
createdAt = Maybe ISO8601
a} :: GetAllowListResponse) 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 criteria that specify the text or text pattern to ignore. The
-- criteria can be the location and name of an S3 object that lists
-- specific text to ignore (s3WordsList), or a regular expression (regex)
-- that defines a text pattern to ignore.
getAllowListResponse_criteria :: Lens.Lens' GetAllowListResponse (Prelude.Maybe AllowListCriteria)
getAllowListResponse_criteria :: Lens' GetAllowListResponse (Maybe AllowListCriteria)
getAllowListResponse_criteria = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe AllowListCriteria
criteria :: Maybe AllowListCriteria
$sel:criteria:GetAllowListResponse' :: GetAllowListResponse -> Maybe AllowListCriteria
criteria} -> Maybe AllowListCriteria
criteria) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe AllowListCriteria
a -> GetAllowListResponse
s {$sel:criteria:GetAllowListResponse' :: Maybe AllowListCriteria
criteria = Maybe AllowListCriteria
a} :: GetAllowListResponse)

-- | The custom description of the allow list.
getAllowListResponse_description :: Lens.Lens' GetAllowListResponse (Prelude.Maybe Prelude.Text)
getAllowListResponse_description :: Lens' GetAllowListResponse (Maybe Text)
getAllowListResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe Text
a -> GetAllowListResponse
s {$sel:description:GetAllowListResponse' :: Maybe Text
description = Maybe Text
a} :: GetAllowListResponse)

-- | The unique identifier for the allow list.
getAllowListResponse_id :: Lens.Lens' GetAllowListResponse (Prelude.Maybe Prelude.Text)
getAllowListResponse_id :: Lens' GetAllowListResponse (Maybe Text)
getAllowListResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe Text
id :: Maybe Text
$sel:id:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe Text
a -> GetAllowListResponse
s {$sel:id:GetAllowListResponse' :: Maybe Text
id = Maybe Text
a} :: GetAllowListResponse)

-- | The custom name of the allow list.
getAllowListResponse_name :: Lens.Lens' GetAllowListResponse (Prelude.Maybe Prelude.Text)
getAllowListResponse_name :: Lens' GetAllowListResponse (Maybe Text)
getAllowListResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe Text
a -> GetAllowListResponse
s {$sel:name:GetAllowListResponse' :: Maybe Text
name = Maybe Text
a} :: GetAllowListResponse)

-- | The current status of the allow list, which indicates whether Amazon
-- Macie can access and use the list\'s criteria.
getAllowListResponse_status :: Lens.Lens' GetAllowListResponse (Prelude.Maybe AllowListStatus)
getAllowListResponse_status :: Lens' GetAllowListResponse (Maybe AllowListStatus)
getAllowListResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe AllowListStatus
status :: Maybe AllowListStatus
$sel:status:GetAllowListResponse' :: GetAllowListResponse -> Maybe AllowListStatus
status} -> Maybe AllowListStatus
status) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe AllowListStatus
a -> GetAllowListResponse
s {$sel:status:GetAllowListResponse' :: Maybe AllowListStatus
status = Maybe AllowListStatus
a} :: GetAllowListResponse)

-- | A map of key-value pairs that specifies which tags (keys and values) are
-- associated with the allow list.
getAllowListResponse_tags :: Lens.Lens' GetAllowListResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getAllowListResponse_tags :: Lens' GetAllowListResponse (Maybe (HashMap Text Text))
getAllowListResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetAllowListResponse' :: GetAllowListResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe (HashMap Text Text)
a -> GetAllowListResponse
s {$sel:tags:GetAllowListResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetAllowListResponse) 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 date and time, in UTC and extended ISO 8601 format, when the allow
-- list\'s settings were most recently changed in Amazon Macie.
getAllowListResponse_updatedAt :: Lens.Lens' GetAllowListResponse (Prelude.Maybe Prelude.UTCTime)
getAllowListResponse_updatedAt :: Lens' GetAllowListResponse (Maybe UTCTime)
getAllowListResponse_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Maybe ISO8601
updatedAt :: Maybe ISO8601
$sel:updatedAt:GetAllowListResponse' :: GetAllowListResponse -> Maybe ISO8601
updatedAt} -> Maybe ISO8601
updatedAt) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Maybe ISO8601
a -> GetAllowListResponse
s {$sel:updatedAt:GetAllowListResponse' :: Maybe ISO8601
updatedAt = Maybe ISO8601
a} :: GetAllowListResponse) 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.
getAllowListResponse_httpStatus :: Lens.Lens' GetAllowListResponse Prelude.Int
getAllowListResponse_httpStatus :: Lens' GetAllowListResponse Int
getAllowListResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAllowListResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetAllowListResponse' :: GetAllowListResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetAllowListResponse
s@GetAllowListResponse' {} Int
a -> GetAllowListResponse
s {$sel:httpStatus:GetAllowListResponse' :: Int
httpStatus = Int
a} :: GetAllowListResponse)

instance Prelude.NFData GetAllowListResponse where
  rnf :: GetAllowListResponse -> ()
rnf GetAllowListResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe ISO8601
Maybe AllowListStatus
Maybe AllowListCriteria
httpStatus :: Int
updatedAt :: Maybe ISO8601
tags :: Maybe (HashMap Text Text)
status :: Maybe AllowListStatus
name :: Maybe Text
id :: Maybe Text
description :: Maybe Text
criteria :: Maybe AllowListCriteria
createdAt :: Maybe ISO8601
arn :: Maybe Text
$sel:httpStatus:GetAllowListResponse' :: GetAllowListResponse -> Int
$sel:updatedAt:GetAllowListResponse' :: GetAllowListResponse -> Maybe ISO8601
$sel:tags:GetAllowListResponse' :: GetAllowListResponse -> Maybe (HashMap Text Text)
$sel:status:GetAllowListResponse' :: GetAllowListResponse -> Maybe AllowListStatus
$sel:name:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
$sel:id:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
$sel:description:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
$sel:criteria:GetAllowListResponse' :: GetAllowListResponse -> Maybe AllowListCriteria
$sel:createdAt:GetAllowListResponse' :: GetAllowListResponse -> Maybe ISO8601
$sel:arn:GetAllowListResponse' :: GetAllowListResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 AllowListCriteria
criteria
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AllowListStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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