{-# 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.Nimble.Types.StreamConfiguration
-- 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.Nimble.Types.StreamConfiguration where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Nimble.Types.AutomaticTerminationMode
import Amazonka.Nimble.Types.SessionPersistenceMode
import Amazonka.Nimble.Types.StreamConfigurationSessionBackup
import Amazonka.Nimble.Types.StreamConfigurationSessionStorage
import Amazonka.Nimble.Types.StreamingClipboardMode
import Amazonka.Nimble.Types.StreamingInstanceType
import Amazonka.Nimble.Types.VolumeConfiguration
import qualified Amazonka.Prelude as Prelude

-- | A configuration for a streaming session.
--
-- /See:/ 'newStreamConfiguration' smart constructor.
data StreamConfiguration = StreamConfiguration'
  { -- | Indicates if a streaming session created from this launch profile should
    -- be terminated automatically or retained without termination after being
    -- in a @STOPPED@ state.
    --
    -- -   When @ACTIVATED@, the streaming session is scheduled for termination
    --     after being in the @STOPPED@ state for the time specified in
    --     @maxStoppedSessionLengthInMinutes@.
    --
    -- -   When @DEACTIVATED@, the streaming session can remain in the
    --     @STOPPED@ state indefinitely.
    --
    -- This parameter is only allowed when @sessionPersistenceMode@ is
    -- @ACTIVATED@. When allowed, the default value for this parameter is
    -- @DEACTIVATED@.
    StreamConfiguration -> Maybe AutomaticTerminationMode
automaticTerminationMode :: Prelude.Maybe AutomaticTerminationMode,
    -- | The length of time, in minutes, that a streaming session can be active
    -- before it is stopped or terminated. After this point, Nimble Studio
    -- automatically terminates or stops the session. The default length of
    -- time is 690 minutes, and the maximum length of time is 30 days.
    StreamConfiguration -> Maybe Natural
maxSessionLengthInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | Integer that determines if you can start and stop your sessions and how
    -- long a session can stay in the @STOPPED@ state. The default value is 0.
    -- The maximum value is 5760.
    --
    -- This field is allowed only when @sessionPersistenceMode@ is @ACTIVATED@
    -- and @automaticTerminationMode@ is @ACTIVATED@.
    --
    -- If the value is set to 0, your sessions can’t be @STOPPED@. If you then
    -- call @StopStreamingSession@, the session fails. If the time that a
    -- session stays in the @READY@ state exceeds the
    -- @maxSessionLengthInMinutes@ value, the session will automatically be
    -- terminated (instead of @STOPPED@).
    --
    -- If the value is set to a positive number, the session can be stopped.
    -- You can call @StopStreamingSession@ to stop sessions in the @READY@
    -- state. If the time that a session stays in the @READY@ state exceeds the
    -- @maxSessionLengthInMinutes@ value, the session will automatically be
    -- stopped (instead of terminated).
    StreamConfiguration -> Maybe Natural
maxStoppedSessionLengthInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | Information about the streaming session backup.
    StreamConfiguration -> Maybe StreamConfigurationSessionBackup
sessionBackup :: Prelude.Maybe StreamConfigurationSessionBackup,
    -- | Determine if a streaming session created from this launch profile can
    -- configure persistent storage. This means that @volumeConfiguration@ and
    -- @automaticTerminationMode@ are configured.
    StreamConfiguration -> Maybe SessionPersistenceMode
sessionPersistenceMode :: Prelude.Maybe SessionPersistenceMode,
    -- | The upload storage for a streaming session.
    StreamConfiguration -> Maybe StreamConfigurationSessionStorage
sessionStorage :: Prelude.Maybe StreamConfigurationSessionStorage,
    -- | Custom volume configuration for the root volumes that are attached to
    -- streaming sessions.
    --
    -- This parameter is only allowed when @sessionPersistenceMode@ is
    -- @ACTIVATED@.
    StreamConfiguration -> Maybe VolumeConfiguration
volumeConfiguration :: Prelude.Maybe VolumeConfiguration,
    -- | Allows or deactivates the use of the system clipboard to copy and paste
    -- between the streaming session and streaming client.
    StreamConfiguration -> StreamingClipboardMode
clipboardMode :: StreamingClipboardMode,
    -- | The EC2 instance types that users can select from when launching a
    -- streaming session with this launch profile.
    StreamConfiguration -> NonEmpty StreamingInstanceType
ec2InstanceTypes :: Prelude.NonEmpty StreamingInstanceType,
    -- | The streaming images that users can select from when launching a
    -- streaming session with this launch profile.
    StreamConfiguration -> NonEmpty Text
streamingImageIds :: Prelude.NonEmpty Prelude.Text
  }
  deriving (StreamConfiguration -> StreamConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamConfiguration -> StreamConfiguration -> Bool
$c/= :: StreamConfiguration -> StreamConfiguration -> Bool
== :: StreamConfiguration -> StreamConfiguration -> Bool
$c== :: StreamConfiguration -> StreamConfiguration -> Bool
Prelude.Eq, Int -> StreamConfiguration -> ShowS
[StreamConfiguration] -> ShowS
StreamConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamConfiguration] -> ShowS
$cshowList :: [StreamConfiguration] -> ShowS
show :: StreamConfiguration -> String
$cshow :: StreamConfiguration -> String
showsPrec :: Int -> StreamConfiguration -> ShowS
$cshowsPrec :: Int -> StreamConfiguration -> ShowS
Prelude.Show, forall x. Rep StreamConfiguration x -> StreamConfiguration
forall x. StreamConfiguration -> Rep StreamConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StreamConfiguration x -> StreamConfiguration
$cfrom :: forall x. StreamConfiguration -> Rep StreamConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'StreamConfiguration' 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:
--
-- 'automaticTerminationMode', 'streamConfiguration_automaticTerminationMode' - Indicates if a streaming session created from this launch profile should
-- be terminated automatically or retained without termination after being
-- in a @STOPPED@ state.
--
-- -   When @ACTIVATED@, the streaming session is scheduled for termination
--     after being in the @STOPPED@ state for the time specified in
--     @maxStoppedSessionLengthInMinutes@.
--
-- -   When @DEACTIVATED@, the streaming session can remain in the
--     @STOPPED@ state indefinitely.
--
-- This parameter is only allowed when @sessionPersistenceMode@ is
-- @ACTIVATED@. When allowed, the default value for this parameter is
-- @DEACTIVATED@.
--
-- 'maxSessionLengthInMinutes', 'streamConfiguration_maxSessionLengthInMinutes' - The length of time, in minutes, that a streaming session can be active
-- before it is stopped or terminated. After this point, Nimble Studio
-- automatically terminates or stops the session. The default length of
-- time is 690 minutes, and the maximum length of time is 30 days.
--
-- 'maxStoppedSessionLengthInMinutes', 'streamConfiguration_maxStoppedSessionLengthInMinutes' - Integer that determines if you can start and stop your sessions and how
-- long a session can stay in the @STOPPED@ state. The default value is 0.
-- The maximum value is 5760.
--
-- This field is allowed only when @sessionPersistenceMode@ is @ACTIVATED@
-- and @automaticTerminationMode@ is @ACTIVATED@.
--
-- If the value is set to 0, your sessions can’t be @STOPPED@. If you then
-- call @StopStreamingSession@, the session fails. If the time that a
-- session stays in the @READY@ state exceeds the
-- @maxSessionLengthInMinutes@ value, the session will automatically be
-- terminated (instead of @STOPPED@).
--
-- If the value is set to a positive number, the session can be stopped.
-- You can call @StopStreamingSession@ to stop sessions in the @READY@
-- state. If the time that a session stays in the @READY@ state exceeds the
-- @maxSessionLengthInMinutes@ value, the session will automatically be
-- stopped (instead of terminated).
--
-- 'sessionBackup', 'streamConfiguration_sessionBackup' - Information about the streaming session backup.
--
-- 'sessionPersistenceMode', 'streamConfiguration_sessionPersistenceMode' - Determine if a streaming session created from this launch profile can
-- configure persistent storage. This means that @volumeConfiguration@ and
-- @automaticTerminationMode@ are configured.
--
-- 'sessionStorage', 'streamConfiguration_sessionStorage' - The upload storage for a streaming session.
--
-- 'volumeConfiguration', 'streamConfiguration_volumeConfiguration' - Custom volume configuration for the root volumes that are attached to
-- streaming sessions.
--
-- This parameter is only allowed when @sessionPersistenceMode@ is
-- @ACTIVATED@.
--
-- 'clipboardMode', 'streamConfiguration_clipboardMode' - Allows or deactivates the use of the system clipboard to copy and paste
-- between the streaming session and streaming client.
--
-- 'ec2InstanceTypes', 'streamConfiguration_ec2InstanceTypes' - The EC2 instance types that users can select from when launching a
-- streaming session with this launch profile.
--
-- 'streamingImageIds', 'streamConfiguration_streamingImageIds' - The streaming images that users can select from when launching a
-- streaming session with this launch profile.
newStreamConfiguration ::
  -- | 'clipboardMode'
  StreamingClipboardMode ->
  -- | 'ec2InstanceTypes'
  Prelude.NonEmpty StreamingInstanceType ->
  -- | 'streamingImageIds'
  Prelude.NonEmpty Prelude.Text ->
  StreamConfiguration
newStreamConfiguration :: StreamingClipboardMode
-> NonEmpty StreamingInstanceType
-> NonEmpty Text
-> StreamConfiguration
newStreamConfiguration
  StreamingClipboardMode
pClipboardMode_
  NonEmpty StreamingInstanceType
pEc2InstanceTypes_
  NonEmpty Text
pStreamingImageIds_ =
    StreamConfiguration'
      { $sel:automaticTerminationMode:StreamConfiguration' :: Maybe AutomaticTerminationMode
automaticTerminationMode =
          forall a. Maybe a
Prelude.Nothing,
        $sel:maxSessionLengthInMinutes:StreamConfiguration' :: Maybe Natural
maxSessionLengthInMinutes = forall a. Maybe a
Prelude.Nothing,
        $sel:maxStoppedSessionLengthInMinutes:StreamConfiguration' :: Maybe Natural
maxStoppedSessionLengthInMinutes = forall a. Maybe a
Prelude.Nothing,
        $sel:sessionBackup:StreamConfiguration' :: Maybe StreamConfigurationSessionBackup
sessionBackup = forall a. Maybe a
Prelude.Nothing,
        $sel:sessionPersistenceMode:StreamConfiguration' :: Maybe SessionPersistenceMode
sessionPersistenceMode = forall a. Maybe a
Prelude.Nothing,
        $sel:sessionStorage:StreamConfiguration' :: Maybe StreamConfigurationSessionStorage
sessionStorage = forall a. Maybe a
Prelude.Nothing,
        $sel:volumeConfiguration:StreamConfiguration' :: Maybe VolumeConfiguration
volumeConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:clipboardMode:StreamConfiguration' :: StreamingClipboardMode
clipboardMode = StreamingClipboardMode
pClipboardMode_,
        $sel:ec2InstanceTypes:StreamConfiguration' :: NonEmpty StreamingInstanceType
ec2InstanceTypes =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty StreamingInstanceType
pEc2InstanceTypes_,
        $sel:streamingImageIds:StreamConfiguration' :: NonEmpty Text
streamingImageIds =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pStreamingImageIds_
      }

-- | Indicates if a streaming session created from this launch profile should
-- be terminated automatically or retained without termination after being
-- in a @STOPPED@ state.
--
-- -   When @ACTIVATED@, the streaming session is scheduled for termination
--     after being in the @STOPPED@ state for the time specified in
--     @maxStoppedSessionLengthInMinutes@.
--
-- -   When @DEACTIVATED@, the streaming session can remain in the
--     @STOPPED@ state indefinitely.
--
-- This parameter is only allowed when @sessionPersistenceMode@ is
-- @ACTIVATED@. When allowed, the default value for this parameter is
-- @DEACTIVATED@.
streamConfiguration_automaticTerminationMode :: Lens.Lens' StreamConfiguration (Prelude.Maybe AutomaticTerminationMode)
streamConfiguration_automaticTerminationMode :: Lens' StreamConfiguration (Maybe AutomaticTerminationMode)
streamConfiguration_automaticTerminationMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {Maybe AutomaticTerminationMode
automaticTerminationMode :: Maybe AutomaticTerminationMode
$sel:automaticTerminationMode:StreamConfiguration' :: StreamConfiguration -> Maybe AutomaticTerminationMode
automaticTerminationMode} -> Maybe AutomaticTerminationMode
automaticTerminationMode) (\s :: StreamConfiguration
s@StreamConfiguration' {} Maybe AutomaticTerminationMode
a -> StreamConfiguration
s {$sel:automaticTerminationMode:StreamConfiguration' :: Maybe AutomaticTerminationMode
automaticTerminationMode = Maybe AutomaticTerminationMode
a} :: StreamConfiguration)

-- | The length of time, in minutes, that a streaming session can be active
-- before it is stopped or terminated. After this point, Nimble Studio
-- automatically terminates or stops the session. The default length of
-- time is 690 minutes, and the maximum length of time is 30 days.
streamConfiguration_maxSessionLengthInMinutes :: Lens.Lens' StreamConfiguration (Prelude.Maybe Prelude.Natural)
streamConfiguration_maxSessionLengthInMinutes :: Lens' StreamConfiguration (Maybe Natural)
streamConfiguration_maxSessionLengthInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {Maybe Natural
maxSessionLengthInMinutes :: Maybe Natural
$sel:maxSessionLengthInMinutes:StreamConfiguration' :: StreamConfiguration -> Maybe Natural
maxSessionLengthInMinutes} -> Maybe Natural
maxSessionLengthInMinutes) (\s :: StreamConfiguration
s@StreamConfiguration' {} Maybe Natural
a -> StreamConfiguration
s {$sel:maxSessionLengthInMinutes:StreamConfiguration' :: Maybe Natural
maxSessionLengthInMinutes = Maybe Natural
a} :: StreamConfiguration)

-- | Integer that determines if you can start and stop your sessions and how
-- long a session can stay in the @STOPPED@ state. The default value is 0.
-- The maximum value is 5760.
--
-- This field is allowed only when @sessionPersistenceMode@ is @ACTIVATED@
-- and @automaticTerminationMode@ is @ACTIVATED@.
--
-- If the value is set to 0, your sessions can’t be @STOPPED@. If you then
-- call @StopStreamingSession@, the session fails. If the time that a
-- session stays in the @READY@ state exceeds the
-- @maxSessionLengthInMinutes@ value, the session will automatically be
-- terminated (instead of @STOPPED@).
--
-- If the value is set to a positive number, the session can be stopped.
-- You can call @StopStreamingSession@ to stop sessions in the @READY@
-- state. If the time that a session stays in the @READY@ state exceeds the
-- @maxSessionLengthInMinutes@ value, the session will automatically be
-- stopped (instead of terminated).
streamConfiguration_maxStoppedSessionLengthInMinutes :: Lens.Lens' StreamConfiguration (Prelude.Maybe Prelude.Natural)
streamConfiguration_maxStoppedSessionLengthInMinutes :: Lens' StreamConfiguration (Maybe Natural)
streamConfiguration_maxStoppedSessionLengthInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {Maybe Natural
maxStoppedSessionLengthInMinutes :: Maybe Natural
$sel:maxStoppedSessionLengthInMinutes:StreamConfiguration' :: StreamConfiguration -> Maybe Natural
maxStoppedSessionLengthInMinutes} -> Maybe Natural
maxStoppedSessionLengthInMinutes) (\s :: StreamConfiguration
s@StreamConfiguration' {} Maybe Natural
a -> StreamConfiguration
s {$sel:maxStoppedSessionLengthInMinutes:StreamConfiguration' :: Maybe Natural
maxStoppedSessionLengthInMinutes = Maybe Natural
a} :: StreamConfiguration)

-- | Information about the streaming session backup.
streamConfiguration_sessionBackup :: Lens.Lens' StreamConfiguration (Prelude.Maybe StreamConfigurationSessionBackup)
streamConfiguration_sessionBackup :: Lens' StreamConfiguration (Maybe StreamConfigurationSessionBackup)
streamConfiguration_sessionBackup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {Maybe StreamConfigurationSessionBackup
sessionBackup :: Maybe StreamConfigurationSessionBackup
$sel:sessionBackup:StreamConfiguration' :: StreamConfiguration -> Maybe StreamConfigurationSessionBackup
sessionBackup} -> Maybe StreamConfigurationSessionBackup
sessionBackup) (\s :: StreamConfiguration
s@StreamConfiguration' {} Maybe StreamConfigurationSessionBackup
a -> StreamConfiguration
s {$sel:sessionBackup:StreamConfiguration' :: Maybe StreamConfigurationSessionBackup
sessionBackup = Maybe StreamConfigurationSessionBackup
a} :: StreamConfiguration)

-- | Determine if a streaming session created from this launch profile can
-- configure persistent storage. This means that @volumeConfiguration@ and
-- @automaticTerminationMode@ are configured.
streamConfiguration_sessionPersistenceMode :: Lens.Lens' StreamConfiguration (Prelude.Maybe SessionPersistenceMode)
streamConfiguration_sessionPersistenceMode :: Lens' StreamConfiguration (Maybe SessionPersistenceMode)
streamConfiguration_sessionPersistenceMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {Maybe SessionPersistenceMode
sessionPersistenceMode :: Maybe SessionPersistenceMode
$sel:sessionPersistenceMode:StreamConfiguration' :: StreamConfiguration -> Maybe SessionPersistenceMode
sessionPersistenceMode} -> Maybe SessionPersistenceMode
sessionPersistenceMode) (\s :: StreamConfiguration
s@StreamConfiguration' {} Maybe SessionPersistenceMode
a -> StreamConfiguration
s {$sel:sessionPersistenceMode:StreamConfiguration' :: Maybe SessionPersistenceMode
sessionPersistenceMode = Maybe SessionPersistenceMode
a} :: StreamConfiguration)

-- | The upload storage for a streaming session.
streamConfiguration_sessionStorage :: Lens.Lens' StreamConfiguration (Prelude.Maybe StreamConfigurationSessionStorage)
streamConfiguration_sessionStorage :: Lens' StreamConfiguration (Maybe StreamConfigurationSessionStorage)
streamConfiguration_sessionStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {Maybe StreamConfigurationSessionStorage
sessionStorage :: Maybe StreamConfigurationSessionStorage
$sel:sessionStorage:StreamConfiguration' :: StreamConfiguration -> Maybe StreamConfigurationSessionStorage
sessionStorage} -> Maybe StreamConfigurationSessionStorage
sessionStorage) (\s :: StreamConfiguration
s@StreamConfiguration' {} Maybe StreamConfigurationSessionStorage
a -> StreamConfiguration
s {$sel:sessionStorage:StreamConfiguration' :: Maybe StreamConfigurationSessionStorage
sessionStorage = Maybe StreamConfigurationSessionStorage
a} :: StreamConfiguration)

-- | Custom volume configuration for the root volumes that are attached to
-- streaming sessions.
--
-- This parameter is only allowed when @sessionPersistenceMode@ is
-- @ACTIVATED@.
streamConfiguration_volumeConfiguration :: Lens.Lens' StreamConfiguration (Prelude.Maybe VolumeConfiguration)
streamConfiguration_volumeConfiguration :: Lens' StreamConfiguration (Maybe VolumeConfiguration)
streamConfiguration_volumeConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {Maybe VolumeConfiguration
volumeConfiguration :: Maybe VolumeConfiguration
$sel:volumeConfiguration:StreamConfiguration' :: StreamConfiguration -> Maybe VolumeConfiguration
volumeConfiguration} -> Maybe VolumeConfiguration
volumeConfiguration) (\s :: StreamConfiguration
s@StreamConfiguration' {} Maybe VolumeConfiguration
a -> StreamConfiguration
s {$sel:volumeConfiguration:StreamConfiguration' :: Maybe VolumeConfiguration
volumeConfiguration = Maybe VolumeConfiguration
a} :: StreamConfiguration)

-- | Allows or deactivates the use of the system clipboard to copy and paste
-- between the streaming session and streaming client.
streamConfiguration_clipboardMode :: Lens.Lens' StreamConfiguration StreamingClipboardMode
streamConfiguration_clipboardMode :: Lens' StreamConfiguration StreamingClipboardMode
streamConfiguration_clipboardMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {StreamingClipboardMode
clipboardMode :: StreamingClipboardMode
$sel:clipboardMode:StreamConfiguration' :: StreamConfiguration -> StreamingClipboardMode
clipboardMode} -> StreamingClipboardMode
clipboardMode) (\s :: StreamConfiguration
s@StreamConfiguration' {} StreamingClipboardMode
a -> StreamConfiguration
s {$sel:clipboardMode:StreamConfiguration' :: StreamingClipboardMode
clipboardMode = StreamingClipboardMode
a} :: StreamConfiguration)

-- | The EC2 instance types that users can select from when launching a
-- streaming session with this launch profile.
streamConfiguration_ec2InstanceTypes :: Lens.Lens' StreamConfiguration (Prelude.NonEmpty StreamingInstanceType)
streamConfiguration_ec2InstanceTypes :: Lens' StreamConfiguration (NonEmpty StreamingInstanceType)
streamConfiguration_ec2InstanceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {NonEmpty StreamingInstanceType
ec2InstanceTypes :: NonEmpty StreamingInstanceType
$sel:ec2InstanceTypes:StreamConfiguration' :: StreamConfiguration -> NonEmpty StreamingInstanceType
ec2InstanceTypes} -> NonEmpty StreamingInstanceType
ec2InstanceTypes) (\s :: StreamConfiguration
s@StreamConfiguration' {} NonEmpty StreamingInstanceType
a -> StreamConfiguration
s {$sel:ec2InstanceTypes:StreamConfiguration' :: NonEmpty StreamingInstanceType
ec2InstanceTypes = NonEmpty StreamingInstanceType
a} :: StreamConfiguration) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The streaming images that users can select from when launching a
-- streaming session with this launch profile.
streamConfiguration_streamingImageIds :: Lens.Lens' StreamConfiguration (Prelude.NonEmpty Prelude.Text)
streamConfiguration_streamingImageIds :: Lens' StreamConfiguration (NonEmpty Text)
streamConfiguration_streamingImageIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamConfiguration' {NonEmpty Text
streamingImageIds :: NonEmpty Text
$sel:streamingImageIds:StreamConfiguration' :: StreamConfiguration -> NonEmpty Text
streamingImageIds} -> NonEmpty Text
streamingImageIds) (\s :: StreamConfiguration
s@StreamConfiguration' {} NonEmpty Text
a -> StreamConfiguration
s {$sel:streamingImageIds:StreamConfiguration' :: NonEmpty Text
streamingImageIds = NonEmpty Text
a} :: StreamConfiguration) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromJSON StreamConfiguration where
  parseJSON :: Value -> Parser StreamConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StreamConfiguration"
      ( \Object
x ->
          Maybe AutomaticTerminationMode
-> Maybe Natural
-> Maybe Natural
-> Maybe StreamConfigurationSessionBackup
-> Maybe SessionPersistenceMode
-> Maybe StreamConfigurationSessionStorage
-> Maybe VolumeConfiguration
-> StreamingClipboardMode
-> NonEmpty StreamingInstanceType
-> NonEmpty Text
-> StreamConfiguration
StreamConfiguration'
            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
"automaticTerminationMode")
            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
"maxSessionLengthInMinutes")
            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
"maxStoppedSessionLengthInMinutes")
            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
"sessionBackup")
            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
"sessionPersistenceMode")
            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
"sessionStorage")
            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
"volumeConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"clipboardMode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ec2InstanceTypes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"streamingImageIds")
      )

instance Prelude.Hashable StreamConfiguration where
  hashWithSalt :: Int -> StreamConfiguration -> Int
hashWithSalt Int
_salt StreamConfiguration' {Maybe Natural
Maybe AutomaticTerminationMode
Maybe SessionPersistenceMode
Maybe StreamConfigurationSessionBackup
Maybe StreamConfigurationSessionStorage
Maybe VolumeConfiguration
NonEmpty Text
NonEmpty StreamingInstanceType
StreamingClipboardMode
streamingImageIds :: NonEmpty Text
ec2InstanceTypes :: NonEmpty StreamingInstanceType
clipboardMode :: StreamingClipboardMode
volumeConfiguration :: Maybe VolumeConfiguration
sessionStorage :: Maybe StreamConfigurationSessionStorage
sessionPersistenceMode :: Maybe SessionPersistenceMode
sessionBackup :: Maybe StreamConfigurationSessionBackup
maxStoppedSessionLengthInMinutes :: Maybe Natural
maxSessionLengthInMinutes :: Maybe Natural
automaticTerminationMode :: Maybe AutomaticTerminationMode
$sel:streamingImageIds:StreamConfiguration' :: StreamConfiguration -> NonEmpty Text
$sel:ec2InstanceTypes:StreamConfiguration' :: StreamConfiguration -> NonEmpty StreamingInstanceType
$sel:clipboardMode:StreamConfiguration' :: StreamConfiguration -> StreamingClipboardMode
$sel:volumeConfiguration:StreamConfiguration' :: StreamConfiguration -> Maybe VolumeConfiguration
$sel:sessionStorage:StreamConfiguration' :: StreamConfiguration -> Maybe StreamConfigurationSessionStorage
$sel:sessionPersistenceMode:StreamConfiguration' :: StreamConfiguration -> Maybe SessionPersistenceMode
$sel:sessionBackup:StreamConfiguration' :: StreamConfiguration -> Maybe StreamConfigurationSessionBackup
$sel:maxStoppedSessionLengthInMinutes:StreamConfiguration' :: StreamConfiguration -> Maybe Natural
$sel:maxSessionLengthInMinutes:StreamConfiguration' :: StreamConfiguration -> Maybe Natural
$sel:automaticTerminationMode:StreamConfiguration' :: StreamConfiguration -> Maybe AutomaticTerminationMode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutomaticTerminationMode
automaticTerminationMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxSessionLengthInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxStoppedSessionLengthInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamConfigurationSessionBackup
sessionBackup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SessionPersistenceMode
sessionPersistenceMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamConfigurationSessionStorage
sessionStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VolumeConfiguration
volumeConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StreamingClipboardMode
clipboardMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty StreamingInstanceType
ec2InstanceTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
streamingImageIds

instance Prelude.NFData StreamConfiguration where
  rnf :: StreamConfiguration -> ()
rnf StreamConfiguration' {Maybe Natural
Maybe AutomaticTerminationMode
Maybe SessionPersistenceMode
Maybe StreamConfigurationSessionBackup
Maybe StreamConfigurationSessionStorage
Maybe VolumeConfiguration
NonEmpty Text
NonEmpty StreamingInstanceType
StreamingClipboardMode
streamingImageIds :: NonEmpty Text
ec2InstanceTypes :: NonEmpty StreamingInstanceType
clipboardMode :: StreamingClipboardMode
volumeConfiguration :: Maybe VolumeConfiguration
sessionStorage :: Maybe StreamConfigurationSessionStorage
sessionPersistenceMode :: Maybe SessionPersistenceMode
sessionBackup :: Maybe StreamConfigurationSessionBackup
maxStoppedSessionLengthInMinutes :: Maybe Natural
maxSessionLengthInMinutes :: Maybe Natural
automaticTerminationMode :: Maybe AutomaticTerminationMode
$sel:streamingImageIds:StreamConfiguration' :: StreamConfiguration -> NonEmpty Text
$sel:ec2InstanceTypes:StreamConfiguration' :: StreamConfiguration -> NonEmpty StreamingInstanceType
$sel:clipboardMode:StreamConfiguration' :: StreamConfiguration -> StreamingClipboardMode
$sel:volumeConfiguration:StreamConfiguration' :: StreamConfiguration -> Maybe VolumeConfiguration
$sel:sessionStorage:StreamConfiguration' :: StreamConfiguration -> Maybe StreamConfigurationSessionStorage
$sel:sessionPersistenceMode:StreamConfiguration' :: StreamConfiguration -> Maybe SessionPersistenceMode
$sel:sessionBackup:StreamConfiguration' :: StreamConfiguration -> Maybe StreamConfigurationSessionBackup
$sel:maxStoppedSessionLengthInMinutes:StreamConfiguration' :: StreamConfiguration -> Maybe Natural
$sel:maxSessionLengthInMinutes:StreamConfiguration' :: StreamConfiguration -> Maybe Natural
$sel:automaticTerminationMode:StreamConfiguration' :: StreamConfiguration -> Maybe AutomaticTerminationMode
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutomaticTerminationMode
automaticTerminationMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxSessionLengthInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxStoppedSessionLengthInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamConfigurationSessionBackup
sessionBackup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SessionPersistenceMode
sessionPersistenceMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamConfigurationSessionStorage
sessionStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VolumeConfiguration
volumeConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StreamingClipboardMode
clipboardMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty StreamingInstanceType
ec2InstanceTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
streamingImageIds