{-# 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.ConnectCases.ListFieldOptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all of the field options for a field identifier in the domain.
module Amazonka.ConnectCases.ListFieldOptions
  ( -- * Creating a Request
    ListFieldOptions (..),
    newListFieldOptions,

    -- * Request Lenses
    listFieldOptions_maxResults,
    listFieldOptions_nextToken,
    listFieldOptions_values,
    listFieldOptions_domainId,
    listFieldOptions_fieldId,

    -- * Destructuring the Response
    ListFieldOptionsResponse (..),
    newListFieldOptionsResponse,

    -- * Response Lenses
    listFieldOptionsResponse_nextToken,
    listFieldOptionsResponse_httpStatus,
    listFieldOptionsResponse_options,
  )
where

import Amazonka.ConnectCases.Types
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

-- | /See:/ 'newListFieldOptions' smart constructor.
data ListFieldOptions = ListFieldOptions'
  { -- | The maximum number of results to return per page.
    ListFieldOptions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of results. Use the value returned in the
    -- previous response in the next request to retrieve the next set of
    -- results.
    ListFieldOptions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of @FieldOption@ values to filter on for @ListFieldOptions@.
    ListFieldOptions -> Maybe [Text]
values :: Prelude.Maybe [Prelude.Text],
    -- | The unique identifier of the Cases domain.
    ListFieldOptions -> Text
domainId :: Prelude.Text,
    -- | The unique identifier of a field.
    ListFieldOptions -> Text
fieldId :: Prelude.Text
  }
  deriving (ListFieldOptions -> ListFieldOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFieldOptions -> ListFieldOptions -> Bool
$c/= :: ListFieldOptions -> ListFieldOptions -> Bool
== :: ListFieldOptions -> ListFieldOptions -> Bool
$c== :: ListFieldOptions -> ListFieldOptions -> Bool
Prelude.Eq, ReadPrec [ListFieldOptions]
ReadPrec ListFieldOptions
Int -> ReadS ListFieldOptions
ReadS [ListFieldOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFieldOptions]
$creadListPrec :: ReadPrec [ListFieldOptions]
readPrec :: ReadPrec ListFieldOptions
$creadPrec :: ReadPrec ListFieldOptions
readList :: ReadS [ListFieldOptions]
$creadList :: ReadS [ListFieldOptions]
readsPrec :: Int -> ReadS ListFieldOptions
$creadsPrec :: Int -> ReadS ListFieldOptions
Prelude.Read, Int -> ListFieldOptions -> ShowS
[ListFieldOptions] -> ShowS
ListFieldOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFieldOptions] -> ShowS
$cshowList :: [ListFieldOptions] -> ShowS
show :: ListFieldOptions -> String
$cshow :: ListFieldOptions -> String
showsPrec :: Int -> ListFieldOptions -> ShowS
$cshowsPrec :: Int -> ListFieldOptions -> ShowS
Prelude.Show, forall x. Rep ListFieldOptions x -> ListFieldOptions
forall x. ListFieldOptions -> Rep ListFieldOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFieldOptions x -> ListFieldOptions
$cfrom :: forall x. ListFieldOptions -> Rep ListFieldOptions x
Prelude.Generic)

-- |
-- Create a value of 'ListFieldOptions' 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:
--
-- 'maxResults', 'listFieldOptions_maxResults' - The maximum number of results to return per page.
--
-- 'nextToken', 'listFieldOptions_nextToken' - The token for the next set of results. Use the value returned in the
-- previous response in the next request to retrieve the next set of
-- results.
--
-- 'values', 'listFieldOptions_values' - A list of @FieldOption@ values to filter on for @ListFieldOptions@.
--
-- 'domainId', 'listFieldOptions_domainId' - The unique identifier of the Cases domain.
--
-- 'fieldId', 'listFieldOptions_fieldId' - The unique identifier of a field.
newListFieldOptions ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'fieldId'
  Prelude.Text ->
  ListFieldOptions
