{-# 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.CreateLaunchProfile
-- 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 launch profile.
module Amazonka.Nimble.CreateLaunchProfile
  ( -- * Creating a Request
    CreateLaunchProfile (..),
    newCreateLaunchProfile,

    -- * Request Lenses
    createLaunchProfile_clientToken,
    createLaunchProfile_description,
    createLaunchProfile_tags,
    createLaunchProfile_ec2SubnetIds,
    createLaunchProfile_launchProfileProtocolVersions,
    createLaunchProfile_name,
    createLaunchProfile_streamConfiguration,
    createLaunchProfile_studioComponentIds,
    createLaunchProfile_studioId,

    -- * Destructuring the Response
    CreateLaunchProfileResponse (..),
    newCreateLaunchProfileResponse,

    -- * Response Lenses
    createLaunchProfileResponse_launchProfile,
    createLaunchProfileResponse_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:/ 'newCreateLaunchProfile' smart constructor.
data CreateLaunchProfile = CreateLaunchProfile'
  { -- | 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.
    CreateLaunchProfile -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The description.
    CreateLaunchProfile -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A collection of labels, in the form of key-value pairs, that apply to
    -- this resource.
    CreateLaunchProfile -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specifies the IDs of the EC2 subnets where streaming sessions will be
    -- accessible from. These subnets must support the specified instance
    -- types.
    CreateLaunchProfile -> [Text]
ec2SubnetIds :: [Prelude.Text],
    -- | The version number of the protocol that is used by the launch profile.
    -- The only valid version is \"2021-03-31\".
    CreateLaunchProfile -> [Text]
launchProfileProtocolVersions :: [Prelude.Text],
    -- | The name for the launch profile.
    CreateLaunchProfile -> Sensitive Text
name :: Data.Sensitive Prelude.Text,
    -- | A configuration for a streaming session.
    CreateLaunchProfile -> StreamConfigurationCreate
streamConfiguration :: StreamConfigurationCreate,
    -- | Unique identifiers for a collection of studio components that can be
    -- used with this launch profile.
    CreateLaunchProfile -> NonEmpty Text
studioComponentIds :: Prelude.NonEmpty Prelude.Text,
    -- | The studio ID.
    CreateLaunchProfile -> Text
studioId :: Prelude.Text
  }
  deriving (CreateLaunchProfile -> CreateLaunchProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLaunchProfile -> CreateLaunchProfile -> Bool
$c/= :: CreateLaunchProfile -> CreateLaunchProfile -> Bool
== :: CreateLaunchProfile -> CreateLaunchProfile -> Bool
$c== :: CreateLaunchProfile -> CreateLaunchProfile -> Bool
Prelude.Eq, Int -> CreateLaunchProfile -> ShowS
[CreateLaunchProfile] -> ShowS
CreateLaunchProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLaunchProfile] -> ShowS
$cshowList :: [CreateLaunchProfile] -> ShowS
show :: CreateLaunchProfile -> String
$cshow :: CreateLaunchProfile -> String
showsPrec :: Int -> CreateLaunchProfile -> ShowS
$cshowsPrec :: Int -> CreateLaunchProfile -> ShowS
Prelude.Show, forall x. Rep CreateLaunchProfile x -> CreateLaunchProfile
forall x. CreateLaunchProfile -> Rep CreateLaunchProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLaunchProfile x -> CreateLaunchProfile
$cfrom :: forall x. CreateLaunchProfile -> Rep CreateLaunchProfile x
Prelude.Generic)

-- |
-- Create a value of 'CreateLaunchProfile' 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', 'createLaunchProfile_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.
--
-- 'description', 'createLaunchProfile_description' - The description.
--
-- 'tags', 'createLaunchProfile_tags' - A collection of labels, in the form of key-value pairs, that apply to
-- this resource.
--
-- 'ec2SubnetIds', 'createLaunchProfile_ec2SubnetIds' - Specifies the IDs of the EC2 subnets where streaming sessions will be
-- accessible from. These subnets must support the specified instance
-- types.
--
-- 'launchProfileProtocolVersions', 'createLaunchProfile_launchProfileProtocolVersions' - The version number of the protocol that is used by the launch profile.
-- The only valid version is \"2021-03-31\".
--
-- 'name', 'createLaunchProfile_name' - The name for the launch profile.
--
-- 'streamConfiguration', 'createLaunchProfile_streamConfiguration' - A configuration for a streaming session.
--
-- 'studioComponentIds', 'createLaunchProfile_studioComponentIds' - Unique identifiers for a collection of studio components that can be
-- used with this launch profile.
--
-- 'studioId', 'createLaunchProfile_studioId' - The studio ID.
newCreateLaunchProfile ::
  -- | 'name'
  Prelude.Text ->
  -- | 'streamConfiguration'
  StreamConfigurationCreate ->
  -- | 'studioComponentIds'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'studioId'
  Prelude.Text ->
  CreateLaunchProfile
newCreateLaunchProfile :: Text
-> StreamConfigurationCreate
-> NonEmpty Text
-> Text
-> CreateLaunchProfile
newCreateLaunchProfile
  Text
pName_
  StreamConfigurationCreate
pStreamConfiguration_
  NonEmpty Text
pStudioComponentIds_
  Text
pStudioId_ =
    CreateLaunchProfile'
      { $sel:clientToken:CreateLaunchProfile' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateLaunchProfile' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLaunchProfile' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:ec2SubnetIds:CreateLaunchProfile' :: [Text]
ec2SubnetIds = forall a. Monoid a => a
Prelude.mempty,
        $sel:launchProfileProtocolVersions:CreateLaunchProfile' :: [Text]
launchProfileProtocolVersions = forall a. Monoid a => a
Prelude.mempty,
        $sel:name:CreateLaunchProfile' :: Sensitive Text
name = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pName_,
        $sel:streamConfiguration:CreateLaunchProfile' :: StreamConfigurationCreate
streamConfiguration = StreamConfigurationCreate
pStreamConfiguration_,
        $sel:studioComponentIds:CreateLaunchProfile' :: NonEmpty Text
studioComponentIds =
          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
pStudioComponentIds_,
        $sel:studioId:CreateLaunchProfile' :: Text
studioId = Text
pStudioId_
      }

-- | 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.
createLaunchProfile_clientToken :: Lens.Lens' CreateLaunchProfile (Prelude.Maybe Prelude.Text)
createLaunchProfile_clientToken :: Lens' CreateLaunchProfile (Maybe Text)
createLaunchProfile_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} Maybe Text
a -> CreateLaunchProfile
s {$sel:clientToken:CreateLaunchProfile' :: Maybe Text
clientToken = Maybe Text
a} :: CreateLaunchProfile)

-- | The description.
createLaunchProfile_description :: Lens.Lens' CreateLaunchProfile (Prelude.Maybe Prelude.Text)
createLaunchProfile_description :: Lens' CreateLaunchProfile (Maybe Text)
createLaunchProfile_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} Maybe (Sensitive Text)
a -> CreateLaunchProfile
s {$sel:description:CreateLaunchProfile' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: CreateLaunchProfile) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | A collection of labels, in the form of key-value pairs, that apply to
-- this resource.
createLaunchProfile_tags :: Lens.Lens' CreateLaunchProfile (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createLaunchProfile_tags :: Lens' CreateLaunchProfile (Maybe (HashMap Text Text))
createLaunchProfile_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} Maybe (HashMap Text Text)
a -> CreateLaunchProfile
s {$sel:tags:CreateLaunchProfile' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateLaunchProfile) 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 the IDs of the EC2 subnets where streaming sessions will be
-- accessible from. These subnets must support the specified instance
-- types.
createLaunchProfile_ec2SubnetIds :: Lens.Lens' CreateLaunchProfile [Prelude.Text]
createLaunchProfile_ec2SubnetIds :: Lens' CreateLaunchProfile [Text]
createLaunchProfile_ec2SubnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {[Text]
ec2SubnetIds :: [Text]
$sel:ec2SubnetIds:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
ec2SubnetIds} -> [Text]
ec2SubnetIds) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} [Text]
a -> CreateLaunchProfile
s {$sel:ec2SubnetIds:CreateLaunchProfile' :: [Text]
ec2SubnetIds = [Text]
a} :: CreateLaunchProfile) 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 version number of the protocol that is used by the launch profile.
-- The only valid version is \"2021-03-31\".
createLaunchProfile_launchProfileProtocolVersions :: Lens.Lens' CreateLaunchProfile [Prelude.Text]
createLaunchProfile_launchProfileProtocolVersions :: Lens' CreateLaunchProfile [Text]
createLaunchProfile_launchProfileProtocolVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {[Text]
launchProfileProtocolVersions :: [Text]
$sel:launchProfileProtocolVersions:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
launchProfileProtocolVersions} -> [Text]
launchProfileProtocolVersions) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} [Text]
a -> CreateLaunchProfile
s {$sel:launchProfileProtocolVersions:CreateLaunchProfile' :: [Text]
launchProfileProtocolVersions = [Text]
a} :: CreateLaunchProfile) 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 name for the launch profile.
createLaunchProfile_name :: Lens.Lens' CreateLaunchProfile Prelude.Text
createLaunchProfile_name :: Lens' CreateLaunchProfile Text
createLaunchProfile_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {Sensitive Text
name :: Sensitive Text
$sel:name:CreateLaunchProfile' :: CreateLaunchProfile -> Sensitive Text
name} -> Sensitive Text
name) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} Sensitive Text
a -> CreateLaunchProfile
s {$sel:name:CreateLaunchProfile' :: Sensitive Text
name = Sensitive Text
a} :: CreateLaunchProfile) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | A configuration for a streaming session.
createLaunchProfile_streamConfiguration :: Lens.Lens' CreateLaunchProfile StreamConfigurationCreate
createLaunchProfile_streamConfiguration :: Lens' CreateLaunchProfile StreamConfigurationCreate
createLaunchProfile_streamConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {StreamConfigurationCreate
streamConfiguration :: StreamConfigurationCreate
$sel:streamConfiguration:CreateLaunchProfile' :: CreateLaunchProfile -> StreamConfigurationCreate
streamConfiguration} -> StreamConfigurationCreate
streamConfiguration) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} StreamConfigurationCreate
a -> CreateLaunchProfile
s {$sel:streamConfiguration:CreateLaunchProfile' :: StreamConfigurationCreate
streamConfiguration = StreamConfigurationCreate
a} :: CreateLaunchProfile)

-- | Unique identifiers for a collection of studio components that can be
-- used with this launch profile.
createLaunchProfile_studioComponentIds :: Lens.Lens' CreateLaunchProfile (Prelude.NonEmpty Prelude.Text)
createLaunchProfile_studioComponentIds :: Lens' CreateLaunchProfile (NonEmpty Text)
createLaunchProfile_studioComponentIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {NonEmpty Text
studioComponentIds :: NonEmpty Text
$sel:studioComponentIds:CreateLaunchProfile' :: CreateLaunchProfile -> NonEmpty Text
studioComponentIds} -> NonEmpty Text
studioComponentIds) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} NonEmpty Text
a -> CreateLaunchProfile
s {$sel:studioComponentIds:CreateLaunchProfile' :: NonEmpty Text
studioComponentIds = NonEmpty Text
a} :: CreateLaunchProfile) 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 studio ID.
createLaunchProfile_studioId :: Lens.Lens' CreateLaunchProfile Prelude.Text
createLaunchProfile_studioId :: Lens' CreateLaunchProfile Text
createLaunchProfile_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfile' {Text
studioId :: Text
$sel:studioId:CreateLaunchProfile' :: CreateLaunchProfile -> Text
studioId} -> Text
studioId) (\s :: CreateLaunchProfile
s@CreateLaunchProfile' {} Text
a -> CreateLaunchProfile
s {$sel:studioId:CreateLaunchProfile' :: Text
studioId = Text
a} :: CreateLaunchProfile)

instance Core.AWSRequest CreateLaunchProfile where
  type
    AWSResponse CreateLaunchProfile =
      CreateLaunchProfileResponse
  request :: (Service -> Service)
-> CreateLaunchProfile -> Request CreateLaunchProfile
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 CreateLaunchProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLaunchProfile)))
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 LaunchProfile -> Int -> CreateLaunchProfileResponse
CreateLaunchProfileResponse'
            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
"launchProfile")
            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 CreateLaunchProfile where
  hashWithSalt :: Int -> CreateLaunchProfile -> Int
hashWithSalt Int
_salt CreateLaunchProfile' {[Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
NonEmpty Text
Text
Sensitive Text
StreamConfigurationCreate
studioId :: Text
studioComponentIds :: NonEmpty Text
streamConfiguration :: StreamConfigurationCreate
name :: Sensitive Text
launchProfileProtocolVersions :: [Text]
ec2SubnetIds :: [Text]
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateLaunchProfile' :: CreateLaunchProfile -> Text
$sel:studioComponentIds:CreateLaunchProfile' :: CreateLaunchProfile -> NonEmpty Text
$sel:streamConfiguration:CreateLaunchProfile' :: CreateLaunchProfile -> StreamConfigurationCreate
$sel:name:CreateLaunchProfile' :: CreateLaunchProfile -> Sensitive Text
$sel:launchProfileProtocolVersions:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:ec2SubnetIds:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:tags:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (HashMap Text Text)
$sel:description:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:CreateLaunchProfile' :: CreateLaunchProfile -> 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 (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
ec2SubnetIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
launchProfileProtocolVersions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StreamConfigurationCreate
streamConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
studioComponentIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData CreateLaunchProfile where
  rnf :: CreateLaunchProfile -> ()
rnf CreateLaunchProfile' {[Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
NonEmpty Text
Text
Sensitive Text
StreamConfigurationCreate
studioId :: Text
studioComponentIds :: NonEmpty Text
streamConfiguration :: StreamConfigurationCreate
name :: Sensitive Text
launchProfileProtocolVersions :: [Text]
ec2SubnetIds :: [Text]
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateLaunchProfile' :: CreateLaunchProfile -> Text
$sel:studioComponentIds:CreateLaunchProfile' :: CreateLaunchProfile -> NonEmpty Text
$sel:streamConfiguration:CreateLaunchProfile' :: CreateLaunchProfile -> StreamConfigurationCreate
$sel:name:CreateLaunchProfile' :: CreateLaunchProfile -> Sensitive Text
$sel:launchProfileProtocolVersions:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:ec2SubnetIds:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:tags:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (HashMap Text Text)
$sel:description:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:CreateLaunchProfile' :: CreateLaunchProfile -> 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 (Sensitive Text)
description
      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]
ec2SubnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
launchProfileProtocolVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StreamConfigurationCreate
streamConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
studioComponentIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

instance Data.ToHeaders CreateLaunchProfile where
  toHeaders :: CreateLaunchProfile -> ResponseHeaders
toHeaders CreateLaunchProfile' {[Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
NonEmpty Text
Text
Sensitive Text
StreamConfigurationCreate
studioId :: Text
studioComponentIds :: NonEmpty Text
streamConfiguration :: StreamConfigurationCreate
name :: Sensitive Text
launchProfileProtocolVersions :: [Text]
ec2SubnetIds :: [Text]
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateLaunchProfile' :: CreateLaunchProfile -> Text
$sel:studioComponentIds:CreateLaunchProfile' :: CreateLaunchProfile -> NonEmpty Text
$sel:streamConfiguration:CreateLaunchProfile' :: CreateLaunchProfile -> StreamConfigurationCreate
$sel:name:CreateLaunchProfile' :: CreateLaunchProfile -> Sensitive Text
$sel:launchProfileProtocolVersions:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:ec2SubnetIds:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:tags:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (HashMap Text Text)
$sel:description:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:CreateLaunchProfile' :: CreateLaunchProfile -> 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 CreateLaunchProfile where
  toJSON :: CreateLaunchProfile -> Value
toJSON CreateLaunchProfile' {[Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
NonEmpty Text
Text
Sensitive Text
StreamConfigurationCreate
studioId :: Text
studioComponentIds :: NonEmpty Text
streamConfiguration :: StreamConfigurationCreate
name :: Sensitive Text
launchProfileProtocolVersions :: [Text]
ec2SubnetIds :: [Text]
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateLaunchProfile' :: CreateLaunchProfile -> Text
$sel:studioComponentIds:CreateLaunchProfile' :: CreateLaunchProfile -> NonEmpty Text
$sel:streamConfiguration:CreateLaunchProfile' :: CreateLaunchProfile -> StreamConfigurationCreate
$sel:name:CreateLaunchProfile' :: CreateLaunchProfile -> Sensitive Text
$sel:launchProfileProtocolVersions:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:ec2SubnetIds:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:tags:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (HashMap Text Text)
$sel:description:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 (Sensitive Text)
description,
            (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
"ec2SubnetIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
ec2SubnetIds),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"launchProfileProtocolVersions"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
launchProfileProtocolVersions
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"streamConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StreamConfigurationCreate
streamConfiguration),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"studioComponentIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
studioComponentIds)
          ]
      )

instance Data.ToPath CreateLaunchProfile where
  toPath :: CreateLaunchProfile -> ByteString
toPath CreateLaunchProfile' {[Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
NonEmpty Text
Text
Sensitive Text
StreamConfigurationCreate
studioId :: Text
studioComponentIds :: NonEmpty Text
streamConfiguration :: StreamConfigurationCreate
name :: Sensitive Text
launchProfileProtocolVersions :: [Text]
ec2SubnetIds :: [Text]
tags :: Maybe (HashMap Text Text)
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:CreateLaunchProfile' :: CreateLaunchProfile -> Text
$sel:studioComponentIds:CreateLaunchProfile' :: CreateLaunchProfile -> NonEmpty Text
$sel:streamConfiguration:CreateLaunchProfile' :: CreateLaunchProfile -> StreamConfigurationCreate
$sel:name:CreateLaunchProfile' :: CreateLaunchProfile -> Sensitive Text
$sel:launchProfileProtocolVersions:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:ec2SubnetIds:CreateLaunchProfile' :: CreateLaunchProfile -> [Text]
$sel:tags:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (HashMap Text Text)
$sel:description:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:CreateLaunchProfile' :: CreateLaunchProfile -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-08-01/studios/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
studioId,
        ByteString
"/launch-profiles"
      ]

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

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

-- |
-- Create a value of 'CreateLaunchProfileResponse' 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:
--
-- 'launchProfile', 'createLaunchProfileResponse_launchProfile' - The launch profile.
--
-- 'httpStatus', 'createLaunchProfileResponse_httpStatus' - The response's http status code.
newCreateLaunchProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLaunchProfileResponse
newCreateLaunchProfileResponse :: Int -> CreateLaunchProfileResponse
newCreateLaunchProfileResponse Int
pHttpStatus_ =
  CreateLaunchProfileResponse'
    { $sel:launchProfile:CreateLaunchProfileResponse' :: Maybe LaunchProfile
launchProfile =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLaunchProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The launch profile.
createLaunchProfileResponse_launchProfile :: Lens.Lens' CreateLaunchProfileResponse (Prelude.Maybe LaunchProfile)
createLaunchProfileResponse_launchProfile :: Lens' CreateLaunchProfileResponse (Maybe LaunchProfile)
createLaunchProfileResponse_launchProfile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchProfileResponse' {Maybe LaunchProfile
launchProfile :: Maybe LaunchProfile
$sel:launchProfile:CreateLaunchProfileResponse' :: CreateLaunchProfileResponse -> Maybe LaunchProfile
launchProfile} -> Maybe LaunchProfile
launchProfile) (\s :: CreateLaunchProfileResponse
s@CreateLaunchProfileResponse' {} Maybe LaunchProfile
a -> CreateLaunchProfileResponse
s {$sel:launchProfile:CreateLaunchProfileResponse' :: Maybe LaunchProfile
launchProfile = Maybe LaunchProfile
a} :: CreateLaunchProfileResponse)

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

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