{-# 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.AmplifyBackend.GetBackend
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides project-level details for your Amplify UI project.
module Amazonka.AmplifyBackend.GetBackend
  ( -- * Creating a Request
    GetBackend (..),
    newGetBackend,

    -- * Request Lenses
    getBackend_backendEnvironmentName,
    getBackend_appId,

    -- * Destructuring the Response
    GetBackendResponse (..),
    newGetBackendResponse,

    -- * Response Lenses
    getBackendResponse_amplifyFeatureFlags,
    getBackendResponse_amplifyMetaConfig,
    getBackendResponse_appId,
    getBackendResponse_appName,
    getBackendResponse_backendEnvironmentList,
    getBackendResponse_backendEnvironmentName,
    getBackendResponse_error,
    getBackendResponse_httpStatus,
  )
where

import Amazonka.AmplifyBackend.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

-- | The request body for GetBackend.
--
-- /See:/ 'newGetBackend' smart constructor.
data GetBackend = GetBackend'
  { -- | The name of the backend environment.
    GetBackend -> Maybe Text
backendEnvironmentName :: Prelude.Maybe Prelude.Text,
    -- | The app ID.
    GetBackend -> Text
appId :: Prelude.Text
  }
  deriving (GetBackend -> GetBackend -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBackend -> GetBackend -> Bool
$c/= :: GetBackend -> GetBackend -> Bool
== :: GetBackend -> GetBackend -> Bool
$c== :: GetBackend -> GetBackend -> Bool
Prelude.Eq, ReadPrec [GetBackend]
ReadPrec GetBackend
Int -> ReadS GetBackend
ReadS [GetBackend]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBackend]
$creadListPrec :: ReadPrec [GetBackend]
readPrec :: ReadPrec GetBackend
$creadPrec :: ReadPrec GetBackend
readList :: ReadS [GetBackend]
$creadList :: ReadS [GetBackend]
readsPrec :: Int -> ReadS GetBackend
$creadsPrec :: Int -> ReadS GetBackend
Prelude.Read, Int -> GetBackend -> ShowS
[GetBackend] -> ShowS
GetBackend -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBackend] -> ShowS
$cshowList :: [GetBackend] -> ShowS
show :: GetBackend -> String
$cshow :: GetBackend -> String
showsPrec :: Int -> GetBackend -> ShowS
$cshowsPrec :: Int -> GetBackend -> ShowS
Prelude.Show, forall x. Rep GetBackend x -> GetBackend
forall x. GetBackend -> Rep GetBackend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBackend x -> GetBackend
$cfrom :: forall x. GetBackend -> Rep GetBackend x
Prelude.Generic)

-- |
-- Create a value of 'GetBackend' 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:
--
-- 'backendEnvironmentName', 'getBackend_backendEnvironmentName' - The name of the backend environment.
--
-- 'appId', 'getBackend_appId' - The app ID.
newGetBackend ::
  -- | 'appId'
  Prelude.Text ->
  GetBackend
newGetBackend :: Text -> GetBackend
newGetBackend Text
pAppId_ =
  GetBackend'
    { $sel:backendEnvironmentName:GetBackend' :: Maybe Text
backendEnvironmentName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:appId:GetBackend' :: Text
appId = Text
pAppId_
    }

-- | The name of the backend environment.
getBackend_backendEnvironmentName :: Lens.Lens' GetBackend (Prelude.Maybe Prelude.Text)
getBackend_backendEnvironmentName :: Lens' GetBackend (Maybe Text)
getBackend_backendEnvironmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackend' {Maybe Text
backendEnvironmentName :: Maybe Text
$sel:backendEnvironmentName:GetBackend' :: GetBackend -> Maybe Text
backendEnvironmentName} -> Maybe Text
backendEnvironmentName) (\s :: GetBackend
s@GetBackend' {} Maybe Text
a -> GetBackend
s {$sel:backendEnvironmentName:GetBackend' :: Maybe Text
backendEnvironmentName = Maybe Text
a} :: GetBackend)

-- | The app ID.
getBackend_appId :: Lens.Lens' GetBackend Prelude.Text
getBackend_appId :: Lens' GetBackend Text
getBackend_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackend' {Text
appId :: Text
$sel:appId:GetBackend' :: GetBackend -> Text
appId} -> Text
appId) (\s :: GetBackend
s@GetBackend' {} Text
a -> GetBackend
s {$sel:appId:GetBackend' :: Text
appId = Text
a} :: GetBackend)

instance Core.AWSRequest GetBackend where
  type AWSResponse GetBackend = GetBackendResponse
  request :: (Service -> Service) -> GetBackend -> Request GetBackend
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 GetBackend
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetBackend)))
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 Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Int
-> GetBackendResponse
GetBackendResponse'
            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
"amplifyFeatureFlags")
            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
"amplifyMetaConfig")
            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
"appId")
            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
"appName")
            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
"backendEnvironmentList"
                            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"backendEnvironmentName")
            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
"error")
            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 GetBackend where
  hashWithSalt :: Int -> GetBackend -> Int
hashWithSalt Int
_salt GetBackend' {Maybe Text
Text
appId :: Text
backendEnvironmentName :: Maybe Text
$sel:appId:GetBackend' :: GetBackend -> Text
$sel:backendEnvironmentName:GetBackend' :: GetBackend -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
backendEnvironmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId

instance Prelude.NFData GetBackend where
  rnf :: GetBackend -> ()
rnf GetBackend' {Maybe Text
Text
appId :: Text
backendEnvironmentName :: Maybe Text
$sel:appId:GetBackend' :: GetBackend -> Text
$sel:backendEnvironmentName:GetBackend' :: GetBackend -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backendEnvironmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appId

instance Data.ToHeaders GetBackend where
  toHeaders :: GetBackend -> 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 GetBackend where
  toJSON :: GetBackend -> Value
toJSON GetBackend' {Maybe Text
Text
appId :: Text
backendEnvironmentName :: Maybe Text
$sel:appId:GetBackend' :: GetBackend -> Text
$sel:backendEnvironmentName:GetBackend' :: GetBackend -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"backendEnvironmentName" 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
backendEnvironmentName
          ]
      )

instance Data.ToPath GetBackend where
  toPath :: GetBackend -> ByteString
toPath GetBackend' {Maybe Text
Text
appId :: Text
backendEnvironmentName :: Maybe Text
$sel:appId:GetBackend' :: GetBackend -> Text
$sel:backendEnvironmentName:GetBackend' :: GetBackend -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/backend/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
appId, ByteString
"/details"]

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

-- | /See:/ 'newGetBackendResponse' smart constructor.
data GetBackendResponse = GetBackendResponse'
  { -- | A stringified version of the cli.json file for your Amplify project.
    GetBackendResponse -> Maybe Text
amplifyFeatureFlags :: Prelude.Maybe Prelude.Text,
    -- | A stringified version of the current configs for your Amplify project.
    GetBackendResponse -> Maybe Text
amplifyMetaConfig :: Prelude.Maybe Prelude.Text,
    -- | The app ID.
    GetBackendResponse -> Maybe Text
appId :: Prelude.Maybe Prelude.Text,
    -- | The name of the app.
    GetBackendResponse -> Maybe Text
appName :: Prelude.Maybe Prelude.Text,
    -- | A list of backend environments in an array.
    GetBackendResponse -> Maybe [Text]
backendEnvironmentList :: Prelude.Maybe [Prelude.Text],
    -- | The name of the backend environment.
    GetBackendResponse -> Maybe Text
backendEnvironmentName :: Prelude.Maybe Prelude.Text,
    -- | If the request failed, this is the returned error.
    GetBackendResponse -> Maybe Text
error :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetBackendResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBackendResponse -> GetBackendResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBackendResponse -> GetBackendResponse -> Bool
$c/= :: GetBackendResponse -> GetBackendResponse -> Bool
== :: GetBackendResponse -> GetBackendResponse -> Bool
$c== :: GetBackendResponse -> GetBackendResponse -> Bool
Prelude.Eq, ReadPrec [GetBackendResponse]
ReadPrec GetBackendResponse
Int -> ReadS GetBackendResponse
ReadS [GetBackendResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBackendResponse]
$creadListPrec :: ReadPrec [GetBackendResponse]
readPrec :: ReadPrec GetBackendResponse
$creadPrec :: ReadPrec GetBackendResponse
readList :: ReadS [GetBackendResponse]
$creadList :: ReadS [GetBackendResponse]
readsPrec :: Int -> ReadS GetBackendResponse
$creadsPrec :: Int -> ReadS GetBackendResponse
Prelude.Read, Int -> GetBackendResponse -> ShowS
[GetBackendResponse] -> ShowS
GetBackendResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBackendResponse] -> ShowS
$cshowList :: [GetBackendResponse] -> ShowS
show :: GetBackendResponse -> String
$cshow :: GetBackendResponse -> String
showsPrec :: Int -> GetBackendResponse -> ShowS
$cshowsPrec :: Int -> GetBackendResponse -> ShowS
Prelude.Show, forall x. Rep GetBackendResponse x -> GetBackendResponse
forall x. GetBackendResponse -> Rep GetBackendResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBackendResponse x -> GetBackendResponse
$cfrom :: forall x. GetBackendResponse -> Rep GetBackendResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBackendResponse' 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:
--
-- 'amplifyFeatureFlags', 'getBackendResponse_amplifyFeatureFlags' - A stringified version of the cli.json file for your Amplify project.
--
-- 'amplifyMetaConfig', 'getBackendResponse_amplifyMetaConfig' - A stringified version of the current configs for your Amplify project.
--
-- 'appId', 'getBackendResponse_appId' - The app ID.
--
-- 'appName', 'getBackendResponse_appName' - The name of the app.
--
-- 'backendEnvironmentList', 'getBackendResponse_backendEnvironmentList' - A list of backend environments in an array.
--
-- 'backendEnvironmentName', 'getBackendResponse_backendEnvironmentName' - The name of the backend environment.
--
-- 'error', 'getBackendResponse_error' - If the request failed, this is the returned error.
--
-- 'httpStatus', 'getBackendResponse_httpStatus' - The response's http status code.
newGetBackendResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBackendResponse
newGetBackendResponse :: Int -> GetBackendResponse
newGetBackendResponse Int
pHttpStatus_ =
  GetBackendResponse'
    { $sel:amplifyFeatureFlags:GetBackendResponse' :: Maybe Text
amplifyFeatureFlags =
        forall a. Maybe a
Prelude.Nothing,
      $sel:amplifyMetaConfig:GetBackendResponse' :: Maybe Text
amplifyMetaConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:appId:GetBackendResponse' :: Maybe Text
appId = forall a. Maybe a
Prelude.Nothing,
      $sel:appName:GetBackendResponse' :: Maybe Text
appName = forall a. Maybe a
Prelude.Nothing,
      $sel:backendEnvironmentList:GetBackendResponse' :: Maybe [Text]
backendEnvironmentList = forall a. Maybe a
Prelude.Nothing,
      $sel:backendEnvironmentName:GetBackendResponse' :: Maybe Text
backendEnvironmentName = forall a. Maybe a
Prelude.Nothing,
      $sel:error:GetBackendResponse' :: Maybe Text
error = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBackendResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A stringified version of the cli.json file for your Amplify project.
getBackendResponse_amplifyFeatureFlags :: Lens.Lens' GetBackendResponse (Prelude.Maybe Prelude.Text)
getBackendResponse_amplifyFeatureFlags :: Lens' GetBackendResponse (Maybe Text)
getBackendResponse_amplifyFeatureFlags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackendResponse' {Maybe Text
amplifyFeatureFlags :: Maybe Text
$sel:amplifyFeatureFlags:GetBackendResponse' :: GetBackendResponse -> Maybe Text
amplifyFeatureFlags} -> Maybe Text
amplifyFeatureFlags) (\s :: GetBackendResponse
s@GetBackendResponse' {} Maybe Text
a -> GetBackendResponse
s {$sel:amplifyFeatureFlags:GetBackendResponse' :: Maybe Text
amplifyFeatureFlags = Maybe Text
a} :: GetBackendResponse)

-- | A stringified version of the current configs for your Amplify project.
getBackendResponse_amplifyMetaConfig :: Lens.Lens' GetBackendResponse (Prelude.Maybe Prelude.Text)
getBackendResponse_amplifyMetaConfig :: Lens' GetBackendResponse (Maybe Text)
getBackendResponse_amplifyMetaConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackendResponse' {Maybe Text
amplifyMetaConfig :: Maybe Text
$sel:amplifyMetaConfig:GetBackendResponse' :: GetBackendResponse -> Maybe Text
amplifyMetaConfig} -> Maybe Text
amplifyMetaConfig) (\s :: GetBackendResponse
s@GetBackendResponse' {} Maybe Text
a -> GetBackendResponse
s {$sel:amplifyMetaConfig:GetBackendResponse' :: Maybe Text
amplifyMetaConfig = Maybe Text
a} :: GetBackendResponse)

-- | The app ID.
getBackendResponse_appId :: Lens.Lens' GetBackendResponse (Prelude.Maybe Prelude.Text)
getBackendResponse_appId :: Lens' GetBackendResponse (Maybe Text)
getBackendResponse_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackendResponse' {Maybe Text
appId :: Maybe Text
$sel:appId:GetBackendResponse' :: GetBackendResponse -> Maybe Text
appId} -> Maybe Text
appId) (\s :: GetBackendResponse
s@GetBackendResponse' {} Maybe Text
a -> GetBackendResponse
s {$sel:appId:GetBackendResponse' :: Maybe Text
appId = Maybe Text
a} :: GetBackendResponse)

-- | The name of the app.
getBackendResponse_appName :: Lens.Lens' GetBackendResponse (Prelude.Maybe Prelude.Text)
getBackendResponse_appName :: Lens' GetBackendResponse (Maybe Text)
getBackendResponse_appName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackendResponse' {Maybe Text
appName :: Maybe Text
$sel:appName:GetBackendResponse' :: GetBackendResponse -> Maybe Text
appName} -> Maybe Text
appName) (\s :: GetBackendResponse
s@GetBackendResponse' {} Maybe Text
a -> GetBackendResponse
s {$sel:appName:GetBackendResponse' :: Maybe Text
appName = Maybe Text
a} :: GetBackendResponse)

-- | A list of backend environments in an array.
getBackendResponse_backendEnvironmentList :: Lens.Lens' GetBackendResponse (Prelude.Maybe [Prelude.Text])
getBackendResponse_backendEnvironmentList :: Lens' GetBackendResponse (Maybe [Text])
getBackendResponse_backendEnvironmentList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackendResponse' {Maybe [Text]
backendEnvironmentList :: Maybe [Text]
$sel:backendEnvironmentList:GetBackendResponse' :: GetBackendResponse -> Maybe [Text]
backendEnvironmentList} -> Maybe [Text]
backendEnvironmentList) (\s :: GetBackendResponse
s@GetBackendResponse' {} Maybe [Text]
a -> GetBackendResponse
s {$sel:backendEnvironmentList:GetBackendResponse' :: Maybe [Text]
backendEnvironmentList = Maybe [Text]
a} :: GetBackendResponse) 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 name of the backend environment.
getBackendResponse_backendEnvironmentName :: Lens.Lens' GetBackendResponse (Prelude.Maybe Prelude.Text)
getBackendResponse_backendEnvironmentName :: Lens' GetBackendResponse (Maybe Text)
getBackendResponse_backendEnvironmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackendResponse' {Maybe Text
backendEnvironmentName :: Maybe Text
$sel:backendEnvironmentName:GetBackendResponse' :: GetBackendResponse -> Maybe Text
backendEnvironmentName} -> Maybe Text
backendEnvironmentName) (\s :: GetBackendResponse
s@GetBackendResponse' {} Maybe Text
a -> GetBackendResponse
s {$sel:backendEnvironmentName:GetBackendResponse' :: Maybe Text
backendEnvironmentName = Maybe Text
a} :: GetBackendResponse)

-- | If the request failed, this is the returned error.
getBackendResponse_error :: Lens.Lens' GetBackendResponse (Prelude.Maybe Prelude.Text)
getBackendResponse_error :: Lens' GetBackendResponse (Maybe Text)
getBackendResponse_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackendResponse' {Maybe Text
error :: Maybe Text
$sel:error:GetBackendResponse' :: GetBackendResponse -> Maybe Text
error} -> Maybe Text
error) (\s :: GetBackendResponse
s@GetBackendResponse' {} Maybe Text
a -> GetBackendResponse
s {$sel:error:GetBackendResponse' :: Maybe Text
error = Maybe Text
a} :: GetBackendResponse)

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

instance Prelude.NFData GetBackendResponse where
  rnf :: GetBackendResponse -> ()
rnf GetBackendResponse' {Int
Maybe [Text]
Maybe Text
httpStatus :: Int
error :: Maybe Text
backendEnvironmentName :: Maybe Text
backendEnvironmentList :: Maybe [Text]
appName :: Maybe Text
appId :: Maybe Text
amplifyMetaConfig :: Maybe Text
amplifyFeatureFlags :: Maybe Text
$sel:httpStatus:GetBackendResponse' :: GetBackendResponse -> Int
$sel:error:GetBackendResponse' :: GetBackendResponse -> Maybe Text
$sel:backendEnvironmentName:GetBackendResponse' :: GetBackendResponse -> Maybe Text
$sel:backendEnvironmentList:GetBackendResponse' :: GetBackendResponse -> Maybe [Text]
$sel:appName:GetBackendResponse' :: GetBackendResponse -> Maybe Text
$sel:appId:GetBackendResponse' :: GetBackendResponse -> Maybe Text
$sel:amplifyMetaConfig:GetBackendResponse' :: GetBackendResponse -> Maybe Text
$sel:amplifyFeatureFlags:GetBackendResponse' :: GetBackendResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
amplifyFeatureFlags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
amplifyMetaConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
appName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
backendEnvironmentList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backendEnvironmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
error
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus