{-# 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.WorkSpaces.CreateWorkspaceBundle
-- 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 the specified WorkSpace bundle. For more information about
-- creating WorkSpace bundles, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/create-custom-bundle.html Create a Custom WorkSpaces Image and Bundle>.
module Amazonka.WorkSpaces.CreateWorkspaceBundle
  ( -- * Creating a Request
    CreateWorkspaceBundle (..),
    newCreateWorkspaceBundle,

    -- * Request Lenses
    createWorkspaceBundle_rootStorage,
    createWorkspaceBundle_tags,
    createWorkspaceBundle_bundleName,
    createWorkspaceBundle_bundleDescription,
    createWorkspaceBundle_imageId,
    createWorkspaceBundle_computeType,
    createWorkspaceBundle_userStorage,

    -- * Destructuring the Response
    CreateWorkspaceBundleResponse (..),
    newCreateWorkspaceBundleResponse,

    -- * Response Lenses
    createWorkspaceBundleResponse_workspaceBundle,
    createWorkspaceBundleResponse_httpStatus,
  )
where

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
import Amazonka.WorkSpaces.Types

-- | /See:/ 'newCreateWorkspaceBundle' smart constructor.
data CreateWorkspaceBundle = CreateWorkspaceBundle'
  { CreateWorkspaceBundle -> Maybe RootStorage
rootStorage :: Prelude.Maybe RootStorage,
    -- | The tags associated with the bundle.
    --
    -- To add tags at the same time when you\'re creating the bundle, you must
    -- create an IAM policy that grants your IAM user permissions to use
    -- @workspaces:CreateTags@.
    CreateWorkspaceBundle -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the bundle.
    CreateWorkspaceBundle -> Text
bundleName :: Prelude.Text,
    -- | The description of the bundle.
    CreateWorkspaceBundle -> Text
bundleDescription :: Prelude.Text,
    -- | The identifier of the image that is used to create the bundle.
    CreateWorkspaceBundle -> Text
imageId :: Prelude.Text,
    CreateWorkspaceBundle -> ComputeType
computeType :: ComputeType,
    CreateWorkspaceBundle -> UserStorage
userStorage :: UserStorage
  }
  deriving (CreateWorkspaceBundle -> CreateWorkspaceBundle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkspaceBundle -> CreateWorkspaceBundle -> Bool
$c/= :: CreateWorkspaceBundle -> CreateWorkspaceBundle -> Bool
== :: CreateWorkspaceBundle -> CreateWorkspaceBundle -> Bool
$c== :: CreateWorkspaceBundle -> CreateWorkspaceBundle -> Bool
Prelude.Eq, ReadPrec [CreateWorkspaceBundle]
ReadPrec CreateWorkspaceBundle
Int -> ReadS CreateWorkspaceBundle
ReadS [CreateWorkspaceBundle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkspaceBundle]
$creadListPrec :: ReadPrec [CreateWorkspaceBundle]
readPrec :: ReadPrec CreateWorkspaceBundle
$creadPrec :: ReadPrec CreateWorkspaceBundle
readList :: ReadS [CreateWorkspaceBundle]
$creadList :: ReadS [CreateWorkspaceBundle]
readsPrec :: Int -> ReadS CreateWorkspaceBundle
$creadsPrec :: Int -> ReadS CreateWorkspaceBundle
Prelude.Read, Int -> CreateWorkspaceBundle -> ShowS
[CreateWorkspaceBundle] -> ShowS
CreateWorkspaceBundle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkspaceBundle] -> ShowS
$cshowList :: [CreateWorkspaceBundle] -> ShowS
show :: CreateWorkspaceBundle -> String
$cshow :: CreateWorkspaceBundle -> String
showsPrec :: Int -> CreateWorkspaceBundle -> ShowS
$cshowsPrec :: Int -> CreateWorkspaceBundle -> ShowS
Prelude.Show, forall x. Rep CreateWorkspaceBundle x -> CreateWorkspaceBundle
forall x. CreateWorkspaceBundle -> Rep CreateWorkspaceBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkspaceBundle x -> CreateWorkspaceBundle
$cfrom :: forall x. CreateWorkspaceBundle -> Rep CreateWorkspaceBundle x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkspaceBundle' 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:
--
-- 'rootStorage', 'createWorkspaceBundle_rootStorage' - Undocumented member.
--
-- 'tags', 'createWorkspaceBundle_tags' - The tags associated with the bundle.
--
-- To add tags at the same time when you\'re creating the bundle, you must
-- create an IAM policy that grants your IAM user permissions to use
-- @workspaces:CreateTags@.
--
-- 'bundleName', 'createWorkspaceBundle_bundleName' - The name of the bundle.
--
-- 'bundleDescription', 'createWorkspaceBundle_bundleDescription' - The description of the bundle.
--
-- 'imageId', 'createWorkspaceBundle_imageId' - The identifier of the image that is used to create the bundle.
--
-- 'computeType', 'createWorkspaceBundle_computeType' - Undocumented member.
--
-- 'userStorage', 'createWorkspaceBundle_userStorage' - Undocumented member.
newCreateWorkspaceBundle ::
  -- | 'bundleName'
  Prelude.Text ->
  -- | 'bundleDescription'
  Prelude.Text ->
  -- | 'imageId'
  Prelude.Text ->
  -- | 'computeType'
  ComputeType ->
  -- | 'userStorage'
  UserStorage ->
  CreateWorkspaceBundle
newCreateWorkspaceBundle :: Text
-> Text
-> Text
-> ComputeType
-> UserStorage
-> CreateWorkspaceBundle
newCreateWorkspaceBundle
  Text
pBundleName_
  Text
pBundleDescription_
  Text
pImageId_
  ComputeType
pComputeType_
  UserStorage
pUserStorage_ =
    CreateWorkspaceBundle'
      { $sel:rootStorage:CreateWorkspaceBundle' :: Maybe RootStorage
rootStorage =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateWorkspaceBundle' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:bundleName:CreateWorkspaceBundle' :: Text
bundleName = Text
pBundleName_,
        $sel:bundleDescription:CreateWorkspaceBundle' :: Text
bundleDescription = Text
pBundleDescription_,
        $sel:imageId:CreateWorkspaceBundle' :: Text
imageId = Text
pImageId_,
        $sel:computeType:CreateWorkspaceBundle' :: ComputeType
computeType = ComputeType
pComputeType_,
        $sel:userStorage:CreateWorkspaceBundle' :: UserStorage
userStorage = UserStorage
pUserStorage_
      }

-- | Undocumented member.
createWorkspaceBundle_rootStorage :: Lens.Lens' CreateWorkspaceBundle (Prelude.Maybe RootStorage)
createWorkspaceBundle_rootStorage :: Lens' CreateWorkspaceBundle (Maybe RootStorage)
createWorkspaceBundle_rootStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundle' {Maybe RootStorage
rootStorage :: Maybe RootStorage
$sel:rootStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe RootStorage
rootStorage} -> Maybe RootStorage
rootStorage) (\s :: CreateWorkspaceBundle
s@CreateWorkspaceBundle' {} Maybe RootStorage
a -> CreateWorkspaceBundle
s {$sel:rootStorage:CreateWorkspaceBundle' :: Maybe RootStorage
rootStorage = Maybe RootStorage
a} :: CreateWorkspaceBundle)

