{-# 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.Nimble.CreateStudio
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a new studio.
--
-- When creating a studio, two IAM roles must be provided: the admin role
-- and the user role. These roles are assumed by your users when they log
-- in to the Nimble Studio portal.
--
-- The user role must have the @AmazonNimbleStudio-StudioUser@ managed
-- policy attached for the portal to function properly.
--
-- The admin role must have the @AmazonNimbleStudio-StudioAdmin@ managed
-- policy attached for the portal to function properly.
--
-- You may optionally specify a KMS key in the
-- @StudioEncryptionConfiguration@.
--
-- In Nimble Studio, resource names, descriptions, initialization scripts,
-- and other data you provide are always encrypted at rest using an KMS
-- key. By default, this key is owned by Amazon Web Services and managed on
-- your behalf. You may provide your own KMS key when calling
-- @CreateStudio@ to encrypt this data using a key you own and manage.
--
-- When providing an KMS key during studio creation, Nimble Studio creates
-- KMS grants in your account to provide your studio user and admin roles
-- access to these KMS keys.
--
-- If you delete this grant, the studio will no longer be accessible to
-- your portal users.
--
-- If you delete the studio KMS key, your studio will no longer be
-- accessible.
module Amazonka.Nimble.CreateStudio
  ( -- * Creating a Request
    CreateStudio (..),
    newCreateStudio,

    -- * Request Lenses
    createStudio_clientToken,
    createStudio_studioEncryptionConfiguration,
    createStudio_tags,
    createStudio_adminRoleArn,
    createStudio_displayName,
    createStudio_studioName,
    createStudio_userRoleArn,

    -- * Destructuring the Response
    CreateStudioResponse (..),
    newCreateStudioResponse,

    -- * Response Lenses
    createStudioResponse_studio,
    createStudioResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateStudio' smart constructor.
data CreateStudio = CreateStudio'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If you don’t specify a client token, the
    -- Amazon Web Services SDK automatically generates a client token and uses
    -- it for the request to ensure idempotency.
    CreateStudio -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The studio encryption configuration.
    CreateStudio -> Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration :: Prelude.Maybe StudioEncryptionConfiguration,
    -- | A collection of labels, in the form of key-value pairs, that apply to
    -- this resource.
    CreateStudio -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The IAM role that studio admins will assume when logging in to the
    -- Nimble Studio portal.
    CreateStudio -> Text
adminRoleArn :: Prelude.Text,
    -- | A friendly name for the studio.
    CreateStudio -> Sensitive Text
displayName :: Data.Sensitive Prelude.Text,
    -- | The studio name that is used in the URL of the Nimble Studio portal when
    -- accessed by Nimble Studio users.
    CreateStudio -> Text
studioName :: Prelude.Text,
    -- | The IAM role that studio users will assume when logging in to the Nimble
    -- Studio portal.
    CreateStudio -> Text
userRoleArn :: Prelude.Text
  }
  deriving (CreateStudio -> CreateStudio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStudio -> CreateStudio -> Bool
$c/= :: CreateStudio -> CreateStudio -> Bool
== :: CreateStudio -> CreateStudio -> Bool
$c== :: CreateStudio -> CreateStudio -> Bool
Prelude.Eq, Int -> CreateStudio -> ShowS
[CreateStudio] -> ShowS
CreateStudio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStudio] -> ShowS
$cshowList :: [CreateStudio] -> ShowS
show :: CreateStudio -> String
$cshow :: CreateStudio -> String
showsPrec :: Int -> CreateStudio -> ShowS
$cshowsPrec :: Int -> CreateStudio -> ShowS
Prelude.Show, forall x. Rep CreateStudio x -> CreateStudio
forall x. CreateStudio -> Rep CreateStudio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStudio x -> CreateStudio
$cfrom :: forall x. CreateStudio -> Rep CreateStudio x
Prelude.Generic)

-- |
-- Create a value of 'CreateStudio' 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:
--
-- 'clientToken', 'createStudio_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If you don’t specify a client token, the
-- Amazon Web Services SDK automatically generates a client token and uses
-- it for the request to ensure idempotency.
--
-- 'studioEncryptionConfiguration', 'createStudio_studioEncryptionConfiguration' - The studio encryption configuration.
--
-- 'tags', 'createStudio_tags' - A collection of labels, in the form of key-value pairs, that apply to
-- this resource.
--
-- 'adminRoleArn', 'createStudio_adminRoleArn' - The IAM role that studio admins will assume when logging in to the
-- Nimble Studio portal.
--
-- 'displayName', 'createStudio_displayName' - A friendly name for the studio.
--
-- 'studioName', 'createStudio_studioName' - The studio name that is used in the URL of the Nimble Studio portal when
-- accessed by Nimble Studio users.
--
-- 'userRoleArn', 'createStudio_userRoleArn' - The IAM role that studio users will assume when logging in to the Nimble
-- Studio portal.
newCreateStudio ::
  -- | 'adminRoleArn'
  Prelude.Text ->
  -- | 'displayName'
  Prelude.Text ->
  -- | 'studioName'
  Prelude.Text ->
  -- | 'userRoleArn'
  Prelude.Text ->
  CreateStudio
newCreateStudio :: Text -> Text -> Text -> Text -> CreateStudio
newCreateStudio
  Text
pAdminRoleArn_
  Text
pDisplayName_
  Text
pStudioName_
  Text
pUserRoleArn_ =
    CreateStudio'
      { $sel:clientToken:CreateStudio' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:studioEncryptionConfiguration:CreateStudio' :: Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateStudio' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:adminRoleArn:CreateStudio' :: Text
adminRoleArn = Text
pAdminRoleArn_,
        $sel:displayName:CreateStudio' :: Sensitive Text
displayName = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pDisplayName_,
        $sel:studioName:CreateStudio' :: Text
studioName = Text
pStudioName_,
        $sel:userRoleArn:CreateStudio' :: Text
userRoleArn = Text
pUserRoleArn_
      }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If you don’t specify a client token, the
-- Amazon Web Services SDK automatically generates a client token and uses
-- it for the request to ensure idempotency.
createStudio_clientToken :: Lens.Lens' CreateStudio (Prelude.Maybe Prelude.Text)
createStudio_clientToken :: Lens' CreateStudio (Maybe Text)
createStudio_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateStudio' :: CreateStudio -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateStudio
s@CreateStudio' {} Maybe Text
a -> CreateStudio
s {$sel:clientToken:CreateStudio' :: Maybe Text
clientToken = Maybe Text
a} :: CreateStudio)

-- | The studio encryption configuration.
createStudio_studioEncryptionConfiguration :: Lens.Lens' CreateStudio (Prelude.Maybe StudioEncryptionConfiguration)
createStudio_studioEncryptionConfiguration :: Lens' CreateStudio (Maybe StudioEncryptionConfiguration)
createStudio_studioEncryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration :: Maybe StudioEncryptionConfiguration
$sel:studioEncryptionConfiguration:CreateStudio' :: CreateStudio -> Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration} -> Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration) (\s :: CreateStudio
s@CreateStudio' {} Maybe StudioEncryptionConfiguration
a -> CreateStudio
s {$sel:studioEncryptionConfiguration:CreateStudio' :: Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration = Maybe StudioEncryptionConfiguration
a} :: CreateStudio)

-- | A collection of labels, in the form of key-value pairs, that apply to
-- this resource.
createStudio_tags :: Lens.Lens' CreateStudio (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createStudio_tags :: Lens' CreateStudio (Maybe (HashMap Text Text))
createStudio_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateStudio' :: CreateStudio -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateStudio
s@CreateStudio' {} Maybe (HashMap Text Text)
a -> CreateStudio
s {$sel:tags:CreateStudio' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateStudio) 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 IAM role that studio admins will assume when logging in to the
-- Nimble Studio portal.
createStudio_adminRoleArn :: Lens.Lens' CreateStudio Prelude.Text
createStudio_adminRoleArn :: Lens' CreateStudio Text
createStudio_adminRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
adminRoleArn :: Text
$sel:adminRoleArn:CreateStudio' :: CreateStudio -> Text
adminRoleArn} -> Text
adminRoleArn) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:adminRoleArn:CreateStudio' :: Text
adminRoleArn = Text
a} :: CreateStudio)

-- | A friendly name for the studio.
createStudio_displayName :: Lens.Lens' CreateStudio Prelude.Text
createStudio_displayName :: Lens' CreateStudio Text
createStudio_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Sensitive Text
displayName :: Sensitive Text
$sel:displayName:CreateStudio' :: CreateStudio -> Sensitive Text
displayName} -> Sensitive Text
displayName) (\s :: CreateStudio
s@CreateStudio' {} Sensitive Text
a -> CreateStudio
s {$sel:displayName:CreateStudio' :: Sensitive Text
displayName = Sensitive Text
a} :: CreateStudio) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The studio name that is used in the URL of the Nimble Studio portal when
-- accessed by Nimble Studio users.
createStudio_studioName :: Lens.Lens' CreateStudio Prelude.Text
createStudio_studioName :: Lens' CreateStudio Text
createStudio_studioName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
studioName :: Text
$sel:studioName:CreateStudio' :: CreateStudio -> Text
studioName} -> Text
studioName) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:studioName:CreateStudio' :: Text
studioName = Text
a} :: CreateStudio)

-- | The IAM role that studio users will assume when logging in to the Nimble
-- Studio portal.
createStudio_userRoleArn :: Lens.Lens' CreateStudio Prelude.Text
createStudio_userRoleArn :: Lens' CreateStudio Text
createStudio_userRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
userRoleArn :: Text
$sel:userRoleArn:CreateStudio' :: CreateStudio -> Text
userRoleArn} -> Text
userRoleArn) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:userRoleArn:CreateStudio' :: Text
userRoleArn = Text
a} :: CreateStudio)

instance Core.AWSRequest CreateStudio where
  type AWSResponse CreateStudio = CreateStudioResponse
  request :: (Service -> Service) -> CreateStudio -> Request CreateStudio
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 CreateStudio
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateStudio)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Studio -> Int -> CreateStudioResponse
CreateStudioResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"studio")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateStudio where
  hashWithSalt :: Int -> CreateStudio -> Int
hashWithSalt Int
_salt CreateStudio' {Maybe Text
Maybe (HashMap Text Text)
Maybe StudioEncryptionConfiguration
Text
Sensitive Text
userRoleArn :: Text
studioName :: Text
displayName :: Sensitive Text
adminRoleArn :: Text
tags :: Maybe (HashMap Text Text)
studioEncryptionConfiguration :: Maybe StudioEncryptionConfiguration
clientToken :: Maybe Text
$sel:userRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:studioName:CreateStudio' :: CreateStudio -> Text
$sel:displayName:CreateStudio' :: CreateStudio -> Sensitive Text
$sel:adminRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:tags:CreateStudio' :: CreateStudio -> Maybe (HashMap Text Text)
$sel:studioEncryptionConfiguration:CreateStudio' :: CreateStudio -> Maybe StudioEncryptionConfiguration
$sel:clientToken:CreateStudio' :: CreateStudio -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
adminRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userRoleArn

instance Prelude.NFData CreateStudio where
  rnf :: CreateStudio -> ()
rnf CreateStudio' {Maybe Text
Maybe (HashMap Text Text)
Maybe StudioEncryptionConfiguration
Text
Sensitive Text
userRoleArn :: Text
studioName :: Text
displayName :: Sensitive Text
adminRoleArn :: Text
tags :: Maybe (HashMap Text Text)
studioEncryptionConfiguration :: Maybe StudioEncryptionConfiguration
clientToken :: Maybe Text
$sel:userRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:studioName:CreateStudio' :: CreateStudio -> Text
$sel:displayName:CreateStudio' :: CreateStudio -> Sensitive Text
$sel:adminRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:tags:CreateStudio' :: CreateStudio -> Maybe (HashMap Text Text)
$sel:studioEncryptionConfiguration:CreateStudio' :: CreateStudio -> Maybe StudioEncryptionConfiguration
$sel:clientToken:CreateStudio' :: CreateStudio -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StudioEncryptionConfiguration
studioEncryptionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
adminRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userRoleArn

instance Data.ToHeaders CreateStudio where
  toHeaders :: CreateStudio -> ResponseHeaders
toHeaders CreateStudio' {Maybe Text
Maybe (HashMap Text Text)
Maybe StudioEncryptionConfiguration
Text
Sensitive Text
userRoleArn :: Text
studioName :: Text
displayName :: Sensitive Text
adminRoleArn :: Text
tags :: Maybe (HashMap Text Text)
studioEncryptionConfiguration :: Maybe StudioEncryptionConfiguration
clientToken :: Maybe Text
$sel:userRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:studioName:CreateStudio' :: CreateStudio -> Text
$sel:displayName:CreateStudio' :: CreateStudio -> Sensitive Text
$sel:adminRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:tags:CreateStudio' :: CreateStudio -> Maybe (HashMap Text Text)
$sel:studioEncryptionConfiguration:CreateStudio' :: CreateStudio -> Maybe StudioEncryptionConfiguration
$sel:clientToken:CreateStudio' :: CreateStudio -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amz-Client-Token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
clientToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON CreateStudio where
  toJSON :: CreateStudio -> Value
toJSON CreateStudio' {Maybe Text
Maybe (HashMap Text Text)
Maybe StudioEncryptionConfiguration
Text
Sensitive Text
userRoleArn :: Text
studioName :: Text
displayName :: Sensitive Text
adminRoleArn :: Text
tags :: Maybe (HashMap Text Text)
studioEncryptionConfiguration :: Maybe StudioEncryptionConfiguration
clientToken :: Maybe Text
$sel:userRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:studioName:CreateStudio' :: CreateStudio -> Text
$sel:displayName:CreateStudio' :: CreateStudio -> Sensitive Text
$sel:adminRoleArn:CreateStudio' :: CreateStudio -> Text
$sel:tags:CreateStudio' :: CreateStudio -> Maybe (HashMap Text Text)
$sel:studioEncryptionConfiguration:CreateStudio' :: CreateStudio -> Maybe StudioEncryptionConfiguration
$sel:clientToken:CreateStudio' :: CreateStudio -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"studioEncryptionConfiguration" 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 StudioEncryptionConfiguration
studioEncryptionConfiguration,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"adminRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
adminRoleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"displayName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
displayName),
            forall a. a -> Maybe a
Prelude.Just (Key
"studioName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
studioName),
            forall a. a -> Maybe a
Prelude.Just (Key
"userRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userRoleArn)
          ]
      )

instance Data.ToPath CreateStudio where
  toPath :: CreateStudio -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2020-08-01/studios"

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

-- | /See:/ 'newCreateStudioResponse' smart constructor.
data CreateStudioResponse = CreateStudioResponse'
  { -- | Information about a studio.
    CreateStudioResponse -> Maybe Studio
studio :: Prelude.Maybe Studio,
    -- | The response's http status code.
    CreateStudioResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateStudioResponse -> CreateStudioResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStudioResponse -> CreateStudioResponse -> Bool
$c/= :: CreateStudioResponse -> CreateStudioResponse -> Bool
== :: CreateStudioResponse -> CreateStudioResponse -> Bool
$c== :: CreateStudioResponse -> CreateStudioResponse -> Bool
Prelude.Eq, Int -> CreateStudioResponse -> ShowS
[CreateStudioResponse] -> ShowS
CreateStudioResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStudioResponse] -> ShowS
$cshowList :: [CreateStudioResponse] -> ShowS
show :: CreateStudioResponse -> String
$cshow :: CreateStudioResponse -> String
showsPrec :: Int -> CreateStudioResponse -> ShowS
$cshowsPrec :: Int -> CreateStudioResponse -> ShowS
Prelude.Show, forall x. Rep CreateStudioResponse x -> CreateStudioResponse
forall x. CreateStudioResponse -> Rep CreateStudioResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStudioResponse x -> CreateStudioResponse
$cfrom :: forall x. CreateStudioResponse -> Rep CreateStudioResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateStudioResponse' 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:
--
-- 'studio', 'createStudioResponse_studio' - Information about a studio.
--
-- 'httpStatus', 'createStudioResponse_httpStatus' - The response's http status code.
newCreateStudioResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateStudioResponse
newCreateStudioResponse :: Int -> CreateStudioResponse
newCreateStudioResponse Int
pHttpStatus_ =
  CreateStudioResponse'
    { $sel:studio:CreateStudioResponse' :: Maybe Studio
studio = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateStudioResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about a studio.
createStudioResponse_studio :: Lens.Lens' CreateStudioResponse (Prelude.Maybe Studio)
createStudioResponse_studio :: Lens' CreateStudioResponse (Maybe Studio)
createStudioResponse_studio = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudioResponse' {Maybe Studio
studio :: Maybe Studio
$sel:studio:CreateStudioResponse' :: CreateStudioResponse -> Maybe Studio
studio} -> Maybe Studio
studio) (\s :: CreateStudioResponse
s@CreateStudioResponse' {} Maybe Studio
a -> CreateStudioResponse
s {$sel:studio:CreateStudioResponse' :: Maybe Studio
studio = Maybe Studio
a} :: CreateStudioResponse)

-- | The response's http status code.
createStudioResponse_httpStatus :: Lens.Lens' CreateStudioResponse Prelude.Int
createStudioResponse_httpStatus :: Lens' CreateStudioResponse Int
createStudioResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudioResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateStudioResponse' :: CreateStudioResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateStudioResponse
s@CreateStudioResponse' {} Int
a -> CreateStudioResponse
s {$sel:httpStatus:CreateStudioResponse' :: Int
httpStatus = Int
a} :: CreateStudioResponse)

instance Prelude.NFData CreateStudioResponse where
  rnf :: CreateStudioResponse -> ()
rnf CreateStudioResponse' {Int
Maybe Studio
httpStatus :: Int
studio :: Maybe Studio
$sel:httpStatus:CreateStudioResponse' :: CreateStudioResponse -> Int
$sel:studio:CreateStudioResponse' :: CreateStudioResponse -> Maybe Studio
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Studio
studio
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus