{-# 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.AppStream.CreateStack
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a stack to start streaming applications to users. A stack
-- consists of an associated fleet, user access policies, and storage
-- configurations.
module Amazonka.AppStream.CreateStack
  ( -- * Creating a Request
    CreateStack (..),
    newCreateStack,

    -- * Request Lenses
    createStack_accessEndpoints,
    createStack_applicationSettings,
    createStack_description,
    createStack_displayName,
    createStack_embedHostDomains,
    createStack_feedbackURL,
    createStack_redirectURL,
    createStack_storageConnectors,
    createStack_streamingExperienceSettings,
    createStack_tags,
    createStack_userSettings,
    createStack_name,

    -- * Destructuring the Response
    CreateStackResponse (..),
    newCreateStackResponse,

    -- * Response Lenses
    createStackResponse_stack,
    createStackResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateStack' smart constructor.
data CreateStack = CreateStack'
  { -- | The list of interface VPC endpoint (interface endpoint) objects. Users
    -- of the stack can connect to AppStream 2.0 only through the specified
    -- endpoints.
    CreateStack -> Maybe (NonEmpty AccessEndpoint)
accessEndpoints :: Prelude.Maybe (Prelude.NonEmpty AccessEndpoint),
    -- | The persistent application settings for users of a stack. When these
    -- settings are enabled, changes that users make to applications and
    -- Windows settings are automatically saved after each session and applied
    -- to the next session.
    CreateStack -> Maybe ApplicationSettings
applicationSettings :: Prelude.Maybe ApplicationSettings,
    -- | The description to display.
    CreateStack -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The stack name to display.
    CreateStack -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The domains where AppStream 2.0 streaming sessions can be embedded in an
    -- iframe. You must approve the domains that you want to host embedded
    -- AppStream 2.0 streaming sessions.
    CreateStack -> Maybe (NonEmpty Text)
embedHostDomains :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The URL that users are redirected to after they click the Send Feedback
    -- link. If no URL is specified, no Send Feedback link is displayed.
    CreateStack -> Maybe Text
feedbackURL :: Prelude.Maybe Prelude.Text,
    -- | The URL that users are redirected to after their streaming session ends.
    CreateStack -> Maybe Text
redirectURL :: Prelude.Maybe Prelude.Text,
    -- | The storage connectors to enable.
    CreateStack -> Maybe [StorageConnector]
storageConnectors :: Prelude.Maybe [StorageConnector],
    -- | The streaming protocol you want your stack to prefer. This can be UDP or
    -- TCP. Currently, UDP is only supported in the Windows native client.
    CreateStack -> Maybe StreamingExperienceSettings
streamingExperienceSettings :: Prelude.Maybe StreamingExperienceSettings,
    -- | The tags to associate with the stack. A tag is a key-value pair, and the
    -- value is optional. For example, Environment=Test. If you do not specify
    -- a value, Environment=.
    --
    -- If you do not specify a value, the value is set to an empty string.
    --
    -- Generally allowed characters are: letters, numbers, and spaces
    -- representable in UTF-8, and the following special characters:
    --
    -- _ . : \/ = + \\ - \@
    --
    -- For more information about tags, see
    -- <https://docs.aws.amazon.com/appstream2/latest/developerguide/tagging-basic.html Tagging Your Resources>
    -- in the /Amazon AppStream 2.0 Administration Guide/.
    CreateStack -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The actions that are enabled or disabled for users during their
    -- streaming sessions. By default, these actions are enabled.
    CreateStack -> Maybe (NonEmpty UserSetting)
userSettings :: Prelude.Maybe (Prelude.NonEmpty UserSetting),
    -- | The name of the stack.
    CreateStack -> Text
name :: Prelude.Text
  }
  deriving (CreateStack -> CreateStack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStack -> CreateStack -> Bool
$c/= :: CreateStack -> CreateStack -> Bool
== :: CreateStack -> CreateStack -> Bool
$c== :: CreateStack -> CreateStack -> Bool
Prelude.Eq, ReadPrec [CreateStack]
ReadPrec CreateStack
Int -> ReadS CreateStack
ReadS [CreateStack]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStack]
$creadListPrec :: ReadPrec [CreateStack]
readPrec :: ReadPrec CreateStack
$creadPrec :: ReadPrec CreateStack
readList :: ReadS [CreateStack]
$creadList :: ReadS [CreateStack]
readsPrec :: Int -> ReadS CreateStack
$creadsPrec :: Int -> ReadS CreateStack
Prelude.Read, Int -> CreateStack -> ShowS
[CreateStack] -> ShowS
CreateStack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStack] -> ShowS
$cshowList :: [CreateStack] -> ShowS
show :: CreateStack -> String
$cshow :: CreateStack -> String
showsPrec :: Int -> CreateStack -> ShowS
$cshowsPrec :: Int -> CreateStack -> ShowS
Prelude.Show, forall x. Rep CreateStack x -> CreateStack
forall x. CreateStack -> Rep CreateStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStack x -> CreateStack
$cfrom :: forall x. CreateStack -> Rep CreateStack x
Prelude.Generic)

-- |
-- Create a value of 'CreateStack' 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:
--
-- 'accessEndpoints', 'createStack_accessEndpoints' - The list of interface VPC endpoint (interface endpoint) objects. Users
-- of the stack can connect to AppStream 2.0 only through the specified
-- endpoints.
--
-- 'applicationSettings', 'createStack_applicationSettings' - The persistent application settings for users of a stack. When these
-- settings are enabled, changes that users make to applications and
-- Windows settings are automatically saved after each session and applied
-- to the next session.
--
-- 'description', 'createStack_description' - The description to display.
--
-- 'displayName', 'createStack_displayName' - The stack name to display.
--
-- 'embedHostDomains', 'createStack_embedHostDomains' - The domains where AppStream 2.0 streaming sessions can be embedded in an
-- iframe. You must approve the domains that you want to host embedded
-- AppStream 2.0 streaming sessions.
--
-- 'feedbackURL', 'createStack_feedbackURL' - The URL that users are redirected to after they click the Send Feedback
-- link. If no URL is specified, no Send Feedback link is displayed.
--
-- 'redirectURL', 'createStack_redirectURL' - The URL that users are redirected to after their streaming session ends.
--
-- 'storageConnectors', 'createStack_storageConnectors' - The storage connectors to enable.
--
-- 'streamingExperienceSettings', 'createStack_streamingExperienceSettings' - The streaming protocol you want your stack to prefer. This can be UDP or
-- TCP. Currently, UDP is only supported in the Windows native client.
--
-- 'tags', 'createStack_tags' - The tags to associate with the stack. A tag is a key-value pair, and the
-- value is optional. For example, Environment=Test. If you do not specify
-- a value, Environment=.
--
-- If you do not specify a value, the value is set to an empty string.
--
-- Generally allowed characters are: letters, numbers, and spaces
-- representable in UTF-8, and the following special characters:
--
-- _ . : \/ = + \\ - \@
--
-- For more information about tags, see
-- <https://docs.aws.amazon.com/appstream2/latest/developerguide/tagging-basic.html Tagging Your Resources>
-- in the /Amazon AppStream 2.0 Administration Guide/.
--
-- 'userSettings', 'createStack_userSettings' - The actions that are enabled or disabled for users during their
-- streaming sessions. By default, these actions are enabled.
--
-- 'name', 'createStack_name' - The name of the stack.
newCreateStack ::
  -- | 'name'
  Prelude.Text ->
  CreateStack
newCreateStack :: Text -> CreateStack
newCreateStack Text
pName_ =
  CreateStack'
    { $sel:accessEndpoints:CreateStack' :: Maybe (NonEmpty AccessEndpoint)
accessEndpoints = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationSettings:CreateStack' :: Maybe ApplicationSettings
applicationSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateStack' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:CreateStack' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:embedHostDomains:CreateStack' :: Maybe (NonEmpty Text)
embedHostDomains = forall a. Maybe a
Prelude.Nothing,
      $sel:feedbackURL:CreateStack' :: Maybe Text
feedbackURL = forall a. Maybe a
Prelude.Nothing,
      $sel:redirectURL:CreateStack' :: Maybe Text
redirectURL = forall a. Maybe a
Prelude.Nothing,
      $sel:storageConnectors:CreateStack' :: Maybe [StorageConnector]
storageConnectors = forall a. Maybe a
Prelude.Nothing,
      $sel:streamingExperienceSettings:CreateStack' :: Maybe StreamingExperienceSettings
streamingExperienceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateStack' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:userSettings:CreateStack' :: Maybe (NonEmpty UserSetting)
userSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateStack' :: Text
name = Text
pName_
    }

-- | The list of interface VPC endpoint (interface endpoint) objects. Users
-- of the stack can connect to AppStream 2.0 only through the specified
-- endpoints.
createStack_accessEndpoints :: Lens.Lens' CreateStack (Prelude.Maybe (Prelude.NonEmpty AccessEndpoint))
createStack_accessEndpoints :: Lens' CreateStack (Maybe (NonEmpty AccessEndpoint))
createStack_accessEndpoints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe (NonEmpty AccessEndpoint)
accessEndpoints :: Maybe (NonEmpty AccessEndpoint)
$sel:accessEndpoints:CreateStack' :: CreateStack -> Maybe (NonEmpty AccessEndpoint)
accessEndpoints} -> Maybe (NonEmpty AccessEndpoint)
accessEndpoints) (\s :: CreateStack
s@CreateStack' {} Maybe (NonEmpty AccessEndpoint)
a -> CreateStack
s {$sel:accessEndpoints:CreateStack' :: Maybe (NonEmpty AccessEndpoint)
accessEndpoints = Maybe (NonEmpty AccessEndpoint)
a} :: CreateStack) 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 persistent application settings for users of a stack. When these
-- settings are enabled, changes that users make to applications and
-- Windows settings are automatically saved after each session and applied
-- to the next session.
createStack_applicationSettings :: Lens.Lens' CreateStack (Prelude.Maybe ApplicationSettings)
createStack_applicationSettings :: Lens' CreateStack (Maybe ApplicationSettings)
createStack_applicationSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe ApplicationSettings
applicationSettings :: Maybe ApplicationSettings
$sel:applicationSettings:CreateStack' :: CreateStack -> Maybe ApplicationSettings
applicationSettings} -> Maybe ApplicationSettings
applicationSettings) (\s :: CreateStack
s@CreateStack' {} Maybe ApplicationSettings
a -> CreateStack
s {$sel:applicationSettings:CreateStack' :: Maybe ApplicationSettings
applicationSettings = Maybe ApplicationSettings
a} :: CreateStack)

-- | The description to display.
createStack_description :: Lens.Lens' CreateStack (Prelude.Maybe Prelude.Text)
createStack_description :: Lens' CreateStack (Maybe Text)
createStack_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe Text
description :: Maybe Text
$sel:description:CreateStack' :: CreateStack -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateStack
s@CreateStack' {} Maybe Text
a -> CreateStack
s {$sel:description:CreateStack' :: Maybe Text
description = Maybe Text
a} :: CreateStack)

-- | The stack name to display.
createStack_displayName :: Lens.Lens' CreateStack (Prelude.Maybe Prelude.Text)
createStack_displayName :: Lens' CreateStack (Maybe Text)
createStack_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe Text
displayName :: Maybe Text
$sel:displayName:CreateStack' :: CreateStack -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: CreateStack
s@CreateStack' {} Maybe Text
a -> CreateStack
s {$sel:displayName:CreateStack' :: Maybe Text
displayName = Maybe Text
a} :: CreateStack)

-- | The domains where AppStream 2.0 streaming sessions can be embedded in an
-- iframe. You must approve the domains that you want to host embedded
-- AppStream 2.0 streaming sessions.
createStack_embedHostDomains :: Lens.Lens' CreateStack (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createStack_embedHostDomains :: Lens' CreateStack (Maybe (NonEmpty Text))
createStack_embedHostDomains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe (NonEmpty Text)
embedHostDomains :: Maybe (NonEmpty Text)
$sel:embedHostDomains:CreateStack' :: CreateStack -> Maybe (NonEmpty Text)
embedHostDomains} -> Maybe (NonEmpty Text)
embedHostDomains) (\s :: CreateStack
s@CreateStack' {} Maybe (NonEmpty Text)
a -> CreateStack
s {$sel:embedHostDomains:CreateStack' :: Maybe (NonEmpty Text)
embedHostDomains = Maybe (NonEmpty Text)
a} :: CreateStack) 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 URL that users are redirected to after they click the Send Feedback
-- link. If no URL is specified, no Send Feedback link is displayed.
createStack_feedbackURL :: Lens.Lens' CreateStack (Prelude.Maybe Prelude.Text)
createStack_feedbackURL :: Lens' CreateStack (Maybe Text)
createStack_feedbackURL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe Text
feedbackURL :: Maybe Text
$sel:feedbackURL:CreateStack' :: CreateStack -> Maybe Text
feedbackURL} -> Maybe Text
feedbackURL) (\s :: CreateStack
s@CreateStack' {} Maybe Text
a -> CreateStack
s {$sel:feedbackURL:CreateStack' :: Maybe Text
feedbackURL = Maybe Text
a} :: CreateStack)

-- | The URL that users are redirected to after their streaming session ends.
createStack_redirectURL :: Lens.Lens' CreateStack (Prelude.Maybe Prelude.Text)
createStack_redirectURL :: Lens' CreateStack (Maybe Text)
createStack_redirectURL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe Text
redirectURL :: Maybe Text
$sel:redirectURL:CreateStack' :: CreateStack -> Maybe Text
redirectURL} -> Maybe Text
redirectURL) (\s :: CreateStack
s@CreateStack' {} Maybe Text
a -> CreateStack
s {$sel:redirectURL:CreateStack' :: Maybe Text
redirectURL = Maybe Text
a} :: CreateStack)

-- | The storage connectors to enable.
createStack_storageConnectors :: Lens.Lens' CreateStack (Prelude.Maybe [StorageConnector])
createStack_storageConnectors :: Lens' CreateStack (Maybe [StorageConnector])
createStack_storageConnectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe [StorageConnector]
storageConnectors :: Maybe [StorageConnector]
$sel:storageConnectors:CreateStack' :: CreateStack -> Maybe [StorageConnector]
storageConnectors} -> Maybe [StorageConnector]
storageConnectors) (\s :: CreateStack
s@CreateStack' {} Maybe [StorageConnector]
a -> CreateStack
s {$sel:storageConnectors:CreateStack' :: Maybe [StorageConnector]
storageConnectors = Maybe [StorageConnector]
a} :: CreateStack) 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 streaming protocol you want your stack to prefer. This can be UDP or
-- TCP. Currently, UDP is only supported in the Windows native client.
createStack_streamingExperienceSettings :: Lens.Lens' CreateStack (Prelude.Maybe StreamingExperienceSettings)
createStack_streamingExperienceSettings :: Lens' CreateStack (Maybe StreamingExperienceSettings)
createStack_streamingExperienceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe StreamingExperienceSettings
streamingExperienceSettings :: Maybe StreamingExperienceSettings
$sel:streamingExperienceSettings:CreateStack' :: CreateStack -> Maybe StreamingExperienceSettings
streamingExperienceSettings} -> Maybe StreamingExperienceSettings
streamingExperienceSettings) (\s :: CreateStack
s@CreateStack' {} Maybe StreamingExperienceSettings
a -> CreateStack
s {$sel:streamingExperienceSettings:CreateStack' :: Maybe StreamingExperienceSettings
streamingExperienceSettings = Maybe StreamingExperienceSettings
a} :: CreateStack)

-- | The tags to associate with the stack. A tag is a key-value pair, and the
-- value is optional. For example, Environment=Test. If you do not specify
-- a value, Environment=.
--
-- If you do not specify a value, the value is set to an empty string.
--
-- Generally allowed characters are: letters, numbers, and spaces
-- representable in UTF-8, and the following special characters:
--
-- _ . : \/ = + \\ - \@
--
-- For more information about tags, see
-- <https://docs.aws.amazon.com/appstream2/latest/developerguide/tagging-basic.html Tagging Your Resources>
-- in the /Amazon AppStream 2.0 Administration Guide/.
createStack_tags :: Lens.Lens' CreateStack (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createStack_tags :: Lens' CreateStack (Maybe (HashMap Text Text))
createStack_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateStack' :: CreateStack -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateStack
s@CreateStack' {} Maybe (HashMap Text Text)
a -> CreateStack
s {$sel:tags:CreateStack' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateStack) 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 actions that are enabled or disabled for users during their
-- streaming sessions. By default, these actions are enabled.
createStack_userSettings :: Lens.Lens' CreateStack (Prelude.Maybe (Prelude.NonEmpty UserSetting))
createStack_userSettings :: Lens' CreateStack (Maybe (NonEmpty UserSetting))
createStack_userSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Maybe (NonEmpty UserSetting)
userSettings :: Maybe (NonEmpty UserSetting)
$sel:userSettings:CreateStack' :: CreateStack -> Maybe (NonEmpty UserSetting)
userSettings} -> Maybe (NonEmpty UserSetting)
userSettings) (\s :: CreateStack
s@CreateStack' {} Maybe (NonEmpty UserSetting)
a -> CreateStack
s {$sel:userSettings:CreateStack' :: Maybe (NonEmpty UserSetting)
userSettings = Maybe (NonEmpty UserSetting)
a} :: CreateStack) 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 of the stack.
createStack_name :: Lens.Lens' CreateStack Prelude.Text
createStack_name :: Lens' CreateStack Text
createStack_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStack' {Text
name :: Text
$sel:name:CreateStack' :: CreateStack -> Text
name} -> Text
name) (\s :: CreateStack
s@CreateStack' {} Text
a -> CreateStack
s {$sel:name:CreateStack' :: Text
name = Text
a} :: CreateStack)

instance Core.AWSRequest CreateStack where
  type AWSResponse CreateStack = CreateStackResponse
  request :: (Service -> Service) -> CreateStack -> Request CreateStack
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 CreateStack
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateStack)))
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 Stack -> Int -> CreateStackResponse
CreateStackResponse'
            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
"Stack")
            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 CreateStack where
  hashWithSalt :: Int -> CreateStack -> Int
hashWithSalt Int
_salt CreateStack' {Maybe [StorageConnector]
Maybe (NonEmpty Text)
Maybe (NonEmpty AccessEndpoint)
Maybe (NonEmpty UserSetting)
Maybe Text
Maybe (HashMap Text Text)
Maybe ApplicationSettings
Maybe StreamingExperienceSettings
Text
name :: Text
userSettings :: Maybe (NonEmpty UserSetting)
tags :: Maybe (HashMap Text Text)
streamingExperienceSettings :: Maybe StreamingExperienceSettings
storageConnectors :: Maybe [StorageConnector]
redirectURL :: Maybe Text
feedbackURL :: Maybe Text
embedHostDomains :: Maybe (NonEmpty Text)
displayName :: Maybe Text
description :: Maybe Text
applicationSettings :: Maybe ApplicationSettings
accessEndpoints :: Maybe (NonEmpty AccessEndpoint)
$sel:name:CreateStack' :: CreateStack -> Text
$sel:userSettings:CreateStack' :: CreateStack -> Maybe (NonEmpty UserSetting)
$sel:tags:CreateStack' :: CreateStack -> Maybe (HashMap Text Text)
$sel:streamingExperienceSettings:CreateStack' :: CreateStack -> Maybe StreamingExperienceSettings
$sel:storageConnectors:CreateStack' :: CreateStack -> Maybe [StorageConnector]
$sel:redirectURL:CreateStack' :: CreateStack -> Maybe Text
$sel:feedbackURL:CreateStack' :: CreateStack -> Maybe Text
$sel:embedHostDomains:CreateStack' :: CreateStack -> Maybe (NonEmpty Text)
$sel:displayName:CreateStack' :: CreateStack -> Maybe Text
$sel:description:CreateStack' :: CreateStack -> Maybe Text
$sel:applicationSettings:CreateStack' :: CreateStack -> Maybe ApplicationSettings
$sel:accessEndpoints:CreateStack' :: CreateStack -> Maybe (NonEmpty AccessEndpoint)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty AccessEndpoint)
accessEndpoints
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApplicationSettings
applicationSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
embedHostDomains
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
feedbackURL
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
redirectURL
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [StorageConnector]
storageConnectors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamingExperienceSettings
streamingExperienceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty UserSetting)
userSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateStack where
  rnf :: CreateStack -> ()
rnf CreateStack' {Maybe [StorageConnector]
Maybe (NonEmpty Text)
Maybe (NonEmpty AccessEndpoint)
Maybe (NonEmpty UserSetting)
Maybe Text
Maybe (HashMap Text Text)
Maybe ApplicationSettings
Maybe StreamingExperienceSettings
Text
name :: Text
userSettings :: Maybe (NonEmpty UserSetting)
tags :: Maybe (HashMap Text Text)
streamingExperienceSettings :: Maybe StreamingExperienceSettings
storageConnectors :: Maybe [StorageConnector]
redirectURL :: Maybe Text
feedbackURL :: Maybe Text
embedHostDomains :: Maybe (NonEmpty Text)
displayName :: Maybe Text
description :: Maybe Text
applicationSettings :: Maybe ApplicationSettings
accessEndpoints :: Maybe (NonEmpty AccessEndpoint)
$sel:name:CreateStack' :: CreateStack -> Text
$sel:userSettings:CreateStack' :: CreateStack -> Maybe (NonEmpty UserSetting)
$sel:tags:CreateStack' :: CreateStack -> Maybe (HashMap Text Text)
$sel:streamingExperienceSettings:CreateStack' :: CreateStack -> Maybe StreamingExperienceSettings
$sel:storageConnectors:CreateStack' :: CreateStack -> Maybe [StorageConnector]
$sel:redirectURL:CreateStack' :: CreateStack -> Maybe Text
$sel:feedbackURL:CreateStack' :: CreateStack -> Maybe Text
$sel:embedHostDomains:CreateStack' :: CreateStack -> Maybe (NonEmpty Text)
$sel:displayName:CreateStack' :: CreateStack -> Maybe Text
$sel:description:CreateStack' :: CreateStack -> Maybe Text
$sel:applicationSettings:CreateStack' :: CreateStack -> Maybe ApplicationSettings
$sel:accessEndpoints:CreateStack' :: CreateStack -> Maybe (NonEmpty AccessEndpoint)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty AccessEndpoint)
accessEndpoints
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ApplicationSettings
applicationSettings
      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
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
embedHostDomains
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
feedbackURL
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
redirectURL
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [StorageConnector]
storageConnectors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamingExperienceSettings
streamingExperienceSettings
      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 Maybe (NonEmpty UserSetting)
userSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateStack where
  toHeaders :: CreateStack -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"PhotonAdminProxyService.CreateStack" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateStack where
  toJSON :: CreateStack -> Value
toJSON CreateStack' {Maybe [StorageConnector]
Maybe (NonEmpty Text)
Maybe (NonEmpty AccessEndpoint)
Maybe (NonEmpty UserSetting)
Maybe Text
Maybe (HashMap Text Text)
Maybe ApplicationSettings
Maybe StreamingExperienceSettings
Text
name :: Text
userSettings :: Maybe (NonEmpty UserSetting)
tags :: Maybe (HashMap Text Text)
streamingExperienceSettings :: Maybe StreamingExperienceSettings
storageConnectors :: Maybe [StorageConnector]
redirectURL :: Maybe Text
feedbackURL :: Maybe Text
embedHostDomains :: Maybe (NonEmpty Text)
displayName :: Maybe Text
description :: Maybe Text
applicationSettings :: Maybe ApplicationSettings
accessEndpoints :: Maybe (NonEmpty AccessEndpoint)
$sel:name:CreateStack' :: CreateStack -> Text
$sel:userSettings:CreateStack' :: CreateStack -> Maybe (NonEmpty UserSetting)
$sel:tags:CreateStack' :: CreateStack -> Maybe (HashMap Text Text)
$sel:streamingExperienceSettings:CreateStack' :: CreateStack -> Maybe StreamingExperienceSettings
$sel:storageConnectors:CreateStack' :: CreateStack -> Maybe [StorageConnector]
$sel:redirectURL:CreateStack' :: CreateStack -> Maybe Text
$sel:feedbackURL:CreateStack' :: CreateStack -> Maybe Text
$sel:embedHostDomains:CreateStack' :: CreateStack -> Maybe (NonEmpty Text)
$sel:displayName:CreateStack' :: CreateStack -> Maybe Text
$sel:description:CreateStack' :: CreateStack -> Maybe Text
$sel:applicationSettings:CreateStack' :: CreateStack -> Maybe ApplicationSettings
$sel:accessEndpoints:CreateStack' :: CreateStack -> Maybe (NonEmpty AccessEndpoint)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessEndpoints" 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 AccessEndpoint)
accessEndpoints,
            (Key
"ApplicationSettings" 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 ApplicationSettings
applicationSettings,
            (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
"DisplayName" 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
displayName,
            (Key
"EmbedHostDomains" 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)
embedHostDomains,
            (Key
"FeedbackURL" 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
feedbackURL,
            (Key
"RedirectURL" 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
redirectURL,
            (Key
"StorageConnectors" 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 [StorageConnector]
storageConnectors,
            (Key
"StreamingExperienceSettings" 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 StreamingExperienceSettings
streamingExperienceSettings,
            (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,
            (Key
"UserSettings" 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 UserSetting)
userSettings,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateStackResponse' smart constructor.
data CreateStackResponse = CreateStackResponse'
  { -- | Information about the stack.
    CreateStackResponse -> Maybe Stack
stack :: Prelude.Maybe Stack,
    -- | The response's http status code.
    CreateStackResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateStackResponse -> CreateStackResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStackResponse -> CreateStackResponse -> Bool
$c/= :: CreateStackResponse -> CreateStackResponse -> Bool
== :: CreateStackResponse -> CreateStackResponse -> Bool
$c== :: CreateStackResponse -> CreateStackResponse -> Bool
Prelude.Eq, ReadPrec [CreateStackResponse]
ReadPrec CreateStackResponse
Int -> ReadS CreateStackResponse
ReadS [CreateStackResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStackResponse]
$creadListPrec :: ReadPrec [CreateStackResponse]
readPrec :: ReadPrec CreateStackResponse
$creadPrec :: ReadPrec CreateStackResponse
readList :: ReadS [CreateStackResponse]
$creadList :: ReadS [CreateStackResponse]
readsPrec :: Int -> ReadS CreateStackResponse
$creadsPrec :: Int -> ReadS CreateStackResponse
Prelude.Read, Int -> CreateStackResponse -> ShowS
[CreateStackResponse] -> ShowS
CreateStackResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStackResponse] -> ShowS
$cshowList :: [CreateStackResponse] -> ShowS
show :: CreateStackResponse -> String
$cshow :: CreateStackResponse -> String
showsPrec :: Int -> CreateStackResponse -> ShowS
$cshowsPrec :: Int -> CreateStackResponse -> ShowS
Prelude.Show, forall x. Rep CreateStackResponse x -> CreateStackResponse
forall x. CreateStackResponse -> Rep CreateStackResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStackResponse x -> CreateStackResponse
$cfrom :: forall x. CreateStackResponse -> Rep CreateStackResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateStackResponse' 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:
--
-- 'stack', 'createStackResponse_stack' - Information about the stack.
--
-- 'httpStatus', 'createStackResponse_httpStatus' - The response's http status code.
newCreateStackResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateStackResponse
newCreateStackResponse :: Int -> CreateStackResponse
newCreateStackResponse Int
pHttpStatus_ =
  CreateStackResponse'
    { $sel:stack:CreateStackResponse' :: Maybe Stack
stack = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateStackResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the stack.
createStackResponse_stack :: Lens.Lens' CreateStackResponse (Prelude.Maybe Stack)
createStackResponse_stack :: Lens' CreateStackResponse (Maybe Stack)
createStackResponse_stack = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackResponse' {Maybe Stack
stack :: Maybe Stack
$sel:stack:CreateStackResponse' :: CreateStackResponse -> Maybe Stack
stack} -> Maybe Stack
stack) (\s :: CreateStackResponse
s@CreateStackResponse' {} Maybe Stack
a -> CreateStackResponse
s {$sel:stack:CreateStackResponse' :: Maybe Stack
stack = Maybe Stack
a} :: CreateStackResponse)

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

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