{-# 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.ServerlessApplicationRepository.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 an application, optionally including an AWS SAM file to create
-- the first application version in the same call.
module Amazonka.ServerlessApplicationRepository.CreateApplication
  ( -- * Creating a Request
    CreateApplication (..),
    newCreateApplication,

    -- * Request Lenses
    createApplication_homePageUrl,
    createApplication_labels,
    createApplication_licenseBody,
    createApplication_licenseUrl,
    createApplication_readmeBody,
    createApplication_readmeUrl,
    createApplication_semanticVersion,
    createApplication_sourceCodeArchiveUrl,
    createApplication_sourceCodeUrl,
    createApplication_spdxLicenseId,
    createApplication_templateBody,
    createApplication_templateUrl,
    createApplication_description,
    createApplication_name,
    createApplication_author,

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

    -- * Response Lenses
    createApplicationResponse_applicationId,
    createApplicationResponse_author,
    createApplicationResponse_creationTime,
    createApplicationResponse_description,
    createApplicationResponse_homePageUrl,
    createApplicationResponse_isVerifiedAuthor,
    createApplicationResponse_labels,
    createApplicationResponse_licenseUrl,
    createApplicationResponse_name,
    createApplicationResponse_readmeUrl,
    createApplicationResponse_spdxLicenseId,
    createApplicationResponse_verifiedAuthorUrl,
    createApplicationResponse_version,
    createApplicationResponse_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.ServerlessApplicationRepository.Types

-- | /See:/ 'newCreateApplication' smart constructor.
data CreateApplication = CreateApplication'
  { -- | A URL with more information about the application, for example the
    -- location of your GitHub repository for the application.
    CreateApplication -> Maybe Text
homePageUrl :: Prelude.Maybe Prelude.Text,
    -- | Labels to improve discovery of apps in search results.
    --
    -- Minimum length=1. Maximum length=127. Maximum number of labels: 10
    --
    -- Pattern: \"^[a-zA-Z0-9+\\\\-_:\\\\\/\@]+$\";
    CreateApplication -> Maybe [Text]
labels :: Prelude.Maybe [Prelude.Text],
    -- | A local text file that contains the license of the app that matches the
    -- spdxLicenseID value of your application. The file has the format
    -- file:\/\/\<path>\/\<filename>.
    --
    -- Maximum size 5 MB
    --
    -- You can specify only one of licenseBody and licenseUrl; otherwise, an
    -- error results.
    CreateApplication -> Maybe Text
licenseBody :: Prelude.Maybe Prelude.Text,
    -- | A link to the S3 object that contains the license of the app that
    -- matches the spdxLicenseID value of your application.
    --
    -- Maximum size 5 MB
    --
    -- You can specify only one of licenseBody and licenseUrl; otherwise, an
    -- error results.
    CreateApplication -> Maybe Text
licenseUrl :: Prelude.Maybe Prelude.Text,
    -- | A local text readme file in Markdown language that contains a more
    -- detailed description of the application and how it works. The file has
    -- the format file:\/\/\<path>\/\<filename>.
    --
    -- Maximum size 5 MB
    --
    -- You can specify only one of readmeBody and readmeUrl; otherwise, an
    -- error results.
    CreateApplication -> Maybe Text
readmeBody :: Prelude.Maybe Prelude.Text,
    -- | A link to the S3 object in Markdown language that contains a more
    -- detailed description of the application and how it works.
    --
    -- Maximum size 5 MB
    --
    -- You can specify only one of readmeBody and readmeUrl; otherwise, an
    -- error results.
    CreateApplication -> Maybe Text
readmeUrl :: Prelude.Maybe Prelude.Text,
    -- | The semantic version of the application:
    --
    -- <https://semver.org/>
    CreateApplication -> Maybe Text
semanticVersion :: Prelude.Maybe Prelude.Text,
    -- | A link to the S3 object that contains the ZIP archive of the source code
    -- for this version of your application.
    --
    -- Maximum size 50 MB
    CreateApplication -> Maybe Text
sourceCodeArchiveUrl :: Prelude.Maybe Prelude.Text,
    -- | A link to a public repository for the source code of your application,
    -- for example the URL of a specific GitHub commit.
    CreateApplication -> Maybe Text
sourceCodeUrl :: Prelude.Maybe Prelude.Text,
    -- | A valid identifier from <https://spdx.org/licenses/>.
    CreateApplication -> Maybe Text
spdxLicenseId :: Prelude.Maybe Prelude.Text,
    -- | The local raw packaged AWS SAM template file of your application. The
    -- file has the format file:\/\/\<path>\/\<filename>.
    --
    -- You can specify only one of templateBody and templateUrl; otherwise an
    -- error results.
    CreateApplication -> Maybe Text
templateBody :: Prelude.Maybe Prelude.Text,
    -- | A link to the S3 object containing the packaged AWS SAM template of your
    -- application.
    --
    -- You can specify only one of templateBody and templateUrl; otherwise an
    -- error results.
    CreateApplication -> Maybe Text
templateUrl :: Prelude.Maybe Prelude.Text,
    -- | The description of the application.
    --
    -- Minimum length=1. Maximum length=256
    CreateApplication -> Text
description :: Prelude.Text,
    -- | The name of the application that you want to publish.
    --
    -- Minimum length=1. Maximum length=140
    --
    -- Pattern: \"[a-zA-Z0-9\\\\-]+\";
    CreateApplication -> Text
name :: Prelude.Text,
    -- | The name of the author publishing the app.
    --
    -- Minimum length=1. Maximum length=127.
    --
    -- Pattern \"^[a-z0-9](([a-z0-9]|-(?!-))*[a-z0-9])?$\";
    CreateApplication -> Text
author :: 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:
--
-- 'homePageUrl', 'createApplication_homePageUrl' - A URL with more information about the application, for example the
-- location of your GitHub repository for the application.
--
-- 'labels', 'createApplication_labels' - Labels to improve discovery of apps in search results.
--
-- Minimum length=1. Maximum length=127. Maximum number of labels: 10
--
-- Pattern: \"^[a-zA-Z0-9+\\\\-_:\\\\\/\@]+$\";
--
-- 'licenseBody', 'createApplication_licenseBody' - A local text file that contains the license of the app that matches the
-- spdxLicenseID value of your application. The file has the format
-- file:\/\/\<path>\/\<filename>.
--
-- Maximum size 5 MB
--
-- You can specify only one of licenseBody and licenseUrl; otherwise, an
-- error results.
--
-- 'licenseUrl', 'createApplication_licenseUrl' - A link to the S3 object that contains the license of the app that
-- matches the spdxLicenseID value of your application.
--
-- Maximum size 5 MB
--
-- You can specify only one of licenseBody and licenseUrl; otherwise, an
-- error results.
--
-- 'readmeBody', 'createApplication_readmeBody' - A local text readme file in Markdown language that contains a more
-- detailed description of the application and how it works. The file has
-- the format file:\/\/\<path>\/\<filename>.
--
-- Maximum size 5 MB
--
-- You can specify only one of readmeBody and readmeUrl; otherwise, an
-- error results.
--
-- 'readmeUrl', 'createApplication_readmeUrl' - A link to the S3 object in Markdown language that contains a more
-- detailed description of the application and how it works.
--
-- Maximum size 5 MB
--
-- You can specify only one of readmeBody and readmeUrl; otherwise, an
-- error results.
--
-- 'semanticVersion', 'createApplication_semanticVersion' - The semantic version of the application:
--
-- <https://semver.org/>
--
-- 'sourceCodeArchiveUrl', 'createApplication_sourceCodeArchiveUrl' - A link to the S3 object that contains the ZIP archive of the source code
-- for this version of your application.
--
-- Maximum size 50 MB
--
-- 'sourceCodeUrl', 'createApplication_sourceCodeUrl' - A link to a public repository for the source code of your application,
-- for example the URL of a specific GitHub commit.
--
-- 'spdxLicenseId', 'createApplication_spdxLicenseId' - A valid identifier from <https://spdx.org/licenses/>.
--
-- 'templateBody', 'createApplication_templateBody' - The local raw packaged AWS SAM template file of your application. The
-- file has the format file:\/\/\<path>\/\<filename>.
--
-- You can specify only one of templateBody and templateUrl; otherwise an
-- error results.
--
-- 'templateUrl', 'createApplication_templateUrl' - A link to the S3 object containing the packaged AWS SAM template of your
-- application.
--
-- You can specify only one of templateBody and templateUrl; otherwise an
-- error results.
--
-- 'description', 'createApplication_description' - The description of the application.
--
-- Minimum length=1. Maximum length=256
--
-- 'name', 'createApplication_name' - The name of the application that you want to publish.
--
-- Minimum length=1. Maximum length=140
--
-- Pattern: \"[a-zA-Z0-9\\\\-]+\";
--
-- 'author', 'createApplication_author' - The name of the author publishing the app.
--
-- Minimum length=1. Maximum length=127.
--
-- Pattern \"^[a-z0-9](([a-z0-9]|-(?!-))*[a-z0-9])?$\";
newCreateApplication ::
  -- | 'description'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'author'
  Prelude.Text ->
  CreateApplication
newCreateApplication :: Text -> Text -> Text -> CreateApplication
newCreateApplication Text
pDescription_ Text
pName_ Text
pAuthor_ =
  CreateApplication'
    { $sel:homePageUrl:CreateApplication' :: Maybe Text
homePageUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:labels:CreateApplication' :: Maybe [Text]
labels = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseBody:CreateApplication' :: Maybe Text
licenseBody = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseUrl:CreateApplication' :: Maybe Text
licenseUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:readmeBody:CreateApplication' :: Maybe Text
readmeBody = forall a. Maybe a
Prelude.Nothing,
      $sel:readmeUrl:CreateApplication' :: Maybe Text
readmeUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:semanticVersion:CreateApplication' :: Maybe Text
semanticVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceCodeArchiveUrl:CreateApplication' :: Maybe Text
sourceCodeArchiveUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceCodeUrl:CreateApplication' :: Maybe Text
sourceCodeUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:spdxLicenseId:CreateApplication' :: Maybe Text
spdxLicenseId = forall a. Maybe a
Prelude.Nothing,
      $sel:templateBody:CreateApplication' :: Maybe Text
templateBody = forall a. Maybe a
Prelude.Nothing,
      $sel:templateUrl:CreateApplication' :: Maybe Text
templateUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateApplication' :: Text
description = Text
pDescription_,
      $sel:name:CreateApplication' :: Text
name = Text
pName_,
      $sel:author:CreateApplication' :: Text
author = Text
pAuthor_
    }

-- | A URL with more information about the application, for example the
-- location of your GitHub repository for the application.
createApplication_homePageUrl :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_homePageUrl :: Lens' CreateApplication (Maybe Text)
createApplication_homePageUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
homePageUrl :: Maybe Text
$sel:homePageUrl:CreateApplication' :: CreateApplication -> Maybe Text
homePageUrl} -> Maybe Text
homePageUrl) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:homePageUrl:CreateApplication' :: Maybe Text
homePageUrl = Maybe Text
a} :: CreateApplication)

