{-# 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.M2.GetDeployment
-- 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 details of a specific deployment with a given deployment
-- identifier.
module Amazonka.M2.GetDeployment
  ( -- * Creating a Request
    GetDeployment (..),
    newGetDeployment,

    -- * Request Lenses
    getDeployment_applicationId,
    getDeployment_deploymentId,

    -- * Destructuring the Response
    GetDeploymentResponse (..),
    newGetDeploymentResponse,

    -- * Response Lenses
    getDeploymentResponse_statusReason,
    getDeploymentResponse_httpStatus,
    getDeploymentResponse_applicationId,
    getDeploymentResponse_applicationVersion,
    getDeploymentResponse_creationTime,
    getDeploymentResponse_deploymentId,
    getDeploymentResponse_environmentId,
    getDeploymentResponse_status,
  )
where

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

-- | /See:/ 'newGetDeployment' smart constructor.
data GetDeployment = GetDeployment'
  { -- | The unique identifier of the application.
    GetDeployment -> Text
applicationId :: Prelude.Text,
    -- | The unique identifier for the deployment.
    GetDeployment -> Text
deploymentId :: Prelude.Text
  }
  deriving (GetDeployment -> GetDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDeployment -> GetDeployment -> Bool
$c/= :: GetDeployment -> GetDeployment -> Bool
== :: GetDeployment -> GetDeployment -> Bool
$c== :: GetDeployment -> GetDeployment -> Bool
Prelude.Eq, ReadPrec [GetDeployment]
ReadPrec GetDeployment
Int -> ReadS GetDeployment
ReadS [GetDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDeployment]
$creadListPrec :: ReadPrec [GetDeployment]
readPrec :: ReadPrec GetDeployment
$creadPrec :: ReadPrec GetDeployment
readList :: ReadS [GetDeployment]
$creadList :: ReadS [GetDeployment]
readsPrec :: Int -> ReadS GetDeployment
$creadsPrec :: Int -> ReadS GetDeployment
Prelude.Read, Int -> GetDeployment -> ShowS
[GetDeployment] -> ShowS
GetDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDeployment] -> ShowS
$cshowList :: [GetDeployment] -> ShowS
show :: GetDeployment -> String
$cshow :: GetDeployment -> String
showsPrec :: Int -> GetDeployment -> ShowS
$cshowsPrec :: Int -> GetDeployment -> ShowS
Prelude.Show, forall x. Rep GetDeployment x -> GetDeployment
forall x. GetDeployment -> Rep GetDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDeployment x -> GetDeployment
$cfrom :: forall x. GetDeployment -> Rep GetDeployment x
Prelude.Generic)

-- |
-- Create a value of 'GetDeployment' 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:
--
-- 'applicationId', 'getDeployment_applicationId' - The unique identifier of the application.
--
-- 'deploymentId', 'getDeployment_deploymentId' - The unique identifier for the deployment.
newGetDeployment ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'deploymentId'
  Prelude.Text ->
  GetDeployment
newGetDeployment :: Text -> Text -> GetDeployment
newGetDeployment Text
pApplicationId_ Text
pDeploymentId_ =
  GetDeployment'
    { $sel:applicationId:GetDeployment' :: Text
applicationId = Text
pApplicationId_,
      $sel:deploymentId:GetDeployment' :: Text
deploymentId = Text
pDeploymentId_
    }

-- | The unique identifier of the application.
getDeployment_applicationId :: Lens.Lens' GetDeployment Prelude.Text
getDeployment_applicationId :: Lens' GetDeployment Text
getDeployment_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeployment' {Text
applicationId :: Text
$sel:applicationId:GetDeployment' :: GetDeployment -> Text
applicationId} -> Text
applicationId) (\s :: GetDeployment
s@GetDeployment' {} Text
a -> GetDeployment
s {$sel:applicationId:GetDeployment' :: Text
applicationId = Text
a} :: GetDeployment)

-- | The unique identifier for the deployment.
getDeployment_deploymentId :: Lens.Lens' GetDeployment Prelude.Text
getDeployment_deploymentId :: Lens' GetDeployment Text
getDeployment_deploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeployment' {Text
deploymentId :: Text
$sel:deploymentId:GetDeployment' :: GetDeployment -> Text
deploymentId} -> Text
deploymentId) (\s :: GetDeployment
s@GetDeployment' {} Text
a -> GetDeployment
s {$sel:deploymentId:GetDeployment' :: Text
deploymentId = Text
a} :: GetDeployment)

instance Core.AWSRequest GetDeployment where
  type
    AWSResponse GetDeployment =
      GetDeploymentResponse
  request :: (Service -> Service) -> GetDeployment -> Request GetDeployment
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 GetDeployment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDeployment)))
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
-> Int
-> Text
-> Natural
-> POSIX
-> Text
-> Text
-> DeploymentLifecycle
-> GetDeploymentResponse
GetDeploymentResponse'
            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
"statusReason")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"applicationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"applicationVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"creationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"deploymentId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String 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 a
Data..:> Key
"status")
      )

instance Prelude.Hashable GetDeployment where
  hashWithSalt :: Int -> GetDeployment -> Int
hashWithSalt Int
_salt GetDeployment' {Text
deploymentId :: Text
applicationId :: Text
$sel:deploymentId:GetDeployment' :: GetDeployment -> Text
$sel:applicationId:GetDeployment' :: GetDeployment -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deploymentId

instance Prelude.NFData GetDeployment where
  rnf :: GetDeployment -> ()
rnf GetDeployment' {Text
deploymentId :: Text
applicationId :: Text
$sel:deploymentId:GetDeployment' :: GetDeployment -> Text
$sel:applicationId:GetDeployment' :: GetDeployment -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deploymentId

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

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

-- | /See:/ 'newGetDeploymentResponse' smart constructor.
data GetDeploymentResponse = GetDeploymentResponse'
  { -- | The reason for the reported status.
    GetDeploymentResponse -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDeploymentResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique identifier of the application.
    GetDeploymentResponse -> Text
applicationId :: Prelude.Text,
    -- | The application version.
    GetDeploymentResponse -> Natural
applicationVersion :: Prelude.Natural,
    -- | The timestamp when the deployment was created.
    GetDeploymentResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The unique identifier of the deployment.
    GetDeploymentResponse -> Text
deploymentId :: Prelude.Text,
    -- | The unique identifier of the runtime environment.
    GetDeploymentResponse -> Text
environmentId :: Prelude.Text,
    -- | The status of the deployment.
    GetDeploymentResponse -> DeploymentLifecycle
status :: DeploymentLifecycle
  }
  deriving (GetDeploymentResponse -> GetDeploymentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDeploymentResponse -> GetDeploymentResponse -> Bool
$c/= :: GetDeploymentResponse -> GetDeploymentResponse -> Bool
== :: GetDeploymentResponse -> GetDeploymentResponse -> Bool
$c== :: GetDeploymentResponse -> GetDeploymentResponse -> Bool
Prelude.Eq, ReadPrec [GetDeploymentResponse]
ReadPrec GetDeploymentResponse
Int -> ReadS GetDeploymentResponse
ReadS [GetDeploymentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDeploymentResponse]
$creadListPrec :: ReadPrec [GetDeploymentResponse]
readPrec :: ReadPrec GetDeploymentResponse
$creadPrec :: ReadPrec GetDeploymentResponse
readList :: ReadS [GetDeploymentResponse]
$creadList :: ReadS [GetDeploymentResponse]
readsPrec :: Int -> ReadS GetDeploymentResponse
$creadsPrec :: Int -> ReadS GetDeploymentResponse
Prelude.Read, Int -> GetDeploymentResponse -> ShowS
[GetDeploymentResponse] -> ShowS
GetDeploymentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDeploymentResponse] -> ShowS
$cshowList :: [GetDeploymentResponse] -> ShowS
show :: GetDeploymentResponse -> String
$cshow :: GetDeploymentResponse -> String
showsPrec :: Int -> GetDeploymentResponse -> ShowS
$cshowsPrec :: Int -> GetDeploymentResponse -> ShowS
Prelude.Show, forall x. Rep GetDeploymentResponse x -> GetDeploymentResponse
forall x. GetDeploymentResponse -> Rep GetDeploymentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDeploymentResponse x -> GetDeploymentResponse
$cfrom :: forall x. GetDeploymentResponse -> Rep GetDeploymentResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDeploymentResponse' 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:
--
-- 'statusReason', 'getDeploymentResponse_statusReason' - The reason for the reported status.
--
-- 'httpStatus', 'getDeploymentResponse_httpStatus' - The response's http status code.
--
-- 'applicationId', 'getDeploymentResponse_applicationId' - The unique identifier of the application.
--
-- 'applicationVersion', 'getDeploymentResponse_applicationVersion' - The application version.
--
-- 'creationTime', 'getDeploymentResponse_creationTime' - The timestamp when the deployment was created.
--
-- 'deploymentId', 'getDeploymentResponse_deploymentId' - The unique identifier of the deployment.
--
-- 'environmentId', 'getDeploymentResponse_environmentId' - The unique identifier of the runtime environment.
--
-- 'status', 'getDeploymentResponse_status' - The status of the deployment.
newGetDeploymentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'applicationVersion'
  Prelude.Natural ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'deploymentId'
  Prelude.Text ->
  -- | 'environmentId'
  Prelude.Text ->
  -- | 'status'
  DeploymentLifecycle ->
  GetDeploymentResponse
newGetDeploymentResponse :: Int
-> Text
-> Natural
-> UTCTime
-> Text
-> Text
-> DeploymentLifecycle
-> GetDeploymentResponse
newGetDeploymentResponse
  Int
pHttpStatus_
  Text
pApplicationId_
  Natural
pApplicationVersion_
  UTCTime
pCreationTime_
  Text
pDeploymentId_
  Text
pEnvironmentId_
  DeploymentLifecycle
pStatus_ =
    GetDeploymentResponse'
      { $sel:statusReason:GetDeploymentResponse' :: Maybe Text
statusReason =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetDeploymentResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:applicationId:GetDeploymentResponse' :: Text
applicationId = Text
pApplicationId_,
        $sel:applicationVersion:GetDeploymentResponse' :: Natural
applicationVersion = Natural
pApplicationVersion_,
        $sel:creationTime:GetDeploymentResponse' :: POSIX
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:deploymentId:GetDeploymentResponse' :: Text
deploymentId = Text
pDeploymentId_,
        $sel:environmentId:GetDeploymentResponse' :: Text
environmentId = Text
pEnvironmentId_,
        $sel:status:GetDeploymentResponse' :: DeploymentLifecycle
status = DeploymentLifecycle
pStatus_
      }

-- | The reason for the reported status.
getDeploymentResponse_statusReason :: Lens.Lens' GetDeploymentResponse (Prelude.Maybe Prelude.Text)
getDeploymentResponse_statusReason :: Lens' GetDeploymentResponse (Maybe Text)
getDeploymentResponse_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentResponse' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:GetDeploymentResponse' :: GetDeploymentResponse -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: GetDeploymentResponse
s@GetDeploymentResponse' {} Maybe Text
a -> GetDeploymentResponse
s {$sel:statusReason:GetDeploymentResponse' :: Maybe Text
statusReason = Maybe Text
a} :: GetDeploymentResponse)

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

-- | The unique identifier of the application.
getDeploymentResponse_applicationId :: Lens.Lens' GetDeploymentResponse Prelude.Text
getDeploymentResponse_applicationId :: Lens' GetDeploymentResponse Text
getDeploymentResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentResponse' {Text
applicationId :: Text
$sel:applicationId:GetDeploymentResponse' :: GetDeploymentResponse -> Text
applicationId} -> Text
applicationId) (\s :: GetDeploymentResponse
s@GetDeploymentResponse' {} Text
a -> GetDeploymentResponse
s {$sel:applicationId:GetDeploymentResponse' :: Text
applicationId = Text
a} :: GetDeploymentResponse)

-- | The application version.
getDeploymentResponse_applicationVersion :: Lens.Lens' GetDeploymentResponse Prelude.Natural
getDeploymentResponse_applicationVersion :: Lens' GetDeploymentResponse Natural
getDeploymentResponse_applicationVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentResponse' {Natural
applicationVersion :: Natural
$sel:applicationVersion:GetDeploymentResponse' :: GetDeploymentResponse -> Natural
applicationVersion} -> Natural
applicationVersion) (\s :: GetDeploymentResponse
s@GetDeploymentResponse' {} Natural
a -> GetDeploymentResponse
s {$sel:applicationVersion:GetDeploymentResponse' :: Natural
applicationVersion = Natural
a} :: GetDeploymentResponse)

-- | The timestamp when the deployment was created.
getDeploymentResponse_creationTime :: Lens.Lens' GetDeploymentResponse Prelude.UTCTime
getDeploymentResponse_creationTime :: Lens' GetDeploymentResponse UTCTime
getDeploymentResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentResponse' {POSIX
creationTime :: POSIX
$sel:creationTime:GetDeploymentResponse' :: GetDeploymentResponse -> POSIX
creationTime} -> POSIX
creationTime) (\s :: GetDeploymentResponse
s@GetDeploymentResponse' {} POSIX
a -> GetDeploymentResponse
s {$sel:creationTime:GetDeploymentResponse' :: POSIX
creationTime = POSIX
a} :: GetDeploymentResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The unique identifier of the deployment.
getDeploymentResponse_deploymentId :: Lens.Lens' GetDeploymentResponse Prelude.Text
getDeploymentResponse_deploymentId :: Lens' GetDeploymentResponse Text
getDeploymentResponse_deploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentResponse' {Text
deploymentId :: Text
$sel:deploymentId:GetDeploymentResponse' :: GetDeploymentResponse -> Text
deploymentId} -> Text
deploymentId) (\s :: GetDeploymentResponse
s@GetDeploymentResponse' {} Text
a -> GetDeploymentResponse
s {$sel:deploymentId:GetDeploymentResponse' :: Text
deploymentId = Text
a} :: GetDeploymentResponse)

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

-- | The status of the deployment.
getDeploymentResponse_status :: Lens.Lens' GetDeploymentResponse DeploymentLifecycle
getDeploymentResponse_status :: Lens' GetDeploymentResponse DeploymentLifecycle
getDeploymentResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentResponse' {DeploymentLifecycle
status :: DeploymentLifecycle
$sel:status:GetDeploymentResponse' :: GetDeploymentResponse -> DeploymentLifecycle
status} -> DeploymentLifecycle
status) (\s :: GetDeploymentResponse
s@GetDeploymentResponse' {} DeploymentLifecycle
a -> GetDeploymentResponse
s {$sel:status:GetDeploymentResponse' :: DeploymentLifecycle
status = DeploymentLifecycle
a} :: GetDeploymentResponse)

instance Prelude.NFData GetDeploymentResponse where
  rnf :: GetDeploymentResponse -> ()
rnf GetDeploymentResponse' {Int
Natural
Maybe Text
Text
POSIX
DeploymentLifecycle
status :: DeploymentLifecycle
environmentId :: Text
deploymentId :: Text
creationTime :: POSIX
applicationVersion :: Natural
applicationId :: Text
httpStatus :: Int
statusReason :: Maybe Text
$sel:status:GetDeploymentResponse' :: GetDeploymentResponse -> DeploymentLifecycle
$sel:environmentId:GetDeploymentResponse' :: GetDeploymentResponse -> Text
$sel:deploymentId:GetDeploymentResponse' :: GetDeploymentResponse -> Text
$sel:creationTime:GetDeploymentResponse' :: GetDeploymentResponse -> POSIX
$sel:applicationVersion:GetDeploymentResponse' :: GetDeploymentResponse -> Natural
$sel:applicationId:GetDeploymentResponse' :: GetDeploymentResponse -> Text
$sel:httpStatus:GetDeploymentResponse' :: GetDeploymentResponse -> Int
$sel:statusReason:GetDeploymentResponse' :: GetDeploymentResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
applicationVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deploymentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeploymentLifecycle
status