{-# 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.CreateApp
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a running app for the specified UserProfile. This operation is
-- automatically invoked by Amazon SageMaker Studio upon access to the
-- associated Domain, and when new kernel configurations are selected by
-- the user. A user may have multiple Apps active simultaneously.
module Amazonka.SageMaker.CreateApp
  ( -- * Creating a Request
    CreateApp (..),
    newCreateApp,

    -- * Request Lenses
    createApp_resourceSpec,
    createApp_spaceName,
    createApp_tags,
    createApp_userProfileName,
    createApp_domainId,
    createApp_appType,
    createApp_appName,

    -- * Destructuring the Response
    CreateAppResponse (..),
    newCreateAppResponse,

    -- * Response Lenses
    createAppResponse_appArn,
    createAppResponse_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:/ 'newCreateApp' smart constructor.
data CreateApp = CreateApp'
  { -- | The instance type and the Amazon Resource Name (ARN) of the SageMaker
    -- image created on the instance.
    --
    -- The value of @InstanceType@ passed as part of the @ResourceSpec@ in the
    -- @CreateApp@ call overrides the value passed as part of the
    -- @ResourceSpec@ configured for the user profile or the domain. If
    -- @InstanceType@ is not specified in any of those three @ResourceSpec@
    -- values for a @KernelGateway@ app, the @CreateApp@ call fails with a
    -- request validation error.
    CreateApp -> Maybe ResourceSpec
resourceSpec :: Prelude.Maybe ResourceSpec,
    -- | The name of the space. If this value is not set, then @UserProfileName@
    -- must be set.
    CreateApp -> Maybe Text
spaceName :: Prelude.Maybe Prelude.Text,
    -- | Each tag consists of a key and an optional value. Tag keys must be
    -- unique per resource.
    CreateApp -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The user profile name. If this value is not set, then @SpaceName@ must
    -- be set.
    CreateApp -> Maybe Text
userProfileName :: Prelude.Maybe Prelude.Text,
    -- | The domain ID.
    CreateApp -> Text
domainId :: Prelude.Text,
    -- | The type of app.
    CreateApp -> AppType
appType :: AppType,
    -- | The name of the app.
    CreateApp -> Text
appName :: Prelude.Text
  }
  deriving (CreateApp -> CreateApp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApp -> CreateApp -> Bool
$c/= :: CreateApp -> CreateApp -> Bool
== :: CreateApp -> CreateApp -> Bool
$c== :: CreateApp -> CreateApp -> Bool
Prelude.Eq, ReadPrec [CreateApp]
ReadPrec CreateApp
Int -> ReadS CreateApp
ReadS [CreateApp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApp]
$creadListPrec :: ReadPrec [CreateApp]
readPrec :: ReadPrec CreateApp
$creadPrec :: ReadPrec CreateApp
readList :: ReadS [CreateApp]
$creadList :: ReadS [CreateApp]
readsPrec :: Int -> ReadS CreateApp
$creadsPrec :: Int -> ReadS CreateApp
Prelude.Read, Int -> CreateApp -> ShowS
[CreateApp] -> ShowS
CreateApp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApp] -> ShowS
$cshowList :: [CreateApp] -> ShowS
show :: CreateApp -> String
$cshow :: CreateApp -> String
showsPrec :: Int -> CreateApp -> ShowS
$cshowsPrec :: Int -> CreateApp -> ShowS
Prelude.Show, forall x. Rep CreateApp x -> CreateApp
forall x. CreateApp -> Rep CreateApp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApp x -> CreateApp
$cfrom :: forall x. CreateApp -> Rep CreateApp x
Prelude.Generic)

-- |
-- Create a value of 'CreateApp' 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:
--
-- 'resourceSpec', 'createApp_resourceSpec' - The instance type and the Amazon Resource Name (ARN) of the SageMaker
-- image created on the instance.
--
-- The value of @InstanceType@ passed as part of the @ResourceSpec@ in the
-- @CreateApp@ call overrides the value passed as part of the
-- @ResourceSpec@ configured for the user profile or the domain. If
-- @InstanceType@ is not specified in any of those three @ResourceSpec@
-- values for a @KernelGateway@ app, the @CreateApp@ call fails with a
-- request validation error.
--
-- 'spaceName', 'createApp_spaceName' - The name of the space. If this value is not set, then @UserProfileName@
-- must be set.
--
-- 'tags', 'createApp_tags' - Each tag consists of a key and an optional value. Tag keys must be
-- unique per resource.
--
-- 'userProfileName', 'createApp_userProfileName' - The user profile name. If this value is not set, then @SpaceName@ must
-- be set.
--
-- 'domainId', 'createApp_domainId' - The domain ID.
--
-- 'appType', 'createApp_appType' - The type of app.
--
-- 'appName', 'createApp_appName' - The name of the app.
newCreateApp ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'appType'
  AppType ->
  -- | 'appName'
  Prelude.Text ->
  CreateApp
newCreateApp :: Text -> AppType -> Text -> CreateApp
newCreateApp Text
pDomainId_ AppType
pAppType_ Text
pAppName_ =
  CreateApp'
    { $sel:resourceSpec:CreateApp' :: Maybe ResourceSpec
resourceSpec = forall a. Maybe a
Prelude.Nothing,
      $sel:spaceName:CreateApp' :: Maybe Text
spaceName = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateApp' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:userProfileName:CreateApp' :: Maybe Text
userProfileName = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:CreateApp' :: Text
domainId = Text
pDomainId_,
      $sel:appType:CreateApp' :: AppType
appType = AppType
pAppType_,
      $sel:appName:CreateApp' :: Text
appName = Text
pAppName_
    }

-- | The instance type and the Amazon Resource Name (ARN) of the SageMaker
-- image created on the instance.
--
-- The value of @InstanceType@ passed as part of the @ResourceSpec@ in the
-- @CreateApp@ call overrides the value passed as part of the
-- @ResourceSpec@ configured for the user profile or the domain. If
-- @InstanceType@ is not specified in any of those three @ResourceSpec@
-- values for a @KernelGateway@ app, the @CreateApp@ call fails with a
-- request validation error.
createApp_resourceSpec :: Lens.Lens' CreateApp (Prelude.Maybe ResourceSpec)
createApp_resourceSpec :: Lens' CreateApp (Maybe ResourceSpec)
createApp_resourceSpec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe ResourceSpec
resourceSpec :: Maybe ResourceSpec
$sel:resourceSpec:CreateApp' :: CreateApp -> Maybe ResourceSpec
resourceSpec} -> Maybe ResourceSpec
resourceSpec) (\s :: CreateApp
s@CreateApp' {} Maybe ResourceSpec
a -> CreateApp
s {$sel:resourceSpec:CreateApp' :: Maybe ResourceSpec
resourceSpec = Maybe ResourceSpec
a} :: CreateApp)

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

-- | Each tag consists of a key and an optional value. Tag keys must be
-- unique per resource.
createApp_tags :: Lens.Lens' CreateApp (Prelude.Maybe [Tag])
createApp_tags :: Lens' CreateApp (Maybe [Tag])
createApp_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApp' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateApp' :: CreateApp -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateApp
s@CreateApp' {} Maybe [Tag]
a -> CreateApp
s {$sel:tags:CreateApp' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateApp) 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

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

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

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

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

instance Core.AWSRequest CreateApp where
  type AWSResponse CreateApp = CreateAppResponse
  request :: (Service -> Service) -> CreateApp -> Request CreateApp
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 CreateApp
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateApp)))
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 -> CreateAppResponse
CreateAppResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateApp where
  hashWithSalt :: Int -> CreateApp -> Int
hashWithSalt Int
_salt CreateApp' {Maybe [Tag]
Maybe Text
Maybe ResourceSpec
Text
AppType
appName :: Text
appType :: AppType
domainId :: Text
userProfileName :: Maybe Text
tags :: Maybe [Tag]
spaceName :: Maybe Text
resourceSpec :: Maybe ResourceSpec
$sel:appName:CreateApp' :: CreateApp -> Text
$sel:appType:CreateApp' :: CreateApp -> AppType
$sel:domainId:CreateApp' :: CreateApp -> Text
$sel:userProfileName:CreateApp' :: CreateApp -> Maybe Text
$sel:tags:CreateApp' :: CreateApp -> Maybe [Tag]
$sel:spaceName:CreateApp' :: CreateApp -> Maybe Text
$sel:resourceSpec:CreateApp' :: CreateApp -> Maybe ResourceSpec
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceSpec
resourceSpec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spaceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      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 CreateApp where
  rnf :: CreateApp -> ()
rnf CreateApp' {Maybe [Tag]
Maybe Text
Maybe ResourceSpec
Text
AppType
appName :: Text
appType :: AppType
domainId :: Text
userProfileName :: Maybe Text
tags :: Maybe [Tag]
spaceName :: Maybe Text
resourceSpec :: Maybe ResourceSpec
$sel:appName:CreateApp' :: CreateApp -> Text
$sel:appType:CreateApp' :: CreateApp -> AppType
$sel:domainId:CreateApp' :: CreateApp -> Text
$sel:userProfileName:CreateApp' :: CreateApp -> Maybe Text
$sel:tags:CreateApp' :: CreateApp -> Maybe [Tag]
$sel:spaceName:CreateApp' :: CreateApp -> Maybe Text
$sel:resourceSpec:CreateApp' :: CreateApp -> Maybe ResourceSpec
..} =
    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 [Tag]
tags
      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 CreateApp where
  toHeaders :: CreateApp -> 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.CreateApp" :: 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 CreateApp where
  toJSON :: CreateApp -> Value
toJSON CreateApp' {Maybe [Tag]
Maybe Text
Maybe ResourceSpec
Text
AppType
appName :: Text
appType :: AppType
domainId :: Text
userProfileName :: Maybe Text
tags :: Maybe [Tag]
spaceName :: Maybe Text
resourceSpec :: Maybe ResourceSpec
$sel:appName:CreateApp' :: CreateApp -> Text
$sel:appType:CreateApp' :: CreateApp -> AppType
$sel:domainId:CreateApp' :: CreateApp -> Text
$sel:userProfileName:CreateApp' :: CreateApp -> Maybe Text
$sel:tags:CreateApp' :: CreateApp -> Maybe [Tag]
$sel:spaceName:CreateApp' :: CreateApp -> Maybe Text
$sel:resourceSpec:CreateApp' :: CreateApp -> Maybe ResourceSpec
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ResourceSpec" 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 ResourceSpec
resourceSpec,
            (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
"Tags" 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 [Tag]
tags,
            (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 CreateApp where
  toPath :: CreateApp -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateAppResponse' smart constructor.
data CreateAppResponse = CreateAppResponse'
  { -- | The Amazon Resource Name (ARN) of the app.
    CreateAppResponse -> Maybe Text
appArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateAppResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateAppResponse -> CreateAppResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAppResponse -> CreateAppResponse -> Bool
$c/= :: CreateAppResponse -> CreateAppResponse -> Bool
== :: CreateAppResponse -> CreateAppResponse -> Bool
$c== :: CreateAppResponse -> CreateAppResponse -> Bool
Prelude.Eq, ReadPrec [CreateAppResponse]
ReadPrec CreateAppResponse
Int -> ReadS CreateAppResponse
ReadS [CreateAppResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAppResponse]
$creadListPrec :: ReadPrec [CreateAppResponse]
readPrec :: ReadPrec CreateAppResponse
$creadPrec :: ReadPrec CreateAppResponse
readList :: ReadS [CreateAppResponse]
$creadList :: ReadS [CreateAppResponse]
readsPrec :: Int -> ReadS CreateAppResponse
$creadsPrec :: Int -> ReadS CreateAppResponse
Prelude.Read, Int -> CreateAppResponse -> ShowS
[CreateAppResponse] -> ShowS
CreateAppResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAppResponse] -> ShowS
$cshowList :: [CreateAppResponse] -> ShowS
show :: CreateAppResponse -> String
$cshow :: CreateAppResponse -> String
showsPrec :: Int -> CreateAppResponse -> ShowS
$cshowsPrec :: Int -> CreateAppResponse -> ShowS
Prelude.Show, forall x. Rep CreateAppResponse x -> CreateAppResponse
forall x. CreateAppResponse -> Rep CreateAppResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAppResponse x -> CreateAppResponse
$cfrom :: forall x. CreateAppResponse -> Rep CreateAppResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAppResponse' 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', 'createAppResponse_appArn' - The Amazon Resource Name (ARN) of the app.
--
-- 'httpStatus', 'createAppResponse_httpStatus' - The response's http status code.
newCreateAppResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAppResponse
newCreateAppResponse :: Int -> CreateAppResponse
newCreateAppResponse Int
pHttpStatus_ =
  CreateAppResponse'
    { $sel:appArn:CreateAppResponse' :: Maybe Text
appArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAppResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData CreateAppResponse where
  rnf :: CreateAppResponse -> ()
rnf CreateAppResponse' {Int
Maybe Text
httpStatus :: Int
appArn :: Maybe Text
$sel:httpStatus:CreateAppResponse' :: CreateAppResponse -> Int
$sel:appArn:CreateAppResponse' :: CreateAppResponse -> 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 Int
httpStatus