{-# 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.FinSpace.CreateEnvironment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a new FinSpace environment.
module Amazonka.FinSpace.CreateEnvironment
  ( -- * Creating a Request
    CreateEnvironment (..),
    newCreateEnvironment,

    -- * Request Lenses
    createEnvironment_dataBundles,
    createEnvironment_description,
    createEnvironment_federationMode,
    createEnvironment_federationParameters,
    createEnvironment_kmsKeyId,
    createEnvironment_superuserParameters,
    createEnvironment_tags,
    createEnvironment_name,

    -- * Destructuring the Response
    CreateEnvironmentResponse (..),
    newCreateEnvironmentResponse,

    -- * Response Lenses
    createEnvironmentResponse_environmentArn,
    createEnvironmentResponse_environmentId,
    createEnvironmentResponse_environmentUrl,
    createEnvironmentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateEnvironment' smart constructor.
data CreateEnvironment = CreateEnvironment'
  { -- | The list of Amazon Resource Names (ARN) of the data bundles to install.
    -- Currently supported data bundle ARNs:
    --
    -- -   @arn:aws:finspace:${Region}::data-bundle\/capital-markets-sample@ -
    --     Contains sample Capital Markets datasets, categories and controlled
    --     vocabularies.
    --
    -- -   @arn:aws:finspace:${Region}::data-bundle\/taq@ (default) - Contains
    --     trades and quotes data in addition to sample Capital Markets data.
    CreateEnvironment -> Maybe [Text]
dataBundles :: Prelude.Maybe [Prelude.Text],
    -- | The description of the FinSpace environment to be created.
    CreateEnvironment -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Authentication mode for the environment.
    --
    -- -   @FEDERATED@ - Users access FinSpace through Single Sign On (SSO) via
    --     your Identity provider.
    --
    -- -   @LOCAL@ - Users access FinSpace via email and password managed
    --     within the FinSpace environment.
    CreateEnvironment -> Maybe FederationMode
federationMode :: Prelude.Maybe FederationMode,
    -- | Configuration information when authentication mode is FEDERATED.
    CreateEnvironment -> Maybe FederationParameters
federationParameters :: Prelude.Maybe FederationParameters,
    -- | The KMS key id to encrypt your data in the FinSpace environment.
    CreateEnvironment -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Configuration information for the superuser.
    CreateEnvironment -> Maybe SuperuserParameters
superuserParameters :: Prelude.Maybe SuperuserParameters,
    -- | Add tags to your FinSpace environment.
    CreateEnvironment -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the FinSpace environment to be created.
    CreateEnvironment -> Text
name :: Prelude.Text
  }
  deriving (CreateEnvironment -> CreateEnvironment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEnvironment -> CreateEnvironment -> Bool
$c/= :: CreateEnvironment -> CreateEnvironment -> Bool
== :: CreateEnvironment -> CreateEnvironment -> Bool
$c== :: CreateEnvironment -> CreateEnvironment -> Bool
Prelude.Eq, Int -> CreateEnvironment -> ShowS
[CreateEnvironment] -> ShowS
CreateEnvironment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEnvironment] -> ShowS
$cshowList :: [CreateEnvironment] -> ShowS
show :: CreateEnvironment -> String
$cshow :: CreateEnvironment -> String
showsPrec :: Int -> CreateEnvironment -> ShowS
$cshowsPrec :: Int -> CreateEnvironment -> ShowS
Prelude.Show, forall x. Rep CreateEnvironment x -> CreateEnvironment
forall x. CreateEnvironment -> Rep CreateEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEnvironment x -> CreateEnvironment
$cfrom :: forall x. CreateEnvironment -> Rep CreateEnvironment x
Prelude.Generic)

-- |
-- Create a value of 'CreateEnvironment' 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:
--
-- 'dataBundles', 'createEnvironment_dataBundles' - The list of Amazon Resource Names (ARN) of the data bundles to install.
-- Currently supported data bundle ARNs:
--
-- -   @arn:aws:finspace:${Region}::data-bundle\/capital-markets-sample@ -
--     Contains sample Capital Markets datasets, categories and controlled
--     vocabularies.
--
-- -   @arn:aws:finspace:${Region}::data-bundle\/taq@ (default) - Contains
--     trades and quotes data in addition to sample Capital Markets data.
--
-- 'description', 'createEnvironment_description' - The description of the FinSpace environment to be created.
--
-- 'federationMode', 'createEnvironment_federationMode' - Authentication mode for the environment.
--
-- -   @FEDERATED@ - Users access FinSpace through Single Sign On (SSO) via
--     your Identity provider.
--
-- -   @LOCAL@ - Users access FinSpace via email and password managed
--     within the FinSpace environment.
--
-- 'federationParameters', 'createEnvironment_federationParameters' - Configuration information when authentication mode is FEDERATED.
--
-- 'kmsKeyId', 'createEnvironment_kmsKeyId' - The KMS key id to encrypt your data in the FinSpace environment.
--
-- 'superuserParameters', 'createEnvironment_superuserParameters' - Configuration information for the superuser.
--
-- 'tags', 'createEnvironment_tags' - Add tags to your FinSpace environment.
--
-- 'name', 'createEnvironment_name' - The name of the FinSpace environment to be created.
newCreateEnvironment ::
  -- | 'name'
  Prelude.Text ->
  CreateEnvironment
newCreateEnvironment :: Text -> CreateEnvironment
newCreateEnvironment Text
pName_ =
  CreateEnvironment'
    { $sel:dataBundles:CreateEnvironment' :: Maybe [Text]
dataBundles = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateEnvironment' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:federationMode:CreateEnvironment' :: Maybe FederationMode
federationMode = forall a. Maybe a
Prelude.Nothing,
      $sel:federationParameters:CreateEnvironment' :: Maybe FederationParameters
federationParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:CreateEnvironment' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:superuserParameters:CreateEnvironment' :: Maybe SuperuserParameters
superuserParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateEnvironment' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateEnvironment' :: Text
name = Text
pName_
    }

-- | The list of Amazon Resource Names (ARN) of the data bundles to install.
-- Currently supported data bundle ARNs:
--
-- -   @arn:aws:finspace:${Region}::data-bundle\/capital-markets-sample@ -
--     Contains sample Capital Markets datasets, categories and controlled
--     vocabularies.
--
-- -   @arn:aws:finspace:${Region}::data-bundle\/taq@ (default) - Contains
--     trades and quotes data in addition to sample Capital Markets data.
createEnvironment_dataBundles :: Lens.Lens' CreateEnvironment (Prelude.Maybe [Prelude.Text])
createEnvironment_dataBundles :: Lens' CreateEnvironment (Maybe [Text])
createEnvironment_dataBundles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe [Text]
dataBundles :: Maybe [Text]
$sel:dataBundles:CreateEnvironment' :: CreateEnvironment -> Maybe [Text]
dataBundles} -> Maybe [Text]
dataBundles) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe [Text]
a -> CreateEnvironment
s {$sel:dataBundles:CreateEnvironment' :: Maybe [Text]
dataBundles = Maybe [Text]
a} :: CreateEnvironment) 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 description of the FinSpace environment to be created.
createEnvironment_description :: Lens.Lens' CreateEnvironment (Prelude.Maybe Prelude.Text)
createEnvironment_description :: Lens' CreateEnvironment (Maybe Text)
createEnvironment_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe Text
description :: Maybe Text
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe Text
a -> CreateEnvironment
s {$sel:description:CreateEnvironment' :: Maybe Text
description = Maybe Text
a} :: CreateEnvironment)

-- | Authentication mode for the environment.
--
-- -   @FEDERATED@ - Users access FinSpace through Single Sign On (SSO) via
--     your Identity provider.
--
-- -   @LOCAL@ - Users access FinSpace via email and password managed
--     within the FinSpace environment.
createEnvironment_federationMode :: Lens.Lens' CreateEnvironment (Prelude.Maybe FederationMode)
createEnvironment_federationMode :: Lens' CreateEnvironment (Maybe FederationMode)
createEnvironment_federationMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe FederationMode
federationMode :: Maybe FederationMode
$sel:federationMode:CreateEnvironment' :: CreateEnvironment -> Maybe FederationMode
federationMode} -> Maybe FederationMode
federationMode) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe FederationMode
a -> CreateEnvironment
s {$sel:federationMode:CreateEnvironment' :: Maybe FederationMode
federationMode = Maybe FederationMode
a} :: CreateEnvironment)

-- | Configuration information when authentication mode is FEDERATED.
createEnvironment_federationParameters :: Lens.Lens' CreateEnvironment (Prelude.Maybe FederationParameters)
createEnvironment_federationParameters :: Lens' CreateEnvironment (Maybe FederationParameters)
createEnvironment_federationParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe FederationParameters
federationParameters :: Maybe FederationParameters
$sel:federationParameters:CreateEnvironment' :: CreateEnvironment -> Maybe FederationParameters
federationParameters} -> Maybe FederationParameters
federationParameters) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe FederationParameters
a -> CreateEnvironment
s {$sel:federationParameters:CreateEnvironment' :: Maybe FederationParameters
federationParameters = Maybe FederationParameters
a} :: CreateEnvironment)

-- | The KMS key id to encrypt your data in the FinSpace environment.
createEnvironment_kmsKeyId :: Lens.Lens' CreateEnvironment (Prelude.Maybe Prelude.Text)
createEnvironment_kmsKeyId :: Lens' CreateEnvironment (Maybe Text)
createEnvironment_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateEnvironment' :: CreateEnvironment -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe Text
a -> CreateEnvironment
s {$sel:kmsKeyId:CreateEnvironment' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateEnvironment)

-- | Configuration information for the superuser.
createEnvironment_superuserParameters :: Lens.Lens' CreateEnvironment (Prelude.Maybe SuperuserParameters)
createEnvironment_superuserParameters :: Lens' CreateEnvironment (Maybe SuperuserParameters)
createEnvironment_superuserParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe SuperuserParameters
superuserParameters :: Maybe SuperuserParameters
$sel:superuserParameters:CreateEnvironment' :: CreateEnvironment -> Maybe SuperuserParameters
superuserParameters} -> Maybe SuperuserParameters
superuserParameters) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe SuperuserParameters
a -> CreateEnvironment
s {$sel:superuserParameters:CreateEnvironment' :: Maybe SuperuserParameters
superuserParameters = Maybe SuperuserParameters
a} :: CreateEnvironment)

-- | Add tags to your FinSpace environment.
createEnvironment_tags :: Lens.Lens' CreateEnvironment (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createEnvironment_tags :: Lens' CreateEnvironment (Maybe (HashMap Text Text))
createEnvironment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe (HashMap Text Text)
a -> CreateEnvironment
s {$sel:tags:CreateEnvironment' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateEnvironment) 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 FinSpace environment to be created.
createEnvironment_name :: Lens.Lens' CreateEnvironment Prelude.Text
createEnvironment_name :: Lens' CreateEnvironment Text
createEnvironment_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Text
name :: Text
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
name} -> Text
name) (\s :: CreateEnvironment
s@CreateEnvironment' {} Text
a -> CreateEnvironment
s {$sel:name:CreateEnvironment' :: Text
name = Text
a} :: CreateEnvironment)

instance Core.AWSRequest CreateEnvironment where
  type
    AWSResponse CreateEnvironment =
      CreateEnvironmentResponse
  request :: (Service -> Service)
-> CreateEnvironment -> Request CreateEnvironment
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 CreateEnvironment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateEnvironment)))
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 Text
-> Maybe Text -> Maybe Text -> Int -> CreateEnvironmentResponse
CreateEnvironmentResponse'
            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
"environmentArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"environmentId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"environmentUrl")
            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 CreateEnvironment where
  hashWithSalt :: Int -> CreateEnvironment -> Int
hashWithSalt Int
_salt CreateEnvironment' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe FederationMode
Maybe FederationParameters
Maybe SuperuserParameters
Text
name :: Text
tags :: Maybe (HashMap Text Text)
superuserParameters :: Maybe SuperuserParameters
kmsKeyId :: Maybe Text
federationParameters :: Maybe FederationParameters
federationMode :: Maybe FederationMode
description :: Maybe Text
dataBundles :: Maybe [Text]
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
$sel:superuserParameters:CreateEnvironment' :: CreateEnvironment -> Maybe SuperuserParameters
$sel:kmsKeyId:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:federationParameters:CreateEnvironment' :: CreateEnvironment -> Maybe FederationParameters
$sel:federationMode:CreateEnvironment' :: CreateEnvironment -> Maybe FederationMode
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:dataBundles:CreateEnvironment' :: CreateEnvironment -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
dataBundles
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FederationMode
federationMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FederationParameters
federationParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SuperuserParameters
superuserParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateEnvironment where
  rnf :: CreateEnvironment -> ()
rnf CreateEnvironment' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe FederationMode
Maybe FederationParameters
Maybe SuperuserParameters
Text
name :: Text
tags :: Maybe (HashMap Text Text)
superuserParameters :: Maybe SuperuserParameters
kmsKeyId :: Maybe Text
federationParameters :: Maybe FederationParameters
federationMode :: Maybe FederationMode
description :: Maybe Text
dataBundles :: Maybe [Text]
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
$sel:superuserParameters:CreateEnvironment' :: CreateEnvironment -> Maybe SuperuserParameters
$sel:kmsKeyId:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:federationParameters:CreateEnvironment' :: CreateEnvironment -> Maybe FederationParameters
$sel:federationMode:CreateEnvironment' :: CreateEnvironment -> Maybe FederationMode
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:dataBundles:CreateEnvironment' :: CreateEnvironment -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
dataBundles
      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 FederationMode
federationMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FederationParameters
federationParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SuperuserParameters
superuserParameters
      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
name

instance Data.ToHeaders CreateEnvironment where
  toHeaders :: CreateEnvironment -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateEnvironment where
  toJSON :: CreateEnvironment -> Value
toJSON CreateEnvironment' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe FederationMode
Maybe FederationParameters
Maybe SuperuserParameters
Text
name :: Text
tags :: Maybe (HashMap Text Text)
superuserParameters :: Maybe SuperuserParameters
kmsKeyId :: Maybe Text
federationParameters :: Maybe FederationParameters
federationMode :: Maybe FederationMode
description :: Maybe Text
dataBundles :: Maybe [Text]
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (HashMap Text Text)
$sel:superuserParameters:CreateEnvironment' :: CreateEnvironment -> Maybe SuperuserParameters
$sel:kmsKeyId:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:federationParameters:CreateEnvironment' :: CreateEnvironment -> Maybe FederationParameters
$sel:federationMode:CreateEnvironment' :: CreateEnvironment -> Maybe FederationMode
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:dataBundles:CreateEnvironment' :: CreateEnvironment -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"dataBundles" 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]
dataBundles,
            (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
"federationMode" 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 FederationMode
federationMode,
            (Key
"federationParameters" 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 FederationParameters
federationParameters,
            (Key
"kmsKeyId" 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
kmsKeyId,
            (Key
"superuserParameters" 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 SuperuserParameters
superuserParameters,
            (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
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateEnvironmentResponse' smart constructor.
data CreateEnvironmentResponse = CreateEnvironmentResponse'
  { -- | The Amazon Resource Name (ARN) of the FinSpace environment that you
    -- created.
    CreateEnvironmentResponse -> Maybe Text
environmentArn :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for FinSpace environment that you created.
    CreateEnvironmentResponse -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | The sign-in url for the web application of the FinSpace environment you
    -- created.
    CreateEnvironmentResponse -> Maybe Text
environmentUrl :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateEnvironmentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateEnvironmentResponse -> CreateEnvironmentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEnvironmentResponse -> CreateEnvironmentResponse -> Bool
$c/= :: CreateEnvironmentResponse -> CreateEnvironmentResponse -> Bool
== :: CreateEnvironmentResponse -> CreateEnvironmentResponse -> Bool
$c== :: CreateEnvironmentResponse -> CreateEnvironmentResponse -> Bool
Prelude.Eq, ReadPrec [CreateEnvironmentResponse]
ReadPrec CreateEnvironmentResponse
Int -> ReadS CreateEnvironmentResponse
ReadS [CreateEnvironmentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEnvironmentResponse]
$creadListPrec :: ReadPrec [CreateEnvironmentResponse]
readPrec :: ReadPrec CreateEnvironmentResponse
$creadPrec :: ReadPrec CreateEnvironmentResponse
readList :: ReadS [CreateEnvironmentResponse]
$creadList :: ReadS [CreateEnvironmentResponse]
readsPrec :: Int -> ReadS CreateEnvironmentResponse
$creadsPrec :: Int -> ReadS CreateEnvironmentResponse
Prelude.Read, Int -> CreateEnvironmentResponse -> ShowS
[CreateEnvironmentResponse] -> ShowS
CreateEnvironmentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEnvironmentResponse] -> ShowS
$cshowList :: [CreateEnvironmentResponse] -> ShowS
show :: CreateEnvironmentResponse -> String
$cshow :: CreateEnvironmentResponse -> String
showsPrec :: Int -> CreateEnvironmentResponse -> ShowS
$cshowsPrec :: Int -> CreateEnvironmentResponse -> ShowS
Prelude.Show, forall x.
Rep CreateEnvironmentResponse x -> CreateEnvironmentResponse
forall x.
CreateEnvironmentResponse -> Rep CreateEnvironmentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateEnvironmentResponse x -> CreateEnvironmentResponse
$cfrom :: forall x.
CreateEnvironmentResponse -> Rep CreateEnvironmentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateEnvironmentResponse' 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:
--
-- 'environmentArn', 'createEnvironmentResponse_environmentArn' - The Amazon Resource Name (ARN) of the FinSpace environment that you
-- created.
--
-- 'environmentId', 'createEnvironmentResponse_environmentId' - The unique identifier for FinSpace environment that you created.
--
-- 'environmentUrl', 'createEnvironmentResponse_environmentUrl' - The sign-in url for the web application of the FinSpace environment you
-- created.
--
-- 'httpStatus', 'createEnvironmentResponse_httpStatus' - The response's http status code.
newCreateEnvironmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateEnvironmentResponse
newCreateEnvironmentResponse :: Int -> CreateEnvironmentResponse
newCreateEnvironmentResponse Int
pHttpStatus_ =
  CreateEnvironmentResponse'
    { $sel:environmentArn:CreateEnvironmentResponse' :: Maybe Text
environmentArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:environmentId:CreateEnvironmentResponse' :: Maybe Text
environmentId = forall a. Maybe a
Prelude.Nothing,
      $sel:environmentUrl:CreateEnvironmentResponse' :: Maybe Text
environmentUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateEnvironmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the FinSpace environment that you
-- created.
createEnvironmentResponse_environmentArn :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.Text)
createEnvironmentResponse_environmentArn :: Lens' CreateEnvironmentResponse (Maybe Text)
createEnvironmentResponse_environmentArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe Text
environmentArn :: Maybe Text
$sel:environmentArn:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
environmentArn} -> Maybe Text
environmentArn) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe Text
a -> CreateEnvironmentResponse
s {$sel:environmentArn:CreateEnvironmentResponse' :: Maybe Text
environmentArn = Maybe Text
a} :: CreateEnvironmentResponse)

-- | The unique identifier for FinSpace environment that you created.
createEnvironmentResponse_environmentId :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.Text)
createEnvironmentResponse_environmentId :: Lens' CreateEnvironmentResponse (Maybe Text)
createEnvironmentResponse_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe Text
environmentId :: Maybe Text
$sel:environmentId:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
environmentId} -> Maybe Text
environmentId) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe Text
a -> CreateEnvironmentResponse
s {$sel:environmentId:CreateEnvironmentResponse' :: Maybe Text
environmentId = Maybe Text
a} :: CreateEnvironmentResponse)

-- | The sign-in url for the web application of the FinSpace environment you
-- created.
createEnvironmentResponse_environmentUrl :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.Text)
createEnvironmentResponse_environmentUrl :: Lens' CreateEnvironmentResponse (Maybe Text)
createEnvironmentResponse_environmentUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe Text
environmentUrl :: Maybe Text
$sel:environmentUrl:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
environmentUrl} -> Maybe Text
environmentUrl) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe Text
a -> CreateEnvironmentResponse
s {$sel:environmentUrl:CreateEnvironmentResponse' :: Maybe Text
environmentUrl = Maybe Text
a} :: CreateEnvironmentResponse)

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

instance Prelude.NFData CreateEnvironmentResponse where
  rnf :: CreateEnvironmentResponse -> ()
rnf CreateEnvironmentResponse' {Int
Maybe Text
httpStatus :: Int
environmentUrl :: Maybe Text
environmentId :: Maybe Text
environmentArn :: Maybe Text
$sel:httpStatus:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Int
$sel:environmentUrl:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
$sel:environmentId:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
$sel:environmentArn:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus