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

    -- * Request Lenses
    createBackendStorage_appId,
    createBackendStorage_resourceName,
    createBackendStorage_backendEnvironmentName,
    createBackendStorage_resourceConfig,

    -- * Destructuring the Response
    CreateBackendStorageResponse (..),
    newCreateBackendStorageResponse,

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

-- |
-- Create a value of 'CreateBackendStorage' 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', 'createBackendStorage_appId' - The app ID.
--
-- 'resourceName', 'createBackendStorage_resourceName' - The name of the storage resource.
--
-- 'backendEnvironmentName', 'createBackendStorage_backendEnvironmentName' - The name of the backend environment.
--
-- 'resourceConfig', 'createBackendStorage_resourceConfig' - The resource configuration for creating backend storage.
newCreateBackendStorage ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'resourceName'
  Prelude.Text ->
  -- | 'backendEnvironmentName'
  Prelude.Text ->
  -- | 'resourceConfig'
  CreateBackendStorageResourceConfig ->
  CreateBackendStorage
newCreateBackendStorage :: Text
-> Text
-> Text
-> CreateBackendStorageResourceConfig
-> CreateBackendStorage
newCreateBackendStorage
  Text
pAppId_
  Text
pResourceName_
  Text
pBackendEnvironmentName_
  CreateBackendStorageResourceConfig
pResourceConfig_ =
    CreateBackendStorage'
      { $sel:appId:CreateBackendStorage' :: Text
appId = Text
pAppId_,
        $sel:resourceName:CreateBackendStorage' :: Text
resourceName = Text
pResourceName_,
        $sel:backendEnvironmentName:CreateBackendStorage' :: Text
backendEnvironmentName = Text
pBackendEnvironmentName_,
        $sel:resourceConfig:CreateBackendStorage' :: CreateBackendStorageResourceConfig
resourceConfig = CreateBackendStorageResourceConfig
pResourceConfig_
      }

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

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

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

-- | The resource configuration for creating backend storage.
createBackendStorage_resourceConfig :: Lens.Lens' CreateBackendStorage CreateBackendStorageResourceConfig
createBackendStorage_resourceConfig :: Lens' CreateBackendStorage CreateBackendStorageResourceConfig
createBackendStorage_resourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackendStorage' {CreateBackendStorageResourceConfig
resourceConfig :: CreateBackendStorageResourceConfig
$sel:resourceConfig:CreateBackendStorage' :: CreateBackendStorage -> CreateBackendStorageResourceConfig
resourceConfig} -> CreateBackendStorageResourceConfig
resourceConfig) (\s :: CreateBackendStorage
s@CreateBackendStorage' {} CreateBackendStorageResourceConfig
a -> CreateBackendStorage
s {$sel:resourceConfig:CreateBackendStorage' :: CreateBackendStorageResourceConfig
resourceConfig = CreateBackendStorageResourceConfig
a} :: CreateBackendStorage)

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

instance Prelude.NFData CreateBackendStorage where
  rnf :: CreateBackendStorage -> ()
rnf CreateBackendStorage' {Text
CreateBackendStorageResourceConfig
resourceConfig :: CreateBackendStorageResourceConfig
backendEnvironmentName :: Text
resourceName :: Text
appId :: Text
$sel:resourceConfig:CreateBackendStorage' :: CreateBackendStorage -> CreateBackendStorageResourceConfig
$sel:backendEnvironmentName:CreateBackendStorage' :: CreateBackendStorage -> Text
$sel:resourceName:CreateBackendStorage' :: CreateBackendStorage -> Text
$sel:appId:CreateBackendStorage' :: CreateBackendStorage -> 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
resourceName
      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 CreateBackendStorageResourceConfig
resourceConfig

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

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

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

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

-- |
-- Create a value of 'CreateBackendStorageResponse' 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', 'createBackendStorageResponse_appId' - The app ID.
--
-- 'backendEnvironmentName', 'createBackendStorageResponse_backendEnvironmentName' - The name of the backend environment.
--
-- 'jobId', 'createBackendStorageResponse_jobId' - The ID for the job.
--
-- 'status', 'createBackendStorageResponse_status' - The current status of the request.
--
-- 'httpStatus', 'createBackendStorageResponse_httpStatus' - The response's http status code.
newCreateBackendStorageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBackendStorageResponse
newCreateBackendStorageResponse :: Int -> CreateBackendStorageResponse
newCreateBackendStorageResponse Int
pHttpStatus_ =
  CreateBackendStorageResponse'
    { $sel:appId:CreateBackendStorageResponse' :: Maybe Text
appId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backendEnvironmentName:CreateBackendStorageResponse' :: Maybe Text
backendEnvironmentName = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:CreateBackendStorageResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateBackendStorageResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBackendStorageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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

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

instance Prelude.NFData CreateBackendStorageResponse where
  rnf :: CreateBackendStorageResponse -> ()
rnf CreateBackendStorageResponse' {Int
Maybe Text
httpStatus :: Int
status :: Maybe Text
jobId :: Maybe Text
backendEnvironmentName :: Maybe Text
appId :: Maybe Text
$sel:httpStatus:CreateBackendStorageResponse' :: CreateBackendStorageResponse -> Int
$sel:status:CreateBackendStorageResponse' :: CreateBackendStorageResponse -> Maybe Text
$sel:jobId:CreateBackendStorageResponse' :: CreateBackendStorageResponse -> Maybe Text
$sel:backendEnvironmentName:CreateBackendStorageResponse' :: CreateBackendStorageResponse -> Maybe Text
$sel:appId:CreateBackendStorageResponse' :: CreateBackendStorageResponse -> 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