{-# 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.UpdateBackendStorage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing backend storage resource.
module Amazonka.AmplifyBackend.UpdateBackendStorage
  ( -- * Creating a Request
    UpdateBackendStorage (..),
    newUpdateBackendStorage,

    -- * Request Lenses
    updateBackendStorage_appId,
    updateBackendStorage_backendEnvironmentName,
    updateBackendStorage_resourceName,
    updateBackendStorage_resourceConfig,

    -- * Destructuring the Response
    UpdateBackendStorageResponse (..),
    newUpdateBackendStorageResponse,

    -- * Response Lenses
    updateBackendStorageResponse_appId,
    updateBackendStorageResponse_backendEnvironmentName,
    updateBackendStorageResponse_jobId,
    updateBackendStorageResponse_status,
    updateBackendStorageResponse_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 UpdateBackendStorage.
--
-- /See:/ 'newUpdateBackendStorage' smart constructor.
data UpdateBackendStorage = UpdateBackendStorage'
  { -- | The app ID.
    UpdateBackendStorage -> Text
appId :: Prelude.Text,
    -- | The name of the backend environment.
    UpdateBackendStorage -> Text
backendEnvironmentName :: Prelude.Text,
    -- | The name of the storage resource.
    UpdateBackendStorage -> Text
resourceName :: Prelude.Text,
    -- | The resource configuration for updating backend storage.
    UpdateBackendStorage -> UpdateBackendStorageResourceConfig
resourceConfig :: UpdateBackendStorageResourceConfig
  }
  deriving (UpdateBackendStorage -> UpdateBackendStorage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBackendStorage -> UpdateBackendStorage -> Bool
$c/= :: UpdateBackendStorage -> UpdateBackendStorage -> Bool
== :: UpdateBackendStorage -> UpdateBackendStorage -> Bool
$c== :: UpdateBackendStorage -> UpdateBackendStorage -> Bool
Prelude.Eq, ReadPrec [UpdateBackendStorage]
ReadPrec UpdateBackendStorage
Int -> ReadS UpdateBackendStorage
ReadS [UpdateBackendStorage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBackendStorage]
$creadListPrec :: ReadPrec [UpdateBackendStorage]
readPrec :: ReadPrec UpdateBackendStorage
$creadPrec :: ReadPrec UpdateBackendStorage
readList :: ReadS [UpdateBackendStorage]
$creadList :: ReadS [UpdateBackendStorage]
readsPrec :: Int -> ReadS UpdateBackendStorage
$creadsPrec :: Int -> ReadS UpdateBackendStorage
Prelude.Read, Int -> UpdateBackendStorage -> ShowS
[UpdateBackendStorage] -> ShowS
UpdateBackendStorage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBackendStorage] -> ShowS
$cshowList :: [UpdateBackendStorage] -> ShowS
show :: UpdateBackendStorage -> String
$cshow :: UpdateBackendStorage -> String
showsPrec :: Int -> UpdateBackendStorage -> ShowS
$cshowsPrec :: Int -> UpdateBackendStorage -> ShowS
Prelude.Show, forall x. Rep UpdateBackendStorage x -> UpdateBackendStorage
forall x. UpdateBackendStorage -> Rep UpdateBackendStorage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBackendStorage x -> UpdateBackendStorage
$cfrom :: forall x. UpdateBackendStorage -> Rep UpdateBackendStorage x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBackendStorage' 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:
--
-- 'appId', 'updateBackendStorage_appId' - The app ID.
--
-- 'backendEnvironmentName', 'updateBackendStorage_backendEnvironmentName' - The name of the backend environment.
--
-- 'resourceName', 'updateBackendStorage_resourceName' - The name of the storage resource.
--
-- 'resourceConfig', 'updateBackendStorage_resourceConfig' - The resource configuration for updating backend storage.
newUpdateBackendStorage ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'backendEnvironmentName'
  Prelude.Text ->
  -- | 'resourceName'
  Prelude.Text ->
  -- | 'resourceConfig'
  UpdateBackendStorageResourceConfig ->
  UpdateBackendStorage
newUpdateBackendStorage :: Text
-> Text
-> Text
-> UpdateBackendStorageResourceConfig
-> UpdateBackendStorage
newUpdateBackendStorage
  Text
pAppId_
  Text
pBackendEnvironmentName_
  Text
pResourceName_
  UpdateBackendStorageResourceConfig
pResourceConfig_ =
    UpdateBackendStorage'
      { $sel:appId:UpdateBackendStorage' :: Text
appId = Text
pAppId_,
        $sel:backendEnvironmentName:UpdateBackendStorage' :: Text
backendEnvironmentName = Text
pBackendEnvironmentName_,
        $sel:resourceName:UpdateBackendStorage' :: Text
resourceName = Text
pResourceName_,
        $sel:resourceConfig:UpdateBackendStorage' :: UpdateBackendStorageResourceConfig
resourceConfig = UpdateBackendStorageResourceConfig
pResourceConfig_
      }

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

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

-- | The name of the storage resource.
updateBackendStorage_resourceName :: Lens.Lens' UpdateBackendStorage Prelude.Text
updateBackendStorage_resourceName :: Lens' UpdateBackendStorage Text
updateBackendStorage_resourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackendStorage' {Text
resourceName :: Text
$sel:resourceName:UpdateBackendStorage' :: UpdateBackendStorage -> Text
resourceName} -> Text
resourceName) (\s :: UpdateBackendStorage
s@UpdateBackendStorage' {} Text
a -> UpdateBackendStorage
s {$sel:resourceName:UpdateBackendStorage' :: Text
resourceName = Text
a} :: UpdateBackendStorage)

-- | The resource configuration for updating backend storage.
updateBackendStorage_resourceConfig :: Lens.Lens' UpdateBackendStorage UpdateBackendStorageResourceConfig
updateBackendStorage_resourceConfig :: Lens' UpdateBackendStorage UpdateBackendStorageResourceConfig
updateBackendStorage_resourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackendStorage' {UpdateBackendStorageResourceConfig
resourceConfig :: UpdateBackendStorageResourceConfig
$sel:resourceConfig:UpdateBackendStorage' :: UpdateBackendStorage -> UpdateBackendStorageResourceConfig
resourceConfig} -> UpdateBackendStorageResourceConfig
resourceConfig) (\s :: UpdateBackendStorage
s@UpdateBackendStorage' {} UpdateBackendStorageResourceConfig
a -> UpdateBackendStorage
s {$sel:resourceConfig:UpdateBackendStorage' :: UpdateBackendStorageResourceConfig
resourceConfig = UpdateBackendStorageResourceConfig
a} :: UpdateBackendStorage)

instance Core.AWSRequest UpdateBackendStorage where
  type
    AWSResponse UpdateBackendStorage =
      UpdateBackendStorageResponse
  request :: (Service -> Service)
-> UpdateBackendStorage -> Request UpdateBackendStorage
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 UpdateBackendStorage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateBackendStorage)))
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
-> Int
-> UpdateBackendStorageResponse
UpdateBackendStorageResponse'
            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
"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
"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
"jobId")
            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
"status")
            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 UpdateBackendStorage where
  hashWithSalt :: Int -> UpdateBackendStorage -> Int
hashWithSalt Int
_salt UpdateBackendStorage' {Text
UpdateBackendStorageResourceConfig
resourceConfig :: UpdateBackendStorageResourceConfig
resourceName :: Text
backendEnvironmentName :: Text
appId :: Text
$sel:resourceConfig:UpdateBackendStorage' :: UpdateBackendStorage -> UpdateBackendStorageResourceConfig
$sel:resourceName:UpdateBackendStorage' :: UpdateBackendStorage -> Text
$sel:backendEnvironmentName:UpdateBackendStorage' :: UpdateBackendStorage -> Text
$sel:appId:UpdateBackendStorage' :: UpdateBackendStorage -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backendEnvironmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateBackendStorageResourceConfig
resourceConfig

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

instance Data.ToHeaders UpdateBackendStorage where
  toHeaders :: UpdateBackendStorage -> 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 UpdateBackendStorage where
  toJSON :: UpdateBackendStorage -> Value
toJSON UpdateBackendStorage' {Text
UpdateBackendStorageResourceConfig
resourceConfig :: UpdateBackendStorageResourceConfig
resourceName :: Text
backendEnvironmentName :: Text
appId :: Text
$sel:resourceConfig:UpdateBackendStorage' :: UpdateBackendStorage -> UpdateBackendStorageResourceConfig
$sel:resourceName:UpdateBackendStorage' :: UpdateBackendStorage -> Text
$sel:backendEnvironmentName:UpdateBackendStorage' :: UpdateBackendStorage -> Text
$sel:appId:UpdateBackendStorage' :: UpdateBackendStorage -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"resourceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"resourceConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UpdateBackendStorageResourceConfig
resourceConfig)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateBackendStorageResponse' 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:
--
-- 'appId', 'updateBackendStorageResponse_appId' - The app ID.
--
-- 'backendEnvironmentName', 'updateBackendStorageResponse_backendEnvironmentName' - The name of the backend environment.
--
-- 'jobId', 'updateBackendStorageResponse_jobId' - The ID for the job.
--
-- 'status', 'updateBackendStorageResponse_status' - The current status of the request.
--
-- 'httpStatus', 'updateBackendStorageResponse_httpStatus' - The response's http status code.
newUpdateBackendStorageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateBackendStorageResponse
newUpdateBackendStorageResponse :: Int -> UpdateBackendStorageResponse
newUpdateBackendStorageResponse Int
pHttpStatus_ =
  UpdateBackendStorageResponse'
    { $sel:appId:UpdateBackendStorageResponse' :: Maybe Text
appId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backendEnvironmentName:UpdateBackendStorageResponse' :: Maybe Text
backendEnvironmentName = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:UpdateBackendStorageResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateBackendStorageResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateBackendStorageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

-- | The ID for the job.
updateBackendStorageResponse_jobId :: Lens.Lens' UpdateBackendStorageResponse (Prelude.Maybe Prelude.Text)
updateBackendStorageResponse_jobId :: Lens' UpdateBackendStorageResponse (Maybe Text)
updateBackendStorageResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackendStorageResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:UpdateBackendStorageResponse' :: UpdateBackendStorageResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: UpdateBackendStorageResponse
s@UpdateBackendStorageResponse' {} Maybe Text
a -> UpdateBackendStorageResponse
s {$sel:jobId:UpdateBackendStorageResponse' :: Maybe Text
jobId = Maybe Text
a} :: UpdateBackendStorageResponse)

-- | The current status of the request.
updateBackendStorageResponse_status :: Lens.Lens' UpdateBackendStorageResponse (Prelude.Maybe Prelude.Text)
updateBackendStorageResponse_status :: Lens' UpdateBackendStorageResponse (Maybe Text)
updateBackendStorageResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackendStorageResponse' {Maybe Text
status :: Maybe Text
$sel:status:UpdateBackendStorageResponse' :: UpdateBackendStorageResponse -> Maybe Text
status} -> Maybe Text
status) (\s :: UpdateBackendStorageResponse
s@UpdateBackendStorageResponse' {} Maybe Text
a -> UpdateBackendStorageResponse
s {$sel:status:UpdateBackendStorageResponse' :: Maybe Text
status = Maybe Text
a} :: UpdateBackendStorageResponse)

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

instance Prelude.NFData UpdateBackendStorageResponse where
  rnf :: UpdateBackendStorageResponse -> ()
rnf UpdateBackendStorageResponse' {Int
Maybe Text
httpStatus :: Int
status :: Maybe Text
jobId :: Maybe Text
backendEnvironmentName :: Maybe Text
appId :: Maybe Text
$sel:httpStatus:UpdateBackendStorageResponse' :: UpdateBackendStorageResponse -> Int
$sel:status:UpdateBackendStorageResponse' :: UpdateBackendStorageResponse -> Maybe Text
$sel:jobId:UpdateBackendStorageResponse' :: UpdateBackendStorageResponse -> Maybe Text
$sel:backendEnvironmentName:UpdateBackendStorageResponse' :: UpdateBackendStorageResponse -> Maybe Text
$sel:appId:UpdateBackendStorageResponse' :: UpdateBackendStorageResponse -> Maybe Text
..} =
    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
backendEnvironmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus