{-# 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.Athena.Types.SessionConfiguration
-- 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.Athena.Types.SessionConfiguration where

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

-- | Contains session configuration information.
--
-- /See:/ 'newSessionConfiguration' smart constructor.
data SessionConfiguration = SessionConfiguration'
  { SessionConfiguration -> Maybe EncryptionConfiguration
encryptionConfiguration :: Prelude.Maybe EncryptionConfiguration,
    -- | The ARN of the execution role used for the session.
    SessionConfiguration -> Maybe Text
executionRole :: Prelude.Maybe Prelude.Text,
    -- | The idle timeout in seconds for the session.
    SessionConfiguration -> Maybe Integer
idleTimeoutSeconds :: Prelude.Maybe Prelude.Integer,
    -- | The Amazon S3 location that stores information for the notebook.
    SessionConfiguration -> Maybe Text
workingDirectory :: Prelude.Maybe Prelude.Text
  }
  deriving (SessionConfiguration -> SessionConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionConfiguration -> SessionConfiguration -> Bool
$c/= :: SessionConfiguration -> SessionConfiguration -> Bool
== :: SessionConfiguration -> SessionConfiguration -> Bool
$c== :: SessionConfiguration -> SessionConfiguration -> Bool
Prelude.Eq, ReadPrec [SessionConfiguration]
ReadPrec SessionConfiguration
Int -> ReadS SessionConfiguration
ReadS [SessionConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SessionConfiguration]
$creadListPrec :: ReadPrec [SessionConfiguration]
readPrec :: ReadPrec SessionConfiguration
$creadPrec :: ReadPrec SessionConfiguration
readList :: ReadS [SessionConfiguration]
$creadList :: ReadS [SessionConfiguration]
readsPrec :: Int -> ReadS SessionConfiguration
$creadsPrec :: Int -> ReadS SessionConfiguration
Prelude.Read, Int -> SessionConfiguration -> ShowS
[SessionConfiguration] -> ShowS
SessionConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionConfiguration] -> ShowS
$cshowList :: [SessionConfiguration] -> ShowS
show :: SessionConfiguration -> String
$cshow :: SessionConfiguration -> String
showsPrec :: Int -> SessionConfiguration -> ShowS
$cshowsPrec :: Int -> SessionConfiguration -> ShowS
Prelude.Show, forall x. Rep SessionConfiguration x -> SessionConfiguration
forall x. SessionConfiguration -> Rep SessionConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SessionConfiguration x -> SessionConfiguration
$cfrom :: forall x. SessionConfiguration -> Rep SessionConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'SessionConfiguration' 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:
--
-- 'encryptionConfiguration', 'sessionConfiguration_encryptionConfiguration' - Undocumented member.
--
-- 'executionRole', 'sessionConfiguration_executionRole' - The ARN of the execution role used for the session.
--
-- 'idleTimeoutSeconds', 'sessionConfiguration_idleTimeoutSeconds' - The idle timeout in seconds for the session.
--
-- 'workingDirectory', 'sessionConfiguration_workingDirectory' - The Amazon S3 location that stores information for the notebook.
newSessionConfiguration ::
  SessionConfiguration
newSessionConfiguration :: SessionConfiguration
newSessionConfiguration =
  SessionConfiguration'
    { $sel:encryptionConfiguration:SessionConfiguration' :: Maybe EncryptionConfiguration
encryptionConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:executionRole:SessionConfiguration' :: Maybe Text
executionRole = forall a. Maybe a
Prelude.Nothing,
      $sel:idleTimeoutSeconds:SessionConfiguration' :: Maybe Integer
idleTimeoutSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:workingDirectory:SessionConfiguration' :: Maybe Text
workingDirectory = forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
sessionConfiguration_encryptionConfiguration :: Lens.Lens' SessionConfiguration (Prelude.Maybe EncryptionConfiguration)
sessionConfiguration_encryptionConfiguration :: Lens' SessionConfiguration (Maybe EncryptionConfiguration)
sessionConfiguration_encryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SessionConfiguration' {Maybe EncryptionConfiguration
encryptionConfiguration :: Maybe EncryptionConfiguration
$sel:encryptionConfiguration:SessionConfiguration' :: SessionConfiguration -> Maybe EncryptionConfiguration
encryptionConfiguration} -> Maybe EncryptionConfiguration
encryptionConfiguration) (\s :: SessionConfiguration
s@SessionConfiguration' {} Maybe EncryptionConfiguration
a -> SessionConfiguration
s {$sel:encryptionConfiguration:SessionConfiguration' :: Maybe EncryptionConfiguration
encryptionConfiguration = Maybe EncryptionConfiguration
a} :: SessionConfiguration)

-- | The ARN of the execution role used for the session.
sessionConfiguration_executionRole :: Lens.Lens' SessionConfiguration (Prelude.Maybe Prelude.Text)
sessionConfiguration_executionRole :: Lens' SessionConfiguration (Maybe Text)
sessionConfiguration_executionRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SessionConfiguration' {Maybe Text
executionRole :: Maybe Text
$sel:executionRole:SessionConfiguration' :: SessionConfiguration -> Maybe Text
executionRole} -> Maybe Text
executionRole) (\s :: SessionConfiguration
s@SessionConfiguration' {} Maybe Text
a -> SessionConfiguration
s {$sel:executionRole:SessionConfiguration' :: Maybe Text
executionRole = Maybe Text
a} :: SessionConfiguration)

-- | The idle timeout in seconds for the session.
sessionConfiguration_idleTimeoutSeconds :: Lens.Lens' SessionConfiguration (Prelude.Maybe Prelude.Integer)
sessionConfiguration_idleTimeoutSeconds :: Lens' SessionConfiguration (Maybe Integer)
sessionConfiguration_idleTimeoutSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SessionConfiguration' {Maybe Integer
idleTimeoutSeconds :: Maybe Integer
$sel:idleTimeoutSeconds:SessionConfiguration' :: SessionConfiguration -> Maybe Integer
idleTimeoutSeconds} -> Maybe Integer
idleTimeoutSeconds) (\s :: SessionConfiguration
s@SessionConfiguration' {} Maybe Integer
a -> SessionConfiguration
s {$sel:idleTimeoutSeconds:SessionConfiguration' :: Maybe Integer
idleTimeoutSeconds = Maybe Integer
a} :: SessionConfiguration)

-- | The Amazon S3 location that stores information for the notebook.
sessionConfiguration_workingDirectory :: Lens.Lens' SessionConfiguration (Prelude.Maybe Prelude.Text)
sessionConfiguration_workingDirectory :: Lens' SessionConfiguration (Maybe Text)
sessionConfiguration_workingDirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SessionConfiguration' {Maybe Text
workingDirectory :: Maybe Text
$sel:workingDirectory:SessionConfiguration' :: SessionConfiguration -> Maybe Text
workingDirectory} -> Maybe Text
workingDirectory) (\s :: SessionConfiguration
s@SessionConfiguration' {} Maybe Text
a -> SessionConfiguration
s {$sel:workingDirectory:SessionConfiguration' :: Maybe Text
workingDirectory = Maybe Text
a} :: SessionConfiguration)

instance Data.FromJSON SessionConfiguration where
  parseJSON :: Value -> Parser SessionConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SessionConfiguration"
      ( \Object
x ->
          Maybe EncryptionConfiguration
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> SessionConfiguration
SessionConfiguration'
            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
"EncryptionConfiguration")
            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
"IdleTimeoutSeconds")
            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
"WorkingDirectory")
      )

instance Prelude.Hashable SessionConfiguration where
  hashWithSalt :: Int -> SessionConfiguration -> Int
hashWithSalt Int
_salt SessionConfiguration' {Maybe Integer
Maybe Text
Maybe EncryptionConfiguration
workingDirectory :: Maybe Text
idleTimeoutSeconds :: Maybe Integer
executionRole :: Maybe Text
encryptionConfiguration :: Maybe EncryptionConfiguration
$sel:workingDirectory:SessionConfiguration' :: SessionConfiguration -> Maybe Text
$sel:idleTimeoutSeconds:SessionConfiguration' :: SessionConfiguration -> Maybe Integer
$sel:executionRole:SessionConfiguration' :: SessionConfiguration -> Maybe Text
$sel:encryptionConfiguration:SessionConfiguration' :: SessionConfiguration -> Maybe EncryptionConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionConfiguration
encryptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
executionRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
idleTimeoutSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
workingDirectory

instance Prelude.NFData SessionConfiguration where
  rnf :: SessionConfiguration -> ()
rnf SessionConfiguration' {Maybe Integer
Maybe Text
Maybe EncryptionConfiguration
workingDirectory :: Maybe Text
idleTimeoutSeconds :: Maybe Integer
executionRole :: Maybe Text
encryptionConfiguration :: Maybe EncryptionConfiguration
$sel:workingDirectory:SessionConfiguration' :: SessionConfiguration -> Maybe Text
$sel:idleTimeoutSeconds:SessionConfiguration' :: SessionConfiguration -> Maybe Integer
$sel:executionRole:SessionConfiguration' :: SessionConfiguration -> Maybe Text
$sel:encryptionConfiguration:SessionConfiguration' :: SessionConfiguration -> Maybe EncryptionConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionConfiguration
encryptionConfiguration
      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 Integer
idleTimeoutSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workingDirectory