{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.EMR.UpdateStudio
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an Amazon EMR Studio configuration, including attributes such as
-- name, description, and subnets.
module Amazonka.EMR.UpdateStudio
  ( -- * Creating a Request
    UpdateStudio (..),
    newUpdateStudio,

    -- * Request Lenses
    updateStudio_defaultS3Location,
    updateStudio_description,
    updateStudio_name,
    updateStudio_subnetIds,
    updateStudio_studioId,

    -- * Destructuring the Response
    UpdateStudioResponse (..),
    newUpdateStudioResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EMR.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateStudio' smart constructor.
data UpdateStudio = UpdateStudio'
  { -- | The Amazon S3 location to back up Workspaces and notebook files for the
    -- Amazon EMR Studio.
    UpdateStudio -> Maybe Text
defaultS3Location :: Prelude.Maybe Prelude.Text,
    -- | A detailed description to assign to the Amazon EMR Studio.
    UpdateStudio -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A descriptive name for the Amazon EMR Studio.
    UpdateStudio -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A list of subnet IDs to associate with the Amazon EMR Studio. The list
    -- can include new subnet IDs, but must also include all of the subnet IDs
    -- previously associated with the Studio. The list order does not matter. A
    -- Studio can have a maximum of 5 subnets. The subnets must belong to the
    -- same VPC as the Studio.
    UpdateStudio -> Maybe [Text]
subnetIds :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the Amazon EMR Studio to update.
    UpdateStudio -> Text
studioId :: Prelude.Text
  }
  deriving (UpdateStudio -> UpdateStudio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStudio -> UpdateStudio -> Bool
$c/= :: UpdateStudio -> UpdateStudio -> Bool
== :: UpdateStudio -> UpdateStudio -> Bool
$c== :: UpdateStudio -> UpdateStudio -> Bool
Prelude.Eq, ReadPrec [UpdateStudio]
ReadPrec UpdateStudio
Int -> ReadS UpdateStudio
ReadS [UpdateStudio]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStudio]
$creadListPrec :: ReadPrec [UpdateStudio]
readPrec :: ReadPrec UpdateStudio
$creadPrec :: ReadPrec UpdateStudio
readList :: ReadS [UpdateStudio]
$creadList :: ReadS [UpdateStudio]
readsPrec :: Int -> ReadS UpdateStudio
$creadsPrec :: Int -> ReadS UpdateStudio
Prelude.Read, Int -> UpdateStudio -> ShowS
[UpdateStudio] -> ShowS
UpdateStudio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStudio] -> ShowS
$cshowList :: [UpdateStudio] -> ShowS
show :: UpdateStudio -> String
$cshow :: UpdateStudio -> String
showsPrec :: Int -> UpdateStudio -> ShowS
$cshowsPrec :: Int -> UpdateStudio -> ShowS
Prelude.Show, forall x. Rep UpdateStudio x -> UpdateStudio
forall x. UpdateStudio -> Rep UpdateStudio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateStudio x -> UpdateStudio
$cfrom :: forall x. UpdateStudio -> Rep UpdateStudio x
Prelude.Generic)

-- |
-- Create a value of 'UpdateStudio' 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:
--
-- 'defaultS3Location', 'updateStudio_defaultS3Location' - The Amazon S3 location to back up Workspaces and notebook files for the
-- Amazon EMR Studio.
--
-- 'description', 'updateStudio_description' - A detailed description to assign to the Amazon EMR Studio.
--
-- 'name', 'updateStudio_name' - A descriptive name for the Amazon EMR Studio.
--
-- 'subnetIds', 'updateStudio_subnetIds' - A list of subnet IDs to associate with the Amazon EMR Studio. The list
-- can include new subnet IDs, but must also include all of the subnet IDs
-- previously associated with the Studio. The list order does not matter. A
-- Studio can have a maximum of 5 subnets. The subnets must belong to the
-- same VPC as the Studio.
--
-- 'studioId', 'updateStudio_studioId' - The ID of the Amazon EMR Studio to update.
newUpdateStudio ::
  -- | 'studioId'
  Prelude.Text ->
  UpdateStudio
newUpdateStudio :: Text -> UpdateStudio
newUpdateStudio Text
pStudioId_ =
  UpdateStudio'
    { $sel:defaultS3Location:UpdateStudio' :: Maybe Text
defaultS3Location = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateStudio' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateStudio' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetIds:UpdateStudio' :: Maybe [Text]
subnetIds = forall a. Maybe a
Prelude.Nothing,
      $sel:studioId:UpdateStudio' :: Text
studioId = Text
pStudioId_
    }

-- | The Amazon S3 location to back up Workspaces and notebook files for the
-- Amazon EMR Studio.
updateStudio_defaultS3Location :: Lens.Lens' UpdateStudio (Prelude.Maybe Prelude.Text)
updateStudio_defaultS3Location :: Lens' UpdateStudio (Maybe Text)
updateStudio_defaultS3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStudio' {Maybe Text
defaultS3Location :: Maybe Text
$sel:defaultS3Location:UpdateStudio' :: UpdateStudio -> Maybe Text
defaultS3Location} -> Maybe Text
defaultS3Location) (\s :: UpdateStudio
s@UpdateStudio' {} Maybe Text
a -> UpdateStudio
s {$sel:defaultS3Location:UpdateStudio' :: Maybe Text
defaultS3Location = Maybe Text
a} :: UpdateStudio)

-- | A detailed description to assign to the Amazon EMR Studio.
updateStudio_description :: Lens.Lens' UpdateStudio (Prelude.Maybe Prelude.Text)
updateStudio_description :: Lens' UpdateStudio (Maybe Text)
updateStudio_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStudio' {Maybe Text
description :: Maybe Text
$sel:description:UpdateStudio' :: UpdateStudio -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateStudio
s@UpdateStudio' {} Maybe Text
a -> UpdateStudio
s {$sel:description:UpdateStudio' :: Maybe Text
description = Maybe Text
a} :: UpdateStudio)

-- | A descriptive name for the Amazon EMR Studio.
updateStudio_name :: Lens.Lens' UpdateStudio (Prelude.Maybe Prelude.Text)
updateStudio_name :: Lens' UpdateStudio (Maybe Text)
updateStudio_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStudio' {Maybe Text
name :: Maybe Text
$sel:name:UpdateStudio' :: UpdateStudio -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateStudio
s@UpdateStudio' {} Maybe Text
a -> UpdateStudio
s {$sel:name:UpdateStudio' :: Maybe Text
name = Maybe Text
a} :: UpdateStudio)

-- | A list of subnet IDs to associate with the Amazon EMR Studio. The list
-- can include new subnet IDs, but must also include all of the subnet IDs
-- previously associated with the Studio. The list order does not matter. A
-- Studio can have a maximum of 5 subnets. The subnets must belong to the
-- same VPC as the Studio.
updateStudio_subnetIds :: Lens.Lens' UpdateStudio (Prelude.Maybe [Prelude.Text])
updateStudio_subnetIds :: Lens' UpdateStudio (Maybe [Text])
updateStudio_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStudio' {Maybe [Text]
subnetIds :: Maybe [Text]
$sel:subnetIds:UpdateStudio' :: UpdateStudio -> Maybe [Text]
subnetIds} -> Maybe [Text]
subnetIds) (\s :: UpdateStudio
s@UpdateStudio' {} Maybe [Text]
a -> UpdateStudio
s {$sel:subnetIds:UpdateStudio' :: Maybe [Text]
subnetIds = Maybe [Text]
a} :: UpdateStudio) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ID of the Amazon EMR Studio to update.
updateStudio_studioId :: Lens.Lens' UpdateStudio Prelude.Text
updateStudio_studioId :: Lens' UpdateStudio Text
updateStudio_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStudio' {Text
studioId :: Text
$sel:studioId:UpdateStudio' :: UpdateStudio -> Text
studioId} -> Text
studioId) (\s :: UpdateStudio
s@UpdateStudio' {} Text
a -> UpdateStudio
s {$sel:studioId:UpdateStudio' :: Text
studioId = Text
a} :: UpdateStudio)

instance Core.AWSRequest UpdateStudio where
  type AWSResponse UpdateStudio = UpdateStudioResponse
  request :: (Service -> Service) -> UpdateStudio -> Request UpdateStudio
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateStudio
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateStudio)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateStudioResponse
UpdateStudioResponse'

instance Prelude.Hashable UpdateStudio where
  hashWithSalt :: Int -> UpdateStudio -> Int
hashWithSalt Int
_salt UpdateStudio' {Maybe [Text]
Maybe Text
Text
studioId :: Text
subnetIds :: Maybe [Text]
name :: Maybe Text
description :: Maybe Text
defaultS3Location :: Maybe Text
$sel:studioId:UpdateStudio' :: UpdateStudio -> Text
$sel:subnetIds:UpdateStudio' :: UpdateStudio -> Maybe [Text]
$sel:name:UpdateStudio' :: UpdateStudio -> Maybe Text
$sel:description:UpdateStudio' :: UpdateStudio -> Maybe Text
$sel:defaultS3Location:UpdateStudio' :: UpdateStudio -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultS3Location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
subnetIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData UpdateStudio where
  rnf :: UpdateStudio -> ()
rnf UpdateStudio' {Maybe [Text]
Maybe Text
Text
studioId :: Text
subnetIds :: Maybe [Text]
name :: Maybe Text
description :: Maybe Text
defaultS3Location :: Maybe Text
$sel:studioId:UpdateStudio' :: UpdateStudio -> Text
$sel:subnetIds:UpdateStudio' :: UpdateStudio -> Maybe [Text]
$sel:name:UpdateStudio' :: UpdateStudio -> Maybe Text
$sel:description:UpdateStudio' :: UpdateStudio -> Maybe Text
$sel:defaultS3Location:UpdateStudio' :: UpdateStudio -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultS3Location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
subnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

instance Data.ToHeaders UpdateStudio where
  toHeaders :: UpdateStudio -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"ElasticMapReduce.UpdateStudio" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateStudio where
  toJSON :: UpdateStudio -> Value
toJSON UpdateStudio' {Maybe [Text]
Maybe Text
Text
studioId :: Text
subnetIds :: Maybe [Text]
name :: Maybe Text
description :: Maybe Text
defaultS3Location :: Maybe Text
$sel:studioId:UpdateStudio' :: UpdateStudio -> Text
$sel:subnetIds:UpdateStudio' :: UpdateStudio -> Maybe [Text]
$sel:name:UpdateStudio' :: UpdateStudio -> Maybe Text
$sel:description:UpdateStudio' :: UpdateStudio -> Maybe Text
$sel:defaultS3Location:UpdateStudio' :: UpdateStudio -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DefaultS3Location" 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
defaultS3Location,
            (Key
"Description" 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
description,
            (Key
"Name" 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
name,
            (Key
"SubnetIds" 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]
subnetIds,
            forall a. a -> Maybe a
Prelude.Just (Key
"StudioId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
studioId)
          ]
      )

instance Data.ToPath UpdateStudio where
  toPath :: UpdateStudio -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery UpdateStudio where
  toQuery :: UpdateStudio -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateStudioResponse' smart constructor.
data UpdateStudioResponse = UpdateStudioResponse'
  {
  }
  deriving (UpdateStudioResponse -> UpdateStudioResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStudioResponse -> UpdateStudioResponse -> Bool
$c/= :: UpdateStudioResponse -> UpdateStudioResponse -> Bool
== :: UpdateStudioResponse -> UpdateStudioResponse -> Bool
$c== :: UpdateStudioResponse -> UpdateStudioResponse -> Bool
Prelude.Eq, ReadPrec [UpdateStudioResponse]
ReadPrec UpdateStudioResponse
Int -> ReadS UpdateStudioResponse
ReadS [UpdateStudioResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStudioResponse]
$creadListPrec :: ReadPrec [UpdateStudioResponse]
readPrec :: ReadPrec UpdateStudioResponse
$creadPrec :: ReadPrec UpdateStudioResponse
readList :: ReadS [UpdateStudioResponse]
$creadList :: ReadS [UpdateStudioResponse]
readsPrec :: Int -> ReadS UpdateStudioResponse
$creadsPrec :: Int -> ReadS UpdateStudioResponse
Prelude.Read, Int -> UpdateStudioResponse -> ShowS
[UpdateStudioResponse] -> ShowS
UpdateStudioResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStudioResponse] -> ShowS
$cshowList :: [UpdateStudioResponse] -> ShowS
show :: UpdateStudioResponse -> String
$cshow :: UpdateStudioResponse -> String
showsPrec :: Int -> UpdateStudioResponse -> ShowS
$cshowsPrec :: Int -> UpdateStudioResponse -> ShowS
Prelude.Show, forall x. Rep UpdateStudioResponse x -> UpdateStudioResponse
forall x. UpdateStudioResponse -> Rep UpdateStudioResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateStudioResponse x -> UpdateStudioResponse
$cfrom :: forall x. UpdateStudioResponse -> Rep UpdateStudioResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateStudioResponse' 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.
newUpdateStudioResponse ::
  UpdateStudioResponse
newUpdateStudioResponse :: UpdateStudioResponse
newUpdateStudioResponse = UpdateStudioResponse
UpdateStudioResponse'

instance Prelude.NFData UpdateStudioResponse where
  rnf :: UpdateStudioResponse -> ()
rnf UpdateStudioResponse
_ = ()