{-# 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.SageMaker.DescribeApp
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the app.
module Amazonka.SageMaker.DescribeApp
  ( -- * Creating a Request
    DescribeApp (..),
    newDescribeApp,

    -- * Request Lenses
    describeApp_spaceName,
    describeApp_userProfileName,
    describeApp_domainId,
    describeApp_appType,
    describeApp_appName,

    -- * Destructuring the Response
    DescribeAppResponse (..),
    newDescribeAppResponse,

    -- * Response Lenses
    describeAppResponse_appArn,
    describeAppResponse_appName,
    describeAppResponse_appType,
    describeAppResponse_creationTime,
    describeAppResponse_domainId,
    describeAppResponse_failureReason,
    describeAppResponse_lastHealthCheckTimestamp,
    describeAppResponse_lastUserActivityTimestamp,
    describeAppResponse_resourceSpec,
    describeAppResponse_spaceName,
    describeAppResponse_status,
    describeAppResponse_userProfileName,
    describeAppResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeApp' smart constructor.
data DescribeApp = DescribeApp'
  { -- | The name of the space.
    DescribeApp -> Maybe Text
spaceName :: Prelude.Maybe Prelude.Text,
    -- | The user profile name. If this value is not set, then @SpaceName@ must
    -- be set.
    DescribeApp -> Maybe Text
userProfileName :: Prelude.Maybe Prelude.Text,
    -- | The domain ID.
    DescribeApp -> Text
domainId :: Prelude.Text,
    -- | The type of app.
    DescribeApp -> AppType
appType :: AppType,
    -- | The name of the app.
    DescribeApp -> Text
appName :: Prelude.Text
  }
  deriving (DescribeApp -> DescribeApp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeApp -> DescribeApp -> Bool
$c/= :: DescribeApp -> DescribeApp -> Bool
== :: DescribeApp -> DescribeApp -> Bool
$c== :: DescribeApp -> DescribeApp -> Bool
Prelude.Eq, ReadPrec [DescribeApp]
ReadPrec DescribeApp
Int -> ReadS DescribeApp
ReadS [DescribeApp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeApp]
$creadListPrec :: ReadPrec [DescribeApp]
readPrec :: ReadPrec DescribeApp
$creadPrec :: ReadPrec DescribeApp
readList :: ReadS [DescribeApp]
$creadList :: ReadS [DescribeApp]
readsPrec :: Int -> ReadS DescribeApp
$creadsPrec :: Int -> ReadS DescribeApp
Prelude.Read, Int -> DescribeApp -> ShowS
[DescribeApp] -> ShowS
DescribeApp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeApp] -> ShowS
$cshowList :: [DescribeApp] -> ShowS
show :: DescribeApp -> String
$cshow :: DescribeApp -> String
showsPrec :: Int -> DescribeApp -> ShowS
$cshowsPrec :: Int -> DescribeApp -> ShowS
Prelude.Show, forall x. Rep DescribeApp x -> DescribeApp
forall x. DescribeApp -> Rep DescribeApp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeApp x -> DescribeApp
$cfrom :: forall x. DescribeApp -> Rep DescribeApp x
Prelude.Generic)

-- |
-- Create a value of 'DescribeApp' 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:
--
-- 'spaceName', 'describeApp_spaceName' - The name of the space.
--
-- 'userProfileName', 'describeApp_userProfileName' - The user profile name. If this value is not set, then @SpaceName@ must
-- be set.
--
-- 'domainId', 'describeApp_domainId' - The domain ID.
--
-- 'appType', 'describeApp_appType' - The type of app.
--
-- 'appName', 'describeApp_appName' - The name of the app.
newDescribeApp ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'appType'
  AppType ->
  -- | 'appName'
  Prelude.Text ->
  DescribeApp
newDescribeApp :: Text -> AppType -> Text -> DescribeApp
newDescribeApp Text
pDomainId_ AppType
pAppType_ Text
pAppName_ =
  DescribeApp'
    { $sel:spaceName:DescribeApp' :: Maybe Text
spaceName = forall a. Maybe a
Prelude.Nothing,
      $sel:userProfileName:DescribeApp' :: Maybe Text
userProfileName = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:DescribeApp' :: Text
domainId = Text
pDomainId_,
      $sel:appType:DescribeApp' :: AppType
appType = AppType
pAppType_,
      $sel:appName:DescribeApp' :: Text
appName = Text
pAppName_
    }

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

-- | The user profile name. If this value is not set, then @SpaceName@ must
-- be set.
describeApp_userProfileName :: Lens.Lens' DescribeApp (Prelude.Maybe Prelude.Text)
describeApp_userProfileName :: Lens' DescribeApp (Maybe Text)
describeApp_userProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeApp' {Maybe Text
userProfileName :: Maybe Text
$sel:userProfileName:DescribeApp' :: DescribeApp -> Maybe Text
userProfileName} -> Maybe Text
userProfileName) (\s :: DescribeApp
s@DescribeApp' {} Maybe Text
a -> DescribeApp
s {$sel:userProfileName:DescribeApp' :: Maybe Text
userProfileName = Maybe Text
a} :: DescribeApp)

-- | The domain ID.
describeApp_domainId :: Lens.Lens' DescribeApp Prelude.Text
describeApp_domainId :: Lens' DescribeApp Text
describeApp_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeApp' {Text
domainId :: Text
$sel:domainId:DescribeApp' :: DescribeApp -> Text
domainId} -> Text
domainId) (\s :: DescribeApp
s@DescribeApp' {} Text
a -> DescribeApp
s {$sel:domainId:DescribeApp' :: Text
domainId = Text
a} :: DescribeApp)

-- | The type of app.
describeApp_appType :: Lens.Lens' DescribeApp AppType
describeApp_appType :: Lens' DescribeApp AppType
describeApp_appType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeApp' {AppType
appType :: AppType
$sel:appType:DescribeApp' :: DescribeApp -> AppType
appType} -> AppType
appType) (\s :: DescribeApp
s@DescribeApp' {} AppType
a -> DescribeApp
s {$sel:appType:DescribeApp' :: AppType
appType = AppType
a} :: DescribeApp)

-- | The name of the app.
describeApp_appName :: Lens.Lens' DescribeApp Prelude.Text
describeApp_appName :: Lens' DescribeApp Text
describeApp_appName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeApp' {Text
appName :: Text
$sel:appName:DescribeApp' :: DescribeApp -> Text
appName} -> Text
appName) (\s :: DescribeApp
s@DescribeApp' {} Text
a -> DescribeApp
s {$sel:appName:DescribeApp' :: Text
appName = Text
a} :: DescribeApp)

instance Core.AWSRequest DescribeApp where
  type AWSResponse DescribeApp = DescribeAppResponse
  request :: (Service -> Service) -> DescribeApp -> Request DescribeApp
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeApp
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeApp)))
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
-> Maybe AppType
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe ResourceSpec
-> Maybe Text
-> Maybe AppStatus
-> Maybe Text
-> Int
-> DescribeAppResponse
DescribeAppResponse'
            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
"AppArn")
            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
"AppName")
            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
"AppType")
            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
"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 (Maybe a)
Data..?> Key
"DomainId")
            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
"FailureReason")
            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
"LastHealthCheckTimestamp")
            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
"LastUserActivityTimestamp")
            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
"ResourceSpec")
            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
"SpaceName")
            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
"Status")
            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
"UserProfileName")
            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 DescribeApp where
  hashWithSalt :: Int -> DescribeApp -> Int
hashWithSalt Int
_salt DescribeApp' {Maybe Text
Text
AppType
appName :: Text
appType :: AppType
domainId :: Text
userProfileName :: Maybe Text
spaceName :: Maybe Text
$sel:appName:DescribeApp' :: DescribeApp -> Text
$sel:appType:DescribeApp' :: DescribeApp -> AppType
$sel:domainId:DescribeApp' :: DescribeApp -> Text
$sel:userProfileName:DescribeApp' :: DescribeApp -> Maybe Text
$sel:spaceName:DescribeApp' :: DescribeApp -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spaceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userProfileName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AppType
appType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appName

instance Prelude.NFData DescribeApp where
  rnf :: DescribeApp -> ()
rnf DescribeApp' {Maybe Text
Text
AppType
appName :: Text
appType :: AppType
domainId :: Text
userProfileName :: Maybe Text
spaceName :: Maybe Text
$sel:appName:DescribeApp' :: DescribeApp -> Text
$sel:appType:DescribeApp' :: DescribeApp -> AppType
$sel:domainId:DescribeApp' :: DescribeApp -> Text
$sel:userProfileName:DescribeApp' :: DescribeApp -> Maybe Text
$sel:spaceName:DescribeApp' :: DescribeApp -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spaceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AppType
appType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appName

instance Data.ToHeaders DescribeApp where
  toHeaders :: DescribeApp -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"SageMaker.DescribeApp" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribeApp where
  toJSON :: DescribeApp -> Value
toJSON DescribeApp' {Maybe Text
Text
AppType
appName :: Text
appType :: AppType
domainId :: Text
userProfileName :: Maybe Text
spaceName :: Maybe Text
$sel:appName:DescribeApp' :: DescribeApp -> Text
$sel:appType:DescribeApp' :: DescribeApp -> AppType
$sel:domainId:DescribeApp' :: DescribeApp -> Text
$sel:userProfileName:DescribeApp' :: DescribeApp -> Maybe Text
$sel:spaceName:DescribeApp' :: DescribeApp -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SpaceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
spaceName,
            (Key
"UserProfileName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
userProfileName,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainId),
            forall a. a -> Maybe a
Prelude.Just (Key
"AppType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AppType
appType),
            forall a. a -> Maybe a
Prelude.Just (Key
"AppName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
appName)
          ]
      )

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

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

-- | /See:/ 'newDescribeAppResponse' smart constructor.
data DescribeAppResponse = DescribeAppResponse'
  { -- | The Amazon Resource Name (ARN) of the app.
    DescribeAppResponse -> Maybe Text
appArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the app.
    DescribeAppResponse -> Maybe Text
appName :: Prelude.Maybe Prelude.Text,
    -- | The type of app.
    DescribeAppResponse -> Maybe AppType
appType :: Prelude.Maybe AppType,
    -- | The creation time.
    DescribeAppResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The domain ID.
    DescribeAppResponse -> Maybe Text
domainId :: Prelude.Maybe Prelude.Text,
    -- | The failure reason.
    DescribeAppResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | The timestamp of the last health check.
    DescribeAppResponse -> Maybe POSIX
lastHealthCheckTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The timestamp of the last user\'s activity. @LastUserActivityTimestamp@
    -- is also updated when SageMaker performs health checks without user
    -- activity. As a result, this value is set to the same value as
    -- @LastHealthCheckTimestamp@.
    DescribeAppResponse -> Maybe POSIX
lastUserActivityTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The instance type and the Amazon Resource Name (ARN) of the SageMaker
    -- image created on the instance.
    DescribeAppResponse -> Maybe ResourceSpec
resourceSpec :: Prelude.Maybe ResourceSpec,
    -- | The name of the space. If this value is not set, then @UserProfileName@
    -- must be set.
    DescribeAppResponse -> Maybe Text
spaceName :: Prelude.Maybe Prelude.Text,
    -- | The status.
    DescribeAppResponse -> Maybe AppStatus
status :: Prelude.Maybe AppStatus,
    -- | The user profile name.
    DescribeAppResponse -> Maybe Text
userProfileName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeAppResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeAppResponse -> DescribeAppResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAppResponse -> DescribeAppResponse -> Bool
$c/= :: DescribeAppResponse -> DescribeAppResponse -> Bool
== :: DescribeAppResponse -> DescribeAppResponse -> Bool
$c== :: DescribeAppResponse -> DescribeAppResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAppResponse]
ReadPrec DescribeAppResponse
Int -> ReadS DescribeAppResponse
ReadS [DescribeAppResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAppResponse]
$creadListPrec :: ReadPrec [DescribeAppResponse]
readPrec :: ReadPrec DescribeAppResponse
$creadPrec :: ReadPrec DescribeAppResponse
readList :: ReadS [DescribeAppResponse]
$creadList :: ReadS [DescribeAppResponse]
readsPrec :: Int -> ReadS DescribeAppResponse
$creadsPrec :: Int -> ReadS DescribeAppResponse
Prelude.Read, Int -> DescribeAppResponse -> ShowS
[DescribeAppResponse] -> ShowS
DescribeAppResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAppResponse] -> ShowS
$cshowList :: [DescribeAppResponse] -> ShowS
show :: DescribeAppResponse -> String
$cshow :: DescribeAppResponse -> String
showsPrec :: Int -> DescribeAppResponse -> ShowS
$cshowsPrec :: Int -> DescribeAppResponse -> ShowS
Prelude.Show, forall x. Rep DescribeAppResponse x -> DescribeAppResponse
forall x. DescribeAppResponse -> Rep DescribeAppResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAppResponse x -> DescribeAppResponse
$cfrom :: forall x. DescribeAppResponse -> Rep DescribeAppResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAppResponse' 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:
--
-- 'appArn', 'describeAppResponse_appArn' - The Amazon Resource Name (ARN) of the app.
--
-- 'appName', 'describeAppResponse_appName' - The name of the app.
--
-- 'appType', 'describeAppResponse_appType' - The type of app.
--
-- 'creationTime', 'describeAppResponse_creationTime' - The creation time.
--
-- 'domainId', 'describeAppResponse_domainId' - The domain ID.
--
-- 'failureReason', 'describeAppResponse_failureReason' - The failure reason.
--
-- 'lastHealthCheckTimestamp', 'describeAppResponse_lastHealthCheckTimestamp' - The timestamp of the last health check.
--
-- 'lastUserActivityTimestamp', 'describeAppResponse_lastUserActivityTimestamp' - The timestamp of the last user\'s activity. @LastUserActivityTimestamp@
-- is also updated when SageMaker performs health checks without user
-- activity. As a result, this value is set to the same value as
-- @LastHealthCheckTimestamp@.
--
-- 'resourceSpec', 'describeAppResponse_resourceSpec' - The instance type and the Amazon Resource Name (ARN) of the SageMaker
-- image created on the instance.
--
-- 'spaceName', 'describeAppResponse_spaceName' - The name of the space. If this value is not set, then @UserProfileName@
-- must be set.
--
-- 'status', 'describeAppResponse_status' - The status.
--
-- 'userProfileName', 'describeAppResponse_userProfileName' - The user profile name.
--
-- 'httpStatus', 'describeAppResponse_httpStatus' - The response's http status code.
newDescribeAppResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAppResponse
newDescribeAppResponse :: Int -> DescribeAppResponse
newDescribeAppResponse Int
pHttpStatus_ =
  DescribeAppResponse'
    { $sel:appArn:DescribeAppResponse' :: Maybe Text
appArn = forall a. Maybe a
Prelude.Nothing,
      $sel:appName:DescribeAppResponse' :: Maybe Text
appName = forall a. Maybe a
Prelude.Nothing,
      $sel:appType:DescribeAppResponse' :: Maybe AppType
appType = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:DescribeAppResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:DescribeAppResponse' :: Maybe Text
domainId = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:DescribeAppResponse' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:lastHealthCheckTimestamp:DescribeAppResponse' :: Maybe POSIX
lastHealthCheckTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUserActivityTimestamp:DescribeAppResponse' :: Maybe POSIX
lastUserActivityTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceSpec:DescribeAppResponse' :: Maybe ResourceSpec
resourceSpec = forall a. Maybe a
Prelude.Nothing,
      $sel:spaceName:DescribeAppResponse' :: Maybe Text
spaceName = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeAppResponse' :: Maybe AppStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:userProfileName:DescribeAppResponse' :: Maybe Text
userProfileName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAppResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

-- | The type of app.
describeAppResponse_appType :: Lens.Lens' DescribeAppResponse (Prelude.Maybe AppType)
describeAppResponse_appType :: Lens' DescribeAppResponse (Maybe AppType)
describeAppResponse_appType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe AppType
appType :: Maybe AppType
$sel:appType:DescribeAppResponse' :: DescribeAppResponse -> Maybe AppType
appType} -> Maybe AppType
appType) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe AppType
a -> DescribeAppResponse
s {$sel:appType:DescribeAppResponse' :: Maybe AppType
appType = Maybe AppType
a} :: DescribeAppResponse)

-- | The creation time.
describeAppResponse_creationTime :: Lens.Lens' DescribeAppResponse (Prelude.Maybe Prelude.UTCTime)
describeAppResponse_creationTime :: Lens' DescribeAppResponse (Maybe UTCTime)
describeAppResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:DescribeAppResponse' :: DescribeAppResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe POSIX
a -> DescribeAppResponse
s {$sel:creationTime:DescribeAppResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: DescribeAppResponse) 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 domain ID.
describeAppResponse_domainId :: Lens.Lens' DescribeAppResponse (Prelude.Maybe Prelude.Text)
describeAppResponse_domainId :: Lens' DescribeAppResponse (Maybe Text)
describeAppResponse_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe Text
domainId :: Maybe Text
$sel:domainId:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
domainId} -> Maybe Text
domainId) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe Text
a -> DescribeAppResponse
s {$sel:domainId:DescribeAppResponse' :: Maybe Text
domainId = Maybe Text
a} :: DescribeAppResponse)

-- | The failure reason.
describeAppResponse_failureReason :: Lens.Lens' DescribeAppResponse (Prelude.Maybe Prelude.Text)
describeAppResponse_failureReason :: Lens' DescribeAppResponse (Maybe Text)
describeAppResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe Text
a -> DescribeAppResponse
s {$sel:failureReason:DescribeAppResponse' :: Maybe Text
failureReason = Maybe Text
a} :: DescribeAppResponse)

-- | The timestamp of the last health check.
describeAppResponse_lastHealthCheckTimestamp :: Lens.Lens' DescribeAppResponse (Prelude.Maybe Prelude.UTCTime)
describeAppResponse_lastHealthCheckTimestamp :: Lens' DescribeAppResponse (Maybe UTCTime)
describeAppResponse_lastHealthCheckTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe POSIX
lastHealthCheckTimestamp :: Maybe POSIX
$sel:lastHealthCheckTimestamp:DescribeAppResponse' :: DescribeAppResponse -> Maybe POSIX
lastHealthCheckTimestamp} -> Maybe POSIX
lastHealthCheckTimestamp) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe POSIX
a -> DescribeAppResponse
s {$sel:lastHealthCheckTimestamp:DescribeAppResponse' :: Maybe POSIX
lastHealthCheckTimestamp = Maybe POSIX
a} :: DescribeAppResponse) 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 timestamp of the last user\'s activity. @LastUserActivityTimestamp@
-- is also updated when SageMaker performs health checks without user
-- activity. As a result, this value is set to the same value as
-- @LastHealthCheckTimestamp@.
describeAppResponse_lastUserActivityTimestamp :: Lens.Lens' DescribeAppResponse (Prelude.Maybe Prelude.UTCTime)
describeAppResponse_lastUserActivityTimestamp :: Lens' DescribeAppResponse (Maybe UTCTime)
describeAppResponse_lastUserActivityTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe POSIX
lastUserActivityTimestamp :: Maybe POSIX
$sel:lastUserActivityTimestamp:DescribeAppResponse' :: DescribeAppResponse -> Maybe POSIX
lastUserActivityTimestamp} -> Maybe POSIX
lastUserActivityTimestamp) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe POSIX
a -> DescribeAppResponse
s {$sel:lastUserActivityTimestamp:DescribeAppResponse' :: Maybe POSIX
lastUserActivityTimestamp = Maybe POSIX
a} :: DescribeAppResponse) 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 instance type and the Amazon Resource Name (ARN) of the SageMaker
-- image created on the instance.
describeAppResponse_resourceSpec :: Lens.Lens' DescribeAppResponse (Prelude.Maybe ResourceSpec)
describeAppResponse_resourceSpec :: Lens' DescribeAppResponse (Maybe ResourceSpec)
describeAppResponse_resourceSpec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe ResourceSpec
resourceSpec :: Maybe ResourceSpec
$sel:resourceSpec:DescribeAppResponse' :: DescribeAppResponse -> Maybe ResourceSpec
resourceSpec} -> Maybe ResourceSpec
resourceSpec) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe ResourceSpec
a -> DescribeAppResponse
s {$sel:resourceSpec:DescribeAppResponse' :: Maybe ResourceSpec
resourceSpec = Maybe ResourceSpec
a} :: DescribeAppResponse)

-- | The name of the space. If this value is not set, then @UserProfileName@
-- must be set.
describeAppResponse_spaceName :: Lens.Lens' DescribeAppResponse (Prelude.Maybe Prelude.Text)
describeAppResponse_spaceName :: Lens' DescribeAppResponse (Maybe Text)
describeAppResponse_spaceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe Text
spaceName :: Maybe Text
$sel:spaceName:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
spaceName} -> Maybe Text
spaceName) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe Text
a -> DescribeAppResponse
s {$sel:spaceName:DescribeAppResponse' :: Maybe Text
spaceName = Maybe Text
a} :: DescribeAppResponse)

-- | The status.
describeAppResponse_status :: Lens.Lens' DescribeAppResponse (Prelude.Maybe AppStatus)
describeAppResponse_status :: Lens' DescribeAppResponse (Maybe AppStatus)
describeAppResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe AppStatus
status :: Maybe AppStatus
$sel:status:DescribeAppResponse' :: DescribeAppResponse -> Maybe AppStatus
status} -> Maybe AppStatus
status) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe AppStatus
a -> DescribeAppResponse
s {$sel:status:DescribeAppResponse' :: Maybe AppStatus
status = Maybe AppStatus
a} :: DescribeAppResponse)

-- | The user profile name.
describeAppResponse_userProfileName :: Lens.Lens' DescribeAppResponse (Prelude.Maybe Prelude.Text)
describeAppResponse_userProfileName :: Lens' DescribeAppResponse (Maybe Text)
describeAppResponse_userProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAppResponse' {Maybe Text
userProfileName :: Maybe Text
$sel:userProfileName:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
userProfileName} -> Maybe Text
userProfileName) (\s :: DescribeAppResponse
s@DescribeAppResponse' {} Maybe Text
a -> DescribeAppResponse
s {$sel:userProfileName:DescribeAppResponse' :: Maybe Text
userProfileName = Maybe Text
a} :: DescribeAppResponse)

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

instance Prelude.NFData DescribeAppResponse where
  rnf :: DescribeAppResponse -> ()
rnf DescribeAppResponse' {Int
Maybe Text
Maybe POSIX
Maybe AppStatus
Maybe AppType
Maybe ResourceSpec
httpStatus :: Int
userProfileName :: Maybe Text
status :: Maybe AppStatus
spaceName :: Maybe Text
resourceSpec :: Maybe ResourceSpec
lastUserActivityTimestamp :: Maybe POSIX
lastHealthCheckTimestamp :: Maybe POSIX
failureReason :: Maybe Text
domainId :: Maybe Text
creationTime :: Maybe POSIX
appType :: Maybe AppType
appName :: Maybe Text
appArn :: Maybe Text
$sel:httpStatus:DescribeAppResponse' :: DescribeAppResponse -> Int
$sel:userProfileName:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
$sel:status:DescribeAppResponse' :: DescribeAppResponse -> Maybe AppStatus
$sel:spaceName:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
$sel:resourceSpec:DescribeAppResponse' :: DescribeAppResponse -> Maybe ResourceSpec
$sel:lastUserActivityTimestamp:DescribeAppResponse' :: DescribeAppResponse -> Maybe POSIX
$sel:lastHealthCheckTimestamp:DescribeAppResponse' :: DescribeAppResponse -> Maybe POSIX
$sel:failureReason:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
$sel:domainId:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
$sel:creationTime:DescribeAppResponse' :: DescribeAppResponse -> Maybe POSIX
$sel:appType:DescribeAppResponse' :: DescribeAppResponse -> Maybe AppType
$sel:appName:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
$sel:appArn:DescribeAppResponse' :: DescribeAppResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
appArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
appName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AppType
appType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastHealthCheckTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUserActivityTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceSpec
resourceSpec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spaceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AppStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus