{-# 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.Greengrass.GetDeploymentStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the status of a deployment.
module Amazonka.Greengrass.GetDeploymentStatus
  ( -- * Creating a Request
    GetDeploymentStatus (..),
    newGetDeploymentStatus,

    -- * Request Lenses
    getDeploymentStatus_groupId,
    getDeploymentStatus_deploymentId,

    -- * Destructuring the Response
    GetDeploymentStatusResponse (..),
    newGetDeploymentStatusResponse,

    -- * Response Lenses
    getDeploymentStatusResponse_deploymentStatus,
    getDeploymentStatusResponse_deploymentType,
    getDeploymentStatusResponse_errorDetails,
    getDeploymentStatusResponse_errorMessage,
    getDeploymentStatusResponse_updatedAt,
    getDeploymentStatusResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'GetDeploymentStatus' 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:
--
-- 'groupId', 'getDeploymentStatus_groupId' - The ID of the Greengrass group.
--
-- 'deploymentId', 'getDeploymentStatus_deploymentId' - The ID of the deployment.
newGetDeploymentStatus ::
  -- | 'groupId'
  Prelude.Text ->
  -- | 'deploymentId'
  Prelude.Text ->
  GetDeploymentStatus
newGetDeploymentStatus :: Text -> Text -> GetDeploymentStatus
newGetDeploymentStatus Text
pGroupId_ Text
pDeploymentId_ =
  GetDeploymentStatus'
    { $sel:groupId:GetDeploymentStatus' :: Text
groupId = Text
pGroupId_,
      $sel:deploymentId:GetDeploymentStatus' :: Text
deploymentId = Text
pDeploymentId_
    }

-- | The ID of the Greengrass group.
getDeploymentStatus_groupId :: Lens.Lens' GetDeploymentStatus Prelude.Text
getDeploymentStatus_groupId :: Lens' GetDeploymentStatus Text
getDeploymentStatus_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentStatus' {Text
groupId :: Text
$sel:groupId:GetDeploymentStatus' :: GetDeploymentStatus -> Text
groupId} -> Text
groupId) (\s :: GetDeploymentStatus
s@GetDeploymentStatus' {} Text
a -> GetDeploymentStatus
s {$sel:groupId:GetDeploymentStatus' :: Text
groupId = Text
a} :: GetDeploymentStatus)

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

instance Core.AWSRequest GetDeploymentStatus where
  type
    AWSResponse GetDeploymentStatus =
      GetDeploymentStatusResponse
  request :: (Service -> Service)
-> GetDeploymentStatus -> Request GetDeploymentStatus
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 GetDeploymentStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDeploymentStatus)))
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 DeploymentType
-> Maybe [ErrorDetail]
-> Maybe Text
-> Maybe Text
-> Int
-> GetDeploymentStatusResponse
GetDeploymentStatusResponse'
            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
"DeploymentStatus")
            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
"DeploymentType")
            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
"ErrorDetails" 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
"ErrorMessage")
            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
"UpdatedAt")
            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 GetDeploymentStatus where
  hashWithSalt :: Int -> GetDeploymentStatus -> Int
hashWithSalt Int
_salt GetDeploymentStatus' {Text
deploymentId :: Text
groupId :: Text
$sel:deploymentId:GetDeploymentStatus' :: GetDeploymentStatus -> Text
$sel:groupId:GetDeploymentStatus' :: GetDeploymentStatus -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
groupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deploymentId

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

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

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

-- | /See:/ 'newGetDeploymentStatusResponse' smart constructor.
data GetDeploymentStatusResponse = GetDeploymentStatusResponse'
  { -- | The status of the deployment: \'\'InProgress\'\', \'\'Building\'\',
    -- \'\'Success\'\', or \'\'Failure\'\'.
    GetDeploymentStatusResponse -> Maybe Text
deploymentStatus :: Prelude.Maybe Prelude.Text,
    -- | The type of the deployment.
    GetDeploymentStatusResponse -> Maybe DeploymentType
deploymentType :: Prelude.Maybe DeploymentType,
    -- | Error details
    GetDeploymentStatusResponse -> Maybe [ErrorDetail]
errorDetails :: Prelude.Maybe [ErrorDetail],
    -- | Error message
    GetDeploymentStatusResponse -> Maybe Text
errorMessage :: Prelude.Maybe Prelude.Text,
    -- | The time, in milliseconds since the epoch, when the deployment status
    -- was updated.
    GetDeploymentStatusResponse -> Maybe Text
updatedAt :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDeploymentStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDeploymentStatusResponse -> GetDeploymentStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDeploymentStatusResponse -> GetDeploymentStatusResponse -> Bool
$c/= :: GetDeploymentStatusResponse -> GetDeploymentStatusResponse -> Bool
== :: GetDeploymentStatusResponse -> GetDeploymentStatusResponse -> Bool
$c== :: GetDeploymentStatusResponse -> GetDeploymentStatusResponse -> Bool
Prelude.Eq, ReadPrec [GetDeploymentStatusResponse]
ReadPrec GetDeploymentStatusResponse
Int -> ReadS GetDeploymentStatusResponse
ReadS [GetDeploymentStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDeploymentStatusResponse]
$creadListPrec :: ReadPrec [GetDeploymentStatusResponse]
readPrec :: ReadPrec GetDeploymentStatusResponse
$creadPrec :: ReadPrec GetDeploymentStatusResponse
readList :: ReadS [GetDeploymentStatusResponse]
$creadList :: ReadS [GetDeploymentStatusResponse]
readsPrec :: Int -> ReadS GetDeploymentStatusResponse
$creadsPrec :: Int -> ReadS GetDeploymentStatusResponse
Prelude.Read, Int -> GetDeploymentStatusResponse -> ShowS
[GetDeploymentStatusResponse] -> ShowS
GetDeploymentStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDeploymentStatusResponse] -> ShowS
$cshowList :: [GetDeploymentStatusResponse] -> ShowS
show :: GetDeploymentStatusResponse -> String
$cshow :: GetDeploymentStatusResponse -> String
showsPrec :: Int -> GetDeploymentStatusResponse -> ShowS
$cshowsPrec :: Int -> GetDeploymentStatusResponse -> ShowS
Prelude.Show, forall x.
Rep GetDeploymentStatusResponse x -> GetDeploymentStatusResponse
forall x.
GetDeploymentStatusResponse -> Rep GetDeploymentStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDeploymentStatusResponse x -> GetDeploymentStatusResponse
$cfrom :: forall x.
GetDeploymentStatusResponse -> Rep GetDeploymentStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDeploymentStatusResponse' 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:
--
-- 'deploymentStatus', 'getDeploymentStatusResponse_deploymentStatus' - The status of the deployment: \'\'InProgress\'\', \'\'Building\'\',
-- \'\'Success\'\', or \'\'Failure\'\'.
--
-- 'deploymentType', 'getDeploymentStatusResponse_deploymentType' - The type of the deployment.
--
-- 'errorDetails', 'getDeploymentStatusResponse_errorDetails' - Error details
--
-- 'errorMessage', 'getDeploymentStatusResponse_errorMessage' - Error message
--
-- 'updatedAt', 'getDeploymentStatusResponse_updatedAt' - The time, in milliseconds since the epoch, when the deployment status
-- was updated.
--
-- 'httpStatus', 'getDeploymentStatusResponse_httpStatus' - The response's http status code.
newGetDeploymentStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDeploymentStatusResponse
newGetDeploymentStatusResponse :: Int -> GetDeploymentStatusResponse
newGetDeploymentStatusResponse Int
pHttpStatus_ =
  GetDeploymentStatusResponse'
    { $sel:deploymentStatus:GetDeploymentStatusResponse' :: Maybe Text
deploymentStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentType:GetDeploymentStatusResponse' :: Maybe DeploymentType
deploymentType = forall a. Maybe a
Prelude.Nothing,
      $sel:errorDetails:GetDeploymentStatusResponse' :: Maybe [ErrorDetail]
errorDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:errorMessage:GetDeploymentStatusResponse' :: Maybe Text
errorMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedAt:GetDeploymentStatusResponse' :: Maybe Text
updatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDeploymentStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of the deployment: \'\'InProgress\'\', \'\'Building\'\',
-- \'\'Success\'\', or \'\'Failure\'\'.
getDeploymentStatusResponse_deploymentStatus :: Lens.Lens' GetDeploymentStatusResponse (Prelude.Maybe Prelude.Text)
getDeploymentStatusResponse_deploymentStatus :: Lens' GetDeploymentStatusResponse (Maybe Text)
getDeploymentStatusResponse_deploymentStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentStatusResponse' {Maybe Text
deploymentStatus :: Maybe Text
$sel:deploymentStatus:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe Text
deploymentStatus} -> Maybe Text
deploymentStatus) (\s :: GetDeploymentStatusResponse
s@GetDeploymentStatusResponse' {} Maybe Text
a -> GetDeploymentStatusResponse
s {$sel:deploymentStatus:GetDeploymentStatusResponse' :: Maybe Text
deploymentStatus = Maybe Text
a} :: GetDeploymentStatusResponse)

-- | The type of the deployment.
getDeploymentStatusResponse_deploymentType :: Lens.Lens' GetDeploymentStatusResponse (Prelude.Maybe DeploymentType)
getDeploymentStatusResponse_deploymentType :: Lens' GetDeploymentStatusResponse (Maybe DeploymentType)
getDeploymentStatusResponse_deploymentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentStatusResponse' {Maybe DeploymentType
deploymentType :: Maybe DeploymentType
$sel:deploymentType:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe DeploymentType
deploymentType} -> Maybe DeploymentType
deploymentType) (\s :: GetDeploymentStatusResponse
s@GetDeploymentStatusResponse' {} Maybe DeploymentType
a -> GetDeploymentStatusResponse
s {$sel:deploymentType:GetDeploymentStatusResponse' :: Maybe DeploymentType
deploymentType = Maybe DeploymentType
a} :: GetDeploymentStatusResponse)

-- | Error details
getDeploymentStatusResponse_errorDetails :: Lens.Lens' GetDeploymentStatusResponse (Prelude.Maybe [ErrorDetail])
getDeploymentStatusResponse_errorDetails :: Lens' GetDeploymentStatusResponse (Maybe [ErrorDetail])
getDeploymentStatusResponse_errorDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentStatusResponse' {Maybe [ErrorDetail]
errorDetails :: Maybe [ErrorDetail]
$sel:errorDetails:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe [ErrorDetail]
errorDetails} -> Maybe [ErrorDetail]
errorDetails) (\s :: GetDeploymentStatusResponse
s@GetDeploymentStatusResponse' {} Maybe [ErrorDetail]
a -> GetDeploymentStatusResponse
s {$sel:errorDetails:GetDeploymentStatusResponse' :: Maybe [ErrorDetail]
errorDetails = Maybe [ErrorDetail]
a} :: GetDeploymentStatusResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Error message
getDeploymentStatusResponse_errorMessage :: Lens.Lens' GetDeploymentStatusResponse (Prelude.Maybe Prelude.Text)
getDeploymentStatusResponse_errorMessage :: Lens' GetDeploymentStatusResponse (Maybe Text)
getDeploymentStatusResponse_errorMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentStatusResponse' {Maybe Text
errorMessage :: Maybe Text
$sel:errorMessage:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe Text
errorMessage} -> Maybe Text
errorMessage) (\s :: GetDeploymentStatusResponse
s@GetDeploymentStatusResponse' {} Maybe Text
a -> GetDeploymentStatusResponse
s {$sel:errorMessage:GetDeploymentStatusResponse' :: Maybe Text
errorMessage = Maybe Text
a} :: GetDeploymentStatusResponse)

-- | The time, in milliseconds since the epoch, when the deployment status
-- was updated.
getDeploymentStatusResponse_updatedAt :: Lens.Lens' GetDeploymentStatusResponse (Prelude.Maybe Prelude.Text)
getDeploymentStatusResponse_updatedAt :: Lens' GetDeploymentStatusResponse (Maybe Text)
getDeploymentStatusResponse_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDeploymentStatusResponse' {Maybe Text
updatedAt :: Maybe Text
$sel:updatedAt:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe Text
updatedAt} -> Maybe Text
updatedAt) (\s :: GetDeploymentStatusResponse
s@GetDeploymentStatusResponse' {} Maybe Text
a -> GetDeploymentStatusResponse
s {$sel:updatedAt:GetDeploymentStatusResponse' :: Maybe Text
updatedAt = Maybe Text
a} :: GetDeploymentStatusResponse)

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

instance Prelude.NFData GetDeploymentStatusResponse where
  rnf :: GetDeploymentStatusResponse -> ()
rnf GetDeploymentStatusResponse' {Int
Maybe [ErrorDetail]
Maybe Text
Maybe DeploymentType
httpStatus :: Int
updatedAt :: Maybe Text
errorMessage :: Maybe Text
errorDetails :: Maybe [ErrorDetail]
deploymentType :: Maybe DeploymentType
deploymentStatus :: Maybe Text
$sel:httpStatus:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Int
$sel:updatedAt:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe Text
$sel:errorMessage:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe Text
$sel:errorDetails:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe [ErrorDetail]
$sel:deploymentType:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe DeploymentType
$sel:deploymentStatus:GetDeploymentStatusResponse' :: GetDeploymentStatusResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deploymentStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentType
deploymentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ErrorDetail]
errorDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
errorMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
updatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus