{-# 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.AppConfigData.StartConfigurationSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a configuration session used to retrieve a deployed
-- configuration. For more information about this API action and to view
-- example CLI commands that show how to use it with the
-- GetLatestConfiguration API action, see
-- <http://docs.aws.amazon.com/appconfig/latest/userguide/appconfig-retrieving-the-configuration Receiving the configuration>
-- in the /AppConfig User Guide/.
module Amazonka.AppConfigData.StartConfigurationSession
  ( -- * Creating a Request
    StartConfigurationSession (..),
    newStartConfigurationSession,

    -- * Request Lenses
    startConfigurationSession_requiredMinimumPollIntervalInSeconds,
    startConfigurationSession_applicationIdentifier,
    startConfigurationSession_environmentIdentifier,
    startConfigurationSession_configurationProfileIdentifier,

    -- * Destructuring the Response
    StartConfigurationSessionResponse (..),
    newStartConfigurationSessionResponse,

    -- * Response Lenses
    startConfigurationSessionResponse_initialConfigurationToken,
    startConfigurationSessionResponse_httpStatus,
  )
where

import Amazonka.AppConfigData.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:/ 'newStartConfigurationSession' smart constructor.
data StartConfigurationSession = StartConfigurationSession'
  { -- | Sets a constraint on a session. If you specify a value of, for example,
    -- 60 seconds, then the client that established the session can\'t call
    -- GetLatestConfiguration more frequently then every 60 seconds.
    StartConfigurationSession -> Maybe Natural
requiredMinimumPollIntervalInSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The application ID or the application name.
    StartConfigurationSession -> Text
applicationIdentifier :: Prelude.Text,
    -- | The environment ID or the environment name.
    StartConfigurationSession -> Text
environmentIdentifier :: Prelude.Text,
    -- | The configuration profile ID or the configuration profile name.
    StartConfigurationSession -> Text
configurationProfileIdentifier :: Prelude.Text
  }
  deriving (StartConfigurationSession -> StartConfigurationSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartConfigurationSession -> StartConfigurationSession -> Bool
$c/= :: StartConfigurationSession -> StartConfigurationSession -> Bool
== :: StartConfigurationSession -> StartConfigurationSession -> Bool
$c== :: StartConfigurationSession -> StartConfigurationSession -> Bool
Prelude.Eq, ReadPrec [StartConfigurationSession]
ReadPrec StartConfigurationSession
Int -> ReadS StartConfigurationSession
ReadS [StartConfigurationSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartConfigurationSession]
$creadListPrec :: ReadPrec [StartConfigurationSession]
readPrec :: ReadPrec StartConfigurationSession
$creadPrec :: ReadPrec StartConfigurationSession
readList :: ReadS [StartConfigurationSession]
$creadList :: ReadS [StartConfigurationSession]
readsPrec :: Int -> ReadS StartConfigurationSession
$creadsPrec :: Int -> ReadS StartConfigurationSession
Prelude.Read, Int -> StartConfigurationSession -> ShowS
[StartConfigurationSession] -> ShowS
StartConfigurationSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartConfigurationSession] -> ShowS
$cshowList :: [StartConfigurationSession] -> ShowS
show :: StartConfigurationSession -> String
$cshow :: StartConfigurationSession -> String
showsPrec :: Int -> StartConfigurationSession -> ShowS
$cshowsPrec :: Int -> StartConfigurationSession -> ShowS
Prelude.Show, forall x.
Rep StartConfigurationSession x -> StartConfigurationSession
forall x.
StartConfigurationSession -> Rep StartConfigurationSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartConfigurationSession x -> StartConfigurationSession
$cfrom :: forall x.
StartConfigurationSession -> Rep StartConfigurationSession x
Prelude.Generic)

-- |
-- Create a value of 'StartConfigurationSession' 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:
--
-- 'requiredMinimumPollIntervalInSeconds', 'startConfigurationSession_requiredMinimumPollIntervalInSeconds' - Sets a constraint on a session. If you specify a value of, for example,
-- 60 seconds, then the client that established the session can\'t call
-- GetLatestConfiguration more frequently then every 60 seconds.
--
-- 'applicationIdentifier', 'startConfigurationSession_applicationIdentifier' - The application ID or the application name.
--
-- 'environmentIdentifier', 'startConfigurationSession_environmentIdentifier' - The environment ID or the environment name.
--
-- 'configurationProfileIdentifier', 'startConfigurationSession_configurationProfileIdentifier' - The configuration profile ID or the configuration profile name.
newStartConfigurationSession ::
  -- | 'applicationIdentifier'
  Prelude.Text ->
  -- | 'environmentIdentifier'
  Prelude.Text ->
  -- | 'configurationProfileIdentifier'
  Prelude.Text ->
  StartConfigurationSession
newStartConfigurationSession :: Text -> Text -> Text -> StartConfigurationSession
newStartConfigurationSession
  Text
pApplicationIdentifier_
  Text
pEnvironmentIdentifier_
  Text
pConfigurationProfileIdentifier_ =
    StartConfigurationSession'
      { $sel:requiredMinimumPollIntervalInSeconds:StartConfigurationSession' :: Maybe Natural
requiredMinimumPollIntervalInSeconds =
          forall a. Maybe a
Prelude.Nothing,
        $sel:applicationIdentifier:StartConfigurationSession' :: Text
applicationIdentifier = Text
pApplicationIdentifier_,
        $sel:environmentIdentifier:StartConfigurationSession' :: Text
environmentIdentifier = Text
pEnvironmentIdentifier_,
        $sel:configurationProfileIdentifier:StartConfigurationSession' :: Text
configurationProfileIdentifier =
          Text
pConfigurationProfileIdentifier_
      }

-- | Sets a constraint on a session. If you specify a value of, for example,
-- 60 seconds, then the client that established the session can\'t call
-- GetLatestConfiguration more frequently then every 60 seconds.
startConfigurationSession_requiredMinimumPollIntervalInSeconds :: Lens.Lens' StartConfigurationSession (Prelude.Maybe Prelude.Natural)
startConfigurationSession_requiredMinimumPollIntervalInSeconds :: Lens' StartConfigurationSession (Maybe Natural)
startConfigurationSession_requiredMinimumPollIntervalInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConfigurationSession' {Maybe Natural
requiredMinimumPollIntervalInSeconds :: Maybe Natural
$sel:requiredMinimumPollIntervalInSeconds:StartConfigurationSession' :: StartConfigurationSession -> Maybe Natural
requiredMinimumPollIntervalInSeconds} -> Maybe Natural
requiredMinimumPollIntervalInSeconds) (\s :: StartConfigurationSession
s@StartConfigurationSession' {} Maybe Natural
a -> StartConfigurationSession
s {$sel:requiredMinimumPollIntervalInSeconds:StartConfigurationSession' :: Maybe Natural
requiredMinimumPollIntervalInSeconds = Maybe Natural
a} :: StartConfigurationSession)

-- | The application ID or the application name.
startConfigurationSession_applicationIdentifier :: Lens.Lens' StartConfigurationSession Prelude.Text
startConfigurationSession_applicationIdentifier :: Lens' StartConfigurationSession Text
startConfigurationSession_applicationIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConfigurationSession' {Text
applicationIdentifier :: Text
$sel:applicationIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
applicationIdentifier} -> Text
applicationIdentifier) (\s :: StartConfigurationSession
s@StartConfigurationSession' {} Text
a -> StartConfigurationSession
s {$sel:applicationIdentifier:StartConfigurationSession' :: Text
applicationIdentifier = Text
a} :: StartConfigurationSession)

-- | The environment ID or the environment name.
startConfigurationSession_environmentIdentifier :: Lens.Lens' StartConfigurationSession Prelude.Text
startConfigurationSession_environmentIdentifier :: Lens' StartConfigurationSession Text
startConfigurationSession_environmentIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConfigurationSession' {Text
environmentIdentifier :: Text
$sel:environmentIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
environmentIdentifier} -> Text
environmentIdentifier) (\s :: StartConfigurationSession
s@StartConfigurationSession' {} Text
a -> StartConfigurationSession
s {$sel:environmentIdentifier:StartConfigurationSession' :: Text
environmentIdentifier = Text
a} :: StartConfigurationSession)

-- | The configuration profile ID or the configuration profile name.
startConfigurationSession_configurationProfileIdentifier :: Lens.Lens' StartConfigurationSession Prelude.Text
startConfigurationSession_configurationProfileIdentifier :: Lens' StartConfigurationSession Text
startConfigurationSession_configurationProfileIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConfigurationSession' {Text
configurationProfileIdentifier :: Text
$sel:configurationProfileIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
configurationProfileIdentifier} -> Text
configurationProfileIdentifier) (\s :: StartConfigurationSession
s@StartConfigurationSession' {} Text
a -> StartConfigurationSession
s {$sel:configurationProfileIdentifier:StartConfigurationSession' :: Text
configurationProfileIdentifier = Text
a} :: StartConfigurationSession)

instance Core.AWSRequest StartConfigurationSession where
  type
    AWSResponse StartConfigurationSession =
      StartConfigurationSessionResponse
  request :: (Service -> Service)
-> StartConfigurationSession -> Request StartConfigurationSession
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 StartConfigurationSession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartConfigurationSession)))
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 -> StartConfigurationSessionResponse
StartConfigurationSessionResponse'
            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
"InitialConfigurationToken")
            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 StartConfigurationSession where
  hashWithSalt :: Int -> StartConfigurationSession -> Int
hashWithSalt Int
_salt StartConfigurationSession' {Maybe Natural
Text
configurationProfileIdentifier :: Text
environmentIdentifier :: Text
applicationIdentifier :: Text
requiredMinimumPollIntervalInSeconds :: Maybe Natural
$sel:configurationProfileIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:environmentIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:applicationIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:requiredMinimumPollIntervalInSeconds:StartConfigurationSession' :: StartConfigurationSession -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
requiredMinimumPollIntervalInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configurationProfileIdentifier

instance Prelude.NFData StartConfigurationSession where
  rnf :: StartConfigurationSession -> ()
rnf StartConfigurationSession' {Maybe Natural
Text
configurationProfileIdentifier :: Text
environmentIdentifier :: Text
applicationIdentifier :: Text
requiredMinimumPollIntervalInSeconds :: Maybe Natural
$sel:configurationProfileIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:environmentIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:applicationIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:requiredMinimumPollIntervalInSeconds:StartConfigurationSession' :: StartConfigurationSession -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
requiredMinimumPollIntervalInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configurationProfileIdentifier

instance Data.ToHeaders StartConfigurationSession where
  toHeaders :: StartConfigurationSession -> 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.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartConfigurationSession where
  toJSON :: StartConfigurationSession -> Value
toJSON StartConfigurationSession' {Maybe Natural
Text
configurationProfileIdentifier :: Text
environmentIdentifier :: Text
applicationIdentifier :: Text
requiredMinimumPollIntervalInSeconds :: Maybe Natural
$sel:configurationProfileIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:environmentIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:applicationIdentifier:StartConfigurationSession' :: StartConfigurationSession -> Text
$sel:requiredMinimumPollIntervalInSeconds:StartConfigurationSession' :: StartConfigurationSession -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"RequiredMinimumPollIntervalInSeconds" 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 Natural
requiredMinimumPollIntervalInSeconds,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ApplicationIdentifier"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationIdentifier
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"EnvironmentIdentifier"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
environmentIdentifier
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ConfigurationProfileIdentifier"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
configurationProfileIdentifier
              )
          ]
      )

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

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

-- | /See:/ 'newStartConfigurationSessionResponse' smart constructor.
data StartConfigurationSessionResponse = StartConfigurationSessionResponse'
  { -- | Token encapsulating state about the configuration session. Provide this
    -- token to the @GetLatestConfiguration@ API to retrieve configuration
    -- data.
    --
    -- This token should only be used once in your first call to
    -- @GetLatestConfiguration@. You MUST use the new token in the
    -- @GetLatestConfiguration@ response (@NextPollConfigurationToken@) in each
    -- subsequent call to @GetLatestConfiguration@.
    StartConfigurationSessionResponse -> Maybe Text
initialConfigurationToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartConfigurationSessionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartConfigurationSessionResponse
-> StartConfigurationSessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartConfigurationSessionResponse
-> StartConfigurationSessionResponse -> Bool
$c/= :: StartConfigurationSessionResponse
-> StartConfigurationSessionResponse -> Bool
== :: StartConfigurationSessionResponse
-> StartConfigurationSessionResponse -> Bool
$c== :: StartConfigurationSessionResponse
-> StartConfigurationSessionResponse -> Bool
Prelude.Eq, ReadPrec [StartConfigurationSessionResponse]
ReadPrec StartConfigurationSessionResponse
Int -> ReadS StartConfigurationSessionResponse
ReadS [StartConfigurationSessionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartConfigurationSessionResponse]
$creadListPrec :: ReadPrec [StartConfigurationSessionResponse]
readPrec :: ReadPrec StartConfigurationSessionResponse
$creadPrec :: ReadPrec StartConfigurationSessionResponse
readList :: ReadS [StartConfigurationSessionResponse]
$creadList :: ReadS [StartConfigurationSessionResponse]
readsPrec :: Int -> ReadS StartConfigurationSessionResponse
$creadsPrec :: Int -> ReadS StartConfigurationSessionResponse
Prelude.Read, Int -> StartConfigurationSessionResponse -> ShowS
[StartConfigurationSessionResponse] -> ShowS
StartConfigurationSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartConfigurationSessionResponse] -> ShowS
$cshowList :: [StartConfigurationSessionResponse] -> ShowS
show :: StartConfigurationSessionResponse -> String
$cshow :: StartConfigurationSessionResponse -> String
showsPrec :: Int -> StartConfigurationSessionResponse -> ShowS
$cshowsPrec :: Int -> StartConfigurationSessionResponse -> ShowS
Prelude.Show, forall x.
Rep StartConfigurationSessionResponse x
-> StartConfigurationSessionResponse
forall x.
StartConfigurationSessionResponse
-> Rep StartConfigurationSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartConfigurationSessionResponse x
-> StartConfigurationSessionResponse
$cfrom :: forall x.
StartConfigurationSessionResponse
-> Rep StartConfigurationSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartConfigurationSessionResponse' 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:
--
-- 'initialConfigurationToken', 'startConfigurationSessionResponse_initialConfigurationToken' - Token encapsulating state about the configuration session. Provide this
-- token to the @GetLatestConfiguration@ API to retrieve configuration
-- data.
--
-- This token should only be used once in your first call to
-- @GetLatestConfiguration@. You MUST use the new token in the
-- @GetLatestConfiguration@ response (@NextPollConfigurationToken@) in each
-- subsequent call to @GetLatestConfiguration@.
--
-- 'httpStatus', 'startConfigurationSessionResponse_httpStatus' - The response's http status code.
newStartConfigurationSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartConfigurationSessionResponse
newStartConfigurationSessionResponse :: Int -> StartConfigurationSessionResponse
newStartConfigurationSessionResponse Int
pHttpStatus_ =
  StartConfigurationSessionResponse'
    { $sel:initialConfigurationToken:StartConfigurationSessionResponse' :: Maybe Text
initialConfigurationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartConfigurationSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Token encapsulating state about the configuration session. Provide this
-- token to the @GetLatestConfiguration@ API to retrieve configuration
-- data.
--
-- This token should only be used once in your first call to
-- @GetLatestConfiguration@. You MUST use the new token in the
-- @GetLatestConfiguration@ response (@NextPollConfigurationToken@) in each
-- subsequent call to @GetLatestConfiguration@.
startConfigurationSessionResponse_initialConfigurationToken :: Lens.Lens' StartConfigurationSessionResponse (Prelude.Maybe Prelude.Text)
startConfigurationSessionResponse_initialConfigurationToken :: Lens' StartConfigurationSessionResponse (Maybe Text)
startConfigurationSessionResponse_initialConfigurationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConfigurationSessionResponse' {Maybe Text
initialConfigurationToken :: Maybe Text
$sel:initialConfigurationToken:StartConfigurationSessionResponse' :: StartConfigurationSessionResponse -> Maybe Text
initialConfigurationToken} -> Maybe Text
initialConfigurationToken) (\s :: StartConfigurationSessionResponse
s@StartConfigurationSessionResponse' {} Maybe Text
a -> StartConfigurationSessionResponse
s {$sel:initialConfigurationToken:StartConfigurationSessionResponse' :: Maybe Text
initialConfigurationToken = Maybe Text
a} :: StartConfigurationSessionResponse)

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

instance
  Prelude.NFData
    StartConfigurationSessionResponse
  where
  rnf :: StartConfigurationSessionResponse -> ()
rnf StartConfigurationSessionResponse' {Int
Maybe Text
httpStatus :: Int
initialConfigurationToken :: Maybe Text
$sel:httpStatus:StartConfigurationSessionResponse' :: StartConfigurationSessionResponse -> Int
$sel:initialConfigurationToken:StartConfigurationSessionResponse' :: StartConfigurationSessionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
initialConfigurationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus