{-# 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.IoTFleetHub.CreateApplication
-- 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 Fleet Hub for AWS IoT Device Management web application.
--
-- Fleet Hub for AWS IoT Device Management is in public preview and is
-- subject to change.
module Amazonka.IoTFleetHub.CreateApplication
  ( -- * Creating a Request
    CreateApplication (..),
    newCreateApplication,

    -- * Request Lenses
    createApplication_applicationDescription,
    createApplication_clientToken,
    createApplication_tags,
    createApplication_applicationName,
    createApplication_roleArn,

    -- * Destructuring the Response
    CreateApplicationResponse (..),
    newCreateApplicationResponse,

    -- * Response Lenses
    createApplicationResponse_httpStatus,
    createApplicationResponse_applicationId,
    createApplicationResponse_applicationArn,
  )
where

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

-- | /See:/ 'newCreateApplication' smart constructor.
data CreateApplication = CreateApplication'
  { -- | An optional description of the web application.
    CreateApplication -> Maybe Text
applicationDescription :: Prelude.Maybe Prelude.Text,
    -- | A unique case-sensitive identifier that you can provide to ensure the
    -- idempotency of the request. Don\'t reuse this client token if a new
    -- idempotent request is required.
    CreateApplication -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A set of key\/value pairs that you can use to manage the web application
    -- resource.
    CreateApplication -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the web application.
    CreateApplication -> Text
applicationName :: Prelude.Text,
    -- | The ARN of the role that the web application assumes when it interacts
    -- with AWS IoT Core.
    --
    -- The name of the role must be in the form
    -- @AWSIotFleetHub_@/@random_string@/@ @.
    CreateApplication -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateApplication -> CreateApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplication -> CreateApplication -> Bool
$c/= :: CreateApplication -> CreateApplication -> Bool
== :: CreateApplication -> CreateApplication -> Bool
$c== :: CreateApplication -> CreateApplication -> Bool
Prelude.Eq, ReadPrec [CreateApplication]
ReadPrec CreateApplication
Int -> ReadS CreateApplication
ReadS [CreateApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplication]
$creadListPrec :: ReadPrec [CreateApplication]
readPrec :: ReadPrec CreateApplication
$creadPrec :: ReadPrec CreateApplication
readList :: ReadS [CreateApplication]
$creadList :: ReadS [CreateApplication]
readsPrec :: Int -> ReadS CreateApplication
$creadsPrec :: Int -> ReadS CreateApplication
Prelude.Read, Int -> CreateApplication -> ShowS
[CreateApplication] -> ShowS
CreateApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplication] -> ShowS
$cshowList :: [CreateApplication] -> ShowS
show :: CreateApplication -> String
$cshow :: CreateApplication -> String
showsPrec :: Int -> CreateApplication -> ShowS
$cshowsPrec :: Int -> CreateApplication -> ShowS
Prelude.Show, forall x. Rep CreateApplication x -> CreateApplication
forall x. CreateApplication -> Rep CreateApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApplication x -> CreateApplication
$cfrom :: forall x. CreateApplication -> Rep CreateApplication x
Prelude.Generic)

-- |
-- Create a value of 'CreateApplication' 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:
--
-- 'applicationDescription', 'createApplication_applicationDescription' - An optional description of the web application.
--
-- 'clientToken', 'createApplication_clientToken' - A unique case-sensitive identifier that you can provide to ensure the
-- idempotency of the request. Don\'t reuse this client token if a new
-- idempotent request is required.
--
-- 'tags', 'createApplication_tags' - A set of key\/value pairs that you can use to manage the web application
-- resource.
--
-- 'applicationName', 'createApplication_applicationName' - The name of the web application.
--
-- 'roleArn', 'createApplication_roleArn' - The ARN of the role that the web application assumes when it interacts
-- with AWS IoT Core.
--
-- The name of the role must be in the form
-- @AWSIotFleetHub_@/@random_string@/@ @.
newCreateApplication ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateApplication
newCreateApplication :: Text -> Text -> CreateApplication
newCreateApplication Text
pApplicationName_ Text
pRoleArn_ =
  CreateApplication'
    { $sel:applicationDescription:CreateApplication' :: Maybe Text
applicationDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateApplication' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateApplication' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationName:CreateApplication' :: Text
applicationName = Text
pApplicationName_,
      $sel:roleArn:CreateApplication' :: Text
roleArn = Text
pRoleArn_
    }

-- | An optional description of the web application.
createApplication_applicationDescription :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_applicationDescription :: Lens' CreateApplication (Maybe Text)
createApplication_applicationDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
applicationDescription :: Maybe Text
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
applicationDescription} -> Maybe Text
applicationDescription) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:applicationDescription:CreateApplication' :: Maybe Text
applicationDescription = Maybe Text
a} :: CreateApplication)

-- | A unique case-sensitive identifier that you can provide to ensure the
-- idempotency of the request. Don\'t reuse this client token if a new
-- idempotent request is required.
createApplication_clientToken :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_clientToken :: Lens' CreateApplication (Maybe Text)
createApplication_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateApplication' :: CreateApplication -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:clientToken:CreateApplication' :: Maybe Text
clientToken = Maybe Text
a} :: CreateApplication)

-- | A set of key\/value pairs that you can use to manage the web application
-- resource.
createApplication_tags :: Lens.Lens' CreateApplication (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createApplication_tags :: Lens' CreateApplication (Maybe (HashMap Text Text))
createApplication_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateApplication
s@CreateApplication' {} Maybe (HashMap Text Text)
a -> CreateApplication
s {$sel:tags:CreateApplication' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateApplication) 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 name of the web application.
createApplication_applicationName :: Lens.Lens' CreateApplication Prelude.Text
createApplication_applicationName :: Lens' CreateApplication Text
createApplication_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
applicationName :: Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
applicationName} -> Text
applicationName) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:applicationName:CreateApplication' :: Text
applicationName = Text
a} :: CreateApplication)

-- | The ARN of the role that the web application assumes when it interacts
-- with AWS IoT Core.
--
-- The name of the role must be in the form
-- @AWSIotFleetHub_@/@random_string@/@ @.
createApplication_roleArn :: Lens.Lens' CreateApplication Prelude.Text
createApplication_roleArn :: Lens' CreateApplication Text
createApplication_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
roleArn :: Text
$sel:roleArn:CreateApplication' :: CreateApplication -> Text
roleArn} -> Text
roleArn) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:roleArn:CreateApplication' :: Text
roleArn = Text
a} :: CreateApplication)

instance Core.AWSRequest CreateApplication where
  type
    AWSResponse CreateApplication =
      CreateApplicationResponse
  request :: (Service -> Service)
-> CreateApplication -> Request CreateApplication
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 CreateApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateApplication)))
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 ->
          Int -> Text -> Text -> CreateApplicationResponse
CreateApplicationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"applicationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"applicationArn")
      )

instance Prelude.Hashable CreateApplication where
  hashWithSalt :: Int -> CreateApplication -> Int
hashWithSalt Int
_salt CreateApplication' {Maybe Text
Maybe (HashMap Text Text)
Text
roleArn :: Text
applicationName :: Text
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
applicationDescription :: Maybe Text
$sel:roleArn:CreateApplication' :: CreateApplication -> Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
$sel:clientToken:CreateApplication' :: CreateApplication -> Maybe Text
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateApplication where
  rnf :: CreateApplication -> ()
rnf CreateApplication' {Maybe Text
Maybe (HashMap Text Text)
Text
roleArn :: Text
applicationName :: Text
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
applicationDescription :: Maybe Text
$sel:roleArn:CreateApplication' :: CreateApplication -> Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
$sel:clientToken:CreateApplication' :: CreateApplication -> Maybe Text
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders CreateApplication where
  toHeaders :: CreateApplication -> 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.ToJSON CreateApplication where
  toJSON :: CreateApplication -> Value
toJSON CreateApplication' {Maybe Text
Maybe (HashMap Text Text)
Text
roleArn :: Text
applicationName :: Text
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
applicationDescription :: Maybe Text
$sel:roleArn:CreateApplication' :: CreateApplication -> Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
$sel:clientToken:CreateApplication' :: CreateApplication -> Maybe Text
$sel:applicationDescription:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"applicationDescription" 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
applicationDescription,
            (Key
"clientToken" 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
clientToken,
            (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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"applicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName),
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateApplicationResponse' 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:
--
-- 'httpStatus', 'createApplicationResponse_httpStatus' - The response's http status code.
--
-- 'applicationId', 'createApplicationResponse_applicationId' - The unique Id of the web application.
--
-- 'applicationArn', 'createApplicationResponse_applicationArn' - The ARN of the web application.
newCreateApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'applicationArn'
  Prelude.Text ->
  CreateApplicationResponse
newCreateApplicationResponse :: Int -> Text -> Text -> CreateApplicationResponse
newCreateApplicationResponse
  Int
pHttpStatus_
  Text
pApplicationId_
  Text
pApplicationArn_ =
    CreateApplicationResponse'
      { $sel:httpStatus:CreateApplicationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:applicationId:CreateApplicationResponse' :: Text
applicationId = Text
pApplicationId_,
        $sel:applicationArn:CreateApplicationResponse' :: Text
applicationArn = Text
pApplicationArn_
      }

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

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

-- | The ARN of the web application.
createApplicationResponse_applicationArn :: Lens.Lens' CreateApplicationResponse Prelude.Text
createApplicationResponse_applicationArn :: Lens' CreateApplicationResponse Text
createApplicationResponse_applicationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Text
applicationArn :: Text
$sel:applicationArn:CreateApplicationResponse' :: CreateApplicationResponse -> Text
applicationArn} -> Text
applicationArn) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Text
a -> CreateApplicationResponse
s {$sel:applicationArn:CreateApplicationResponse' :: Text
applicationArn = Text
a} :: CreateApplicationResponse)

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