{-# 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.Route53Domains.GetDomainSuggestions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The GetDomainSuggestions operation returns a list of suggested domain
-- names.
module Amazonka.Route53Domains.GetDomainSuggestions
  ( -- * Creating a Request
    GetDomainSuggestions (..),
    newGetDomainSuggestions,

    -- * Request Lenses
    getDomainSuggestions_domainName,
    getDomainSuggestions_suggestionCount,
    getDomainSuggestions_onlyAvailable,

    -- * Destructuring the Response
    GetDomainSuggestionsResponse (..),
    newGetDomainSuggestionsResponse,

    -- * Response Lenses
    getDomainSuggestionsResponse_suggestionsList,
    getDomainSuggestionsResponse_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.Route53Domains.Types

-- | /See:/ 'newGetDomainSuggestions' smart constructor.
data GetDomainSuggestions = GetDomainSuggestions'
  { -- | A domain name that you want to use as the basis for a list of possible
    -- domain names. The top-level domain (TLD), such as .com, must be a TLD
    -- that Route 53 supports. For a list of supported TLDs, see
    -- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
    -- in the /Amazon Route 53 Developer Guide/.
    --
    -- The domain name can contain only the following characters:
    --
    -- -   Letters a through z. Domain names are not case sensitive.
    --
    -- -   Numbers 0 through 9.
    --
    -- -   Hyphen (-). You can\'t specify a hyphen at the beginning or end of a
    --     label.
    --
    -- -   Period (.) to separate the labels in the name, such as the @.@ in
    --     @example.com@.
    --
    -- Internationalized domain names are not supported for some top-level
    -- domains. To determine whether the TLD that you want to use supports
    -- internationalized domain names, see
    -- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>.
    GetDomainSuggestions -> Text
domainName :: Prelude.Text,
    -- | The number of suggested domain names that you want Route 53 to return.
    -- Specify a value between 1 and 50.
    GetDomainSuggestions -> Int
suggestionCount :: Prelude.Int,
    -- | If @OnlyAvailable@ is @true@, Route 53 returns only domain names that
    -- are available. If @OnlyAvailable@ is @false@, Route 53 returns domain
    -- names without checking whether they\'re available to be registered. To
    -- determine whether the domain is available, you can call
    -- @checkDomainAvailability@ for each suggestion.
    GetDomainSuggestions -> Bool
onlyAvailable :: Prelude.Bool
  }
  deriving (GetDomainSuggestions -> GetDomainSuggestions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainSuggestions -> GetDomainSuggestions -> Bool
$c/= :: GetDomainSuggestions -> GetDomainSuggestions -> Bool
== :: GetDomainSuggestions -> GetDomainSuggestions -> Bool
$c== :: GetDomainSuggestions -> GetDomainSuggestions -> Bool
Prelude.Eq, ReadPrec [GetDomainSuggestions]
ReadPrec GetDomainSuggestions
Int -> ReadS GetDomainSuggestions
ReadS [GetDomainSuggestions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomainSuggestions]
$creadListPrec :: ReadPrec [GetDomainSuggestions]
readPrec :: ReadPrec GetDomainSuggestions
$creadPrec :: ReadPrec GetDomainSuggestions
readList :: ReadS [GetDomainSuggestions]
$creadList :: ReadS [GetDomainSuggestions]
readsPrec :: Int -> ReadS GetDomainSuggestions
$creadsPrec :: Int -> ReadS GetDomainSuggestions
Prelude.Read, Int -> GetDomainSuggestions -> ShowS
[GetDomainSuggestions] -> ShowS
GetDomainSuggestions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainSuggestions] -> ShowS
$cshowList :: [GetDomainSuggestions] -> ShowS
show :: GetDomainSuggestions -> String
$cshow :: GetDomainSuggestions -> String
showsPrec :: Int -> GetDomainSuggestions -> ShowS
$cshowsPrec :: Int -> GetDomainSuggestions -> ShowS
Prelude.Show, forall x. Rep GetDomainSuggestions x -> GetDomainSuggestions
forall x. GetDomainSuggestions -> Rep GetDomainSuggestions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomainSuggestions x -> GetDomainSuggestions
$cfrom :: forall x. GetDomainSuggestions -> Rep GetDomainSuggestions x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainSuggestions' 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:
--
-- 'domainName', 'getDomainSuggestions_domainName' - A domain name that you want to use as the basis for a list of possible
-- domain names. The top-level domain (TLD), such as .com, must be a TLD
-- that Route 53 supports. For a list of supported TLDs, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
-- in the /Amazon Route 53 Developer Guide/.
--
-- The domain name can contain only the following characters:
--
-- -   Letters a through z. Domain names are not case sensitive.
--
-- -   Numbers 0 through 9.
--
-- -   Hyphen (-). You can\'t specify a hyphen at the beginning or end of a
--     label.
--
-- -   Period (.) to separate the labels in the name, such as the @.@ in
--     @example.com@.
--
-- Internationalized domain names are not supported for some top-level
-- domains. To determine whether the TLD that you want to use supports
-- internationalized domain names, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>.
--
-- 'suggestionCount', 'getDomainSuggestions_suggestionCount' - The number of suggested domain names that you want Route 53 to return.
-- Specify a value between 1 and 50.
--
-- 'onlyAvailable', 'getDomainSuggestions_onlyAvailable' - If @OnlyAvailable@ is @true@, Route 53 returns only domain names that
-- are available. If @OnlyAvailable@ is @false@, Route 53 returns domain
-- names without checking whether they\'re available to be registered. To
-- determine whether the domain is available, you can call
-- @checkDomainAvailability@ for each suggestion.
newGetDomainSuggestions ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'suggestionCount'
  Prelude.Int ->
  -- | 'onlyAvailable'
  Prelude.Bool ->
  GetDomainSuggestions
newGetDomainSuggestions :: Text -> Int -> Bool -> GetDomainSuggestions
newGetDomainSuggestions
  Text
pDomainName_
  Int
pSuggestionCount_
  Bool
pOnlyAvailable_ =
    GetDomainSuggestions'
      { $sel:domainName:GetDomainSuggestions' :: Text
domainName = Text
pDomainName_,
        $sel:suggestionCount:GetDomainSuggestions' :: Int
suggestionCount = Int
pSuggestionCount_,
        $sel:onlyAvailable:GetDomainSuggestions' :: Bool
onlyAvailable = Bool
pOnlyAvailable_
      }

-- | A domain name that you want to use as the basis for a list of possible
-- domain names. The top-level domain (TLD), such as .com, must be a TLD
-- that Route 53 supports. For a list of supported TLDs, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
-- in the /Amazon Route 53 Developer Guide/.
--
-- The domain name can contain only the following characters:
--
-- -   Letters a through z. Domain names are not case sensitive.
--
-- -   Numbers 0 through 9.
--
-- -   Hyphen (-). You can\'t specify a hyphen at the beginning or end of a
--     label.
--
-- -   Period (.) to separate the labels in the name, such as the @.@ in
--     @example.com@.
--
-- Internationalized domain names are not supported for some top-level
-- domains. To determine whether the TLD that you want to use supports
-- internationalized domain names, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>.
getDomainSuggestions_domainName :: Lens.Lens' GetDomainSuggestions Prelude.Text
getDomainSuggestions_domainName :: Lens' GetDomainSuggestions Text
getDomainSuggestions_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainSuggestions' {Text
domainName :: Text
$sel:domainName:GetDomainSuggestions' :: GetDomainSuggestions -> Text
domainName} -> Text
domainName) (\s :: GetDomainSuggestions
s@GetDomainSuggestions' {} Text
a -> GetDomainSuggestions
s {$sel:domainName:GetDomainSuggestions' :: Text
domainName = Text
a} :: GetDomainSuggestions)

-- | The number of suggested domain names that you want Route 53 to return.
-- Specify a value between 1 and 50.
getDomainSuggestions_suggestionCount :: Lens.Lens' GetDomainSuggestions Prelude.Int
getDomainSuggestions_suggestionCount :: Lens' GetDomainSuggestions Int
getDomainSuggestions_suggestionCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainSuggestions' {Int
suggestionCount :: Int
$sel:suggestionCount:GetDomainSuggestions' :: GetDomainSuggestions -> Int
suggestionCount} -> Int
suggestionCount) (\s :: GetDomainSuggestions
s@GetDomainSuggestions' {} Int
a -> GetDomainSuggestions
s {$sel:suggestionCount:GetDomainSuggestions' :: Int
suggestionCount = Int
a} :: GetDomainSuggestions)

-- | If @OnlyAvailable@ is @true@, Route 53 returns only domain names that
-- are available. If @OnlyAvailable@ is @false@, Route 53 returns domain
-- names without checking whether they\'re available to be registered. To
-- determine whether the domain is available, you can call
-- @checkDomainAvailability@ for each suggestion.
getDomainSuggestions_onlyAvailable :: Lens.Lens' GetDomainSuggestions Prelude.Bool
getDomainSuggestions_onlyAvailable :: Lens' GetDomainSuggestions Bool
getDomainSuggestions_onlyAvailable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainSuggestions' {Bool
onlyAvailable :: Bool
$sel:onlyAvailable:GetDomainSuggestions' :: GetDomainSuggestions -> Bool
onlyAvailable} -> Bool
onlyAvailable) (\s :: GetDomainSuggestions
s@GetDomainSuggestions' {} Bool
a -> GetDomainSuggestions
s {$sel:onlyAvailable:GetDomainSuggestions' :: Bool
onlyAvailable = Bool
a} :: GetDomainSuggestions)

instance Core.AWSRequest GetDomainSuggestions where
  type
    AWSResponse GetDomainSuggestions =
      GetDomainSuggestionsResponse
  request :: (Service -> Service)
-> GetDomainSuggestions -> Request GetDomainSuggestions
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 GetDomainSuggestions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDomainSuggestions)))
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 [DomainSuggestion] -> Int -> GetDomainSuggestionsResponse
GetDomainSuggestionsResponse'
            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
"SuggestionsList"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetDomainSuggestions where
  hashWithSalt :: Int -> GetDomainSuggestions -> Int
hashWithSalt Int
_salt GetDomainSuggestions' {Bool
Int
Text
onlyAvailable :: Bool
suggestionCount :: Int
domainName :: Text
$sel:onlyAvailable:GetDomainSuggestions' :: GetDomainSuggestions -> Bool
$sel:suggestionCount:GetDomainSuggestions' :: GetDomainSuggestions -> Int
$sel:domainName:GetDomainSuggestions' :: GetDomainSuggestions -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
suggestionCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
onlyAvailable

instance Prelude.NFData GetDomainSuggestions where
  rnf :: GetDomainSuggestions -> ()
rnf GetDomainSuggestions' {Bool
Int
Text
onlyAvailable :: Bool
suggestionCount :: Int
domainName :: Text
$sel:onlyAvailable:GetDomainSuggestions' :: GetDomainSuggestions -> Bool
$sel:suggestionCount:GetDomainSuggestions' :: GetDomainSuggestions -> Int
$sel:domainName:GetDomainSuggestions' :: GetDomainSuggestions -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
suggestionCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
onlyAvailable

instance Data.ToHeaders GetDomainSuggestions where
  toHeaders :: GetDomainSuggestions -> 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
"Route53Domains_v20140515.GetDomainSuggestions" ::
                          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 GetDomainSuggestions where
  toJSON :: GetDomainSuggestions -> Value
toJSON GetDomainSuggestions' {Bool
Int
Text
onlyAvailable :: Bool
suggestionCount :: Int
domainName :: Text
$sel:onlyAvailable:GetDomainSuggestions' :: GetDomainSuggestions -> Bool
$sel:suggestionCount:GetDomainSuggestions' :: GetDomainSuggestions -> Int
$sel:domainName:GetDomainSuggestions' :: GetDomainSuggestions -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SuggestionCount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
suggestionCount),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OnlyAvailable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
onlyAvailable)
          ]
      )

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

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

-- | /See:/ 'newGetDomainSuggestionsResponse' smart constructor.
data GetDomainSuggestionsResponse = GetDomainSuggestionsResponse'
  { -- | A list of possible domain names. If you specified @true@ for
    -- @OnlyAvailable@ in the request, the list contains only domains that are
    -- available for registration.
    GetDomainSuggestionsResponse -> Maybe [DomainSuggestion]
suggestionsList :: Prelude.Maybe [DomainSuggestion],
    -- | The response's http status code.
    GetDomainSuggestionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDomainSuggestionsResponse
-> GetDomainSuggestionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainSuggestionsResponse
-> GetDomainSuggestionsResponse -> Bool
$c/= :: GetDomainSuggestionsResponse
-> GetDomainSuggestionsResponse -> Bool
== :: GetDomainSuggestionsResponse
-> GetDomainSuggestionsResponse -> Bool
$c== :: GetDomainSuggestionsResponse
-> GetDomainSuggestionsResponse -> Bool
Prelude.Eq, ReadPrec [GetDomainSuggestionsResponse]
ReadPrec GetDomainSuggestionsResponse
Int -> ReadS GetDomainSuggestionsResponse
ReadS [GetDomainSuggestionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomainSuggestionsResponse]
$creadListPrec :: ReadPrec [GetDomainSuggestionsResponse]
readPrec :: ReadPrec GetDomainSuggestionsResponse
$creadPrec :: ReadPrec GetDomainSuggestionsResponse
readList :: ReadS [GetDomainSuggestionsResponse]
$creadList :: ReadS [GetDomainSuggestionsResponse]
readsPrec :: Int -> ReadS GetDomainSuggestionsResponse
$creadsPrec :: Int -> ReadS GetDomainSuggestionsResponse
Prelude.Read, Int -> GetDomainSuggestionsResponse -> ShowS
[GetDomainSuggestionsResponse] -> ShowS
GetDomainSuggestionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainSuggestionsResponse] -> ShowS
$cshowList :: [GetDomainSuggestionsResponse] -> ShowS
show :: GetDomainSuggestionsResponse -> String
$cshow :: GetDomainSuggestionsResponse -> String
showsPrec :: Int -> GetDomainSuggestionsResponse -> ShowS
$cshowsPrec :: Int -> GetDomainSuggestionsResponse -> ShowS
Prelude.Show, forall x.
Rep GetDomainSuggestionsResponse x -> GetDomainSuggestionsResponse
forall x.
GetDomainSuggestionsResponse -> Rep GetDomainSuggestionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDomainSuggestionsResponse x -> GetDomainSuggestionsResponse
$cfrom :: forall x.
GetDomainSuggestionsResponse -> Rep GetDomainSuggestionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainSuggestionsResponse' 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:
--
-- 'suggestionsList', 'getDomainSuggestionsResponse_suggestionsList' - A list of possible domain names. If you specified @true@ for
-- @OnlyAvailable@ in the request, the list contains only domains that are
-- available for registration.
--
-- 'httpStatus', 'getDomainSuggestionsResponse_httpStatus' - The response's http status code.
newGetDomainSuggestionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDomainSuggestionsResponse
newGetDomainSuggestionsResponse :: Int -> GetDomainSuggestionsResponse
newGetDomainSuggestionsResponse Int
pHttpStatus_ =
  GetDomainSuggestionsResponse'
    { $sel:suggestionsList:GetDomainSuggestionsResponse' :: Maybe [DomainSuggestion]
suggestionsList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDomainSuggestionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of possible domain names. If you specified @true@ for
-- @OnlyAvailable@ in the request, the list contains only domains that are
-- available for registration.
getDomainSuggestionsResponse_suggestionsList :: Lens.Lens' GetDomainSuggestionsResponse (Prelude.Maybe [DomainSuggestion])
getDomainSuggestionsResponse_suggestionsList :: Lens' GetDomainSuggestionsResponse (Maybe [DomainSuggestion])
getDomainSuggestionsResponse_suggestionsList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainSuggestionsResponse' {Maybe [DomainSuggestion]
suggestionsList :: Maybe [DomainSuggestion]
$sel:suggestionsList:GetDomainSuggestionsResponse' :: GetDomainSuggestionsResponse -> Maybe [DomainSuggestion]
suggestionsList} -> Maybe [DomainSuggestion]
suggestionsList) (\s :: GetDomainSuggestionsResponse
s@GetDomainSuggestionsResponse' {} Maybe [DomainSuggestion]
a -> GetDomainSuggestionsResponse
s {$sel:suggestionsList:GetDomainSuggestionsResponse' :: Maybe [DomainSuggestion]
suggestionsList = Maybe [DomainSuggestion]
a} :: GetDomainSuggestionsResponse) 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 response's http status code.
getDomainSuggestionsResponse_httpStatus :: Lens.Lens' GetDomainSuggestionsResponse Prelude.Int
getDomainSuggestionsResponse_httpStatus :: Lens' GetDomainSuggestionsResponse Int
getDomainSuggestionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainSuggestionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetDomainSuggestionsResponse' :: GetDomainSuggestionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetDomainSuggestionsResponse
s@GetDomainSuggestionsResponse' {} Int
a -> GetDomainSuggestionsResponse
s {$sel:httpStatus:GetDomainSuggestionsResponse' :: Int
httpStatus = Int
a} :: GetDomainSuggestionsResponse)

instance Prelude.NFData GetDomainSuggestionsResponse where
  rnf :: GetDomainSuggestionsResponse -> ()
rnf GetDomainSuggestionsResponse' {Int
Maybe [DomainSuggestion]
httpStatus :: Int
suggestionsList :: Maybe [DomainSuggestion]
$sel:httpStatus:GetDomainSuggestionsResponse' :: GetDomainSuggestionsResponse -> Int
$sel:suggestionsList:GetDomainSuggestionsResponse' :: GetDomainSuggestionsResponse -> Maybe [DomainSuggestion]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DomainSuggestion]
suggestionsList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus