{-# 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.GetApplicationVersion
-- 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 details about a specific version of a specific application.
module Amazonka.M2.GetApplicationVersion
  ( -- * Creating a Request
    GetApplicationVersion (..),
    newGetApplicationVersion,

    -- * Request Lenses
    getApplicationVersion_applicationId,
    getApplicationVersion_applicationVersion,

    -- * Destructuring the Response
    GetApplicationVersionResponse (..),
    newGetApplicationVersionResponse,

    -- * Response Lenses
    getApplicationVersionResponse_description,
    getApplicationVersionResponse_statusReason,
    getApplicationVersionResponse_httpStatus,
    getApplicationVersionResponse_applicationVersion,
    getApplicationVersionResponse_creationTime,
    getApplicationVersionResponse_definitionContent,
    getApplicationVersionResponse_name,
    getApplicationVersionResponse_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:/ 'newGetApplicationVersion' smart constructor.
data GetApplicationVersion = GetApplicationVersion'
  { -- | The unique identifier of the application.
    GetApplicationVersion -> Text
applicationId :: Prelude.Text,
    -- | The specific version of the application.
    GetApplicationVersion -> Natural
applicationVersion :: Prelude.Natural
  }
  deriving (GetApplicationVersion -> GetApplicationVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplicationVersion -> GetApplicationVersion -> Bool
$c/= :: GetApplicationVersion -> GetApplicationVersion -> Bool
== :: GetApplicationVersion -> GetApplicationVersion -> Bool
$c== :: GetApplicationVersion -> GetApplicationVersion -> Bool
Prelude.Eq, ReadPrec [GetApplicationVersion]
ReadPrec GetApplicationVersion
Int -> ReadS GetApplicationVersion
ReadS [GetApplicationVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplicationVersion]
$creadListPrec :: ReadPrec [GetApplicationVersion]
readPrec :: ReadPrec GetApplicationVersion
$creadPrec :: ReadPrec GetApplicationVersion
readList :: ReadS [GetApplicationVersion]
$creadList :: ReadS [GetApplicationVersion]
readsPrec :: Int -> ReadS GetApplicationVersion
$creadsPrec :: Int -> ReadS GetApplicationVersion
Prelude.Read, Int -> GetApplicationVersion -> ShowS
[GetApplicationVersion] -> ShowS
GetApplicationVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplicationVersion] -> ShowS
$cshowList :: [GetApplicationVersion] -> ShowS
show :: GetApplicationVersion -> String
$cshow :: GetApplicationVersion -> String
showsPrec :: Int -> GetApplicationVersion -> ShowS
$cshowsPrec :: Int -> GetApplicationVersion -> ShowS
Prelude.Show, forall x. Rep GetApplicationVersion x -> GetApplicationVersion
forall x. GetApplicationVersion -> Rep GetApplicationVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplicationVersion x -> GetApplicationVersion
$cfrom :: forall x. GetApplicationVersion -> Rep GetApplicationVersion x
Prelude.Generic)

-- |
-- Create a value of 'GetApplicationVersion' 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', 'getApplicationVersion_applicationId' - The unique identifier of the application.
--
-- 'applicationVersion', 'getApplicationVersion_applicationVersion' - The specific version of the application.
newGetApplicationVersion ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'applicationVersion'
  Prelude.Natural ->
  GetApplicationVersion
newGetApplicationVersion :: Text -> Natural -> GetApplicationVersion
newGetApplicationVersion
  Text
pApplicationId_
  Natural
pApplicationVersion_ =
    GetApplicationVersion'
      { $sel:applicationId:GetApplicationVersion' :: Text
applicationId =
          Text
pApplicationId_,
        $sel:applicationVersion:GetApplicationVersion' :: Natural
applicationVersion = Natural
pApplicationVersion_
      }

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

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

instance Core.AWSRequest GetApplicationVersion where
  type
    AWSResponse GetApplicationVersion =
      GetApplicationVersionResponse
  request :: (Service -> Service)
-> GetApplicationVersion -> Request GetApplicationVersion
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 GetApplicationVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetApplicationVersion)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Int
-> Natural
-> POSIX
-> Text
-> Text
-> ApplicationVersionLifecycle
-> GetApplicationVersionResponse
GetApplicationVersionResponse'
            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
"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
"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
"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
"definitionContent")
            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
"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 a
Data..:> Key
"status")
      )

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

instance Prelude.NFData GetApplicationVersion where
  rnf :: GetApplicationVersion -> ()
rnf GetApplicationVersion' {Natural
Text
applicationVersion :: Natural
applicationId :: Text
$sel:applicationVersion:GetApplicationVersion' :: GetApplicationVersion -> Natural
$sel:applicationId:GetApplicationVersion' :: GetApplicationVersion -> 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 Natural
applicationVersion

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

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

-- | /See:/ 'newGetApplicationVersionResponse' smart constructor.
data GetApplicationVersionResponse = GetApplicationVersionResponse'
  { -- | The application description.
    GetApplicationVersionResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The reason for the reported status.
    GetApplicationVersionResponse -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetApplicationVersionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The specific version of the application.
    GetApplicationVersionResponse -> Natural
applicationVersion :: Prelude.Natural,
    -- | The timestamp when the application version was created.
    GetApplicationVersionResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The content of the application definition. This is a JSON object that
    -- contains the resource configuration and definitions that identify an
    -- application.
    GetApplicationVersionResponse -> Text
definitionContent :: Prelude.Text,
    -- | The name of the application version.
    GetApplicationVersionResponse -> Text
name :: Prelude.Text,
    -- | The status of the application version.
    GetApplicationVersionResponse -> ApplicationVersionLifecycle
status :: ApplicationVersionLifecycle
  }
  deriving (GetApplicationVersionResponse
-> GetApplicationVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplicationVersionResponse
-> GetApplicationVersionResponse -> Bool
$c/= :: GetApplicationVersionResponse
-> GetApplicationVersionResponse -> Bool
== :: GetApplicationVersionResponse
-> GetApplicationVersionResponse -> Bool
$c== :: GetApplicationVersionResponse
-> GetApplicationVersionResponse -> Bool
Prelude.Eq, ReadPrec [GetApplicationVersionResponse]
ReadPrec GetApplicationVersionResponse
Int -> ReadS GetApplicationVersionResponse
ReadS [GetApplicationVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplicationVersionResponse]
$creadListPrec :: ReadPrec [GetApplicationVersionResponse]
readPrec :: ReadPrec GetApplicationVersionResponse
$creadPrec :: ReadPrec GetApplicationVersionResponse
readList :: ReadS [GetApplicationVersionResponse]
$creadList :: ReadS [GetApplicationVersionResponse]
readsPrec :: Int -> ReadS GetApplicationVersionResponse
$creadsPrec :: Int -> ReadS GetApplicationVersionResponse
Prelude.Read, Int -> GetApplicationVersionResponse -> ShowS
[GetApplicationVersionResponse] -> ShowS
GetApplicationVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplicationVersionResponse] -> ShowS
$cshowList :: [GetApplicationVersionResponse] -> ShowS
show :: GetApplicationVersionResponse -> String
$cshow :: GetApplicationVersionResponse -> String
showsPrec :: Int -> GetApplicationVersionResponse -> ShowS
$cshowsPrec :: Int -> GetApplicationVersionResponse -> ShowS
Prelude.Show, forall x.
Rep GetApplicationVersionResponse x
-> GetApplicationVersionResponse
forall x.
GetApplicationVersionResponse
-> Rep GetApplicationVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetApplicationVersionResponse x
-> GetApplicationVersionResponse
$cfrom :: forall x.
GetApplicationVersionResponse
-> Rep GetApplicationVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetApplicationVersionResponse' 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:
--
-- 'description', 'getApplicationVersionResponse_description' - The application description.
--
-- 'statusReason', 'getApplicationVersionResponse_statusReason' - The reason for the reported status.
--
-- 'httpStatus', 'getApplicationVersionResponse_httpStatus' - The response's http status code.
--
-- 'applicationVersion', 'getApplicationVersionResponse_applicationVersion' - The specific version of the application.
--
-- 'creationTime', 'getApplicationVersionResponse_creationTime' - The timestamp when the application version was created.
--
-- 'definitionContent', 'getApplicationVersionResponse_definitionContent' - The content of the application definition. This is a JSON object that
-- contains the resource configuration and definitions that identify an
-- application.
--
-- 'name', 'getApplicationVersionResponse_name' - The name of the application version.
--
-- 'status', 'getApplicationVersionResponse_status' - The status of the application version.
newGetApplicationVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationVersion'
  Prelude.Natural ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'definitionContent'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  ApplicationVersionLifecycle ->
  GetApplicationVersionResponse
newGetApplicationVersionResponse :: Int
-> Natural
-> UTCTime
-> Text
-> Text
-> ApplicationVersionLifecycle
-> GetApplicationVersionResponse
newGetApplicationVersionResponse
  Int
pHttpStatus_
  Natural
pApplicationVersion_
  UTCTime
pCreationTime_
  Text
pDefinitionContent_
  Text
pName_
  ApplicationVersionLifecycle
pStatus_ =
    GetApplicationVersionResponse'
      { $sel:description:GetApplicationVersionResponse' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:GetApplicationVersionResponse' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetApplicationVersionResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:applicationVersion:GetApplicationVersionResponse' :: Natural
applicationVersion = Natural
pApplicationVersion_,
        $sel:creationTime:GetApplicationVersionResponse' :: POSIX
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:definitionContent:GetApplicationVersionResponse' :: Text
definitionContent = Text
pDefinitionContent_,
        $sel:name:GetApplicationVersionResponse' :: Text
name = Text
pName_,
        $sel:status:GetApplicationVersionResponse' :: ApplicationVersionLifecycle
status = ApplicationVersionLifecycle
pStatus_
      }

-- | The application description.
getApplicationVersionResponse_description :: Lens.Lens' GetApplicationVersionResponse (Prelude.Maybe Prelude.Text)
getApplicationVersionResponse_description :: Lens' GetApplicationVersionResponse (Maybe Text)
getApplicationVersionResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationVersionResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetApplicationVersionResponse
s@GetApplicationVersionResponse' {} Maybe Text
a -> GetApplicationVersionResponse
s {$sel:description:GetApplicationVersionResponse' :: Maybe Text
description = Maybe Text
a} :: GetApplicationVersionResponse)

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

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

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

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

-- | The content of the application definition. This is a JSON object that
-- contains the resource configuration and definitions that identify an
-- application.
getApplicationVersionResponse_definitionContent :: Lens.Lens' GetApplicationVersionResponse Prelude.Text
getApplicationVersionResponse_definitionContent :: Lens' GetApplicationVersionResponse Text
getApplicationVersionResponse_definitionContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationVersionResponse' {Text
definitionContent :: Text
$sel:definitionContent:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Text
definitionContent} -> Text
definitionContent) (\s :: GetApplicationVersionResponse
s@GetApplicationVersionResponse' {} Text
a -> GetApplicationVersionResponse
s {$sel:definitionContent:GetApplicationVersionResponse' :: Text
definitionContent = Text
a} :: GetApplicationVersionResponse)

-- | The name of the application version.
getApplicationVersionResponse_name :: Lens.Lens' GetApplicationVersionResponse Prelude.Text
getApplicationVersionResponse_name :: Lens' GetApplicationVersionResponse Text
getApplicationVersionResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationVersionResponse' {Text
name :: Text
$sel:name:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Text
name} -> Text
name) (\s :: GetApplicationVersionResponse
s@GetApplicationVersionResponse' {} Text
a -> GetApplicationVersionResponse
s {$sel:name:GetApplicationVersionResponse' :: Text
name = Text
a} :: GetApplicationVersionResponse)

-- | The status of the application version.
getApplicationVersionResponse_status :: Lens.Lens' GetApplicationVersionResponse ApplicationVersionLifecycle
getApplicationVersionResponse_status :: Lens' GetApplicationVersionResponse ApplicationVersionLifecycle
getApplicationVersionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationVersionResponse' {ApplicationVersionLifecycle
status :: ApplicationVersionLifecycle
$sel:status:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> ApplicationVersionLifecycle
status} -> ApplicationVersionLifecycle
status) (\s :: GetApplicationVersionResponse
s@GetApplicationVersionResponse' {} ApplicationVersionLifecycle
a -> GetApplicationVersionResponse
s {$sel:status:GetApplicationVersionResponse' :: ApplicationVersionLifecycle
status = ApplicationVersionLifecycle
a} :: GetApplicationVersionResponse)

instance Prelude.NFData GetApplicationVersionResponse where
  rnf :: GetApplicationVersionResponse -> ()
rnf GetApplicationVersionResponse' {Int
Natural
Maybe Text
Text
POSIX
ApplicationVersionLifecycle
status :: ApplicationVersionLifecycle
name :: Text
definitionContent :: Text
creationTime :: POSIX
applicationVersion :: Natural
httpStatus :: Int
statusReason :: Maybe Text
description :: Maybe Text
$sel:status:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> ApplicationVersionLifecycle
$sel:name:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Text
$sel:definitionContent:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Text
$sel:creationTime:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> POSIX
$sel:applicationVersion:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Natural
$sel:httpStatus:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Int
$sel:statusReason:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Maybe Text
$sel:description:GetApplicationVersionResponse' :: GetApplicationVersionResponse -> Maybe Text
..} =
    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
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 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
definitionContent
      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 ApplicationVersionLifecycle
status