newListFieldOptions :: Text -> Text -> ListFieldOptions
newListFieldOptions Text
pDomainId_ Text
pFieldId_ =
  ListFieldOptions'
    { $sel:maxResults:ListFieldOptions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFieldOptions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:values:ListFieldOptions' :: Maybe [Text]
values = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:ListFieldOptions' :: Text
domainId = Text
pDomainId_,
      $sel:fieldId:ListFieldOptions' :: Text
fieldId = Text
pFieldId_
    }

-- | The maximum number of results to return per page.
listFieldOptions_maxResults :: Lens.Lens' ListFieldOptions (Prelude.Maybe Prelude.Natural)
listFieldOptions_maxResults :: Lens' ListFieldOptions (Maybe Natural)
listFieldOptions_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFieldOptions' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListFieldOptions' :: ListFieldOptions -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListFieldOptions
s@ListFieldOptions' {} Maybe Natural
a -> ListFieldOptions
s {$sel:maxResults:ListFieldOptions' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListFieldOptions)

-- | The token for the next set of results. Use the value returned in the
-- previous response in the next request to retrieve the next set of
-- results.
listFieldOptions_nextToken :: Lens.Lens' ListFieldOptions (Prelude.Maybe Prelude.Text)
listFieldOptions_nextToken :: Lens' ListFieldOptions (Maybe Text)
listFieldOptions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFieldOptions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFieldOptions' :: ListFieldOptions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFieldOptions
s@ListFieldOptions' {} Maybe Text
a -> ListFieldOptions
s {$sel:nextToken:ListFieldOptions' :: Maybe Text
nextToken = Maybe Text
a} :: ListFieldOptions)

-- | A list of @FieldOption@ values to filter on for @ListFieldOptions@.
listFieldOptions_values :: Lens.Lens' ListFieldOptions (Prelude.Maybe [Prelude.Text])
listFieldOptions_values :: Lens' ListFieldOptions (Maybe [Text])
listFieldOptions_values = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFieldOptions' {Maybe [Text]
values :: Maybe [Text]
$sel:values:ListFieldOptions' :: ListFieldOptions -> Maybe [Text]
values} -> Maybe [Text]
values) (\s :: ListFieldOptions
s@ListFieldOptions' {} Maybe [Text]
a -> ListFieldOptions
s {$sel:values:ListFieldOptions' :: Maybe [Text]
values = Maybe [Text]
a} :: ListFieldOptions) 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 unique identifier of the Cases domain.
listFieldOptions_domainId :: Lens.Lens' ListFieldOptions Prelude.Text
listFieldOptions_domainId :: Lens' ListFieldOptions Text
listFieldOptions_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFieldOptions' {Text
domainId :: Text
$sel:domainId:ListFieldOptions' :: ListFieldOptions -> Text
domainId} -> Text
domainId) (\s :: ListFieldOptions
s@ListFieldOptions' {} Text
a -> ListFieldOptions
s {$sel:domainId:ListFieldOptions' :: Text
domainId = Text
a} :: ListFieldOptions)

-- | The unique identifier of a field.
listFieldOptions_fieldId :: Lens.Lens' ListFieldOptions Prelude.Text
listFieldOptions_fieldId :: Lens' ListFieldOptions Text
listFieldOptions_fieldId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFieldOptions' {Text
fieldId :: Text
$sel:fieldId:ListFieldOptions' :: ListFieldOptions -> Text
fieldId} -> Text
fieldId) (\s :: ListFieldOptions
s@ListFieldOptions' {} Text
a -> ListFieldOptions
s {$sel:fieldId:ListFieldOptions' :: Text
fieldId = Text
a} :: ListFieldOptions)

instance Core.AWSRequest ListFieldOptions where
  type
    AWSResponse ListFieldOptions =
      ListFieldOptionsResponse
  request :: (Service -> Service)
-> ListFieldOptions -> Request ListFieldOptions
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 ListFieldOptions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListFieldOptions)))
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 -> Int -> [FieldOption] -> ListFieldOptionsResponse
ListFieldOptionsResponse'
            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
"nextToken")
            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))
            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
"options" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ListFieldOptions where
  hashWithSalt :: Int -> ListFieldOptions -> Int
hashWithSalt Int
_salt ListFieldOptions' {Maybe Natural
Maybe [Text]
Maybe Text
Text
fieldId :: Text
domainId :: Text
values :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:fieldId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:domainId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:values:ListFieldOptions' :: ListFieldOptions -> Maybe [Text]
$sel:nextToken:ListFieldOptions' :: ListFieldOptions -> Maybe Text
$sel:maxResults:ListFieldOptions' :: ListFieldOptions -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
values
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fieldId

instance Prelude.NFData ListFieldOptions where
  rnf :: ListFieldOptions -> ()
rnf ListFieldOptions' {Maybe Natural
Maybe [Text]
Maybe Text
Text
fieldId :: Text
domainId :: Text
values :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:fieldId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:domainId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:values:ListFieldOptions' :: ListFieldOptions -> Maybe [Text]
$sel:nextToken:ListFieldOptions' :: ListFieldOptions -> Maybe Text
$sel:maxResults:ListFieldOptions' :: ListFieldOptions -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
values
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fieldId

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

instance Data.ToJSON ListFieldOptions where
  toJSON :: ListFieldOptions -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath ListFieldOptions where
  toPath :: ListFieldOptions -> ByteString
toPath ListFieldOptions' {Maybe Natural
Maybe [Text]
Maybe Text
Text
fieldId :: Text
domainId :: Text
values :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:fieldId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:domainId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:values:ListFieldOptions' :: ListFieldOptions -> Maybe [Text]
$sel:nextToken:ListFieldOptions' :: ListFieldOptions -> Maybe Text
$sel:maxResults:ListFieldOptions' :: ListFieldOptions -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainId,
        ByteString
"/fields/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
fieldId,
        ByteString
"/options-list"
      ]

instance Data.ToQuery ListFieldOptions where
  toQuery :: ListFieldOptions -> QueryString
toQuery ListFieldOptions' {Maybe Natural
Maybe [Text]
Maybe Text
Text
fieldId :: Text
domainId :: Text
values :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:fieldId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:domainId:ListFieldOptions' :: ListFieldOptions -> Text
$sel:values:ListFieldOptions' :: ListFieldOptions -> Maybe [Text]
$sel:nextToken:ListFieldOptions' :: ListFieldOptions -> Maybe Text
$sel:maxResults:ListFieldOptions' :: ListFieldOptions -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"values"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
values)
      ]

-- | /See:/ 'newListFieldOptionsResponse' smart constructor.
data ListFieldOptionsResponse = ListFieldOptionsResponse'
  { -- | The token for the next set of results. This is null if there are no more
    -- results to return.
    ListFieldOptionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListFieldOptionsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of @FieldOption@ objects.
    ListFieldOptionsResponse -> [FieldOption]
options :: [FieldOption]
  }
  deriving (ListFieldOptionsResponse -> ListFieldOptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFieldOptionsResponse -> ListFieldOptionsResponse -> Bool
$c/= :: ListFieldOptionsResponse -> ListFieldOptionsResponse -> Bool
== :: ListFieldOptionsResponse -> ListFieldOptionsResponse -> Bool
$c== :: ListFieldOptionsResponse -> ListFieldOptionsResponse -> Bool
Prelude.Eq, ReadPrec [ListFieldOptionsResponse]
ReadPrec ListFieldOptionsResponse
Int -> ReadS ListFieldOptionsResponse
ReadS [ListFieldOptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFieldOptionsResponse]
$creadListPrec :: ReadPrec [ListFieldOptionsResponse]
readPrec :: ReadPrec ListFieldOptionsResponse
$creadPrec :: ReadPrec ListFieldOptionsResponse
readList :: ReadS [ListFieldOptionsResponse]
$creadList :: ReadS [ListFieldOptionsResponse]
readsPrec :: Int -> ReadS ListFieldOptionsResponse
$creadsPrec :: Int -> ReadS ListFieldOptionsResponse
Prelude.Read, Int -> ListFieldOptionsResponse -> ShowS
[ListFieldOptionsResponse] -> ShowS
ListFieldOptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFieldOptionsResponse] -> ShowS
$cshowList :: [ListFieldOptionsResponse] -> ShowS
show :: ListFieldOptionsResponse -> String
$cshow :: ListFieldOptionsResponse -> String
showsPrec :: Int -> ListFieldOptionsResponse -> ShowS
$cshowsPrec :: Int -> ListFieldOptionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListFieldOptionsResponse x -> ListFieldOptionsResponse
forall x.
ListFieldOptionsResponse -> Rep ListFieldOptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListFieldOptionsResponse x -> ListFieldOptionsResponse
$cfrom :: forall x.
ListFieldOptionsResponse -> Rep ListFieldOptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListFieldOptionsResponse' 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:
--
-- 'nextToken', 'listFieldOptionsResponse_nextToken' - The token for the next set of results. This is null if there are no more
-- results to return.
--
-- 'httpStatus', 'listFieldOptionsResponse_httpStatus' - The response's http status code.
--
-- 'options', 'listFieldOptionsResponse_options' - A list of @FieldOption@ objects.
newListFieldOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListFieldOptionsResponse
newListFieldOptionsResponse :: Int -> ListFieldOptionsResponse
newListFieldOptionsResponse Int
pHttpStatus_ =
  ListFieldOptionsResponse'
    { $sel:nextToken:ListFieldOptionsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListFieldOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:options:ListFieldOptionsResponse' :: [FieldOption]
options = forall a. Monoid a => a
Prelude.mempty
    }

-- | The token for the next set of results. This is null if there are no more
-- results to return.
listFieldOptionsResponse_nextToken :: Lens.Lens' ListFieldOptionsResponse (Prelude.Maybe Prelude.Text)
listFieldOptionsResponse_nextToken :: Lens' ListFieldOptionsResponse (Maybe Text)
listFieldOptionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFieldOptionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFieldOptionsResponse' :: ListFieldOptionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFieldOptionsResponse
s@ListFieldOptionsResponse' {} Maybe Text
a -> ListFieldOptionsResponse
s {$sel:nextToken:ListFieldOptionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListFieldOptionsResponse)

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

-- | A list of @FieldOption@ objects.
listFieldOptionsResponse_options :: Lens.Lens' ListFieldOptionsResponse [FieldOption]
listFieldOptionsResponse_options :: Lens' ListFieldOptionsResponse [FieldOption]
listFieldOptionsResponse_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFieldOptionsResponse' {[FieldOption]
options :: [FieldOption]
$sel:options:ListFieldOptionsResponse' :: ListFieldOptionsResponse -> [FieldOption]
options} -> [FieldOption]
options) (\s :: ListFieldOptionsResponse
s@ListFieldOptionsResponse' {} [FieldOption]
a -> ListFieldOptionsResponse
s {$sel:options:ListFieldOptionsResponse' :: [FieldOption]
options = [FieldOption]
a} :: ListFieldOptionsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData ListFieldOptionsResponse where
  rnf :: ListFieldOptionsResponse -> ()
rnf ListFieldOptionsResponse' {Int
[FieldOption]
Maybe Text
options :: [FieldOption]
httpStatus :: Int
nextToken :: Maybe Text
$sel:options:ListFieldOptionsResponse' :: ListFieldOptionsResponse -> [FieldOption]
$sel:httpStatus:ListFieldOptionsResponse' :: ListFieldOptionsResponse -> Int
$sel:nextToken:ListFieldOptionsResponse' :: ListFieldOptionsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [FieldOption]
options