{-# 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.UpdateLaunchProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update a launch profile.
module Amazonka.Nimble.UpdateLaunchProfile
  ( -- * Creating a Request
    UpdateLaunchProfile (..),
    newUpdateLaunchProfile,

    -- * Request Lenses
    updateLaunchProfile_clientToken,
    updateLaunchProfile_description,
    updateLaunchProfile_launchProfileProtocolVersions,
    updateLaunchProfile_name,
    updateLaunchProfile_streamConfiguration,
    updateLaunchProfile_studioComponentIds,
    updateLaunchProfile_launchProfileId,
    updateLaunchProfile_studioId,

    -- * Destructuring the Response
    UpdateLaunchProfileResponse (..),
    newUpdateLaunchProfileResponse,

    -- * Response Lenses
    updateLaunchProfileResponse_launchProfile,
    updateLaunchProfileResponse_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:/ 'newUpdateLaunchProfile' smart constructor.
data UpdateLaunchProfile = UpdateLaunchProfile'
  { -- | 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.
    UpdateLaunchProfile -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The description.
    UpdateLaunchProfile -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The version number of the protocol that is used by the launch profile.
    -- The only valid version is \"2021-03-31\".
    UpdateLaunchProfile -> Maybe [Text]
launchProfileProtocolVersions :: Prelude.Maybe [Prelude.Text],
    -- | The name for the launch profile.
    UpdateLaunchProfile -> Maybe (Sensitive Text)
name :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A configuration for a streaming session.
    UpdateLaunchProfile -> Maybe StreamConfigurationCreate
streamConfiguration :: Prelude.Maybe StreamConfigurationCreate,
    -- | Unique identifiers for a collection of studio components that can be
    -- used with this launch profile.
    UpdateLaunchProfile -> Maybe (NonEmpty Text)
studioComponentIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The ID of the launch profile used to control access from the streaming
    -- session.
    UpdateLaunchProfile -> Text
launchProfileId :: Prelude.Text,
    -- | The studio ID.
    UpdateLaunchProfile -> Text
studioId :: Prelude.Text
  }
  deriving (UpdateLaunchProfile -> UpdateLaunchProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLaunchProfile -> UpdateLaunchProfile -> Bool
$c/= :: UpdateLaunchProfile -> UpdateLaunchProfile -> Bool
== :: UpdateLaunchProfile -> UpdateLaunchProfile -> Bool
$c== :: UpdateLaunchProfile -> UpdateLaunchProfile -> Bool
Prelude.Eq, Int -> UpdateLaunchProfile -> ShowS
[UpdateLaunchProfile] -> ShowS
UpdateLaunchProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLaunchProfile] -> ShowS
$cshowList :: [UpdateLaunchProfile] -> ShowS
show :: UpdateLaunchProfile -> String
$cshow :: UpdateLaunchProfile -> String
showsPrec :: Int -> UpdateLaunchProfile -> ShowS
$cshowsPrec :: Int -> UpdateLaunchProfile -> ShowS
Prelude.Show, forall x. Rep UpdateLaunchProfile x -> UpdateLaunchProfile
forall x. UpdateLaunchProfile -> Rep UpdateLaunchProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLaunchProfile x -> UpdateLaunchProfile
$cfrom :: forall x. UpdateLaunchProfile -> Rep UpdateLaunchProfile x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLaunchProfile' 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', 'updateLaunchProfile_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', 'updateLaunchProfile_description' - The description.
--
-- 'launchProfileProtocolVersions', 'updateLaunchProfile_launchProfileProtocolVersions' - The version number of the protocol that is used by the launch profile.
-- The only valid version is \"2021-03-31\".
--
-- 'name', 'updateLaunchProfile_name' - The name for the launch profile.
--
-- 'streamConfiguration', 'updateLaunchProfile_streamConfiguration' - A configuration for a streaming session.
--
-- 'studioComponentIds', 'updateLaunchProfile_studioComponentIds' - Unique identifiers for a collection of studio components that can be
-- used with this launch profile.
--
-- 'launchProfileId', 'updateLaunchProfile_launchProfileId' - The ID of the launch profile used to control access from the streaming
-- session.
--
-- 'studioId', 'updateLaunchProfile_studioId' - The studio ID.
newUpdateLaunchProfile ::
  -- | 'launchProfileId'
  Prelude.Text ->
  -- | 'studioId'
  Prelude.Text ->
  UpdateLaunchProfile
newUpdateLaunchProfile :: Text -> Text -> UpdateLaunchProfile
newUpdateLaunchProfile Text
pLaunchProfileId_ Text
pStudioId_ =
  UpdateLaunchProfile'
    { $sel:clientToken:UpdateLaunchProfile' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateLaunchProfile' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
      $sel:launchProfileProtocolVersions:UpdateLaunchProfile' :: Maybe [Text]
launchProfileProtocolVersions = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateLaunchProfile' :: Maybe (Sensitive Text)
name = forall a. Maybe a
Prelude.Nothing,
      $sel:streamConfiguration:UpdateLaunchProfile' :: Maybe StreamConfigurationCreate
streamConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:studioComponentIds:UpdateLaunchProfile' :: Maybe (NonEmpty Text)
studioComponentIds = forall a. Maybe a
Prelude.Nothing,
      $sel:launchProfileId:UpdateLaunchProfile' :: Text
launchProfileId = Text
pLaunchProfileId_,
      $sel:studioId:UpdateLaunchProfile' :: 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.
updateLaunchProfile_clientToken :: Lens.Lens' UpdateLaunchProfile (Prelude.Maybe Prelude.Text)
updateLaunchProfile_clientToken :: Lens' UpdateLaunchProfile (Maybe Text)
updateLaunchProfile_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchProfile' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateLaunchProfile
s@UpdateLaunchProfile' {} Maybe Text
a -> UpdateLaunchProfile
s {$sel:clientToken:UpdateLaunchProfile' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateLaunchProfile)

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

-- | The version number of the protocol that is used by the launch profile.
-- The only valid version is \"2021-03-31\".
updateLaunchProfile_launchProfileProtocolVersions :: Lens.Lens' UpdateLaunchProfile (Prelude.Maybe [Prelude.Text])
updateLaunchProfile_launchProfileProtocolVersions :: Lens' UpdateLaunchProfile (Maybe [Text])
updateLaunchProfile_launchProfileProtocolVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchProfile' {Maybe [Text]
launchProfileProtocolVersions :: Maybe [Text]
$sel:launchProfileProtocolVersions:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe [Text]
launchProfileProtocolVersions} -> Maybe [Text]
launchProfileProtocolVersions) (\s :: UpdateLaunchProfile
s@UpdateLaunchProfile' {} Maybe [Text]
a -> UpdateLaunchProfile
s {$sel:launchProfileProtocolVersions:UpdateLaunchProfile' :: Maybe [Text]
launchProfileProtocolVersions = Maybe [Text]
a} :: UpdateLaunchProfile) 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 name for the launch profile.
updateLaunchProfile_name :: Lens.Lens' UpdateLaunchProfile (Prelude.Maybe Prelude.Text)
updateLaunchProfile_name :: Lens' UpdateLaunchProfile (Maybe Text)
updateLaunchProfile_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchProfile' {Maybe (Sensitive Text)
name :: Maybe (Sensitive Text)
$sel:name:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
name} -> Maybe (Sensitive Text)
name) (\s :: UpdateLaunchProfile
s@UpdateLaunchProfile' {} Maybe (Sensitive Text)
a -> UpdateLaunchProfile
s {$sel:name:UpdateLaunchProfile' :: Maybe (Sensitive Text)
name = Maybe (Sensitive Text)
a} :: UpdateLaunchProfile) 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 configuration for a streaming session.
updateLaunchProfile_streamConfiguration :: Lens.Lens' UpdateLaunchProfile (Prelude.Maybe StreamConfigurationCreate)
updateLaunchProfile_streamConfiguration :: Lens' UpdateLaunchProfile (Maybe StreamConfigurationCreate)
updateLaunchProfile_streamConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchProfile' {Maybe StreamConfigurationCreate
streamConfiguration :: Maybe StreamConfigurationCreate
$sel:streamConfiguration:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe StreamConfigurationCreate
streamConfiguration} -> Maybe StreamConfigurationCreate
streamConfiguration) (\s :: UpdateLaunchProfile
s@UpdateLaunchProfile' {} Maybe StreamConfigurationCreate
a -> UpdateLaunchProfile
s {$sel:streamConfiguration:UpdateLaunchProfile' :: Maybe StreamConfigurationCreate
streamConfiguration = Maybe StreamConfigurationCreate
a} :: UpdateLaunchProfile)

-- | Unique identifiers for a collection of studio components that can be
-- used with this launch profile.
updateLaunchProfile_studioComponentIds :: Lens.Lens' UpdateLaunchProfile (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
updateLaunchProfile_studioComponentIds :: Lens' UpdateLaunchProfile (Maybe (NonEmpty Text))
updateLaunchProfile_studioComponentIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchProfile' {Maybe (NonEmpty Text)
studioComponentIds :: Maybe (NonEmpty Text)
$sel:studioComponentIds:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (NonEmpty Text)
studioComponentIds} -> Maybe (NonEmpty Text)
studioComponentIds) (\s :: UpdateLaunchProfile
s@UpdateLaunchProfile' {} Maybe (NonEmpty Text)
a -> UpdateLaunchProfile
s {$sel:studioComponentIds:UpdateLaunchProfile' :: Maybe (NonEmpty Text)
studioComponentIds = Maybe (NonEmpty Text)
a} :: UpdateLaunchProfile) 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 launch profile used to control access from the streaming
-- session.
updateLaunchProfile_launchProfileId :: Lens.Lens' UpdateLaunchProfile Prelude.Text
updateLaunchProfile_launchProfileId :: Lens' UpdateLaunchProfile Text
updateLaunchProfile_launchProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchProfile' {Text
launchProfileId :: Text
$sel:launchProfileId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
launchProfileId} -> Text
launchProfileId) (\s :: UpdateLaunchProfile
s@UpdateLaunchProfile' {} Text
a -> UpdateLaunchProfile
s {$sel:launchProfileId:UpdateLaunchProfile' :: Text
launchProfileId = Text
a} :: UpdateLaunchProfile)

-- | The studio ID.
updateLaunchProfile_studioId :: Lens.Lens' UpdateLaunchProfile Prelude.Text
updateLaunchProfile_studioId :: Lens' UpdateLaunchProfile Text
updateLaunchProfile_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchProfile' {Text
studioId :: Text
$sel:studioId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
studioId} -> Text
studioId) (\s :: UpdateLaunchProfile
s@UpdateLaunchProfile' {} Text
a -> UpdateLaunchProfile
s {$sel:studioId:UpdateLaunchProfile' :: Text
studioId = Text
a} :: UpdateLaunchProfile)

instance Core.AWSRequest UpdateLaunchProfile where
  type
    AWSResponse UpdateLaunchProfile =
      UpdateLaunchProfileResponse
  request :: (Service -> Service)
-> UpdateLaunchProfile -> Request UpdateLaunchProfile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateLaunchProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateLaunchProfile)))
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 -> UpdateLaunchProfileResponse
UpdateLaunchProfileResponse'
            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 UpdateLaunchProfile where
  hashWithSalt :: Int -> UpdateLaunchProfile -> Int
hashWithSalt Int
_salt UpdateLaunchProfile' {Maybe [Text]
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe StreamConfigurationCreate
Text
studioId :: Text
launchProfileId :: Text
studioComponentIds :: Maybe (NonEmpty Text)
streamConfiguration :: Maybe StreamConfigurationCreate
name :: Maybe (Sensitive Text)
launchProfileProtocolVersions :: Maybe [Text]
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:launchProfileId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:studioComponentIds:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (NonEmpty Text)
$sel:streamConfiguration:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe StreamConfigurationCreate
$sel:name:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:launchProfileProtocolVersions:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe [Text]
$sel:description:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:UpdateLaunchProfile' :: UpdateLaunchProfile -> 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 [Text]
launchProfileProtocolVersions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamConfigurationCreate
streamConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
studioComponentIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
launchProfileId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

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

instance Data.ToHeaders UpdateLaunchProfile where
  toHeaders :: UpdateLaunchProfile -> ResponseHeaders
toHeaders UpdateLaunchProfile' {Maybe [Text]
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe StreamConfigurationCreate
Text
studioId :: Text
launchProfileId :: Text
studioComponentIds :: Maybe (NonEmpty Text)
streamConfiguration :: Maybe StreamConfigurationCreate
name :: Maybe (Sensitive Text)
launchProfileProtocolVersions :: Maybe [Text]
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:launchProfileId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:studioComponentIds:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (NonEmpty Text)
$sel:streamConfiguration:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe StreamConfigurationCreate
$sel:name:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:launchProfileProtocolVersions:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe [Text]
$sel:description:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:UpdateLaunchProfile' :: UpdateLaunchProfile -> 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 UpdateLaunchProfile where
  toJSON :: UpdateLaunchProfile -> Value
toJSON UpdateLaunchProfile' {Maybe [Text]
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe StreamConfigurationCreate
Text
studioId :: Text
launchProfileId :: Text
studioComponentIds :: Maybe (NonEmpty Text)
streamConfiguration :: Maybe StreamConfigurationCreate
name :: Maybe (Sensitive Text)
launchProfileProtocolVersions :: Maybe [Text]
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:launchProfileId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:studioComponentIds:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (NonEmpty Text)
$sel:streamConfiguration:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe StreamConfigurationCreate
$sel:name:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:launchProfileProtocolVersions:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe [Text]
$sel:description:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:UpdateLaunchProfile' :: UpdateLaunchProfile -> 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
"launchProfileProtocolVersions" 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]
launchProfileProtocolVersions,
            (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 (Sensitive Text)
name,
            (Key
"streamConfiguration" 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 StreamConfigurationCreate
streamConfiguration,
            (Key
"studioComponentIds" 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 (NonEmpty Text)
studioComponentIds
          ]
      )

instance Data.ToPath UpdateLaunchProfile where
  toPath :: UpdateLaunchProfile -> ByteString
toPath UpdateLaunchProfile' {Maybe [Text]
Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe StreamConfigurationCreate
Text
studioId :: Text
launchProfileId :: Text
studioComponentIds :: Maybe (NonEmpty Text)
streamConfiguration :: Maybe StreamConfigurationCreate
name :: Maybe (Sensitive Text)
launchProfileProtocolVersions :: Maybe [Text]
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:studioId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:launchProfileId:UpdateLaunchProfile' :: UpdateLaunchProfile -> Text
$sel:studioComponentIds:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (NonEmpty Text)
$sel:streamConfiguration:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe StreamConfigurationCreate
$sel:name:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:launchProfileProtocolVersions:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe [Text]
$sel:description:UpdateLaunchProfile' :: UpdateLaunchProfile -> Maybe (Sensitive Text)
$sel:clientToken:UpdateLaunchProfile' :: UpdateLaunchProfile -> 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/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
launchProfileId
      ]

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

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

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

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

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

instance Prelude.NFData UpdateLaunchProfileResponse where
  rnf :: UpdateLaunchProfileResponse -> ()
rnf UpdateLaunchProfileResponse' {Int
Maybe LaunchProfile
httpStatus :: Int
launchProfile :: Maybe LaunchProfile
$sel:httpStatus:UpdateLaunchProfileResponse' :: UpdateLaunchProfileResponse -> Int
$sel:launchProfile:UpdateLaunchProfileResponse' :: UpdateLaunchProfileResponse -> 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