{-# 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.MigrationHubReFactorSpaces.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)
--
-- Creates an Amazon Web Services Migration Hub Refactor Spaces
-- environment. The caller owns the environment resource, and all Refactor
-- Spaces applications, services, and routes created within the
-- environment. They are referred to as the /environment owner/. The
-- environment owner has cross-account visibility and control of Refactor
-- Spaces resources that are added to the environment by other accounts
-- that the environment is shared with. When creating an environment,
-- Refactor Spaces provisions a transit gateway in your account.
module Amazonka.MigrationHubReFactorSpaces.CreateEnvironment
  ( -- * Creating a Request
    CreateEnvironment (..),
    newCreateEnvironment,

    -- * Request Lenses
    createEnvironment_clientToken,
    createEnvironment_description,
    createEnvironment_tags,
    createEnvironment_name,
    createEnvironment_networkFabricType,

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

    -- * Response Lenses
    createEnvironmentResponse_arn,
    createEnvironmentResponse_createdTime,
    createEnvironmentResponse_description,
    createEnvironmentResponse_environmentId,
    createEnvironmentResponse_lastUpdatedTime,
    createEnvironmentResponse_name,
    createEnvironmentResponse_networkFabricType,
    createEnvironmentResponse_ownerAccountId,
    createEnvironmentResponse_state,
    createEnvironmentResponse_tags,
    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.MigrationHubReFactorSpaces.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'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateEnvironment -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The description of the environment.
    CreateEnvironment -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The tags to assign to the environment. A tag is a label that you assign
    -- to an Amazon Web Services resource. Each tag consists of a key-value
    -- pair.
    CreateEnvironment -> Maybe (Sensitive (HashMap Text Text))
tags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The name of the environment.
    CreateEnvironment -> Text
name :: Prelude.Text,
    -- | The network fabric type of the environment.
    CreateEnvironment -> NetworkFabricType
networkFabricType :: NetworkFabricType
  }
  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:
--
-- 'clientToken', 'createEnvironment_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'description', 'createEnvironment_description' - The description of the environment.
--
-- 'tags', 'createEnvironment_tags' - The tags to assign to the environment. A tag is a label that you assign
-- to an Amazon Web Services resource. Each tag consists of a key-value
-- pair.
--
-- 'name', 'createEnvironment_name' - The name of the environment.
--
-- 'networkFabricType', 'createEnvironment_networkFabricType' - The network fabric type of the environment.
newCreateEnvironment ::
  -- | 'name'
  Prelude.Text ->
  -- | 'networkFabricType'
  NetworkFabricType ->
  CreateEnvironment
newCreateEnvironment :: Text -> NetworkFabricType -> CreateEnvironment
newCreateEnvironment Text
pName_ NetworkFabricType
pNetworkFabricType_ =
  CreateEnvironment'
    { $sel:clientToken:CreateEnvironment' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateEnvironment' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateEnvironment' :: Maybe (Sensitive (HashMap Text Text))
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateEnvironment' :: Text
name = Text
pName_,
      $sel:networkFabricType:CreateEnvironment' :: NetworkFabricType
networkFabricType = NetworkFabricType
pNetworkFabricType_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createEnvironment_clientToken :: Lens.Lens' CreateEnvironment (Prelude.Maybe Prelude.Text)
createEnvironment_clientToken :: Lens' CreateEnvironment (Maybe Text)
createEnvironment_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateEnvironment' :: CreateEnvironment -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe Text
a -> CreateEnvironment
s {$sel:clientToken:CreateEnvironment' :: Maybe Text
clientToken = Maybe Text
a} :: CreateEnvironment)

-- | The description of the environment.
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)

-- | The tags to assign to the environment. A tag is a label that you assign
-- to an Amazon Web Services resource. Each tag consists of a key-value
-- pair.
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 (Sensitive (HashMap Text Text))
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (Sensitive (HashMap Text Text))
tags} -> Maybe (Sensitive (HashMap Text Text))
tags) (\s :: CreateEnvironment
s@CreateEnvironment' {} Maybe (Sensitive (HashMap Text Text))
a -> CreateEnvironment
s {$sel:tags:CreateEnvironment' :: Maybe (Sensitive (HashMap Text Text))
tags = Maybe (Sensitive (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 a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | The name of the environment.
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)

-- | The network fabric type of the environment.
createEnvironment_networkFabricType :: Lens.Lens' CreateEnvironment NetworkFabricType
createEnvironment_networkFabricType :: Lens' CreateEnvironment NetworkFabricType
createEnvironment_networkFabricType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironment' {NetworkFabricType
networkFabricType :: NetworkFabricType
$sel:networkFabricType:CreateEnvironment' :: CreateEnvironment -> NetworkFabricType
networkFabricType} -> NetworkFabricType
networkFabricType) (\s :: CreateEnvironment
s@CreateEnvironment' {} NetworkFabricType
a -> CreateEnvironment
s {$sel:networkFabricType:CreateEnvironment' :: NetworkFabricType
networkFabricType = NetworkFabricType
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 POSIX
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe NetworkFabricType
-> Maybe Text
-> Maybe EnvironmentState
-> Maybe (Sensitive (HashMap Text 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
"Arn")
            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
"CreatedTime")
            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
"Description")
            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
"LastUpdatedTime")
            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
"Name")
            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
"NetworkFabricType")
            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
"OwnerAccountId")
            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
"State")
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 (Sensitive (HashMap Text Text))
Text
NetworkFabricType
networkFabricType :: NetworkFabricType
name :: Text
tags :: Maybe (Sensitive (HashMap Text Text))
description :: Maybe Text
clientToken :: Maybe Text
$sel:networkFabricType:CreateEnvironment' :: CreateEnvironment -> NetworkFabricType
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (Sensitive (HashMap Text Text))
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:clientToken:CreateEnvironment' :: CreateEnvironment -> 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 Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text Text))
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NetworkFabricType
networkFabricType

instance Prelude.NFData CreateEnvironment where
  rnf :: CreateEnvironment -> ()
rnf CreateEnvironment' {Maybe Text
Maybe (Sensitive (HashMap Text Text))
Text
NetworkFabricType
networkFabricType :: NetworkFabricType
name :: Text
tags :: Maybe (Sensitive (HashMap Text Text))
description :: Maybe Text
clientToken :: Maybe Text
$sel:networkFabricType:CreateEnvironment' :: CreateEnvironment -> NetworkFabricType
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (Sensitive (HashMap Text Text))
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:clientToken:CreateEnvironment' :: CreateEnvironment -> 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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NetworkFabricType
networkFabricType

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 (Sensitive (HashMap Text Text))
Text
NetworkFabricType
networkFabricType :: NetworkFabricType
name :: Text
tags :: Maybe (Sensitive (HashMap Text Text))
description :: Maybe Text
clientToken :: Maybe Text
$sel:networkFabricType:CreateEnvironment' :: CreateEnvironment -> NetworkFabricType
$sel:name:CreateEnvironment' :: CreateEnvironment -> Text
$sel:tags:CreateEnvironment' :: CreateEnvironment -> Maybe (Sensitive (HashMap Text Text))
$sel:description:CreateEnvironment' :: CreateEnvironment -> Maybe Text
$sel:clientToken:CreateEnvironment' :: CreateEnvironment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (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
"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 (Sensitive (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),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"NetworkFabricType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NetworkFabricType
networkFabricType)
          ]
      )

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

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 environment.
    CreateEnvironmentResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | A timestamp that indicates when the environment is created.
    CreateEnvironmentResponse -> Maybe POSIX
createdTime :: Prelude.Maybe Data.POSIX,
    -- | A description of the environment.
    CreateEnvironmentResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the environment.
    CreateEnvironmentResponse -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | A timestamp that indicates when the environment was last updated.
    CreateEnvironmentResponse -> Maybe POSIX
lastUpdatedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the environment.
    CreateEnvironmentResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The network fabric type of the environment.
    CreateEnvironmentResponse -> Maybe NetworkFabricType
networkFabricType :: Prelude.Maybe NetworkFabricType,
    -- | The Amazon Web Services account ID of environment owner.
    CreateEnvironmentResponse -> Maybe Text
ownerAccountId :: Prelude.Maybe Prelude.Text,
    -- | The current state of the environment.
    CreateEnvironmentResponse -> Maybe EnvironmentState
state :: Prelude.Maybe EnvironmentState,
    -- | The tags assigned to the created environment. A tag is a label that you
    -- assign to an Amazon Web Services resource. Each tag consists of a
    -- key-value pair..
    CreateEnvironmentResponse -> Maybe (Sensitive (HashMap Text Text))
tags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text 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, 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:
--
-- 'arn', 'createEnvironmentResponse_arn' - The Amazon Resource Name (ARN) of the environment.
--
-- 'createdTime', 'createEnvironmentResponse_createdTime' - A timestamp that indicates when the environment is created.
--
-- 'description', 'createEnvironmentResponse_description' - A description of the environment.
--
-- 'environmentId', 'createEnvironmentResponse_environmentId' - The unique identifier of the environment.
--
-- 'lastUpdatedTime', 'createEnvironmentResponse_lastUpdatedTime' - A timestamp that indicates when the environment was last updated.
--
-- 'name', 'createEnvironmentResponse_name' - The name of the environment.
--
-- 'networkFabricType', 'createEnvironmentResponse_networkFabricType' - The network fabric type of the environment.
--
-- 'ownerAccountId', 'createEnvironmentResponse_ownerAccountId' - The Amazon Web Services account ID of environment owner.
--
-- 'state', 'createEnvironmentResponse_state' - The current state of the environment.
--
-- 'tags', 'createEnvironmentResponse_tags' - The tags assigned to the created environment. A tag is a label that you
-- assign to an Amazon Web Services resource. Each tag consists of a
-- key-value pair..
--
-- 'httpStatus', 'createEnvironmentResponse_httpStatus' - The response's http status code.
newCreateEnvironmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateEnvironmentResponse
newCreateEnvironmentResponse :: Int -> CreateEnvironmentResponse
newCreateEnvironmentResponse Int
pHttpStatus_ =
  CreateEnvironmentResponse'
    { $sel:arn:CreateEnvironmentResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTime:CreateEnvironmentResponse' :: Maybe POSIX
createdTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateEnvironmentResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:environmentId:CreateEnvironmentResponse' :: Maybe Text
environmentId = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedTime:CreateEnvironmentResponse' :: Maybe POSIX
lastUpdatedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateEnvironmentResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:networkFabricType:CreateEnvironmentResponse' :: Maybe NetworkFabricType
networkFabricType = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerAccountId:CreateEnvironmentResponse' :: Maybe Text
ownerAccountId = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CreateEnvironmentResponse' :: Maybe EnvironmentState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateEnvironmentResponse' :: Maybe (Sensitive (HashMap Text Text))
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateEnvironmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | A timestamp that indicates when the environment is created.
createEnvironmentResponse_createdTime :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.UTCTime)
createEnvironmentResponse_createdTime :: Lens' CreateEnvironmentResponse (Maybe UTCTime)
createEnvironmentResponse_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe POSIX
createdTime :: Maybe POSIX
$sel:createdTime:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe POSIX
createdTime} -> Maybe POSIX
createdTime) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe POSIX
a -> CreateEnvironmentResponse
s {$sel:createdTime:CreateEnvironmentResponse' :: Maybe POSIX
createdTime = Maybe POSIX
a} :: CreateEnvironmentResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A description of the environment.
createEnvironmentResponse_description :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.Text)
createEnvironmentResponse_description :: Lens' CreateEnvironmentResponse (Maybe Text)
createEnvironmentResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe Text
a -> CreateEnvironmentResponse
s {$sel:description:CreateEnvironmentResponse' :: Maybe Text
description = Maybe Text
a} :: CreateEnvironmentResponse)

-- | The unique identifier of the environment.
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)

-- | A timestamp that indicates when the environment was last updated.
createEnvironmentResponse_lastUpdatedTime :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.UTCTime)
createEnvironmentResponse_lastUpdatedTime :: Lens' CreateEnvironmentResponse (Maybe UTCTime)
createEnvironmentResponse_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe POSIX
lastUpdatedTime :: Maybe POSIX
$sel:lastUpdatedTime:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe POSIX
lastUpdatedTime} -> Maybe POSIX
lastUpdatedTime) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe POSIX
a -> CreateEnvironmentResponse
s {$sel:lastUpdatedTime:CreateEnvironmentResponse' :: Maybe POSIX
lastUpdatedTime = Maybe POSIX
a} :: CreateEnvironmentResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the environment.
createEnvironmentResponse_name :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.Text)
createEnvironmentResponse_name :: Lens' CreateEnvironmentResponse (Maybe Text)
createEnvironmentResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe Text
a -> CreateEnvironmentResponse
s {$sel:name:CreateEnvironmentResponse' :: Maybe Text
name = Maybe Text
a} :: CreateEnvironmentResponse)

-- | The network fabric type of the environment.
createEnvironmentResponse_networkFabricType :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe NetworkFabricType)
createEnvironmentResponse_networkFabricType :: Lens' CreateEnvironmentResponse (Maybe NetworkFabricType)
createEnvironmentResponse_networkFabricType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe NetworkFabricType
networkFabricType :: Maybe NetworkFabricType
$sel:networkFabricType:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe NetworkFabricType
networkFabricType} -> Maybe NetworkFabricType
networkFabricType) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe NetworkFabricType
a -> CreateEnvironmentResponse
s {$sel:networkFabricType:CreateEnvironmentResponse' :: Maybe NetworkFabricType
networkFabricType = Maybe NetworkFabricType
a} :: CreateEnvironmentResponse)

-- | The Amazon Web Services account ID of environment owner.
createEnvironmentResponse_ownerAccountId :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe Prelude.Text)
createEnvironmentResponse_ownerAccountId :: Lens' CreateEnvironmentResponse (Maybe Text)
createEnvironmentResponse_ownerAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe Text
ownerAccountId :: Maybe Text
$sel:ownerAccountId:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
ownerAccountId} -> Maybe Text
ownerAccountId) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe Text
a -> CreateEnvironmentResponse
s {$sel:ownerAccountId:CreateEnvironmentResponse' :: Maybe Text
ownerAccountId = Maybe Text
a} :: CreateEnvironmentResponse)

-- | The current state of the environment.
createEnvironmentResponse_state :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe EnvironmentState)
createEnvironmentResponse_state :: Lens' CreateEnvironmentResponse (Maybe EnvironmentState)
createEnvironmentResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe EnvironmentState
state :: Maybe EnvironmentState
$sel:state:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe EnvironmentState
state} -> Maybe EnvironmentState
state) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe EnvironmentState
a -> CreateEnvironmentResponse
s {$sel:state:CreateEnvironmentResponse' :: Maybe EnvironmentState
state = Maybe EnvironmentState
a} :: CreateEnvironmentResponse)

-- | The tags assigned to the created environment. A tag is a label that you
-- assign to an Amazon Web Services resource. Each tag consists of a
-- key-value pair..
createEnvironmentResponse_tags :: Lens.Lens' CreateEnvironmentResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createEnvironmentResponse_tags :: Lens' CreateEnvironmentResponse (Maybe (HashMap Text Text))
createEnvironmentResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentResponse' {Maybe (Sensitive (HashMap Text Text))
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:tags:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe (Sensitive (HashMap Text Text))
tags} -> Maybe (Sensitive (HashMap Text Text))
tags) (\s :: CreateEnvironmentResponse
s@CreateEnvironmentResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> CreateEnvironmentResponse
s {$sel:tags:CreateEnvironmentResponse' :: Maybe (Sensitive (HashMap Text Text))
tags = Maybe (Sensitive (HashMap Text Text))
a} :: CreateEnvironmentResponse) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | The 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
Maybe (Sensitive (HashMap Text Text))
Maybe POSIX
Maybe EnvironmentState
Maybe NetworkFabricType
httpStatus :: Int
tags :: Maybe (Sensitive (HashMap Text Text))
state :: Maybe EnvironmentState
ownerAccountId :: Maybe Text
networkFabricType :: Maybe NetworkFabricType
name :: Maybe Text
lastUpdatedTime :: Maybe POSIX
environmentId :: Maybe Text
description :: Maybe Text
createdTime :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Int
$sel:tags:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe (Sensitive (HashMap Text Text))
$sel:state:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe EnvironmentState
$sel:ownerAccountId:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
$sel:networkFabricType:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe NetworkFabricType
$sel:name:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
$sel:lastUpdatedTime:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe POSIX
$sel:environmentId:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
$sel:description:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
$sel:createdTime:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe POSIX
$sel:arn:CreateEnvironmentResponse' :: CreateEnvironmentResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdTime
      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
environmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkFabricType
networkFabricType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EnvironmentState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus