{-# 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.DirectoryService.DescribeSettings
-- 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 information about the configurable settings for the specified
-- directory.
module Amazonka.DirectoryService.DescribeSettings
  ( -- * Creating a Request
    DescribeSettings (..),
    newDescribeSettings,

    -- * Request Lenses
    describeSettings_nextToken,
    describeSettings_status,
    describeSettings_directoryId,

    -- * Destructuring the Response
    DescribeSettingsResponse (..),
    newDescribeSettingsResponse,

    -- * Response Lenses
    describeSettingsResponse_directoryId,
    describeSettingsResponse_nextToken,
    describeSettingsResponse_settingEntries,
    describeSettingsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeSettings' smart constructor.
data DescribeSettings = DescribeSettings'
  { -- | The @DescribeSettingsResult.NextToken@ value from a previous call to
    -- DescribeSettings. Pass null if this is the first call.
    DescribeSettings -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The status of the directory settings for which to retrieve information.
    DescribeSettings -> Maybe DirectoryConfigurationStatus
status :: Prelude.Maybe DirectoryConfigurationStatus,
    -- | The identifier of the directory for which to retrieve information.
    DescribeSettings -> Text
directoryId :: Prelude.Text
  }
  deriving (DescribeSettings -> DescribeSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSettings -> DescribeSettings -> Bool
$c/= :: DescribeSettings -> DescribeSettings -> Bool
== :: DescribeSettings -> DescribeSettings -> Bool
$c== :: DescribeSettings -> DescribeSettings -> Bool
Prelude.Eq, ReadPrec [DescribeSettings]
ReadPrec DescribeSettings
Int -> ReadS DescribeSettings
ReadS [DescribeSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSettings]
$creadListPrec :: ReadPrec [DescribeSettings]
readPrec :: ReadPrec DescribeSettings
$creadPrec :: ReadPrec DescribeSettings
readList :: ReadS [DescribeSettings]
$creadList :: ReadS [DescribeSettings]
readsPrec :: Int -> ReadS DescribeSettings
$creadsPrec :: Int -> ReadS DescribeSettings
Prelude.Read, Int -> DescribeSettings -> ShowS
[DescribeSettings] -> ShowS
DescribeSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSettings] -> ShowS
$cshowList :: [DescribeSettings] -> ShowS
show :: DescribeSettings -> String
$cshow :: DescribeSettings -> String
showsPrec :: Int -> DescribeSettings -> ShowS
$cshowsPrec :: Int -> DescribeSettings -> ShowS
Prelude.Show, forall x. Rep DescribeSettings x -> DescribeSettings
forall x. DescribeSettings -> Rep DescribeSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeSettings x -> DescribeSettings
$cfrom :: forall x. DescribeSettings -> Rep DescribeSettings x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSettings' 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', 'describeSettings_nextToken' - The @DescribeSettingsResult.NextToken@ value from a previous call to
-- DescribeSettings. Pass null if this is the first call.
--
-- 'status', 'describeSettings_status' - The status of the directory settings for which to retrieve information.
--
-- 'directoryId', 'describeSettings_directoryId' - The identifier of the directory for which to retrieve information.
newDescribeSettings ::
  -- | 'directoryId'
  Prelude.Text ->
  DescribeSettings
newDescribeSettings :: Text -> DescribeSettings
newDescribeSettings Text
pDirectoryId_ =
  DescribeSettings'
    { $sel:nextToken:DescribeSettings' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeSettings' :: Maybe DirectoryConfigurationStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:directoryId:DescribeSettings' :: Text
directoryId = Text
pDirectoryId_
    }

-- | The @DescribeSettingsResult.NextToken@ value from a previous call to
-- DescribeSettings. Pass null if this is the first call.
describeSettings_nextToken :: Lens.Lens' DescribeSettings (Prelude.Maybe Prelude.Text)
describeSettings_nextToken :: Lens' DescribeSettings (Maybe Text)
describeSettings_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSettings' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeSettings' :: DescribeSettings -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeSettings
s@DescribeSettings' {} Maybe Text
a -> DescribeSettings
s {$sel:nextToken:DescribeSettings' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeSettings)

-- | The status of the directory settings for which to retrieve information.
describeSettings_status :: Lens.Lens' DescribeSettings (Prelude.Maybe DirectoryConfigurationStatus)
describeSettings_status :: Lens' DescribeSettings (Maybe DirectoryConfigurationStatus)
describeSettings_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSettings' {Maybe DirectoryConfigurationStatus
status :: Maybe DirectoryConfigurationStatus
$sel:status:DescribeSettings' :: DescribeSettings -> Maybe DirectoryConfigurationStatus
status} -> Maybe DirectoryConfigurationStatus
status) (\s :: DescribeSettings
s@DescribeSettings' {} Maybe DirectoryConfigurationStatus
a -> DescribeSettings
s {$sel:status:DescribeSettings' :: Maybe DirectoryConfigurationStatus
status = Maybe DirectoryConfigurationStatus
a} :: DescribeSettings)

-- | The identifier of the directory for which to retrieve information.
describeSettings_directoryId :: Lens.Lens' DescribeSettings Prelude.Text
describeSettings_directoryId :: Lens' DescribeSettings Text
describeSettings_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSettings' {Text
directoryId :: Text
$sel:directoryId:DescribeSettings' :: DescribeSettings -> Text
directoryId} -> Text
directoryId) (\s :: DescribeSettings
s@DescribeSettings' {} Text
a -> DescribeSettings
s {$sel:directoryId:DescribeSettings' :: Text
directoryId = Text
a} :: DescribeSettings)

instance Core.AWSRequest DescribeSettings where
  type
    AWSResponse DescribeSettings =
      DescribeSettingsResponse
  request :: (Service -> Service)
-> DescribeSettings -> Request DescribeSettings
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 DescribeSettings
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeSettings)))
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 [SettingEntry]
-> Int
-> DescribeSettingsResponse
DescribeSettingsResponse'
            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
"DirectoryId")
            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
"NextToken")
            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
"SettingEntries" 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 DescribeSettings where
  hashWithSalt :: Int -> DescribeSettings -> Int
hashWithSalt Int
_salt DescribeSettings' {Maybe Text
Maybe DirectoryConfigurationStatus
Text
directoryId :: Text
status :: Maybe DirectoryConfigurationStatus
nextToken :: Maybe Text
$sel:directoryId:DescribeSettings' :: DescribeSettings -> Text
$sel:status:DescribeSettings' :: DescribeSettings -> Maybe DirectoryConfigurationStatus
$sel:nextToken:DescribeSettings' :: DescribeSettings -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DirectoryConfigurationStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId

instance Prelude.NFData DescribeSettings where
  rnf :: DescribeSettings -> ()
rnf DescribeSettings' {Maybe Text
Maybe DirectoryConfigurationStatus
Text
directoryId :: Text
status :: Maybe DirectoryConfigurationStatus
nextToken :: Maybe Text
$sel:directoryId:DescribeSettings' :: DescribeSettings -> Text
$sel:status:DescribeSettings' :: DescribeSettings -> Maybe DirectoryConfigurationStatus
$sel:nextToken:DescribeSettings' :: DescribeSettings -> 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 Maybe DirectoryConfigurationStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId

instance Data.ToHeaders DescribeSettings where
  toHeaders :: DescribeSettings -> 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
"DirectoryService_20150416.DescribeSettings" ::
                          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 DescribeSettings where
  toJSON :: DescribeSettings -> Value
toJSON DescribeSettings' {Maybe Text
Maybe DirectoryConfigurationStatus
Text
directoryId :: Text
status :: Maybe DirectoryConfigurationStatus
nextToken :: Maybe Text
$sel:directoryId:DescribeSettings' :: DescribeSettings -> Text
$sel:status:DescribeSettings' :: DescribeSettings -> Maybe DirectoryConfigurationStatus
$sel:nextToken:DescribeSettings' :: DescribeSettings -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"Status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe DirectoryConfigurationStatus
status,
            forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId)
          ]
      )

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

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

-- | /See:/ 'newDescribeSettingsResponse' smart constructor.
data DescribeSettingsResponse = DescribeSettingsResponse'
  { -- | The identifier of the directory.
    DescribeSettingsResponse -> Maybe Text
directoryId :: Prelude.Maybe Prelude.Text,
    -- | If not null, token that indicates that more results are available. Pass
    -- this value for the @NextToken@ parameter in a subsequent call to
    -- @DescribeSettings@ to retrieve the next set of items.
    DescribeSettingsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of SettingEntry objects that were retrieved.
    --
    -- It is possible that this list contains less than the number of items
    -- specified in the @Limit@ member of the request. This occurs if there are
    -- less than the requested number of items left to retrieve, or if the
    -- limitations of the operation have been exceeded.
    DescribeSettingsResponse -> Maybe [SettingEntry]
settingEntries :: Prelude.Maybe [SettingEntry],
    -- | The response's http status code.
    DescribeSettingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeSettingsResponse -> DescribeSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSettingsResponse -> DescribeSettingsResponse -> Bool
$c/= :: DescribeSettingsResponse -> DescribeSettingsResponse -> Bool
== :: DescribeSettingsResponse -> DescribeSettingsResponse -> Bool
$c== :: DescribeSettingsResponse -> DescribeSettingsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeSettingsResponse]
ReadPrec DescribeSettingsResponse
Int -> ReadS DescribeSettingsResponse
ReadS [DescribeSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSettingsResponse]
$creadListPrec :: ReadPrec [DescribeSettingsResponse]
readPrec :: ReadPrec DescribeSettingsResponse
$creadPrec :: ReadPrec DescribeSettingsResponse
readList :: ReadS [DescribeSettingsResponse]
$creadList :: ReadS [DescribeSettingsResponse]
readsPrec :: Int -> ReadS DescribeSettingsResponse
$creadsPrec :: Int -> ReadS DescribeSettingsResponse
Prelude.Read, Int -> DescribeSettingsResponse -> ShowS
[DescribeSettingsResponse] -> ShowS
DescribeSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSettingsResponse] -> ShowS
$cshowList :: [DescribeSettingsResponse] -> ShowS
show :: DescribeSettingsResponse -> String
$cshow :: DescribeSettingsResponse -> String
showsPrec :: Int -> DescribeSettingsResponse -> ShowS
$cshowsPrec :: Int -> DescribeSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeSettingsResponse x -> DescribeSettingsResponse
forall x.
DescribeSettingsResponse -> Rep DescribeSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeSettingsResponse x -> DescribeSettingsResponse
$cfrom :: forall x.
DescribeSettingsResponse -> Rep DescribeSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSettingsResponse' 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:
--
-- 'directoryId', 'describeSettingsResponse_directoryId' - The identifier of the directory.
--
-- 'nextToken', 'describeSettingsResponse_nextToken' - If not null, token that indicates that more results are available. Pass
-- this value for the @NextToken@ parameter in a subsequent call to
-- @DescribeSettings@ to retrieve the next set of items.
--
-- 'settingEntries', 'describeSettingsResponse_settingEntries' - The list of SettingEntry objects that were retrieved.
--
-- It is possible that this list contains less than the number of items
-- specified in the @Limit@ member of the request. This occurs if there are
-- less than the requested number of items left to retrieve, or if the
-- limitations of the operation have been exceeded.
--
-- 'httpStatus', 'describeSettingsResponse_httpStatus' - The response's http status code.
newDescribeSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeSettingsResponse
newDescribeSettingsResponse :: Int -> DescribeSettingsResponse
newDescribeSettingsResponse Int
pHttpStatus_ =
  DescribeSettingsResponse'
    { $sel:directoryId:DescribeSettingsResponse' :: Maybe Text
directoryId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeSettingsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:settingEntries:DescribeSettingsResponse' :: Maybe [SettingEntry]
settingEntries = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the directory.
describeSettingsResponse_directoryId :: Lens.Lens' DescribeSettingsResponse (Prelude.Maybe Prelude.Text)
describeSettingsResponse_directoryId :: Lens' DescribeSettingsResponse (Maybe Text)
describeSettingsResponse_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSettingsResponse' {Maybe Text
directoryId :: Maybe Text
$sel:directoryId:DescribeSettingsResponse' :: DescribeSettingsResponse -> Maybe Text
directoryId} -> Maybe Text
directoryId) (\s :: DescribeSettingsResponse
s@DescribeSettingsResponse' {} Maybe Text
a -> DescribeSettingsResponse
s {$sel:directoryId:DescribeSettingsResponse' :: Maybe Text
directoryId = Maybe Text
a} :: DescribeSettingsResponse)

-- | If not null, token that indicates that more results are available. Pass
-- this value for the @NextToken@ parameter in a subsequent call to
-- @DescribeSettings@ to retrieve the next set of items.
describeSettingsResponse_nextToken :: Lens.Lens' DescribeSettingsResponse (Prelude.Maybe Prelude.Text)
describeSettingsResponse_nextToken :: Lens' DescribeSettingsResponse (Maybe Text)
describeSettingsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSettingsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeSettingsResponse' :: DescribeSettingsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeSettingsResponse
s@DescribeSettingsResponse' {} Maybe Text
a -> DescribeSettingsResponse
s {$sel:nextToken:DescribeSettingsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeSettingsResponse)

-- | The list of SettingEntry objects that were retrieved.
--
-- It is possible that this list contains less than the number of items
-- specified in the @Limit@ member of the request. This occurs if there are
-- less than the requested number of items left to retrieve, or if the
-- limitations of the operation have been exceeded.
describeSettingsResponse_settingEntries :: Lens.Lens' DescribeSettingsResponse (Prelude.Maybe [SettingEntry])
describeSettingsResponse_settingEntries :: Lens' DescribeSettingsResponse (Maybe [SettingEntry])
describeSettingsResponse_settingEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSettingsResponse' {Maybe [SettingEntry]
settingEntries :: Maybe [SettingEntry]
$sel:settingEntries:DescribeSettingsResponse' :: DescribeSettingsResponse -> Maybe [SettingEntry]
settingEntries} -> Maybe [SettingEntry]
settingEntries) (\s :: DescribeSettingsResponse
s@DescribeSettingsResponse' {} Maybe [SettingEntry]
a -> DescribeSettingsResponse
s {$sel:settingEntries:DescribeSettingsResponse' :: Maybe [SettingEntry]
settingEntries = Maybe [SettingEntry]
a} :: DescribeSettingsResponse) 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.
describeSettingsResponse_httpStatus :: Lens.Lens' DescribeSettingsResponse Prelude.Int
describeSettingsResponse_httpStatus :: Lens' DescribeSettingsResponse Int
describeSettingsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSettingsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeSettingsResponse' :: DescribeSettingsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeSettingsResponse
s@DescribeSettingsResponse' {} Int
a -> DescribeSettingsResponse
s {$sel:httpStatus:DescribeSettingsResponse' :: Int
httpStatus = Int
a} :: DescribeSettingsResponse)

instance Prelude.NFData DescribeSettingsResponse where
  rnf :: DescribeSettingsResponse -> ()
rnf DescribeSettingsResponse' {Int
Maybe [SettingEntry]
Maybe Text
httpStatus :: Int
settingEntries :: Maybe [SettingEntry]
nextToken :: Maybe Text
directoryId :: Maybe Text
$sel:httpStatus:DescribeSettingsResponse' :: DescribeSettingsResponse -> Int
$sel:settingEntries:DescribeSettingsResponse' :: DescribeSettingsResponse -> Maybe [SettingEntry]
$sel:nextToken:DescribeSettingsResponse' :: DescribeSettingsResponse -> Maybe Text
$sel:directoryId:DescribeSettingsResponse' :: DescribeSettingsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
directoryId
      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 [SettingEntry]
settingEntries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus