{-# 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.Route53Resolver.ImportFirewallDomains
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports domain names from a file into a domain list, for use in a DNS
-- firewall rule group.
--
-- Each domain specification in your domain list must satisfy the following
-- requirements:
--
-- -   It can optionally start with @*@ (asterisk).
--
-- -   With the exception of the optional starting asterisk, it must only
--     contain the following characters: @A-Z@, @a-z@, @0-9@, @-@ (hyphen).
--
-- -   It must be from 1-255 characters in length.
module Amazonka.Route53Resolver.ImportFirewallDomains
  ( -- * Creating a Request
    ImportFirewallDomains (..),
    newImportFirewallDomains,

    -- * Request Lenses
    importFirewallDomains_firewallDomainListId,
    importFirewallDomains_operation,
    importFirewallDomains_domainFileUrl,

    -- * Destructuring the Response
    ImportFirewallDomainsResponse (..),
    newImportFirewallDomainsResponse,

    -- * Response Lenses
    importFirewallDomainsResponse_id,
    importFirewallDomainsResponse_name,
    importFirewallDomainsResponse_status,
    importFirewallDomainsResponse_statusMessage,
    importFirewallDomainsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newImportFirewallDomains' smart constructor.
data ImportFirewallDomains = ImportFirewallDomains'
  { -- | The ID of the domain list that you want to modify with the import
    -- operation.
    ImportFirewallDomains -> Text
firewallDomainListId :: Prelude.Text,
    -- | What you want DNS Firewall to do with the domains that are listed in the
    -- file. This must be set to @REPLACE@, which updates the domain list to
    -- exactly match the list in the file.
    ImportFirewallDomains -> FirewallDomainImportOperation
operation :: FirewallDomainImportOperation,
    -- | The fully qualified URL or URI of the file stored in Amazon Simple
    -- Storage Service (Amazon S3) that contains the list of domains to import.
    --
    -- The file must be in an S3 bucket that\'s in the same Region as your DNS
    -- Firewall. The file must be a text file and must contain a single domain
    -- per line.
    ImportFirewallDomains -> Text
domainFileUrl :: Prelude.Text
  }
  deriving (ImportFirewallDomains -> ImportFirewallDomains -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportFirewallDomains -> ImportFirewallDomains -> Bool
$c/= :: ImportFirewallDomains -> ImportFirewallDomains -> Bool
== :: ImportFirewallDomains -> ImportFirewallDomains -> Bool
$c== :: ImportFirewallDomains -> ImportFirewallDomains -> Bool
Prelude.Eq, ReadPrec [ImportFirewallDomains]
ReadPrec ImportFirewallDomains
Int -> ReadS ImportFirewallDomains
ReadS [ImportFirewallDomains]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportFirewallDomains]
$creadListPrec :: ReadPrec [ImportFirewallDomains]
readPrec :: ReadPrec ImportFirewallDomains
$creadPrec :: ReadPrec ImportFirewallDomains
readList :: ReadS [ImportFirewallDomains]
$creadList :: ReadS [ImportFirewallDomains]
readsPrec :: Int -> ReadS ImportFirewallDomains
$creadsPrec :: Int -> ReadS ImportFirewallDomains
Prelude.Read, Int -> ImportFirewallDomains -> ShowS
[ImportFirewallDomains] -> ShowS
ImportFirewallDomains -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportFirewallDomains] -> ShowS
$cshowList :: [ImportFirewallDomains] -> ShowS
show :: ImportFirewallDomains -> String
$cshow :: ImportFirewallDomains -> String
showsPrec :: Int -> ImportFirewallDomains -> ShowS
$cshowsPrec :: Int -> ImportFirewallDomains -> ShowS
Prelude.Show, forall x. Rep ImportFirewallDomains x -> ImportFirewallDomains
forall x. ImportFirewallDomains -> Rep ImportFirewallDomains x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportFirewallDomains x -> ImportFirewallDomains
$cfrom :: forall x. ImportFirewallDomains -> Rep ImportFirewallDomains x
Prelude.Generic)

-- |
-- Create a value of 'ImportFirewallDomains' 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:
--
-- 'firewallDomainListId', 'importFirewallDomains_firewallDomainListId' - The ID of the domain list that you want to modify with the import
-- operation.
--
-- 'operation', 'importFirewallDomains_operation' - What you want DNS Firewall to do with the domains that are listed in the
-- file. This must be set to @REPLACE@, which updates the domain list to
-- exactly match the list in the file.
--
-- 'domainFileUrl', 'importFirewallDomains_domainFileUrl' - The fully qualified URL or URI of the file stored in Amazon Simple
-- Storage Service (Amazon S3) that contains the list of domains to import.
--
-- The file must be in an S3 bucket that\'s in the same Region as your DNS
-- Firewall. The file must be a text file and must contain a single domain
-- per line.
newImportFirewallDomains ::
  -- | 'firewallDomainListId'
  Prelude.Text ->
  -- | 'operation'
  FirewallDomainImportOperation ->
  -- | 'domainFileUrl'
  Prelude.Text ->
  ImportFirewallDomains
newImportFirewallDomains :: Text
-> FirewallDomainImportOperation -> Text -> ImportFirewallDomains
newImportFirewallDomains
  Text
pFirewallDomainListId_
  FirewallDomainImportOperation
pOperation_
  Text
pDomainFileUrl_ =
    ImportFirewallDomains'
      { $sel:firewallDomainListId:ImportFirewallDomains' :: Text
firewallDomainListId =
          Text
pFirewallDomainListId_,
        $sel:operation:ImportFirewallDomains' :: FirewallDomainImportOperation
operation = FirewallDomainImportOperation
pOperation_,
        $sel:domainFileUrl:ImportFirewallDomains' :: Text
domainFileUrl = Text
pDomainFileUrl_
      }

-- | The ID of the domain list that you want to modify with the import
-- operation.
importFirewallDomains_firewallDomainListId :: Lens.Lens' ImportFirewallDomains Prelude.Text
importFirewallDomains_firewallDomainListId :: Lens' ImportFirewallDomains Text
importFirewallDomains_firewallDomainListId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportFirewallDomains' {Text
firewallDomainListId :: Text
$sel:firewallDomainListId:ImportFirewallDomains' :: ImportFirewallDomains -> Text
firewallDomainListId} -> Text
firewallDomainListId) (\s :: ImportFirewallDomains
s@ImportFirewallDomains' {} Text
a -> ImportFirewallDomains
s {$sel:firewallDomainListId:ImportFirewallDomains' :: Text
firewallDomainListId = Text
a} :: ImportFirewallDomains)

-- | What you want DNS Firewall to do with the domains that are listed in the
-- file. This must be set to @REPLACE@, which updates the domain list to
-- exactly match the list in the file.
importFirewallDomains_operation :: Lens.Lens' ImportFirewallDomains FirewallDomainImportOperation
importFirewallDomains_operation :: Lens' ImportFirewallDomains FirewallDomainImportOperation
importFirewallDomains_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportFirewallDomains' {FirewallDomainImportOperation
operation :: FirewallDomainImportOperation
$sel:operation:ImportFirewallDomains' :: ImportFirewallDomains -> FirewallDomainImportOperation
operation} -> FirewallDomainImportOperation
operation) (\s :: ImportFirewallDomains
s@ImportFirewallDomains' {} FirewallDomainImportOperation
a -> ImportFirewallDomains
s {$sel:operation:ImportFirewallDomains' :: FirewallDomainImportOperation
operation = FirewallDomainImportOperation
a} :: ImportFirewallDomains)

-- | The fully qualified URL or URI of the file stored in Amazon Simple
-- Storage Service (Amazon S3) that contains the list of domains to import.
--
-- The file must be in an S3 bucket that\'s in the same Region as your DNS
-- Firewall. The file must be a text file and must contain a single domain
-- per line.
importFirewallDomains_domainFileUrl :: Lens.Lens' ImportFirewallDomains Prelude.Text
importFirewallDomains_domainFileUrl :: Lens' ImportFirewallDomains Text
importFirewallDomains_domainFileUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportFirewallDomains' {Text
domainFileUrl :: Text
$sel:domainFileUrl:ImportFirewallDomains' :: ImportFirewallDomains -> Text
domainFileUrl} -> Text
domainFileUrl) (\s :: ImportFirewallDomains
s@ImportFirewallDomains' {} Text
a -> ImportFirewallDomains
s {$sel:domainFileUrl:ImportFirewallDomains' :: Text
domainFileUrl = Text
a} :: ImportFirewallDomains)

instance Core.AWSRequest ImportFirewallDomains where
  type
    AWSResponse ImportFirewallDomains =
      ImportFirewallDomainsResponse
  request :: (Service -> Service)
-> ImportFirewallDomains -> Request ImportFirewallDomains
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ImportFirewallDomains
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportFirewallDomains)))
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 Text
-> Maybe FirewallDomainListStatus
-> Maybe Text
-> Int
-> ImportFirewallDomainsResponse
ImportFirewallDomainsResponse'
            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
"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
"StatusMessage")
            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 ImportFirewallDomains where
  hashWithSalt :: Int -> ImportFirewallDomains -> Int
hashWithSalt Int
_salt ImportFirewallDomains' {Text
FirewallDomainImportOperation
domainFileUrl :: Text
operation :: FirewallDomainImportOperation
firewallDomainListId :: Text
$sel:domainFileUrl:ImportFirewallDomains' :: ImportFirewallDomains -> Text
$sel:operation:ImportFirewallDomains' :: ImportFirewallDomains -> FirewallDomainImportOperation
$sel:firewallDomainListId:ImportFirewallDomains' :: ImportFirewallDomains -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
firewallDomainListId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FirewallDomainImportOperation
operation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainFileUrl

instance Prelude.NFData ImportFirewallDomains where
  rnf :: ImportFirewallDomains -> ()
rnf ImportFirewallDomains' {Text
FirewallDomainImportOperation
domainFileUrl :: Text
operation :: FirewallDomainImportOperation
firewallDomainListId :: Text
$sel:domainFileUrl:ImportFirewallDomains' :: ImportFirewallDomains -> Text
$sel:operation:ImportFirewallDomains' :: ImportFirewallDomains -> FirewallDomainImportOperation
$sel:firewallDomainListId:ImportFirewallDomains' :: ImportFirewallDomains -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
firewallDomainListId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FirewallDomainImportOperation
operation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainFileUrl

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

instance Data.ToJSON ImportFirewallDomains where
  toJSON :: ImportFirewallDomains -> Value
toJSON ImportFirewallDomains' {Text
FirewallDomainImportOperation
domainFileUrl :: Text
operation :: FirewallDomainImportOperation
firewallDomainListId :: Text
$sel:domainFileUrl:ImportFirewallDomains' :: ImportFirewallDomains -> Text
$sel:operation:ImportFirewallDomains' :: ImportFirewallDomains -> FirewallDomainImportOperation
$sel:firewallDomainListId:ImportFirewallDomains' :: ImportFirewallDomains -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"FirewallDomainListId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
firewallDomainListId
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"Operation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FirewallDomainImportOperation
operation),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DomainFileUrl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainFileUrl)
          ]
      )

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

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

-- | /See:/ 'newImportFirewallDomainsResponse' smart constructor.
data ImportFirewallDomainsResponse = ImportFirewallDomainsResponse'
  { -- | The Id of the firewall domain list that DNS Firewall just updated.
    ImportFirewallDomainsResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain list.
    ImportFirewallDomainsResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    ImportFirewallDomainsResponse -> Maybe FirewallDomainListStatus
status :: Prelude.Maybe FirewallDomainListStatus,
    -- | Additional information about the status of the list, if available.
    ImportFirewallDomainsResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ImportFirewallDomainsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportFirewallDomainsResponse
-> ImportFirewallDomainsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportFirewallDomainsResponse
-> ImportFirewallDomainsResponse -> Bool
$c/= :: ImportFirewallDomainsResponse
-> ImportFirewallDomainsResponse -> Bool
== :: ImportFirewallDomainsResponse
-> ImportFirewallDomainsResponse -> Bool
$c== :: ImportFirewallDomainsResponse
-> ImportFirewallDomainsResponse -> Bool
Prelude.Eq, ReadPrec [ImportFirewallDomainsResponse]
ReadPrec ImportFirewallDomainsResponse
Int -> ReadS ImportFirewallDomainsResponse
ReadS [ImportFirewallDomainsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportFirewallDomainsResponse]
$creadListPrec :: ReadPrec [ImportFirewallDomainsResponse]
readPrec :: ReadPrec ImportFirewallDomainsResponse
$creadPrec :: ReadPrec ImportFirewallDomainsResponse
readList :: ReadS [ImportFirewallDomainsResponse]
$creadList :: ReadS [ImportFirewallDomainsResponse]
readsPrec :: Int -> ReadS ImportFirewallDomainsResponse
$creadsPrec :: Int -> ReadS ImportFirewallDomainsResponse
Prelude.Read, Int -> ImportFirewallDomainsResponse -> ShowS
[ImportFirewallDomainsResponse] -> ShowS
ImportFirewallDomainsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportFirewallDomainsResponse] -> ShowS
$cshowList :: [ImportFirewallDomainsResponse] -> ShowS
show :: ImportFirewallDomainsResponse -> String
$cshow :: ImportFirewallDomainsResponse -> String
showsPrec :: Int -> ImportFirewallDomainsResponse -> ShowS
$cshowsPrec :: Int -> ImportFirewallDomainsResponse -> ShowS
Prelude.Show, forall x.
Rep ImportFirewallDomainsResponse x
-> ImportFirewallDomainsResponse
forall x.
ImportFirewallDomainsResponse
-> Rep ImportFirewallDomainsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ImportFirewallDomainsResponse x
-> ImportFirewallDomainsResponse
$cfrom :: forall x.
ImportFirewallDomainsResponse
-> Rep ImportFirewallDomainsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportFirewallDomainsResponse' 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', 'importFirewallDomainsResponse_id' - The Id of the firewall domain list that DNS Firewall just updated.
--
-- 'name', 'importFirewallDomainsResponse_name' - The name of the domain list.
--
-- 'status', 'importFirewallDomainsResponse_status' -
--
-- 'statusMessage', 'importFirewallDomainsResponse_statusMessage' - Additional information about the status of the list, if available.
--
-- 'httpStatus', 'importFirewallDomainsResponse_httpStatus' - The response's http status code.
newImportFirewallDomainsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportFirewallDomainsResponse
newImportFirewallDomainsResponse :: Int -> ImportFirewallDomainsResponse
newImportFirewallDomainsResponse Int
pHttpStatus_ =
  ImportFirewallDomainsResponse'
    { $sel:id:ImportFirewallDomainsResponse' :: Maybe Text
id =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:ImportFirewallDomainsResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ImportFirewallDomainsResponse' :: Maybe FirewallDomainListStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:ImportFirewallDomainsResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportFirewallDomainsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Id of the firewall domain list that DNS Firewall just updated.
importFirewallDomainsResponse_id :: Lens.Lens' ImportFirewallDomainsResponse (Prelude.Maybe Prelude.Text)
importFirewallDomainsResponse_id :: Lens' ImportFirewallDomainsResponse (Maybe Text)
importFirewallDomainsResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportFirewallDomainsResponse' {Maybe Text
id :: Maybe Text
$sel:id:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: ImportFirewallDomainsResponse
s@ImportFirewallDomainsResponse' {} Maybe Text
a -> ImportFirewallDomainsResponse
s {$sel:id:ImportFirewallDomainsResponse' :: Maybe Text
id = Maybe Text
a} :: ImportFirewallDomainsResponse)

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

importFirewallDomainsResponse_status :: Lens.Lens' ImportFirewallDomainsResponse (Prelude.Maybe FirewallDomainListStatus)
importFirewallDomainsResponse_status :: Lens'
  ImportFirewallDomainsResponse (Maybe FirewallDomainListStatus)
importFirewallDomainsResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportFirewallDomainsResponse' {Maybe FirewallDomainListStatus
status :: Maybe FirewallDomainListStatus
$sel:status:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Maybe FirewallDomainListStatus
status} -> Maybe FirewallDomainListStatus
status) (\s :: ImportFirewallDomainsResponse
s@ImportFirewallDomainsResponse' {} Maybe FirewallDomainListStatus
a -> ImportFirewallDomainsResponse
s {$sel:status:ImportFirewallDomainsResponse' :: Maybe FirewallDomainListStatus
status = Maybe FirewallDomainListStatus
a} :: ImportFirewallDomainsResponse)

-- | Additional information about the status of the list, if available.
importFirewallDomainsResponse_statusMessage :: Lens.Lens' ImportFirewallDomainsResponse (Prelude.Maybe Prelude.Text)
importFirewallDomainsResponse_statusMessage :: Lens' ImportFirewallDomainsResponse (Maybe Text)
importFirewallDomainsResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportFirewallDomainsResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: ImportFirewallDomainsResponse
s@ImportFirewallDomainsResponse' {} Maybe Text
a -> ImportFirewallDomainsResponse
s {$sel:statusMessage:ImportFirewallDomainsResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: ImportFirewallDomainsResponse)

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

instance Prelude.NFData ImportFirewallDomainsResponse where
  rnf :: ImportFirewallDomainsResponse -> ()
rnf ImportFirewallDomainsResponse' {Int
Maybe Text
Maybe FirewallDomainListStatus
httpStatus :: Int
statusMessage :: Maybe Text
status :: Maybe FirewallDomainListStatus
name :: Maybe Text
id :: Maybe Text
$sel:httpStatus:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Int
$sel:statusMessage:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Maybe Text
$sel:status:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Maybe FirewallDomainListStatus
$sel:name:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Maybe Text
$sel:id:ImportFirewallDomainsResponse' :: ImportFirewallDomainsResponse -> Maybe Text
..} =
    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 FirewallDomainListStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus