{-# 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.SageMaker.Types.UserSettings
-- 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.SageMaker.Types.UserSettings 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.SageMaker.Types.CanvasAppSettings
import Amazonka.SageMaker.Types.JupyterServerAppSettings
import Amazonka.SageMaker.Types.KernelGatewayAppSettings
import Amazonka.SageMaker.Types.RSessionAppSettings
import Amazonka.SageMaker.Types.RStudioServerProAppSettings
import Amazonka.SageMaker.Types.SharingSettings
import Amazonka.SageMaker.Types.TensorBoardAppSettings

-- | A collection of settings that apply to users of Amazon SageMaker Studio.
-- These settings are specified when the @CreateUserProfile@ API is called,
-- and as @DefaultUserSettings@ when the @CreateDomain@ API is called.
--
-- @SecurityGroups@ is aggregated when specified in both calls. For all
-- other settings in @UserSettings@, the values specified in
-- @CreateUserProfile@ take precedence over those specified in
-- @CreateDomain@.
--
-- /See:/ 'newUserSettings' smart constructor.
data UserSettings = UserSettings'
  { -- | The Canvas app settings.
    UserSettings -> Maybe CanvasAppSettings
canvasAppSettings :: Prelude.Maybe CanvasAppSettings,
    -- | The execution role for the user.
    UserSettings -> Maybe Text
executionRole :: Prelude.Maybe Prelude.Text,
    -- | The Jupyter server\'s app settings.
    UserSettings -> Maybe JupyterServerAppSettings
jupyterServerAppSettings :: Prelude.Maybe JupyterServerAppSettings,
    -- | The kernel gateway app settings.
    UserSettings -> Maybe KernelGatewayAppSettings
kernelGatewayAppSettings :: Prelude.Maybe KernelGatewayAppSettings,
    -- | A collection of settings that configure the @RSessionGateway@ app.
    UserSettings -> Maybe RSessionAppSettings
rSessionAppSettings :: Prelude.Maybe RSessionAppSettings,
    -- | A collection of settings that configure user interaction with the
    -- @RStudioServerPro@ app.
    UserSettings -> Maybe RStudioServerProAppSettings
rStudioServerProAppSettings :: Prelude.Maybe RStudioServerProAppSettings,
    -- | The security groups for the Amazon Virtual Private Cloud (VPC) that
    -- Studio uses for communication.
    --
    -- Optional when the @CreateDomain.AppNetworkAccessType@ parameter is set
    -- to @PublicInternetOnly@.
    --
    -- Required when the @CreateDomain.AppNetworkAccessType@ parameter is set
    -- to @VpcOnly@.
    --
    -- Amazon SageMaker adds a security group to allow NFS traffic from
    -- SageMaker Studio. Therefore, the number of security groups that you can
    -- specify is one less than the maximum number shown.
    UserSettings -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | Specifies options for sharing SageMaker Studio notebooks.
    UserSettings -> Maybe SharingSettings
sharingSettings :: Prelude.Maybe SharingSettings,
    -- | The TensorBoard app settings.
    UserSettings -> Maybe TensorBoardAppSettings
tensorBoardAppSettings :: Prelude.Maybe TensorBoardAppSettings
  }
  deriving (UserSettings -> UserSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserSettings -> UserSettings -> Bool
$c/= :: UserSettings -> UserSettings -> Bool
== :: UserSettings -> UserSettings -> Bool
$c== :: UserSettings -> UserSettings -> Bool
Prelude.Eq, ReadPrec [UserSettings]
ReadPrec UserSettings
Int -> ReadS UserSettings
ReadS [UserSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserSettings]
$creadListPrec :: ReadPrec [UserSettings]
readPrec :: ReadPrec UserSettings
$creadPrec :: ReadPrec UserSettings
readList :: ReadS [UserSettings]
$creadList :: ReadS [UserSettings]
readsPrec :: Int -> ReadS UserSettings
$creadsPrec :: Int -> ReadS UserSettings
Prelude.Read, Int -> UserSettings -> ShowS
[UserSettings] -> ShowS
UserSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserSettings] -> ShowS
$cshowList :: [UserSettings] -> ShowS
show :: UserSettings -> String
$cshow :: UserSettings -> String
showsPrec :: Int -> UserSettings -> ShowS
$cshowsPrec :: Int -> UserSettings -> ShowS
Prelude.Show, forall x. Rep UserSettings x -> UserSettings
forall x. UserSettings -> Rep UserSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserSettings x -> UserSettings
$cfrom :: forall x. UserSettings -> Rep UserSettings x
Prelude.Generic)

-- |
-- Create a value of 'UserSettings' 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:
--
-- 'canvasAppSettings', 'userSettings_canvasAppSettings' - The Canvas app settings.
--
-- 'executionRole', 'userSettings_executionRole' - The execution role for the user.
--
-- 'jupyterServerAppSettings', 'userSettings_jupyterServerAppSettings' - The Jupyter server\'s app settings.
--
-- 'kernelGatewayAppSettings', 'userSettings_kernelGatewayAppSettings' - The kernel gateway app settings.
--
-- 'rSessionAppSettings', 'userSettings_rSessionAppSettings' - A collection of settings that configure the @RSessionGateway@ app.
--
-- 'rStudioServerProAppSettings', 'userSettings_rStudioServerProAppSettings' - A collection of settings that configure user interaction with the
-- @RStudioServerPro@ app.
--
-- 'securityGroups', 'userSettings_securityGroups' - The security groups for the Amazon Virtual Private Cloud (VPC) that
-- Studio uses for communication.
--
-- Optional when the @CreateDomain.AppNetworkAccessType@ parameter is set
-- to @PublicInternetOnly@.
--
-- Required when the @CreateDomain.AppNetworkAccessType@ parameter is set
-- to @VpcOnly@.
--
-- Amazon SageMaker adds a security group to allow NFS traffic from
-- SageMaker Studio. Therefore, the number of security groups that you can
-- specify is one less than the maximum number shown.
--
-- 'sharingSettings', 'userSettings_sharingSettings' - Specifies options for sharing SageMaker Studio notebooks.
--
-- 'tensorBoardAppSettings', 'userSettings_tensorBoardAppSettings' - The TensorBoard app settings.
newUserSettings ::
  UserSettings
newUserSettings :: UserSettings
newUserSettings =
  UserSettings'
    { $sel:canvasAppSettings:UserSettings' :: Maybe CanvasAppSettings
canvasAppSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:executionRole:UserSettings' :: Maybe Text
executionRole = forall a. Maybe a
Prelude.Nothing,
      $sel:jupyterServerAppSettings:UserSettings' :: Maybe JupyterServerAppSettings
jupyterServerAppSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:kernelGatewayAppSettings:UserSettings' :: Maybe KernelGatewayAppSettings
kernelGatewayAppSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:rSessionAppSettings:UserSettings' :: Maybe RSessionAppSettings
rSessionAppSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:rStudioServerProAppSettings:UserSettings' :: Maybe RStudioServerProAppSettings
rStudioServerProAppSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:UserSettings' :: Maybe [Text]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:sharingSettings:UserSettings' :: Maybe SharingSettings
sharingSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:tensorBoardAppSettings:UserSettings' :: Maybe TensorBoardAppSettings
tensorBoardAppSettings = forall a. Maybe a
Prelude.Nothing
    }

-- | The Canvas app settings.
userSettings_canvasAppSettings :: Lens.Lens' UserSettings (Prelude.Maybe CanvasAppSettings)
userSettings_canvasAppSettings :: Lens' UserSettings (Maybe CanvasAppSettings)
userSettings_canvasAppSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe CanvasAppSettings
canvasAppSettings :: Maybe CanvasAppSettings
$sel:canvasAppSettings:UserSettings' :: UserSettings -> Maybe CanvasAppSettings
canvasAppSettings} -> Maybe CanvasAppSettings
canvasAppSettings) (\s :: UserSettings
s@UserSettings' {} Maybe CanvasAppSettings
a -> UserSettings
s {$sel:canvasAppSettings:UserSettings' :: Maybe CanvasAppSettings
canvasAppSettings = Maybe CanvasAppSettings
a} :: UserSettings)

-- | The execution role for the user.
userSettings_executionRole :: Lens.Lens' UserSettings (Prelude.Maybe Prelude.Text)
userSettings_executionRole :: Lens' UserSettings (Maybe Text)
userSettings_executionRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe Text
executionRole :: Maybe Text
$sel:executionRole:UserSettings' :: UserSettings -> Maybe Text
executionRole} -> Maybe Text
executionRole) (\s :: UserSettings
s@UserSettings' {} Maybe Text
a -> UserSettings
s {$sel:executionRole:UserSettings' :: Maybe Text
executionRole = Maybe Text
a} :: UserSettings)

-- | The Jupyter server\'s app settings.
userSettings_jupyterServerAppSettings :: Lens.Lens' UserSettings (Prelude.Maybe JupyterServerAppSettings)
userSettings_jupyterServerAppSettings :: Lens' UserSettings (Maybe JupyterServerAppSettings)
userSettings_jupyterServerAppSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe JupyterServerAppSettings
jupyterServerAppSettings :: Maybe JupyterServerAppSettings
$sel:jupyterServerAppSettings:UserSettings' :: UserSettings -> Maybe JupyterServerAppSettings
jupyterServerAppSettings} -> Maybe JupyterServerAppSettings
jupyterServerAppSettings) (\s :: UserSettings
s@UserSettings' {} Maybe JupyterServerAppSettings
a -> UserSettings
s {$sel:jupyterServerAppSettings:UserSettings' :: Maybe JupyterServerAppSettings
jupyterServerAppSettings = Maybe JupyterServerAppSettings
a} :: UserSettings)

-- | The kernel gateway app settings.
userSettings_kernelGatewayAppSettings :: Lens.Lens' UserSettings (Prelude.Maybe KernelGatewayAppSettings)
userSettings_kernelGatewayAppSettings :: Lens' UserSettings (Maybe KernelGatewayAppSettings)
userSettings_kernelGatewayAppSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe KernelGatewayAppSettings
kernelGatewayAppSettings :: Maybe KernelGatewayAppSettings
$sel:kernelGatewayAppSettings:UserSettings' :: UserSettings -> Maybe KernelGatewayAppSettings
kernelGatewayAppSettings} -> Maybe KernelGatewayAppSettings
kernelGatewayAppSettings) (\s :: UserSettings
s@UserSettings' {} Maybe KernelGatewayAppSettings
a -> UserSettings
s {$sel:kernelGatewayAppSettings:UserSettings' :: Maybe KernelGatewayAppSettings
kernelGatewayAppSettings = Maybe KernelGatewayAppSettings
a} :: UserSettings)

-- | A collection of settings that configure the @RSessionGateway@ app.
userSettings_rSessionAppSettings :: Lens.Lens' UserSettings (Prelude.Maybe RSessionAppSettings)
userSettings_rSessionAppSettings :: Lens' UserSettings (Maybe RSessionAppSettings)
userSettings_rSessionAppSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe RSessionAppSettings
rSessionAppSettings :: Maybe RSessionAppSettings
$sel:rSessionAppSettings:UserSettings' :: UserSettings -> Maybe RSessionAppSettings
rSessionAppSettings} -> Maybe RSessionAppSettings
rSessionAppSettings) (\s :: UserSettings
s@UserSettings' {} Maybe RSessionAppSettings
a -> UserSettings
s {$sel:rSessionAppSettings:UserSettings' :: Maybe RSessionAppSettings
rSessionAppSettings = Maybe RSessionAppSettings
a} :: UserSettings)

-- | A collection of settings that configure user interaction with the
-- @RStudioServerPro@ app.
userSettings_rStudioServerProAppSettings :: Lens.Lens' UserSettings (Prelude.Maybe RStudioServerProAppSettings)
userSettings_rStudioServerProAppSettings :: Lens' UserSettings (Maybe RStudioServerProAppSettings)
userSettings_rStudioServerProAppSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe RStudioServerProAppSettings
rStudioServerProAppSettings :: Maybe RStudioServerProAppSettings
$sel:rStudioServerProAppSettings:UserSettings' :: UserSettings -> Maybe RStudioServerProAppSettings
rStudioServerProAppSettings} -> Maybe RStudioServerProAppSettings
rStudioServerProAppSettings) (\s :: UserSettings
s@UserSettings' {} Maybe RStudioServerProAppSettings
a -> UserSettings
s {$sel:rStudioServerProAppSettings:UserSettings' :: Maybe RStudioServerProAppSettings
rStudioServerProAppSettings = Maybe RStudioServerProAppSettings
a} :: UserSettings)

-- | The security groups for the Amazon Virtual Private Cloud (VPC) that
-- Studio uses for communication.
--
-- Optional when the @CreateDomain.AppNetworkAccessType@ parameter is set
-- to @PublicInternetOnly@.
--
-- Required when the @CreateDomain.AppNetworkAccessType@ parameter is set
-- to @VpcOnly@.
--
-- Amazon SageMaker adds a security group to allow NFS traffic from
-- SageMaker Studio. Therefore, the number of security groups that you can
-- specify is one less than the maximum number shown.
userSettings_securityGroups :: Lens.Lens' UserSettings (Prelude.Maybe [Prelude.Text])
userSettings_securityGroups :: Lens' UserSettings (Maybe [Text])
userSettings_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe [Text]
securityGroups :: Maybe [Text]
$sel:securityGroups:UserSettings' :: UserSettings -> Maybe [Text]
securityGroups} -> Maybe [Text]
securityGroups) (\s :: UserSettings
s@UserSettings' {} Maybe [Text]
a -> UserSettings
s {$sel:securityGroups:UserSettings' :: Maybe [Text]
securityGroups = Maybe [Text]
a} :: UserSettings) 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

-- | Specifies options for sharing SageMaker Studio notebooks.
userSettings_sharingSettings :: Lens.Lens' UserSettings (Prelude.Maybe SharingSettings)
userSettings_sharingSettings :: Lens' UserSettings (Maybe SharingSettings)
userSettings_sharingSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe SharingSettings
sharingSettings :: Maybe SharingSettings
$sel:sharingSettings:UserSettings' :: UserSettings -> Maybe SharingSettings
sharingSettings} -> Maybe SharingSettings
sharingSettings) (\s :: UserSettings
s@UserSettings' {} Maybe SharingSettings
a -> UserSettings
s {$sel:sharingSettings:UserSettings' :: Maybe SharingSettings
sharingSettings = Maybe SharingSettings
a} :: UserSettings)

-- | The TensorBoard app settings.
userSettings_tensorBoardAppSettings :: Lens.Lens' UserSettings (Prelude.Maybe TensorBoardAppSettings)
userSettings_tensorBoardAppSettings :: Lens' UserSettings (Maybe TensorBoardAppSettings)
userSettings_tensorBoardAppSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserSettings' {Maybe TensorBoardAppSettings
tensorBoardAppSettings :: Maybe TensorBoardAppSettings
$sel:tensorBoardAppSettings:UserSettings' :: UserSettings -> Maybe TensorBoardAppSettings
tensorBoardAppSettings} -> Maybe TensorBoardAppSettings
tensorBoardAppSettings) (\s :: UserSettings
s@UserSettings' {} Maybe TensorBoardAppSettings
a -> UserSettings
s {$sel:tensorBoardAppSettings:UserSettings' :: Maybe TensorBoardAppSettings
tensorBoardAppSettings = Maybe TensorBoardAppSettings
a} :: UserSettings)

instance Data.FromJSON UserSettings where
  parseJSON :: Value -> Parser UserSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"UserSettings"
      ( \Object
x ->
          Maybe CanvasAppSettings
-> Maybe Text
-> Maybe JupyterServerAppSettings
-> Maybe KernelGatewayAppSettings
-> Maybe RSessionAppSettings
-> Maybe RStudioServerProAppSettings
-> Maybe [Text]
-> Maybe SharingSettings
-> Maybe TensorBoardAppSettings
-> UserSettings
UserSettings'
            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
"CanvasAppSettings")
            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
"ExecutionRole")
            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
"JupyterServerAppSettings")
            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
"KernelGatewayAppSettings")
            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
"RSessionAppSettings")
            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
"RStudioServerProAppSettings")
            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
"SecurityGroups" 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
"SharingSettings")
            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
"TensorBoardAppSettings")
      )

instance Prelude.Hashable UserSettings where
  hashWithSalt :: Int -> UserSettings -> Int
hashWithSalt Int
_salt UserSettings' {Maybe [Text]
Maybe Text
Maybe RStudioServerProAppSettings
Maybe RSessionAppSettings
Maybe KernelGatewayAppSettings
Maybe JupyterServerAppSettings
Maybe SharingSettings
Maybe TensorBoardAppSettings
Maybe CanvasAppSettings
tensorBoardAppSettings :: Maybe TensorBoardAppSettings
sharingSettings :: Maybe SharingSettings
securityGroups :: Maybe [Text]
rStudioServerProAppSettings :: Maybe RStudioServerProAppSettings
rSessionAppSettings :: Maybe RSessionAppSettings
kernelGatewayAppSettings :: Maybe KernelGatewayAppSettings
jupyterServerAppSettings :: Maybe JupyterServerAppSettings
executionRole :: Maybe Text
canvasAppSettings :: Maybe CanvasAppSettings
$sel:tensorBoardAppSettings:UserSettings' :: UserSettings -> Maybe TensorBoardAppSettings
$sel:sharingSettings:UserSettings' :: UserSettings -> Maybe SharingSettings
$sel:securityGroups:UserSettings' :: UserSettings -> Maybe [Text]
$sel:rStudioServerProAppSettings:UserSettings' :: UserSettings -> Maybe RStudioServerProAppSettings
$sel:rSessionAppSettings:UserSettings' :: UserSettings -> Maybe RSessionAppSettings
$sel:kernelGatewayAppSettings:UserSettings' :: UserSettings -> Maybe KernelGatewayAppSettings
$sel:jupyterServerAppSettings:UserSettings' :: UserSettings -> Maybe JupyterServerAppSettings
$sel:executionRole:UserSettings' :: UserSettings -> Maybe Text
$sel:canvasAppSettings:UserSettings' :: UserSettings -> Maybe CanvasAppSettings
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CanvasAppSettings
canvasAppSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
executionRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JupyterServerAppSettings
jupyterServerAppSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KernelGatewayAppSettings
kernelGatewayAppSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RSessionAppSettings
rSessionAppSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RStudioServerProAppSettings
rStudioServerProAppSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SharingSettings
sharingSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TensorBoardAppSettings
tensorBoardAppSettings

instance Prelude.NFData UserSettings where
  rnf :: UserSettings -> ()
rnf UserSettings' {Maybe [Text]
Maybe Text
Maybe RStudioServerProAppSettings
Maybe RSessionAppSettings
Maybe KernelGatewayAppSettings
Maybe JupyterServerAppSettings
Maybe SharingSettings
Maybe TensorBoardAppSettings
Maybe CanvasAppSettings
tensorBoardAppSettings :: Maybe TensorBoardAppSettings
sharingSettings :: Maybe SharingSettings
securityGroups :: Maybe [Text]
rStudioServerProAppSettings :: Maybe RStudioServerProAppSettings
rSessionAppSettings :: Maybe RSessionAppSettings
kernelGatewayAppSettings :: Maybe KernelGatewayAppSettings
jupyterServerAppSettings :: Maybe JupyterServerAppSettings
executionRole :: Maybe Text
canvasAppSettings :: Maybe CanvasAppSettings
$sel:tensorBoardAppSettings:UserSettings' :: UserSettings -> Maybe TensorBoardAppSettings
$sel:sharingSettings:UserSettings' :: UserSettings -> Maybe SharingSettings
$sel:securityGroups:UserSettings' :: UserSettings -> Maybe [Text]
$sel:rStudioServerProAppSettings:UserSettings' :: UserSettings -> Maybe RStudioServerProAppSettings
$sel:rSessionAppSettings:UserSettings' :: UserSettings -> Maybe RSessionAppSettings
$sel:kernelGatewayAppSettings:UserSettings' :: UserSettings -> Maybe KernelGatewayAppSettings
$sel:jupyterServerAppSettings:UserSettings' :: UserSettings -> Maybe JupyterServerAppSettings
$sel:executionRole:UserSettings' :: UserSettings -> Maybe Text
$sel:canvasAppSettings:UserSettings' :: UserSettings -> Maybe CanvasAppSettings
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CanvasAppSettings
canvasAppSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JupyterServerAppSettings
jupyterServerAppSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KernelGatewayAppSettings
kernelGatewayAppSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RSessionAppSettings
rSessionAppSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RStudioServerProAppSettings
rStudioServerProAppSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SharingSettings
sharingSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TensorBoardAppSettings
tensorBoardAppSettings

instance Data.ToJSON UserSettings where
  toJSON :: UserSettings -> Value
toJSON UserSettings' {Maybe [Text]
Maybe Text
Maybe RStudioServerProAppSettings
Maybe RSessionAppSettings
Maybe KernelGatewayAppSettings
Maybe JupyterServerAppSettings
Maybe SharingSettings
Maybe TensorBoardAppSettings
Maybe CanvasAppSettings
tensorBoardAppSettings :: Maybe TensorBoardAppSettings
sharingSettings :: Maybe SharingSettings
securityGroups :: Maybe [Text]
rStudioServerProAppSettings :: Maybe RStudioServerProAppSettings
rSessionAppSettings :: Maybe RSessionAppSettings
kernelGatewayAppSettings :: Maybe KernelGatewayAppSettings
jupyterServerAppSettings :: Maybe JupyterServerAppSettings
executionRole :: Maybe Text
canvasAppSettings :: Maybe CanvasAppSettings
$sel:tensorBoardAppSettings:UserSettings' :: UserSettings -> Maybe TensorBoardAppSettings
$sel:sharingSettings:UserSettings' :: UserSettings -> Maybe SharingSettings
$sel:securityGroups:UserSettings' :: UserSettings -> Maybe [Text]
$sel:rStudioServerProAppSettings:UserSettings' :: UserSettings -> Maybe RStudioServerProAppSettings
$sel:rSessionAppSettings:UserSettings' :: UserSettings -> Maybe RSessionAppSettings
$sel:kernelGatewayAppSettings:UserSettings' :: UserSettings -> Maybe KernelGatewayAppSettings
$sel:jupyterServerAppSettings:UserSettings' :: UserSettings -> Maybe JupyterServerAppSettings
$sel:executionRole:UserSettings' :: UserSettings -> Maybe Text
$sel:canvasAppSettings:UserSettings' :: UserSettings -> Maybe CanvasAppSettings
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CanvasAppSettings" 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 CanvasAppSettings
canvasAppSettings,
            (Key
"ExecutionRole" 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 Text
executionRole,
            (Key
"JupyterServerAppSettings" 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 JupyterServerAppSettings
jupyterServerAppSettings,
            (Key
"KernelGatewayAppSettings" 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 KernelGatewayAppSettings
kernelGatewayAppSettings,
            (Key
"RSessionAppSettings" 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 RSessionAppSettings
rSessionAppSettings,
            (Key
"RStudioServerProAppSettings" 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 RStudioServerProAppSettings
rStudioServerProAppSettings,
            (Key
"SecurityGroups" 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 [Text]
securityGroups,
            (Key
"SharingSettings" 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 SharingSettings
sharingSettings,
            (Key
"TensorBoardAppSettings" 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 TensorBoardAppSettings
tensorBoardAppSettings
          ]
      )