{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.WorkspaceProperties
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.WorkSpaces.Types.WorkspaceProperties 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 Amazonka.WorkSpaces.Types.Compute
import Amazonka.WorkSpaces.Types.Protocol
import Amazonka.WorkSpaces.Types.RunningMode

-- | Describes a WorkSpace.
--
-- /See:/ 'newWorkspaceProperties' smart constructor.
data WorkspaceProperties = WorkspaceProperties'
  { -- | The compute type. For more information, see
    -- <http://aws.amazon.com/workspaces/details/#Amazon_WorkSpaces_Bundles Amazon WorkSpaces Bundles>.
    WorkspaceProperties -> Maybe Compute
computeTypeName :: Prelude.Maybe Compute,
    -- | The protocol. For more information, see
    -- <https://docs.aws.amazon.com/workspaces/latest/adminguide/amazon-workspaces-protocols.html Protocols for Amazon WorkSpaces>.
    --
    -- -   Only available for WorkSpaces created with PCoIP bundles.
    --
    -- -   The @Protocols@ property is case sensitive. Ensure you use @PCOIP@
    --     or @WSP@.
    --
    -- -   Unavailable for Windows 7 WorkSpaces and WorkSpaces using GPU-based
    --     bundles (Graphics, GraphicsPro, Graphics.g4dn, and
    --     GraphicsPro.g4dn).
    WorkspaceProperties -> Maybe [Protocol]
protocols :: Prelude.Maybe [Protocol],
    -- | The size of the root volume. For important information about how to
    -- modify the size of the root and user volumes, see
    -- <https://docs.aws.amazon.com/workspaces/latest/adminguide/modify-workspaces.html Modify a WorkSpace>.
    WorkspaceProperties -> Maybe Int
rootVolumeSizeGib :: Prelude.Maybe Prelude.Int,
    -- | The running mode. For more information, see
    -- <https://docs.aws.amazon.com/workspaces/latest/adminguide/running-mode.html Manage the WorkSpace Running Mode>.
    --
    -- The @MANUAL@ value is only supported by Amazon WorkSpaces Core. Contact
    -- your account team to be allow-listed to use this value. For more
    -- information, see
    -- <http://aws.amazon.com/workspaces/core/ Amazon WorkSpaces Core>.
    WorkspaceProperties -> Maybe RunningMode
runningMode :: Prelude.Maybe RunningMode,
    -- | The time after a user logs off when WorkSpaces are automatically
    -- stopped. Configured in 60-minute intervals.
    WorkspaceProperties -> Maybe Int
runningModeAutoStopTimeoutInMinutes :: Prelude.Maybe Prelude.Int,
    -- | The size of the user storage. For important information about how to
    -- modify the size of the root and user volumes, see
    -- <https://docs.aws.amazon.com/workspaces/latest/adminguide/modify-workspaces.html Modify a WorkSpace>.
    WorkspaceProperties -> Maybe Int
userVolumeSizeGib :: Prelude.Maybe Prelude.Int
  }
  deriving (WorkspaceProperties -> WorkspaceProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceProperties -> WorkspaceProperties -> Bool
$c/= :: WorkspaceProperties -> WorkspaceProperties -> Bool
== :: WorkspaceProperties -> WorkspaceProperties -> Bool
$c== :: WorkspaceProperties -> WorkspaceProperties -> Bool
Prelude.Eq, ReadPrec [WorkspaceProperties]
ReadPrec WorkspaceProperties
Int -> ReadS WorkspaceProperties
ReadS [WorkspaceProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceProperties]
$creadListPrec :: ReadPrec [WorkspaceProperties]
readPrec :: ReadPrec WorkspaceProperties
$creadPrec :: ReadPrec WorkspaceProperties
readList :: ReadS [WorkspaceProperties]
$creadList :: ReadS [WorkspaceProperties]
readsPrec :: Int -> ReadS WorkspaceProperties
$creadsPrec :: Int -> ReadS WorkspaceProperties
Prelude.Read, Int -> WorkspaceProperties -> ShowS
[WorkspaceProperties] -> ShowS
WorkspaceProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceProperties] -> ShowS
$cshowList :: [WorkspaceProperties] -> ShowS
show :: WorkspaceProperties -> String
$cshow :: WorkspaceProperties -> String
showsPrec :: Int -> WorkspaceProperties -> ShowS
$cshowsPrec :: Int -> WorkspaceProperties -> ShowS
Prelude.Show, forall x. Rep WorkspaceProperties x -> WorkspaceProperties
forall x. WorkspaceProperties -> Rep WorkspaceProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WorkspaceProperties x -> WorkspaceProperties
$cfrom :: forall x. WorkspaceProperties -> Rep WorkspaceProperties x
Prelude.Generic)

-- |
-- Create a value of 'WorkspaceProperties' 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:
--
-- 'computeTypeName', 'workspaceProperties_computeTypeName' - The compute type. For more information, see
-- <http://aws.amazon.com/workspaces/details/#Amazon_WorkSpaces_Bundles Amazon WorkSpaces Bundles>.
--
-- 'protocols', 'workspaceProperties_protocols' - The protocol. For more information, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/amazon-workspaces-protocols.html Protocols for Amazon WorkSpaces>.
--
-- -   Only available for WorkSpaces created with PCoIP bundles.
--
-- -   The @Protocols@ property is case sensitive. Ensure you use @PCOIP@
--     or @WSP@.
--
-- -   Unavailable for Windows 7 WorkSpaces and WorkSpaces using GPU-based
--     bundles (Graphics, GraphicsPro, Graphics.g4dn, and
--     GraphicsPro.g4dn).
--
-- 'rootVolumeSizeGib', 'workspaceProperties_rootVolumeSizeGib' - The size of the root volume. For important information about how to
-- modify the size of the root and user volumes, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/modify-workspaces.html Modify a WorkSpace>.
--
-- 'runningMode', 'workspaceProperties_runningMode' - The running mode. For more information, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/running-mode.html Manage the WorkSpace Running Mode>.
--
-- The @MANUAL@ value is only supported by Amazon WorkSpaces Core. Contact
-- your account team to be allow-listed to use this value. For more
-- information, see
-- <http://aws.amazon.com/workspaces/core/ Amazon WorkSpaces Core>.
--
-- 'runningModeAutoStopTimeoutInMinutes', 'workspaceProperties_runningModeAutoStopTimeoutInMinutes' - The time after a user logs off when WorkSpaces are automatically
-- stopped. Configured in 60-minute intervals.
--
-- 'userVolumeSizeGib', 'workspaceProperties_userVolumeSizeGib' - The size of the user storage. For important information about how to
-- modify the size of the root and user volumes, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/modify-workspaces.html Modify a WorkSpace>.
newWorkspaceProperties ::
  WorkspaceProperties
newWorkspaceProperties :: WorkspaceProperties
newWorkspaceProperties =
  WorkspaceProperties'
    { $sel:computeTypeName:WorkspaceProperties' :: Maybe Compute
computeTypeName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:protocols:WorkspaceProperties' :: Maybe [Protocol]
protocols = forall a. Maybe a
Prelude.Nothing,
      $sel:rootVolumeSizeGib:WorkspaceProperties' :: Maybe Int
rootVolumeSizeGib = forall a. Maybe a
Prelude.Nothing,
      $sel:runningMode:WorkspaceProperties' :: Maybe RunningMode
runningMode = forall a. Maybe a
Prelude.Nothing,
      $sel:runningModeAutoStopTimeoutInMinutes:WorkspaceProperties' :: Maybe Int
runningModeAutoStopTimeoutInMinutes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:userVolumeSizeGib:WorkspaceProperties' :: Maybe Int
userVolumeSizeGib = forall a. Maybe a
Prelude.Nothing
    }

-- | The compute type. For more information, see
-- <http://aws.amazon.com/workspaces/details/#Amazon_WorkSpaces_Bundles Amazon WorkSpaces Bundles>.
workspaceProperties_computeTypeName :: Lens.Lens' WorkspaceProperties (Prelude.Maybe Compute)
workspaceProperties_computeTypeName :: Lens' WorkspaceProperties (Maybe Compute)
workspaceProperties_computeTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkspaceProperties' {Maybe Compute
computeTypeName :: Maybe Compute
$sel:computeTypeName:WorkspaceProperties' :: WorkspaceProperties -> Maybe Compute
computeTypeName} -> Maybe Compute
computeTypeName) (\s :: WorkspaceProperties
s@WorkspaceProperties' {} Maybe Compute
a -> WorkspaceProperties
s {$sel:computeTypeName:WorkspaceProperties' :: Maybe Compute
computeTypeName = Maybe Compute
a} :: WorkspaceProperties)

-- | The protocol. For more information, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/amazon-workspaces-protocols.html Protocols for Amazon WorkSpaces>.
--
-- -   Only available for WorkSpaces created with PCoIP bundles.
--
-- -   The @Protocols@ property is case sensitive. Ensure you use @PCOIP@
--     or @WSP@.
--
-- -   Unavailable for Windows 7 WorkSpaces and WorkSpaces using GPU-based
--     bundles (Graphics, GraphicsPro, Graphics.g4dn, and
--     GraphicsPro.g4dn).
workspaceProperties_protocols :: Lens.Lens' WorkspaceProperties (Prelude.Maybe [Protocol])
workspaceProperties_protocols :: Lens' WorkspaceProperties (Maybe [Protocol])
workspaceProperties_protocols = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkspaceProperties' {Maybe [Protocol]
protocols :: Maybe [Protocol]
$sel:protocols:WorkspaceProperties' :: WorkspaceProperties -> Maybe [Protocol]
protocols} -> Maybe [Protocol]
protocols) (\s :: WorkspaceProperties
s@WorkspaceProperties' {} Maybe [Protocol]
a -> WorkspaceProperties
s {$sel:protocols:WorkspaceProperties' :: Maybe [Protocol]
protocols = Maybe [Protocol]
a} :: WorkspaceProperties) 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 size of the root volume. For important information about how to
-- modify the size of the root and user volumes, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/modify-workspaces.html Modify a WorkSpace>.
workspaceProperties_rootVolumeSizeGib :: Lens.Lens' WorkspaceProperties (Prelude.Maybe Prelude.Int)
workspaceProperties_rootVolumeSizeGib :: Lens' WorkspaceProperties (Maybe Int)
workspaceProperties_rootVolumeSizeGib = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkspaceProperties' {Maybe Int
rootVolumeSizeGib :: Maybe Int
$sel:rootVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
rootVolumeSizeGib} -> Maybe Int
rootVolumeSizeGib) (\s :: WorkspaceProperties
s@WorkspaceProperties' {} Maybe Int
a -> WorkspaceProperties
s {$sel:rootVolumeSizeGib:WorkspaceProperties' :: Maybe Int
rootVolumeSizeGib = Maybe Int
a} :: WorkspaceProperties)

-- | The running mode. For more information, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/running-mode.html Manage the WorkSpace Running Mode>.
--
-- The @MANUAL@ value is only supported by Amazon WorkSpaces Core. Contact
-- your account team to be allow-listed to use this value. For more
-- information, see
-- <http://aws.amazon.com/workspaces/core/ Amazon WorkSpaces Core>.
workspaceProperties_runningMode :: Lens.Lens' WorkspaceProperties (Prelude.Maybe RunningMode)
workspaceProperties_runningMode :: Lens' WorkspaceProperties (Maybe RunningMode)
workspaceProperties_runningMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkspaceProperties' {Maybe RunningMode
runningMode :: Maybe RunningMode
$sel:runningMode:WorkspaceProperties' :: WorkspaceProperties -> Maybe RunningMode
runningMode} -> Maybe RunningMode
runningMode) (\s :: WorkspaceProperties
s@WorkspaceProperties' {} Maybe RunningMode
a -> WorkspaceProperties
s {$sel:runningMode:WorkspaceProperties' :: Maybe RunningMode
runningMode = Maybe RunningMode
a} :: WorkspaceProperties)

-- | The time after a user logs off when WorkSpaces are automatically
-- stopped. Configured in 60-minute intervals.
workspaceProperties_runningModeAutoStopTimeoutInMinutes :: Lens.Lens' WorkspaceProperties (Prelude.Maybe Prelude.Int)
workspaceProperties_runningModeAutoStopTimeoutInMinutes :: Lens' WorkspaceProperties (Maybe Int)
workspaceProperties_runningModeAutoStopTimeoutInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkspaceProperties' {Maybe Int
runningModeAutoStopTimeoutInMinutes :: Maybe Int
$sel:runningModeAutoStopTimeoutInMinutes:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
runningModeAutoStopTimeoutInMinutes} -> Maybe Int
runningModeAutoStopTimeoutInMinutes) (\s :: WorkspaceProperties
s@WorkspaceProperties' {} Maybe Int
a -> WorkspaceProperties
s {$sel:runningModeAutoStopTimeoutInMinutes:WorkspaceProperties' :: Maybe Int
runningModeAutoStopTimeoutInMinutes = Maybe Int
a} :: WorkspaceProperties)

-- | The size of the user storage. For important information about how to
-- modify the size of the root and user volumes, see
-- <https://docs.aws.amazon.com/workspaces/latest/adminguide/modify-workspaces.html Modify a WorkSpace>.
workspaceProperties_userVolumeSizeGib :: Lens.Lens' WorkspaceProperties (Prelude.Maybe Prelude.Int)
workspaceProperties_userVolumeSizeGib :: Lens' WorkspaceProperties (Maybe Int)
workspaceProperties_userVolumeSizeGib = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WorkspaceProperties' {Maybe Int
userVolumeSizeGib :: Maybe Int
$sel:userVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
userVolumeSizeGib} -> Maybe Int
userVolumeSizeGib) (\s :: WorkspaceProperties
s@WorkspaceProperties' {} Maybe Int
a -> WorkspaceProperties
s {$sel:userVolumeSizeGib:WorkspaceProperties' :: Maybe Int
userVolumeSizeGib = Maybe Int
a} :: WorkspaceProperties)

instance Data.FromJSON WorkspaceProperties where
  parseJSON :: Value -> Parser WorkspaceProperties
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"WorkspaceProperties"
      ( \Object
x ->
          Maybe Compute
-> Maybe [Protocol]
-> Maybe Int
-> Maybe RunningMode
-> Maybe Int
-> Maybe Int
-> WorkspaceProperties
WorkspaceProperties'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ComputeTypeName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Protocols" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"RootVolumeSizeGib")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RunningMode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RunningModeAutoStopTimeoutInMinutes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"UserVolumeSizeGib")
      )

instance Prelude.Hashable WorkspaceProperties where
  hashWithSalt :: Int -> WorkspaceProperties -> Int
hashWithSalt Int
_salt WorkspaceProperties' {Maybe Int
Maybe [Protocol]
Maybe Compute
Maybe RunningMode
userVolumeSizeGib :: Maybe Int
runningModeAutoStopTimeoutInMinutes :: Maybe Int
runningMode :: Maybe RunningMode
rootVolumeSizeGib :: Maybe Int
protocols :: Maybe [Protocol]
computeTypeName :: Maybe Compute
$sel:userVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:runningModeAutoStopTimeoutInMinutes:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:runningMode:WorkspaceProperties' :: WorkspaceProperties -> Maybe RunningMode
$sel:rootVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:protocols:WorkspaceProperties' :: WorkspaceProperties -> Maybe [Protocol]
$sel:computeTypeName:WorkspaceProperties' :: WorkspaceProperties -> Maybe Compute
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Compute
computeTypeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Protocol]
protocols
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
rootVolumeSizeGib
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RunningMode
runningMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
runningModeAutoStopTimeoutInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
userVolumeSizeGib

instance Prelude.NFData WorkspaceProperties where
  rnf :: WorkspaceProperties -> ()
rnf WorkspaceProperties' {Maybe Int
Maybe [Protocol]
Maybe Compute
Maybe RunningMode
userVolumeSizeGib :: Maybe Int
runningModeAutoStopTimeoutInMinutes :: Maybe Int
runningMode :: Maybe RunningMode
rootVolumeSizeGib :: Maybe Int
protocols :: Maybe [Protocol]
computeTypeName :: Maybe Compute
$sel:userVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:runningModeAutoStopTimeoutInMinutes:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:runningMode:WorkspaceProperties' :: WorkspaceProperties -> Maybe RunningMode
$sel:rootVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:protocols:WorkspaceProperties' :: WorkspaceProperties -> Maybe [Protocol]
$sel:computeTypeName:WorkspaceProperties' :: WorkspaceProperties -> Maybe Compute
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Compute
computeTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Protocol]
protocols
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
rootVolumeSizeGib
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RunningMode
runningMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
runningModeAutoStopTimeoutInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
userVolumeSizeGib

instance Data.ToJSON WorkspaceProperties where
  toJSON :: WorkspaceProperties -> Value
toJSON WorkspaceProperties' {Maybe Int
Maybe [Protocol]
Maybe Compute
Maybe RunningMode
userVolumeSizeGib :: Maybe Int
runningModeAutoStopTimeoutInMinutes :: Maybe Int
runningMode :: Maybe RunningMode
rootVolumeSizeGib :: Maybe Int
protocols :: Maybe [Protocol]
computeTypeName :: Maybe Compute
$sel:userVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:runningModeAutoStopTimeoutInMinutes:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:runningMode:WorkspaceProperties' :: WorkspaceProperties -> Maybe RunningMode
$sel:rootVolumeSizeGib:WorkspaceProperties' :: WorkspaceProperties -> Maybe Int
$sel:protocols:WorkspaceProperties' :: WorkspaceProperties -> Maybe [Protocol]
$sel:computeTypeName:WorkspaceProperties' :: WorkspaceProperties -> Maybe Compute
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ComputeTypeName" 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 Compute
computeTypeName,
            (Key
"Protocols" 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 [Protocol]
protocols,
            (Key
"RootVolumeSizeGib" 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 Int
rootVolumeSizeGib,
            (Key
"RunningMode" 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 RunningMode
runningMode,
            (Key
"RunningModeAutoStopTimeoutInMinutes" 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 Int
runningModeAutoStopTimeoutInMinutes,
            (Key
"UserVolumeSizeGib" 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 Int
userVolumeSizeGib
          ]
      )