-- | Labels to improve discovery of apps in search results.
--
-- Minimum length=1. Maximum length=127. Maximum number of labels: 10
--
-- Pattern: \"^[a-zA-Z0-9+\\\\-_:\\\\\/\@]+$\";
createApplication_labels :: Lens.Lens' CreateApplication (Prelude.Maybe [Prelude.Text])
createApplication_labels :: Lens' CreateApplication (Maybe [Text])
createApplication_labels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe [Text]
labels :: Maybe [Text]
$sel:labels:CreateApplication' :: CreateApplication -> Maybe [Text]
labels} -> Maybe [Text]
labels) (\s :: CreateApplication
s@CreateApplication' {} Maybe [Text]
a -> CreateApplication
s {$sel:labels:CreateApplication' :: Maybe [Text]
labels = Maybe [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

-- | A local text file that contains the license of the app that matches the
-- spdxLicenseID value of your application. The file has the format
-- file:\/\/\<path>\/\<filename>.
--
-- Maximum size 5 MB
--
-- You can specify only one of licenseBody and licenseUrl; otherwise, an
-- error results.
createApplication_licenseBody :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_licenseBody :: Lens' CreateApplication (Maybe Text)
createApplication_licenseBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
licenseBody :: Maybe Text
$sel:licenseBody:CreateApplication' :: CreateApplication -> Maybe Text
licenseBody} -> Maybe Text
licenseBody) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:licenseBody:CreateApplication' :: Maybe Text
licenseBody = Maybe Text
a} :: CreateApplication)

-- | A link to the S3 object that contains the license of the app that
-- matches the spdxLicenseID value of your application.
--
-- Maximum size 5 MB
--
-- You can specify only one of licenseBody and licenseUrl; otherwise, an
-- error results.
createApplication_licenseUrl :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_licenseUrl :: Lens' CreateApplication (Maybe Text)
createApplication_licenseUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
licenseUrl :: Maybe Text
$sel:licenseUrl:CreateApplication' :: CreateApplication -> Maybe Text
licenseUrl} -> Maybe Text
licenseUrl) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:licenseUrl:CreateApplication' :: Maybe Text
licenseUrl = Maybe Text
a} :: CreateApplication)

-- | A local text readme file in Markdown language that contains a more
-- detailed description of the application and how it works. The file has
-- the format file:\/\/\<path>\/\<filename>.
--
-- Maximum size 5 MB
--
-- You can specify only one of readmeBody and readmeUrl; otherwise, an
-- error results.
createApplication_readmeBody :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_readmeBody :: Lens' CreateApplication (Maybe Text)
createApplication_readmeBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
readmeBody :: Maybe Text
$sel:readmeBody:CreateApplication' :: CreateApplication -> Maybe Text
readmeBody} -> Maybe Text
readmeBody) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:readmeBody:CreateApplication' :: Maybe Text
readmeBody = Maybe Text
a} :: CreateApplication)

-- | A link to the S3 object in Markdown language that contains a more
-- detailed description of the application and how it works.
--
-- Maximum size 5 MB
--
-- You can specify only one of readmeBody and readmeUrl; otherwise, an
-- error results.
createApplication_readmeUrl :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_readmeUrl :: Lens' CreateApplication (Maybe Text)
createApplication_readmeUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
readmeUrl :: Maybe Text
$sel:readmeUrl:CreateApplication' :: CreateApplication -> Maybe Text
readmeUrl} -> Maybe Text
readmeUrl) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:readmeUrl:CreateApplication' :: Maybe Text
readmeUrl = Maybe Text
a} :: CreateApplication)

-- | The semantic version of the application:
--
-- <https://semver.org/>
createApplication_semanticVersion :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_semanticVersion :: Lens' CreateApplication (Maybe Text)
createApplication_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
semanticVersion :: Maybe Text
$sel:semanticVersion:CreateApplication' :: CreateApplication -> Maybe Text
semanticVersion} -> Maybe Text
semanticVersion) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:semanticVersion:CreateApplication' :: Maybe Text
semanticVersion = Maybe Text
a} :: CreateApplication)

-- | A link to the S3 object that contains the ZIP archive of the source code
-- for this version of your application.
--
-- Maximum size 50 MB
createApplication_sourceCodeArchiveUrl :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_sourceCodeArchiveUrl :: Lens' CreateApplication (Maybe Text)
createApplication_sourceCodeArchiveUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
sourceCodeArchiveUrl :: Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplication' :: CreateApplication -> Maybe Text
sourceCodeArchiveUrl} -> Maybe Text
sourceCodeArchiveUrl) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:sourceCodeArchiveUrl:CreateApplication' :: Maybe Text
sourceCodeArchiveUrl = Maybe Text
a} :: CreateApplication)

-- | A link to a public repository for the source code of your application,
-- for example the URL of a specific GitHub commit.
createApplication_sourceCodeUrl :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_sourceCodeUrl :: Lens' CreateApplication (Maybe Text)
createApplication_sourceCodeUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
sourceCodeUrl :: Maybe Text
$sel:sourceCodeUrl:CreateApplication' :: CreateApplication -> Maybe Text
sourceCodeUrl} -> Maybe Text
sourceCodeUrl) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:sourceCodeUrl:CreateApplication' :: Maybe Text
sourceCodeUrl = Maybe Text
a} :: CreateApplication)

-- | A valid identifier from <https://spdx.org/licenses/>.
createApplication_spdxLicenseId :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_spdxLicenseId :: Lens' CreateApplication (Maybe Text)
createApplication_spdxLicenseId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
spdxLicenseId :: Maybe Text
$sel:spdxLicenseId:CreateApplication' :: CreateApplication -> Maybe Text
spdxLicenseId} -> Maybe Text
spdxLicenseId) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:spdxLicenseId:CreateApplication' :: Maybe Text
spdxLicenseId = Maybe Text
a} :: CreateApplication)

-- | The local raw packaged AWS SAM template file of your application. The
-- file has the format file:\/\/\<path>\/\<filename>.
--
-- You can specify only one of templateBody and templateUrl; otherwise an
-- error results.
createApplication_templateBody :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_templateBody :: Lens' CreateApplication (Maybe Text)
createApplication_templateBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
templateBody :: Maybe Text
$sel:templateBody:CreateApplication' :: CreateApplication -> Maybe Text
templateBody} -> Maybe Text
templateBody) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:templateBody:CreateApplication' :: Maybe Text
templateBody = Maybe Text
a} :: CreateApplication)

-- | A link to the S3 object containing the packaged AWS SAM template of your
-- application.
--
-- You can specify only one of templateBody and templateUrl; otherwise an
-- error results.
createApplication_templateUrl :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_templateUrl :: Lens' CreateApplication (Maybe Text)
createApplication_templateUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
templateUrl :: Maybe Text
$sel:templateUrl:CreateApplication' :: CreateApplication -> Maybe Text
templateUrl} -> Maybe Text
templateUrl) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:templateUrl:CreateApplication' :: Maybe Text
templateUrl = Maybe Text
a} :: CreateApplication)

-- | The description of the application.
--
-- Minimum length=1. Maximum length=256
createApplication_description :: Lens.Lens' CreateApplication Prelude.Text
createApplication_description :: Lens' CreateApplication Text
createApplication_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
description :: Text
$sel:description:CreateApplication' :: CreateApplication -> Text
description} -> Text
description) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:description:CreateApplication' :: Text
description = Text
a} :: CreateApplication)

-- | The name of the application that you want to publish.
--
-- Minimum length=1. Maximum length=140
--
-- Pattern: \"[a-zA-Z0-9\\\\-]+\";
createApplication_name :: Lens.Lens' CreateApplication Prelude.Text
createApplication_name :: Lens' CreateApplication Text
createApplication_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
name :: Text
$sel:name:CreateApplication' :: CreateApplication -> Text
name} -> Text
name) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:name:CreateApplication' :: Text
name = Text
a} :: CreateApplication)

-- | The name of the author publishing the app.
--
-- Minimum length=1. Maximum length=127.
--
-- Pattern \"^[a-z0-9](([a-z0-9]|-(?!-))*[a-z0-9])?$\";
createApplication_author :: Lens.Lens' CreateApplication Prelude.Text
createApplication_author :: Lens' CreateApplication Text
createApplication_author = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
author :: Text
$sel:author:CreateApplication' :: CreateApplication -> Text
author} -> Text
author) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:author:CreateApplication' :: Text
author = 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 ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Version
-> Int
-> CreateApplicationResponse
CreateApplicationResponse'
            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
"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 (Maybe a)
Data..?> Key
"author")
            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
"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
"homePageUrl")
            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
"isVerifiedAuthor")
            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
"labels" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"licenseUrl")
            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
"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 (Maybe a)
Data..?> Key
"readmeUrl")
            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
"spdxLicenseId")
            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
"verifiedAuthorUrl")
            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
"version")
            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 CreateApplication where
  hashWithSalt :: Int -> CreateApplication -> Int
hashWithSalt Int
_salt CreateApplication' {Maybe [Text]
Maybe Text
Text
author :: Text
name :: Text
description :: Text
templateUrl :: Maybe Text
templateBody :: Maybe Text
spdxLicenseId :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
semanticVersion :: Maybe Text
readmeUrl :: Maybe Text
readmeBody :: Maybe Text
licenseUrl :: Maybe Text
licenseBody :: Maybe Text
labels :: Maybe [Text]
homePageUrl :: Maybe Text
$sel:author:CreateApplication' :: CreateApplication -> Text
$sel:name:CreateApplication' :: CreateApplication -> Text
$sel:description:CreateApplication' :: CreateApplication -> Text
$sel:templateUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:templateBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:spdxLicenseId:CreateApplication' :: CreateApplication -> Maybe Text
$sel:sourceCodeUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:semanticVersion:CreateApplication' :: CreateApplication -> Maybe Text
$sel:readmeUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:readmeBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:licenseUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:licenseBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:labels:CreateApplication' :: CreateApplication -> Maybe [Text]
$sel:homePageUrl:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
homePageUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
labels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
licenseBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
licenseUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
readmeBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
readmeUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
semanticVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceCodeArchiveUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceCodeUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spdxLicenseId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
author

instance Prelude.NFData CreateApplication where
  rnf :: CreateApplication -> ()
rnf CreateApplication' {Maybe [Text]
Maybe Text
Text
author :: Text
name :: Text
description :: Text
templateUrl :: Maybe Text
templateBody :: Maybe Text
spdxLicenseId :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
semanticVersion :: Maybe Text
readmeUrl :: Maybe Text
readmeBody :: Maybe Text
licenseUrl :: Maybe Text
licenseBody :: Maybe Text
labels :: Maybe [Text]
homePageUrl :: Maybe Text
$sel:author:CreateApplication' :: CreateApplication -> Text
$sel:name:CreateApplication' :: CreateApplication -> Text
$sel:description:CreateApplication' :: CreateApplication -> Text
$sel:templateUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:templateBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:spdxLicenseId:CreateApplication' :: CreateApplication -> Maybe Text
$sel:sourceCodeUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:semanticVersion:CreateApplication' :: CreateApplication -> Maybe Text
$sel:readmeUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:readmeBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:licenseUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:licenseBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:labels:CreateApplication' :: CreateApplication -> Maybe [Text]
$sel:homePageUrl:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
homePageUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
labels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
licenseBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
licenseUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
readmeBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
readmeUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
semanticVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceCodeArchiveUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceCodeUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spdxLicenseId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      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 Text
author

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 Text
Text
author :: Text
name :: Text
description :: Text
templateUrl :: Maybe Text
templateBody :: Maybe Text
spdxLicenseId :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
semanticVersion :: Maybe Text
readmeUrl :: Maybe Text
readmeBody :: Maybe Text
licenseUrl :: Maybe Text
licenseBody :: Maybe Text
labels :: Maybe [Text]
homePageUrl :: Maybe Text
$sel:author:CreateApplication' :: CreateApplication -> Text
$sel:name:CreateApplication' :: CreateApplication -> Text
$sel:description:CreateApplication' :: CreateApplication -> Text
$sel:templateUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:templateBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:spdxLicenseId:CreateApplication' :: CreateApplication -> Maybe Text
$sel:sourceCodeUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:semanticVersion:CreateApplication' :: CreateApplication -> Maybe Text
$sel:readmeUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:readmeBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:licenseUrl:CreateApplication' :: CreateApplication -> Maybe Text
$sel:licenseBody:CreateApplication' :: CreateApplication -> Maybe Text
$sel:labels:CreateApplication' :: CreateApplication -> Maybe [Text]
$sel:homePageUrl:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"homePageUrl" 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
homePageUrl,
            (Key
"labels" 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]
labels,
            (Key
"licenseBody" 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
licenseBody,
            (Key
"licenseUrl" 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
licenseUrl,
            (Key
"readmeBody" 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
readmeBody,
            (Key
"readmeUrl" 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
readmeUrl,
            (Key
"semanticVersion" 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
semanticVersion,
            (Key
"sourceCodeArchiveUrl" 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
sourceCodeArchiveUrl,
            (Key
"sourceCodeUrl" 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
sourceCodeUrl,
            (Key
"spdxLicenseId" 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
spdxLicenseId,
            (Key
"templateBody" 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
templateBody,
            (Key
"templateUrl" 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
templateUrl,
            forall a. a -> Maybe a
Prelude.Just (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"author" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
author)
          ]
      )

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 application Amazon Resource Name (ARN).
    CreateApplicationResponse -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    -- | The name of the author publishing the app.
    --
    -- Minimum length=1. Maximum length=127.
    --
    -- Pattern \"^[a-z0-9](([a-z0-9]|-(?!-))*[a-z0-9])?$\";
    CreateApplicationResponse -> Maybe Text
author :: Prelude.Maybe Prelude.Text,
    -- | The date and time this resource was created.
    CreateApplicationResponse -> Maybe Text
creationTime :: Prelude.Maybe Prelude.Text,
    -- | The description of the application.
    --
    -- Minimum length=1. Maximum length=256
    CreateApplicationResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A URL with more information about the application, for example the
    -- location of your GitHub repository for the application.
    CreateApplicationResponse -> Maybe Text
homePageUrl :: Prelude.Maybe Prelude.Text,
    -- | Whether the author of this application has been verified. This means
    -- means that AWS has made a good faith review, as a reasonable and prudent
    -- service provider, of the information provided by the requester and has
    -- confirmed that the requester\'s identity is as claimed.
    CreateApplicationResponse -> Maybe Bool
isVerifiedAuthor :: Prelude.Maybe Prelude.Bool,
    -- | Labels to improve discovery of apps in search results.
    --
    -- Minimum length=1. Maximum length=127. Maximum number of labels: 10
    --
    -- Pattern: \"^[a-zA-Z0-9+\\\\-_:\\\\\/\@]+$\";
    CreateApplicationResponse -> Maybe [Text]
labels :: Prelude.Maybe [Prelude.Text],
    -- | A link to a license file of the app that matches the spdxLicenseID value
    -- of your application.
    --
    -- Maximum size 5 MB
    CreateApplicationResponse -> Maybe Text
licenseUrl :: Prelude.Maybe Prelude.Text,
    -- | The name of the application.
    --
    -- Minimum length=1. Maximum length=140
    --
    -- Pattern: \"[a-zA-Z0-9\\\\-]+\";
    CreateApplicationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A link to the readme file in Markdown language that contains a more
    -- detailed description of the application and how it works.
    --
    -- Maximum size 5 MB
    CreateApplicationResponse -> Maybe Text
readmeUrl :: Prelude.Maybe Prelude.Text,
    -- | A valid identifier from https:\/\/spdx.org\/licenses\/.
    CreateApplicationResponse -> Maybe Text
spdxLicenseId :: Prelude.Maybe Prelude.Text,
    -- | The URL to the public profile of a verified author. This URL is
    -- submitted by the author.
    CreateApplicationResponse -> Maybe Text
verifiedAuthorUrl :: Prelude.Maybe Prelude.Text,
    -- | Version information about the application.
    CreateApplicationResponse -> Maybe Version
version :: Prelude.Maybe Version,
    -- | The response's http status code.
    CreateApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  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:
--
-- 'applicationId', 'createApplicationResponse_applicationId' - The application Amazon Resource Name (ARN).
--
-- 'author', 'createApplicationResponse_author' - The name of the author publishing the app.
--
-- Minimum length=1. Maximum length=127.
--
-- Pattern \"^[a-z0-9](([a-z0-9]|-(?!-))*[a-z0-9])?$\";
--
-- 'creationTime', 'createApplicationResponse_creationTime' - The date and time this resource was created.
--
-- 'description', 'createApplicationResponse_description' - The description of the application.
--
-- Minimum length=1. Maximum length=256
--
-- 'homePageUrl', 'createApplicationResponse_homePageUrl' - A URL with more information about the application, for example the
-- location of your GitHub repository for the application.
--
-- 'isVerifiedAuthor', 'createApplicationResponse_isVerifiedAuthor' - Whether the author of this application has been verified. This means
-- means that AWS has made a good faith review, as a reasonable and prudent
-- service provider, of the information provided by the requester and has
-- confirmed that the requester\'s identity is as claimed.
--
-- 'labels', 'createApplicationResponse_labels' - Labels to improve discovery of apps in search results.
--
-- Minimum length=1. Maximum length=127. Maximum number of labels: 10
--
-- Pattern: \"^[a-zA-Z0-9+\\\\-_:\\\\\/\@]+$\";
--
-- 'licenseUrl', 'createApplicationResponse_licenseUrl' - A link to a license file of the app that matches the spdxLicenseID value
-- of your application.
--
-- Maximum size 5 MB
--
-- 'name', 'createApplicationResponse_name' - The name of the application.
--
-- Minimum length=1. Maximum length=140
--
-- Pattern: \"[a-zA-Z0-9\\\\-]+\";
--
-- 'readmeUrl', 'createApplicationResponse_readmeUrl' - A link to the readme file in Markdown language that contains a more
-- detailed description of the application and how it works.
--
-- Maximum size 5 MB
--
-- 'spdxLicenseId', 'createApplicationResponse_spdxLicenseId' - A valid identifier from https:\/\/spdx.org\/licenses\/.
--
-- 'verifiedAuthorUrl', 'createApplicationResponse_verifiedAuthorUrl' - The URL to the public profile of a verified author. This URL is
-- submitted by the author.
--
-- 'version', 'createApplicationResponse_version' - Version information about the application.
--
-- 'httpStatus', 'createApplicationResponse_httpStatus' - The response's http status code.
newCreateApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateApplicationResponse
newCreateApplicationResponse :: Int -> CreateApplicationResponse
newCreateApplicationResponse Int
pHttpStatus_ =
  CreateApplicationResponse'
    { $sel:applicationId:CreateApplicationResponse' :: Maybe Text
applicationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:author:CreateApplicationResponse' :: Maybe Text
author = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:CreateApplicationResponse' :: Maybe Text
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateApplicationResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:homePageUrl:CreateApplicationResponse' :: Maybe Text
homePageUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:isVerifiedAuthor:CreateApplicationResponse' :: Maybe Bool
isVerifiedAuthor = forall a. Maybe a
Prelude.Nothing,
      $sel:labels:CreateApplicationResponse' :: Maybe [Text]
labels = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseUrl:CreateApplicationResponse' :: Maybe Text
licenseUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateApplicationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:readmeUrl:CreateApplicationResponse' :: Maybe Text
readmeUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:spdxLicenseId:CreateApplicationResponse' :: Maybe Text
spdxLicenseId = forall a. Maybe a
Prelude.Nothing,
      $sel:verifiedAuthorUrl:CreateApplicationResponse' :: Maybe Text
verifiedAuthorUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:version:CreateApplicationResponse' :: Maybe Version
version = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The application Amazon Resource Name (ARN).
createApplicationResponse_applicationId :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_applicationId :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:applicationId:CreateApplicationResponse' :: Maybe Text
applicationId = Maybe Text
a} :: CreateApplicationResponse)

-- | The name of the author publishing the app.
--
-- Minimum length=1. Maximum length=127.
--
-- Pattern \"^[a-z0-9](([a-z0-9]|-(?!-))*[a-z0-9])?$\";
createApplicationResponse_author :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_author :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_author = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
author :: Maybe Text
$sel:author:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
author} -> Maybe Text
author) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:author:CreateApplicationResponse' :: Maybe Text
author = Maybe Text
a} :: CreateApplicationResponse)

-- | The date and time this resource was created.
createApplicationResponse_creationTime :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_creationTime :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
creationTime :: Maybe Text
$sel:creationTime:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
creationTime} -> Maybe Text
creationTime) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:creationTime:CreateApplicationResponse' :: Maybe Text
creationTime = Maybe Text
a} :: CreateApplicationResponse)

-- | The description of the application.
--
-- Minimum length=1. Maximum length=256
createApplicationResponse_description :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_description :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:description:CreateApplicationResponse' :: Maybe Text
description = Maybe Text
a} :: CreateApplicationResponse)

-- | A URL with more information about the application, for example the
-- location of your GitHub repository for the application.
createApplicationResponse_homePageUrl :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_homePageUrl :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_homePageUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
homePageUrl :: Maybe Text
$sel:homePageUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
homePageUrl} -> Maybe Text
homePageUrl) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:homePageUrl:CreateApplicationResponse' :: Maybe Text
homePageUrl = Maybe Text
a} :: CreateApplicationResponse)

-- | Whether the author of this application has been verified. This means
-- means that AWS has made a good faith review, as a reasonable and prudent
-- service provider, of the information provided by the requester and has
-- confirmed that the requester\'s identity is as claimed.
createApplicationResponse_isVerifiedAuthor :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Bool)
createApplicationResponse_isVerifiedAuthor :: Lens' CreateApplicationResponse (Maybe Bool)
createApplicationResponse_isVerifiedAuthor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Bool
isVerifiedAuthor :: Maybe Bool
$sel:isVerifiedAuthor:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Bool
isVerifiedAuthor} -> Maybe Bool
isVerifiedAuthor) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Bool
a -> CreateApplicationResponse
s {$sel:isVerifiedAuthor:CreateApplicationResponse' :: Maybe Bool
isVerifiedAuthor = Maybe Bool
a} :: CreateApplicationResponse)

-- | Labels to improve discovery of apps in search results.
--
-- Minimum length=1. Maximum length=127. Maximum number of labels: 10
--
-- Pattern: \"^[a-zA-Z0-9+\\\\-_:\\\\\/\@]+$\";
createApplicationResponse_labels :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe [Prelude.Text])
createApplicationResponse_labels :: Lens' CreateApplicationResponse (Maybe [Text])
createApplicationResponse_labels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe [Text]
labels :: Maybe [Text]
$sel:labels:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe [Text]
labels} -> Maybe [Text]
labels) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe [Text]
a -> CreateApplicationResponse
s {$sel:labels:CreateApplicationResponse' :: Maybe [Text]
labels = Maybe [Text]
a} :: CreateApplicationResponse) 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

-- | A link to a license file of the app that matches the spdxLicenseID value
-- of your application.
--
-- Maximum size 5 MB
createApplicationResponse_licenseUrl :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_licenseUrl :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_licenseUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
licenseUrl :: Maybe Text
$sel:licenseUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
licenseUrl} -> Maybe Text
licenseUrl) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:licenseUrl:CreateApplicationResponse' :: Maybe Text
licenseUrl = Maybe Text
a} :: CreateApplicationResponse)

-- | The name of the application.
--
-- Minimum length=1. Maximum length=140
--
-- Pattern: \"[a-zA-Z0-9\\\\-]+\";
createApplicationResponse_name :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_name :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:name:CreateApplicationResponse' :: Maybe Text
name = Maybe Text
a} :: CreateApplicationResponse)

-- | A link to the readme file in Markdown language that contains a more
-- detailed description of the application and how it works.
--
-- Maximum size 5 MB
createApplicationResponse_readmeUrl :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_readmeUrl :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_readmeUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
readmeUrl :: Maybe Text
$sel:readmeUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
readmeUrl} -> Maybe Text
readmeUrl) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:readmeUrl:CreateApplicationResponse' :: Maybe Text
readmeUrl = Maybe Text
a} :: CreateApplicationResponse)

-- | A valid identifier from https:\/\/spdx.org\/licenses\/.
createApplicationResponse_spdxLicenseId :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_spdxLicenseId :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_spdxLicenseId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
spdxLicenseId :: Maybe Text
$sel:spdxLicenseId:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
spdxLicenseId} -> Maybe Text
spdxLicenseId) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:spdxLicenseId:CreateApplicationResponse' :: Maybe Text
spdxLicenseId = Maybe Text
a} :: CreateApplicationResponse)

-- | The URL to the public profile of a verified author. This URL is
-- submitted by the author.
createApplicationResponse_verifiedAuthorUrl :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_verifiedAuthorUrl :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_verifiedAuthorUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
verifiedAuthorUrl :: Maybe Text
$sel:verifiedAuthorUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
verifiedAuthorUrl} -> Maybe Text
verifiedAuthorUrl) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:verifiedAuthorUrl:CreateApplicationResponse' :: Maybe Text
verifiedAuthorUrl = Maybe Text
a} :: CreateApplicationResponse)

-- | Version information about the application.
createApplicationResponse_version :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Version)
createApplicationResponse_version :: Lens' CreateApplicationResponse (Maybe Version)
createApplicationResponse_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Version
version :: Maybe Version
$sel:version:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Version
version} -> Maybe Version
version) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Version
a -> CreateApplicationResponse
s {$sel:version:CreateApplicationResponse' :: Maybe Version
version = Maybe Version
a} :: CreateApplicationResponse)

-- | 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)

instance Prelude.NFData CreateApplicationResponse where
  rnf :: CreateApplicationResponse -> ()
rnf CreateApplicationResponse' {Int
Maybe Bool
Maybe [Text]
Maybe Text
Maybe Version
httpStatus :: Int
version :: Maybe Version
verifiedAuthorUrl :: Maybe Text
spdxLicenseId :: Maybe Text
readmeUrl :: Maybe Text
name :: Maybe Text
licenseUrl :: Maybe Text
labels :: Maybe [Text]
isVerifiedAuthor :: Maybe Bool
homePageUrl :: Maybe Text
description :: Maybe Text
creationTime :: Maybe Text
author :: Maybe Text
applicationId :: Maybe Text
$sel:httpStatus:CreateApplicationResponse' :: CreateApplicationResponse -> Int
$sel:version:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Version
$sel:verifiedAuthorUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:spdxLicenseId:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:readmeUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:name:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:licenseUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:labels:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe [Text]
$sel:isVerifiedAuthor:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Bool
$sel:homePageUrl:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:description:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:creationTime:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:author:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
$sel:applicationId:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
author
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
homePageUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isVerifiedAuthor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
labels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
licenseUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
readmeUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spdxLicenseId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
verifiedAuthorUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Version
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus