{-# 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.GetEnvironment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets an Amazon Web Services Migration Hub Refactor Spaces environment.
module Amazonka.MigrationHubReFactorSpaces.GetEnvironment
  ( -- * Creating a Request
    GetEnvironment (..),
    newGetEnvironment,

    -- * Request Lenses
    getEnvironment_environmentIdentifier,

    -- * Destructuring the Response
    GetEnvironmentResponse (..),
    newGetEnvironmentResponse,

    -- * Response Lenses
    getEnvironmentResponse_arn,
    getEnvironmentResponse_createdTime,
    getEnvironmentResponse_description,
    getEnvironmentResponse_environmentId,
    getEnvironmentResponse_error,
    getEnvironmentResponse_lastUpdatedTime,
    getEnvironmentResponse_name,
    getEnvironmentResponse_networkFabricType,
    getEnvironmentResponse_ownerAccountId,
    getEnvironmentResponse_state,
    getEnvironmentResponse_tags,
    getEnvironmentResponse_transitGatewayId,
    getEnvironmentResponse_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:/ 'newGetEnvironment' smart constructor.
data GetEnvironment = GetEnvironment'
  { -- | The ID of the environment.
    GetEnvironment -> Text
environmentIdentifier :: Prelude.Text
  }
  deriving (GetEnvironment -> GetEnvironment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEnvironment -> GetEnvironment -> Bool
$c/= :: GetEnvironment -> GetEnvironment -> Bool
== :: GetEnvironment -> GetEnvironment -> Bool
$c== :: GetEnvironment -> GetEnvironment -> Bool
Prelude.Eq, ReadPrec [GetEnvironment]
ReadPrec GetEnvironment
Int -> ReadS GetEnvironment
ReadS [GetEnvironment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEnvironment]
$creadListPrec :: ReadPrec [GetEnvironment]
readPrec :: ReadPrec GetEnvironment
$creadPrec :: ReadPrec GetEnvironment
readList :: ReadS [GetEnvironment]
$creadList :: ReadS [GetEnvironment]
readsPrec :: Int -> ReadS GetEnvironment
$creadsPrec :: Int -> ReadS GetEnvironment
Prelude.Read, Int -> GetEnvironment -> ShowS
[GetEnvironment] -> ShowS
GetEnvironment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEnvironment] -> ShowS
$cshowList :: [GetEnvironment] -> ShowS
show :: GetEnvironment -> String
$cshow :: GetEnvironment -> String
showsPrec :: Int -> GetEnvironment -> ShowS
$cshowsPrec :: Int -> GetEnvironment -> ShowS
Prelude.Show, forall x. Rep GetEnvironment x -> GetEnvironment
forall x. GetEnvironment -> Rep GetEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEnvironment x -> GetEnvironment
$cfrom :: forall x. GetEnvironment -> Rep GetEnvironment x
Prelude.Generic)

-- |
-- Create a value of 'GetEnvironment' 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:
--
-- 'environmentIdentifier', 'getEnvironment_environmentIdentifier' - The ID of the environment.
newGetEnvironment ::
  -- | 'environmentIdentifier'
  Prelude.Text ->
  GetEnvironment
newGetEnvironment :: Text -> GetEnvironment
newGetEnvironment Text
pEnvironmentIdentifier_ =
  GetEnvironment'
    { $sel:environmentIdentifier:GetEnvironment' :: Text
environmentIdentifier =
        Text
pEnvironmentIdentifier_
    }

-- | The ID of the environment.
getEnvironment_environmentIdentifier :: Lens.Lens' GetEnvironment Prelude.Text
getEnvironment_environmentIdentifier :: Lens' GetEnvironment Text
getEnvironment_environmentIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironment' {Text
environmentIdentifier :: Text
$sel:environmentIdentifier:GetEnvironment' :: GetEnvironment -> Text
environmentIdentifier} -> Text
environmentIdentifier) (\s :: GetEnvironment
s@GetEnvironment' {} Text
a -> GetEnvironment
s {$sel:environmentIdentifier:GetEnvironment' :: Text
environmentIdentifier = Text
a} :: GetEnvironment)

instance Core.AWSRequest GetEnvironment where
  type
    AWSResponse GetEnvironment =
      GetEnvironmentResponse
  request :: (Service -> Service) -> GetEnvironment -> Request GetEnvironment
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetEnvironment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetEnvironment)))
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 ErrorResponse
-> Maybe POSIX
-> Maybe Text
-> Maybe NetworkFabricType
-> Maybe Text
-> Maybe EnvironmentState
-> Maybe (Sensitive (HashMap Text Text))
-> Maybe Text
-> Int
-> GetEnvironmentResponse
GetEnvironmentResponse'
            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
"Error")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TransitGatewayId")
            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 GetEnvironment where
  hashWithSalt :: Int -> GetEnvironment -> Int
hashWithSalt Int
_salt GetEnvironment' {Text
environmentIdentifier :: Text
$sel:environmentIdentifier:GetEnvironment' :: GetEnvironment -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentIdentifier

instance Prelude.NFData GetEnvironment where
  rnf :: GetEnvironment -> ()
rnf GetEnvironment' {Text
environmentIdentifier :: Text
$sel:environmentIdentifier:GetEnvironment' :: GetEnvironment -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
environmentIdentifier

instance Data.ToHeaders GetEnvironment where
  toHeaders :: GetEnvironment -> 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.ToPath GetEnvironment where
  toPath :: GetEnvironment -> ByteString
toPath GetEnvironment' {Text
environmentIdentifier :: Text
$sel:environmentIdentifier:GetEnvironment' :: GetEnvironment -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/environments/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
environmentIdentifier]

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

-- | /See:/ 'newGetEnvironmentResponse' smart constructor.
data GetEnvironmentResponse = GetEnvironmentResponse'
  { -- | The Amazon Resource Name (ARN) of the environment.
    GetEnvironmentResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | A timestamp that indicates when the environment is created.
    GetEnvironmentResponse -> Maybe POSIX
createdTime :: Prelude.Maybe Data.POSIX,
    -- | The description of the environment.
    GetEnvironmentResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the environment.
    GetEnvironmentResponse -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | Any error associated with the environment resource.
    GetEnvironmentResponse -> Maybe ErrorResponse
error :: Prelude.Maybe ErrorResponse,
    -- | A timestamp that indicates when the environment was last updated.
    GetEnvironmentResponse -> Maybe POSIX
lastUpdatedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the environment.
    GetEnvironmentResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The network fabric type of the environment.
    GetEnvironmentResponse -> Maybe NetworkFabricType
networkFabricType :: Prelude.Maybe NetworkFabricType,
    -- | The Amazon Web Services account ID of the environment owner.
    GetEnvironmentResponse -> Maybe Text
ownerAccountId :: Prelude.Maybe Prelude.Text,
    -- | The current state of the environment.
    GetEnvironmentResponse -> Maybe EnvironmentState
state :: Prelude.Maybe EnvironmentState,
    -- | 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.
    GetEnvironmentResponse -> Maybe (Sensitive (HashMap Text Text))
tags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The ID of the transit gateway set up by the environment.
    GetEnvironmentResponse -> Maybe Text
transitGatewayId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetEnvironmentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
$c/= :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
== :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
$c== :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
Prelude.Eq, Int -> GetEnvironmentResponse -> ShowS
[GetEnvironmentResponse] -> ShowS
GetEnvironmentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEnvironmentResponse] -> ShowS
$cshowList :: [GetEnvironmentResponse] -> ShowS
show :: GetEnvironmentResponse -> String
$cshow :: GetEnvironmentResponse -> String
showsPrec :: Int -> GetEnvironmentResponse -> ShowS
$cshowsPrec :: Int -> GetEnvironmentResponse -> ShowS
Prelude.Show, forall x. Rep GetEnvironmentResponse x -> GetEnvironmentResponse
forall x. GetEnvironmentResponse -> Rep GetEnvironmentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEnvironmentResponse x -> GetEnvironmentResponse
$cfrom :: forall x. GetEnvironmentResponse -> Rep GetEnvironmentResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetEnvironmentResponse' 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', 'getEnvironmentResponse_arn' - The Amazon Resource Name (ARN) of the environment.
--
-- 'createdTime', 'getEnvironmentResponse_createdTime' - A timestamp that indicates when the environment is created.
--
-- 'description', 'getEnvironmentResponse_description' - The description of the environment.
--
-- 'environmentId', 'getEnvironmentResponse_environmentId' - The unique identifier of the environment.
--
-- 'error', 'getEnvironmentResponse_error' - Any error associated with the environment resource.
--
-- 'lastUpdatedTime', 'getEnvironmentResponse_lastUpdatedTime' - A timestamp that indicates when the environment was last updated.
--
-- 'name', 'getEnvironmentResponse_name' - The name of the environment.
--
-- 'networkFabricType', 'getEnvironmentResponse_networkFabricType' - The network fabric type of the environment.
--
-- 'ownerAccountId', 'getEnvironmentResponse_ownerAccountId' - The Amazon Web Services account ID of the environment owner.
--
-- 'state', 'getEnvironmentResponse_state' - The current state of the environment.
--
-- 'tags', 'getEnvironmentResponse_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.
--
-- 'transitGatewayId', 'getEnvironmentResponse_transitGatewayId' - The ID of the transit gateway set up by the environment.
--
-- 'httpStatus', 'getEnvironmentResponse_httpStatus' - The response's http status code.
newGetEnvironmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetEnvironmentResponse
newGetEnvironmentResponse :: Int -> GetEnvironmentResponse
newGetEnvironmentResponse Int
pHttpStatus_ =
  GetEnvironmentResponse'
    { $sel:arn:GetEnvironmentResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTime:GetEnvironmentResponse' :: Maybe POSIX
createdTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetEnvironmentResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:environmentId:GetEnvironmentResponse' :: Maybe Text
environmentId = forall a. Maybe a
Prelude.Nothing,
      $sel:error:GetEnvironmentResponse' :: Maybe ErrorResponse
error = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedTime:GetEnvironmentResponse' :: Maybe POSIX
lastUpdatedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetEnvironmentResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:networkFabricType:GetEnvironmentResponse' :: Maybe NetworkFabricType
networkFabricType = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerAccountId:GetEnvironmentResponse' :: Maybe Text
ownerAccountId = forall a. Maybe a
Prelude.Nothing,
      $sel:state:GetEnvironmentResponse' :: Maybe EnvironmentState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetEnvironmentResponse' :: Maybe (Sensitive (HashMap Text Text))
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:transitGatewayId:GetEnvironmentResponse' :: Maybe Text
transitGatewayId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetEnvironmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | A timestamp that indicates when the environment is created.
getEnvironmentResponse_createdTime :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.UTCTime)
getEnvironmentResponse_createdTime :: Lens' GetEnvironmentResponse (Maybe UTCTime)
getEnvironmentResponse_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe POSIX
createdTime :: Maybe POSIX
$sel:createdTime:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe POSIX
createdTime} -> Maybe POSIX
createdTime) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe POSIX
a -> GetEnvironmentResponse
s {$sel:createdTime:GetEnvironmentResponse' :: Maybe POSIX
createdTime = Maybe POSIX
a} :: GetEnvironmentResponse) 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 description of the environment.
getEnvironmentResponse_description :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_description :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:description:GetEnvironmentResponse' :: Maybe Text
description = Maybe Text
a} :: GetEnvironmentResponse)

-- | The unique identifier of the environment.
getEnvironmentResponse_environmentId :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_environmentId :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
environmentId :: Maybe Text
$sel:environmentId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
environmentId} -> Maybe Text
environmentId) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:environmentId:GetEnvironmentResponse' :: Maybe Text
environmentId = Maybe Text
a} :: GetEnvironmentResponse)

-- | Any error associated with the environment resource.
getEnvironmentResponse_error :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe ErrorResponse)
getEnvironmentResponse_error :: Lens' GetEnvironmentResponse (Maybe ErrorResponse)
getEnvironmentResponse_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe ErrorResponse
error :: Maybe ErrorResponse
$sel:error:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe ErrorResponse
error} -> Maybe ErrorResponse
error) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe ErrorResponse
a -> GetEnvironmentResponse
s {$sel:error:GetEnvironmentResponse' :: Maybe ErrorResponse
error = Maybe ErrorResponse
a} :: GetEnvironmentResponse)

-- | A timestamp that indicates when the environment was last updated.
getEnvironmentResponse_lastUpdatedTime :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.UTCTime)
getEnvironmentResponse_lastUpdatedTime :: Lens' GetEnvironmentResponse (Maybe UTCTime)
getEnvironmentResponse_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe POSIX
lastUpdatedTime :: Maybe POSIX
$sel:lastUpdatedTime:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe POSIX
lastUpdatedTime} -> Maybe POSIX
lastUpdatedTime) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe POSIX
a -> GetEnvironmentResponse
s {$sel:lastUpdatedTime:GetEnvironmentResponse' :: Maybe POSIX
lastUpdatedTime = Maybe POSIX
a} :: GetEnvironmentResponse) 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.
getEnvironmentResponse_name :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_name :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:name:GetEnvironmentResponse' :: Maybe Text
name = Maybe Text
a} :: GetEnvironmentResponse)

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

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

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

-- | 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.
getEnvironmentResponse_tags :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getEnvironmentResponse_tags :: Lens' GetEnvironmentResponse (Maybe (HashMap Text Text))
getEnvironmentResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe (Sensitive (HashMap Text Text))
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:tags:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe (Sensitive (HashMap Text Text))
tags} -> Maybe (Sensitive (HashMap Text Text))
tags) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> GetEnvironmentResponse
s {$sel:tags:GetEnvironmentResponse' :: Maybe (Sensitive (HashMap Text Text))
tags = Maybe (Sensitive (HashMap Text Text))
a} :: GetEnvironmentResponse) 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 ID of the transit gateway set up by the environment.
getEnvironmentResponse_transitGatewayId :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_transitGatewayId :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_transitGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
transitGatewayId :: Maybe Text
$sel:transitGatewayId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
transitGatewayId} -> Maybe Text
transitGatewayId) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:transitGatewayId:GetEnvironmentResponse' :: Maybe Text
transitGatewayId = Maybe Text
a} :: GetEnvironmentResponse)

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

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