module Stratosphere.WorkSpaces.WorkspacesPool (
        module Exports, WorkspacesPool(..), mkWorkspacesPool
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.WorkSpaces.WorkspacesPool.ApplicationSettingsProperty as Exports
import {-# SOURCE #-} Stratosphere.WorkSpaces.WorkspacesPool.CapacityProperty as Exports
import {-# SOURCE #-} Stratosphere.WorkSpaces.WorkspacesPool.TimeoutSettingsProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data WorkspacesPool
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html>
    WorkspacesPool {WorkspacesPool -> ()
haddock_workaround_ :: (),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-applicationsettings>
                    WorkspacesPool -> Maybe ApplicationSettingsProperty
applicationSettings :: (Prelude.Maybe ApplicationSettingsProperty),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-bundleid>
                    WorkspacesPool -> Value Text
bundleId :: (Value Prelude.Text),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-capacity>
                    WorkspacesPool -> CapacityProperty
capacity :: CapacityProperty,
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-description>
                    WorkspacesPool -> Maybe (Value Text)
description :: (Prelude.Maybe (Value Prelude.Text)),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-directoryid>
                    WorkspacesPool -> Value Text
directoryId :: (Value Prelude.Text),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-poolname>
                    WorkspacesPool -> Value Text
poolName :: (Value Prelude.Text),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-runningmode>
                    WorkspacesPool -> Maybe (Value Text)
runningMode :: (Prelude.Maybe (Value Prelude.Text)),
                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-workspaces-workspacespool.html#cfn-workspaces-workspacespool-timeoutsettings>
                    WorkspacesPool -> Maybe TimeoutSettingsProperty
timeoutSettings :: (Prelude.Maybe TimeoutSettingsProperty)}
  deriving stock (WorkspacesPool -> WorkspacesPool -> Bool
(WorkspacesPool -> WorkspacesPool -> Bool)
-> (WorkspacesPool -> WorkspacesPool -> Bool) -> Eq WorkspacesPool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkspacesPool -> WorkspacesPool -> Bool
== :: WorkspacesPool -> WorkspacesPool -> Bool
$c/= :: WorkspacesPool -> WorkspacesPool -> Bool
/= :: WorkspacesPool -> WorkspacesPool -> Bool
Prelude.Eq, Int -> WorkspacesPool -> ShowS
[WorkspacesPool] -> ShowS
WorkspacesPool -> String
(Int -> WorkspacesPool -> ShowS)
-> (WorkspacesPool -> String)
-> ([WorkspacesPool] -> ShowS)
-> Show WorkspacesPool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkspacesPool -> ShowS
showsPrec :: Int -> WorkspacesPool -> ShowS
$cshow :: WorkspacesPool -> String
show :: WorkspacesPool -> String
$cshowList :: [WorkspacesPool] -> ShowS
showList :: [WorkspacesPool] -> ShowS
Prelude.Show)
mkWorkspacesPool ::
  Value Prelude.Text
  -> CapacityProperty
     -> Value Prelude.Text -> Value Prelude.Text -> WorkspacesPool
mkWorkspacesPool :: Value Text
-> CapacityProperty -> Value Text -> Value Text -> WorkspacesPool
mkWorkspacesPool Value Text
bundleId CapacityProperty
capacity Value Text
directoryId Value Text
poolName
  = WorkspacesPool
      {haddock_workaround_ :: ()
haddock_workaround_ = (), bundleId :: Value Text
bundleId = Value Text
bundleId,
       capacity :: CapacityProperty
capacity = CapacityProperty
capacity, directoryId :: Value Text
directoryId = Value Text
directoryId,
       poolName :: Value Text
poolName = Value Text
poolName, applicationSettings :: Maybe ApplicationSettingsProperty
applicationSettings = Maybe ApplicationSettingsProperty
forall a. Maybe a
Prelude.Nothing,
       description :: Maybe (Value Text)
description = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing, runningMode :: Maybe (Value Text)
runningMode = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing,
       timeoutSettings :: Maybe TimeoutSettingsProperty
timeoutSettings = Maybe TimeoutSettingsProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties WorkspacesPool where
  toResourceProperties :: WorkspacesPool -> ResourceProperties
toResourceProperties WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::WorkSpaces::WorkspacesPool",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"BundleId" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
bundleId, Key
"Capacity" Key -> CapacityProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= CapacityProperty
capacity,
                            Key
"DirectoryId" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
directoryId, Key
"PoolName" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
poolName]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> ApplicationSettingsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ApplicationSettings" (ApplicationSettingsProperty -> (Key, Value))
-> Maybe ApplicationSettingsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ApplicationSettingsProperty
applicationSettings,
                               Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Description" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
description,
                               Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RunningMode" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
runningMode,
                               Key -> TimeoutSettingsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"TimeoutSettings" (TimeoutSettingsProperty -> (Key, Value))
-> Maybe TimeoutSettingsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TimeoutSettingsProperty
timeoutSettings]))}
instance JSON.ToJSON WorkspacesPool where
  toJSON :: WorkspacesPool -> Value
toJSON WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"BundleId" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
bundleId, Key
"Capacity" Key -> CapacityProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= CapacityProperty
capacity,
               Key
"DirectoryId" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
directoryId, Key
"PoolName" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
poolName]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> ApplicationSettingsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ApplicationSettings" (ApplicationSettingsProperty -> (Key, Value))
-> Maybe ApplicationSettingsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ApplicationSettingsProperty
applicationSettings,
                  Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Description" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
description,
                  Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RunningMode" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
runningMode,
                  Key -> TimeoutSettingsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"TimeoutSettings" (TimeoutSettingsProperty -> (Key, Value))
-> Maybe TimeoutSettingsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TimeoutSettingsProperty
timeoutSettings])))
instance Property "ApplicationSettings" WorkspacesPool where
  type PropertyType "ApplicationSettings" WorkspacesPool = ApplicationSettingsProperty
  set :: PropertyType "ApplicationSettings" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "ApplicationSettings" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {applicationSettings :: Maybe ApplicationSettingsProperty
applicationSettings = ApplicationSettingsProperty -> Maybe ApplicationSettingsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ApplicationSettings" WorkspacesPool
ApplicationSettingsProperty
newValue, Maybe (Value Text)
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: ()
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
instance Property "BundleId" WorkspacesPool where
  type PropertyType "BundleId" WorkspacesPool = Value Prelude.Text
  set :: PropertyType "BundleId" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "BundleId" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {bundleId :: Value Text
bundleId = PropertyType "BundleId" WorkspacesPool
Value Text
newValue, Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
instance Property "Capacity" WorkspacesPool where
  type PropertyType "Capacity" WorkspacesPool = CapacityProperty
  set :: PropertyType "Capacity" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "Capacity" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {capacity :: CapacityProperty
capacity = PropertyType "Capacity" WorkspacesPool
CapacityProperty
newValue, Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
instance Property "Description" WorkspacesPool where
  type PropertyType "Description" WorkspacesPool = Value Prelude.Text
  set :: PropertyType "Description" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "Description" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {description :: Maybe (Value Text)
description = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Description" WorkspacesPool
Value Text
newValue, Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
instance Property "DirectoryId" WorkspacesPool where
  type PropertyType "DirectoryId" WorkspacesPool = Value Prelude.Text
  set :: PropertyType "DirectoryId" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "DirectoryId" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {directoryId :: Value Text
directoryId = PropertyType "DirectoryId" WorkspacesPool
Value Text
newValue, Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
instance Property "PoolName" WorkspacesPool where
  type PropertyType "PoolName" WorkspacesPool = Value Prelude.Text
  set :: PropertyType "PoolName" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "PoolName" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {poolName :: Value Text
poolName = PropertyType "PoolName" WorkspacesPool
Value Text
newValue, Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
instance Property "RunningMode" WorkspacesPool where
  type PropertyType "RunningMode" WorkspacesPool = Value Prelude.Text
  set :: PropertyType "RunningMode" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "RunningMode" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {runningMode :: Maybe (Value Text)
runningMode = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RunningMode" WorkspacesPool
Value Text
newValue, Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
timeoutSettings :: Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
instance Property "TimeoutSettings" WorkspacesPool where
  type PropertyType "TimeoutSettings" WorkspacesPool = TimeoutSettingsProperty
  set :: PropertyType "TimeoutSettings" WorkspacesPool
-> WorkspacesPool -> WorkspacesPool
set PropertyType "TimeoutSettings" WorkspacesPool
newValue WorkspacesPool {Maybe (Value Text)
Maybe ApplicationSettingsProperty
Maybe TimeoutSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: WorkspacesPool -> ()
applicationSettings :: WorkspacesPool -> Maybe ApplicationSettingsProperty
bundleId :: WorkspacesPool -> Value Text
capacity :: WorkspacesPool -> CapacityProperty
description :: WorkspacesPool -> Maybe (Value Text)
directoryId :: WorkspacesPool -> Value Text
poolName :: WorkspacesPool -> Value Text
runningMode :: WorkspacesPool -> Maybe (Value Text)
timeoutSettings :: WorkspacesPool -> Maybe TimeoutSettingsProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
timeoutSettings :: Maybe TimeoutSettingsProperty
..}
    = WorkspacesPool {timeoutSettings :: Maybe TimeoutSettingsProperty
timeoutSettings = TimeoutSettingsProperty -> Maybe TimeoutSettingsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "TimeoutSettings" WorkspacesPool
TimeoutSettingsProperty
newValue, Maybe (Value Text)
Maybe ApplicationSettingsProperty
()
Value Text
CapacityProperty
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
haddock_workaround_ :: ()
applicationSettings :: Maybe ApplicationSettingsProperty
bundleId :: Value Text
capacity :: CapacityProperty
description :: Maybe (Value Text)
directoryId :: Value Text
poolName :: Value Text
runningMode :: Maybe (Value Text)
..}