-- | The tags associated with the bundle.
--
-- To add tags at the same time when you\'re creating the bundle, you must
-- create an IAM policy that grants your IAM user permissions to use
-- @workspaces:CreateTags@.
createWorkspaceBundle_tags :: Lens.Lens' CreateWorkspaceBundle (Prelude.Maybe [Tag])
createWorkspaceBundle_tags :: Lens' CreateWorkspaceBundle (Maybe [Tag])
createWorkspaceBundle_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundle' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateWorkspaceBundle
s@CreateWorkspaceBundle' {} Maybe [Tag]
a -> CreateWorkspaceBundle
s {$sel:tags:CreateWorkspaceBundle' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateWorkspaceBundle) 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 bundle.
createWorkspaceBundle_bundleName :: Lens.Lens' CreateWorkspaceBundle Prelude.Text
createWorkspaceBundle_bundleName :: Lens' CreateWorkspaceBundle Text
createWorkspaceBundle_bundleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundle' {Text
bundleName :: Text
$sel:bundleName:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
bundleName} -> Text
bundleName) (\s :: CreateWorkspaceBundle
s@CreateWorkspaceBundle' {} Text
a -> CreateWorkspaceBundle
s {$sel:bundleName:CreateWorkspaceBundle' :: Text
bundleName = Text
a} :: CreateWorkspaceBundle)

-- | The description of the bundle.
createWorkspaceBundle_bundleDescription :: Lens.Lens' CreateWorkspaceBundle Prelude.Text
createWorkspaceBundle_bundleDescription :: Lens' CreateWorkspaceBundle Text
createWorkspaceBundle_bundleDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundle' {Text
bundleDescription :: Text
$sel:bundleDescription:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
bundleDescription} -> Text
bundleDescription) (\s :: CreateWorkspaceBundle
s@CreateWorkspaceBundle' {} Text
a -> CreateWorkspaceBundle
s {$sel:bundleDescription:CreateWorkspaceBundle' :: Text
bundleDescription = Text
a} :: CreateWorkspaceBundle)

-- | The identifier of the image that is used to create the bundle.
createWorkspaceBundle_imageId :: Lens.Lens' CreateWorkspaceBundle Prelude.Text
createWorkspaceBundle_imageId :: Lens' CreateWorkspaceBundle Text
createWorkspaceBundle_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundle' {Text
imageId :: Text
$sel:imageId:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
imageId} -> Text
imageId) (\s :: CreateWorkspaceBundle
s@CreateWorkspaceBundle' {} Text
a -> CreateWorkspaceBundle
s {$sel:imageId:CreateWorkspaceBundle' :: Text
imageId = Text
a} :: CreateWorkspaceBundle)

-- | Undocumented member.
createWorkspaceBundle_computeType :: Lens.Lens' CreateWorkspaceBundle ComputeType
createWorkspaceBundle_computeType :: Lens' CreateWorkspaceBundle ComputeType
createWorkspaceBundle_computeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundle' {ComputeType
computeType :: ComputeType
$sel:computeType:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> ComputeType
computeType} -> ComputeType
computeType) (\s :: CreateWorkspaceBundle
s@CreateWorkspaceBundle' {} ComputeType
a -> CreateWorkspaceBundle
s {$sel:computeType:CreateWorkspaceBundle' :: ComputeType
computeType = ComputeType
a} :: CreateWorkspaceBundle)

-- | Undocumented member.
createWorkspaceBundle_userStorage :: Lens.Lens' CreateWorkspaceBundle UserStorage
createWorkspaceBundle_userStorage :: Lens' CreateWorkspaceBundle UserStorage
createWorkspaceBundle_userStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundle' {UserStorage
userStorage :: UserStorage
$sel:userStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> UserStorage
userStorage} -> UserStorage
userStorage) (\s :: CreateWorkspaceBundle
s@CreateWorkspaceBundle' {} UserStorage
a -> CreateWorkspaceBundle
s {$sel:userStorage:CreateWorkspaceBundle' :: UserStorage
userStorage = UserStorage
a} :: CreateWorkspaceBundle)

instance Core.AWSRequest CreateWorkspaceBundle where
  type
    AWSResponse CreateWorkspaceBundle =
      CreateWorkspaceBundleResponse
  request :: (Service -> Service)
-> CreateWorkspaceBundle -> Request CreateWorkspaceBundle
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 CreateWorkspaceBundle
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateWorkspaceBundle)))
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 WorkspaceBundle -> Int -> CreateWorkspaceBundleResponse
CreateWorkspaceBundleResponse'
            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
"WorkspaceBundle")
            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 CreateWorkspaceBundle where
  hashWithSalt :: Int -> CreateWorkspaceBundle -> Int
hashWithSalt Int
_salt CreateWorkspaceBundle' {Maybe [Tag]
Maybe RootStorage
Text
ComputeType
UserStorage
userStorage :: UserStorage
computeType :: ComputeType
imageId :: Text
bundleDescription :: Text
bundleName :: Text
tags :: Maybe [Tag]
rootStorage :: Maybe RootStorage
$sel:userStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> UserStorage
$sel:computeType:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> ComputeType
$sel:imageId:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:bundleDescription:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:bundleName:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:tags:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe [Tag]
$sel:rootStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe RootStorage
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RootStorage
rootStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bundleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bundleDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ComputeType
computeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UserStorage
userStorage

instance Prelude.NFData CreateWorkspaceBundle where
  rnf :: CreateWorkspaceBundle -> ()
rnf CreateWorkspaceBundle' {Maybe [Tag]
Maybe RootStorage
Text
ComputeType
UserStorage
userStorage :: UserStorage
computeType :: ComputeType
imageId :: Text
bundleDescription :: Text
bundleName :: Text
tags :: Maybe [Tag]
rootStorage :: Maybe RootStorage
$sel:userStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> UserStorage
$sel:computeType:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> ComputeType
$sel:imageId:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:bundleDescription:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:bundleName:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:tags:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe [Tag]
$sel:rootStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe RootStorage
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RootStorage
rootStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bundleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bundleDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ComputeType
computeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UserStorage
userStorage

instance Data.ToHeaders CreateWorkspaceBundle where
  toHeaders :: CreateWorkspaceBundle -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"WorkspacesService.CreateWorkspaceBundle" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateWorkspaceBundle where
  toJSON :: CreateWorkspaceBundle -> Value
toJSON CreateWorkspaceBundle' {Maybe [Tag]
Maybe RootStorage
Text
ComputeType
UserStorage
userStorage :: UserStorage
computeType :: ComputeType
imageId :: Text
bundleDescription :: Text
bundleName :: Text
tags :: Maybe [Tag]
rootStorage :: Maybe RootStorage
$sel:userStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> UserStorage
$sel:computeType:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> ComputeType
$sel:imageId:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:bundleDescription:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:bundleName:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Text
$sel:tags:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe [Tag]
$sel:rootStorage:CreateWorkspaceBundle' :: CreateWorkspaceBundle -> Maybe RootStorage
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"RootStorage" 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 RootStorage
rootStorage,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"BundleName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
bundleName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"BundleDescription" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
bundleDescription),
            forall a. a -> Maybe a
Prelude.Just (Key
"ImageId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
imageId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ComputeType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ComputeType
computeType),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserStorage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UserStorage
userStorage)
          ]
      )

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

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

-- | /See:/ 'newCreateWorkspaceBundleResponse' smart constructor.
data CreateWorkspaceBundleResponse = CreateWorkspaceBundleResponse'
  { CreateWorkspaceBundleResponse -> Maybe WorkspaceBundle
workspaceBundle :: Prelude.Maybe WorkspaceBundle,
    -- | The response's http status code.
    CreateWorkspaceBundleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateWorkspaceBundleResponse
-> CreateWorkspaceBundleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkspaceBundleResponse
-> CreateWorkspaceBundleResponse -> Bool
$c/= :: CreateWorkspaceBundleResponse
-> CreateWorkspaceBundleResponse -> Bool
== :: CreateWorkspaceBundleResponse
-> CreateWorkspaceBundleResponse -> Bool
$c== :: CreateWorkspaceBundleResponse
-> CreateWorkspaceBundleResponse -> Bool
Prelude.Eq, ReadPrec [CreateWorkspaceBundleResponse]
ReadPrec CreateWorkspaceBundleResponse
Int -> ReadS CreateWorkspaceBundleResponse
ReadS [CreateWorkspaceBundleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkspaceBundleResponse]
$creadListPrec :: ReadPrec [CreateWorkspaceBundleResponse]
readPrec :: ReadPrec CreateWorkspaceBundleResponse
$creadPrec :: ReadPrec CreateWorkspaceBundleResponse
readList :: ReadS [CreateWorkspaceBundleResponse]
$creadList :: ReadS [CreateWorkspaceBundleResponse]
readsPrec :: Int -> ReadS CreateWorkspaceBundleResponse
$creadsPrec :: Int -> ReadS CreateWorkspaceBundleResponse
Prelude.Read, Int -> CreateWorkspaceBundleResponse -> ShowS
[CreateWorkspaceBundleResponse] -> ShowS
CreateWorkspaceBundleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkspaceBundleResponse] -> ShowS
$cshowList :: [CreateWorkspaceBundleResponse] -> ShowS
show :: CreateWorkspaceBundleResponse -> String
$cshow :: CreateWorkspaceBundleResponse -> String
showsPrec :: Int -> CreateWorkspaceBundleResponse -> ShowS
$cshowsPrec :: Int -> CreateWorkspaceBundleResponse -> ShowS
Prelude.Show, forall x.
Rep CreateWorkspaceBundleResponse x
-> CreateWorkspaceBundleResponse
forall x.
CreateWorkspaceBundleResponse
-> Rep CreateWorkspaceBundleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateWorkspaceBundleResponse x
-> CreateWorkspaceBundleResponse
$cfrom :: forall x.
CreateWorkspaceBundleResponse
-> Rep CreateWorkspaceBundleResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkspaceBundleResponse' 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:
--
-- 'workspaceBundle', 'createWorkspaceBundleResponse_workspaceBundle' - Undocumented member.
--
-- 'httpStatus', 'createWorkspaceBundleResponse_httpStatus' - The response's http status code.
newCreateWorkspaceBundleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateWorkspaceBundleResponse
newCreateWorkspaceBundleResponse :: Int -> CreateWorkspaceBundleResponse
newCreateWorkspaceBundleResponse Int
pHttpStatus_ =
  CreateWorkspaceBundleResponse'
    { $sel:workspaceBundle:CreateWorkspaceBundleResponse' :: Maybe WorkspaceBundle
workspaceBundle =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateWorkspaceBundleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createWorkspaceBundleResponse_workspaceBundle :: Lens.Lens' CreateWorkspaceBundleResponse (Prelude.Maybe WorkspaceBundle)
createWorkspaceBundleResponse_workspaceBundle :: Lens' CreateWorkspaceBundleResponse (Maybe WorkspaceBundle)
createWorkspaceBundleResponse_workspaceBundle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceBundleResponse' {Maybe WorkspaceBundle
workspaceBundle :: Maybe WorkspaceBundle
$sel:workspaceBundle:CreateWorkspaceBundleResponse' :: CreateWorkspaceBundleResponse -> Maybe WorkspaceBundle
workspaceBundle} -> Maybe WorkspaceBundle
workspaceBundle) (\s :: CreateWorkspaceBundleResponse
s@CreateWorkspaceBundleResponse' {} Maybe WorkspaceBundle
a -> CreateWorkspaceBundleResponse
s {$sel:workspaceBundle:CreateWorkspaceBundleResponse' :: Maybe WorkspaceBundle
workspaceBundle = Maybe WorkspaceBundle
a} :: CreateWorkspaceBundleResponse)

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

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