{-# 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.GetApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the specified application.
module Amazonka.ServerlessApplicationRepository.GetApplication
  ( -- * Creating a Request
    GetApplication (..),
    newGetApplication,

    -- * Request Lenses
    getApplication_semanticVersion,
    getApplication_applicationId,

    -- * Destructuring the Response
    GetApplicationResponse (..),
    newGetApplicationResponse,

    -- * Response Lenses
    getApplicationResponse_applicationId,
    getApplicationResponse_author,
    getApplicationResponse_creationTime,
    getApplicationResponse_description,
    getApplicationResponse_homePageUrl,
    getApplicationResponse_isVerifiedAuthor,
    getApplicationResponse_labels,
    getApplicationResponse_licenseUrl,
    getApplicationResponse_name,
    getApplicationResponse_readmeUrl,
    getApplicationResponse_spdxLicenseId,
    getApplicationResponse_verifiedAuthorUrl,
    getApplicationResponse_version,
    getApplicationResponse_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:/ 'newGetApplication' smart constructor.
data GetApplication = GetApplication'
  { -- | The semantic version of the application to get.
    GetApplication -> Maybe Text
semanticVersion :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the application.
    GetApplication -> Text
applicationId :: Prelude.Text
  }
  deriving (GetApplication -> GetApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplication -> GetApplication -> Bool
$c/= :: GetApplication -> GetApplication -> Bool
== :: GetApplication -> GetApplication -> Bool
$c== :: GetApplication -> GetApplication -> Bool
Prelude.Eq, ReadPrec [GetApplication]
ReadPrec GetApplication
Int -> ReadS GetApplication
ReadS [GetApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplication]
$creadListPrec :: ReadPrec [GetApplication]
readPrec :: ReadPrec GetApplication
$creadPrec :: ReadPrec GetApplication
readList :: ReadS [GetApplication]
$creadList :: ReadS [GetApplication]
readsPrec :: Int -> ReadS GetApplication
$creadsPrec :: Int -> ReadS GetApplication
Prelude.Read, Int -> GetApplication -> ShowS
[GetApplication] -> ShowS
GetApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplication] -> ShowS
$cshowList :: [GetApplication] -> ShowS
show :: GetApplication -> String
$cshow :: GetApplication -> String
showsPrec :: Int -> GetApplication -> ShowS
$cshowsPrec :: Int -> GetApplication -> ShowS
Prelude.Show, forall x. Rep GetApplication x -> GetApplication
forall x. GetApplication -> Rep GetApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplication x -> GetApplication
$cfrom :: forall x. GetApplication -> Rep GetApplication x
Prelude.Generic)

-- |
-- Create a value of 'GetApplication' 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:
--
-- 'semanticVersion', 'getApplication_semanticVersion' - The semantic version of the application to get.
--
-- 'applicationId', 'getApplication_applicationId' - The Amazon Resource Name (ARN) of the application.
newGetApplication ::
  -- | 'applicationId'
  Prelude.Text ->
  GetApplication
newGetApplication :: Text -> GetApplication
newGetApplication Text
pApplicationId_ =
  GetApplication'
    { $sel:semanticVersion:GetApplication' :: Maybe Text
semanticVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationId:GetApplication' :: Text
applicationId = Text
pApplicationId_
    }

-- | The semantic version of the application to get.
getApplication_semanticVersion :: Lens.Lens' GetApplication (Prelude.Maybe Prelude.Text)
getApplication_semanticVersion :: Lens' GetApplication (Maybe Text)
getApplication_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplication' {Maybe Text
semanticVersion :: Maybe Text
$sel:semanticVersion:GetApplication' :: GetApplication -> Maybe Text
semanticVersion} -> Maybe Text
semanticVersion) (\s :: GetApplication
s@GetApplication' {} Maybe Text
a -> GetApplication
s {$sel:semanticVersion:GetApplication' :: Maybe Text
semanticVersion = Maybe Text
a} :: GetApplication)

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

instance Core.AWSRequest GetApplication where
  type
    AWSResponse GetApplication =
      GetApplicationResponse
  request :: (Service -> Service) -> GetApplication -> Request GetApplication
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetApplication
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetApplication)))
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
-> GetApplicationResponse
GetApplicationResponse'
            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 GetApplication where
  hashWithSalt :: Int -> GetApplication -> Int
hashWithSalt Int
_salt GetApplication' {Maybe Text
Text
applicationId :: Text
semanticVersion :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Text
$sel:semanticVersion:GetApplication' :: GetApplication -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
semanticVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId

instance Prelude.NFData GetApplication where
  rnf :: GetApplication -> ()
rnf GetApplication' {Maybe Text
Text
applicationId :: Text
semanticVersion :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Text
$sel:semanticVersion:GetApplication' :: GetApplication -> Maybe Text
..} =
    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 Text
applicationId

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

instance Data.ToPath GetApplication where
  toPath :: GetApplication -> ByteString
toPath GetApplication' {Maybe Text
Text
applicationId :: Text
semanticVersion :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Text
$sel:semanticVersion:GetApplication' :: GetApplication -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/applications/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId]

instance Data.ToQuery GetApplication where
  toQuery :: GetApplication -> QueryString
toQuery GetApplication' {Maybe Text
Text
applicationId :: Text
semanticVersion :: Maybe Text
$sel:applicationId:GetApplication' :: GetApplication -> Text
$sel:semanticVersion:GetApplication' :: GetApplication -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"semanticVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
semanticVersion]

-- | /See:/ 'newGetApplicationResponse' smart constructor.
data GetApplicationResponse = GetApplicationResponse'
  { -- | The application Amazon Resource Name (ARN).
    GetApplicationResponse -> 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])?$\";
    GetApplicationResponse -> Maybe Text
author :: Prelude.Maybe Prelude.Text,
    -- | The date and time this resource was created.
    GetApplicationResponse -> Maybe Text
creationTime :: Prelude.Maybe Prelude.Text,
    -- | The description of the application.
    --
    -- Minimum length=1. Maximum length=256
    GetApplicationResponse -> 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.
    GetApplicationResponse -> 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.
    GetApplicationResponse -> 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+\\\\-_:\\\\\/\@]+$\";
    GetApplicationResponse -> 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
    GetApplicationResponse -> Maybe Text
licenseUrl :: Prelude.Maybe Prelude.Text,
    -- | The name of the application.
    --
    -- Minimum length=1. Maximum length=140
    --
    -- Pattern: \"[a-zA-Z0-9\\\\-]+\";
    GetApplicationResponse -> 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
    GetApplicationResponse -> Maybe Text
readmeUrl :: Prelude.Maybe Prelude.Text,
    -- | A valid identifier from https:\/\/spdx.org\/licenses\/.
    GetApplicationResponse -> Maybe Text
spdxLicenseId :: Prelude.Maybe Prelude.Text,
    -- | The URL to the public profile of a verified author. This URL is
    -- submitted by the author.
    GetApplicationResponse -> Maybe Text
verifiedAuthorUrl :: Prelude.Maybe Prelude.Text,
    -- | Version information about the application.
    GetApplicationResponse -> Maybe Version
version :: Prelude.Maybe Version,
    -- | The response's http status code.
    GetApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetApplicationResponse -> GetApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplicationResponse -> GetApplicationResponse -> Bool
$c/= :: GetApplicationResponse -> GetApplicationResponse -> Bool
== :: GetApplicationResponse -> GetApplicationResponse -> Bool
$c== :: GetApplicationResponse -> GetApplicationResponse -> Bool
Prelude.Eq, ReadPrec [GetApplicationResponse]
ReadPrec GetApplicationResponse
Int -> ReadS GetApplicationResponse
ReadS [GetApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplicationResponse]
$creadListPrec :: ReadPrec [GetApplicationResponse]
readPrec :: ReadPrec GetApplicationResponse
$creadPrec :: ReadPrec GetApplicationResponse
readList :: ReadS [GetApplicationResponse]
$creadList :: ReadS [GetApplicationResponse]
readsPrec :: Int -> ReadS GetApplicationResponse
$creadsPrec :: Int -> ReadS GetApplicationResponse
Prelude.Read, Int -> GetApplicationResponse -> ShowS
[GetApplicationResponse] -> ShowS
GetApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplicationResponse] -> ShowS
$cshowList :: [GetApplicationResponse] -> ShowS
show :: GetApplicationResponse -> String
$cshow :: GetApplicationResponse -> String
showsPrec :: Int -> GetApplicationResponse -> ShowS
$cshowsPrec :: Int -> GetApplicationResponse -> ShowS
Prelude.Show, forall x. Rep GetApplicationResponse x -> GetApplicationResponse
forall x. GetApplicationResponse -> Rep GetApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplicationResponse x -> GetApplicationResponse
$cfrom :: forall x. GetApplicationResponse -> Rep GetApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetApplicationResponse' 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', 'getApplicationResponse_applicationId' - The application Amazon Resource Name (ARN).
--
-- 'author', 'getApplicationResponse_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', 'getApplicationResponse_creationTime' - The date and time this resource was created.
--
-- 'description', 'getApplicationResponse_description' - The description of the application.
--
-- Minimum length=1. Maximum length=256
--
-- 'homePageUrl', 'getApplicationResponse_homePageUrl' - A URL with more information about the application, for example the
-- location of your GitHub repository for the application.
--
-- 'isVerifiedAuthor', 'getApplicationResponse_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', 'getApplicationResponse_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', 'getApplicationResponse_licenseUrl' - A link to a license file of the app that matches the spdxLicenseID value
-- of your application.
--
-- Maximum size 5 MB
--
-- 'name', 'getApplicationResponse_name' - The name of the application.
--
-- Minimum length=1. Maximum length=140
--
-- Pattern: \"[a-zA-Z0-9\\\\-]+\";
--
-- 'readmeUrl', 'getApplicationResponse_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', 'getApplicationResponse_spdxLicenseId' - A valid identifier from https:\/\/spdx.org\/licenses\/.
--
-- 'verifiedAuthorUrl', 'getApplicationResponse_verifiedAuthorUrl' - The URL to the public profile of a verified author. This URL is
-- submitted by the author.
--
-- 'version', 'getApplicationResponse_version' - Version information about the application.
--
-- 'httpStatus', 'getApplicationResponse_httpStatus' - The response's http status code.
newGetApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetApplicationResponse
newGetApplicationResponse :: Int -> GetApplicationResponse
newGetApplicationResponse Int
pHttpStatus_ =
  GetApplicationResponse'
    { $sel:applicationId:GetApplicationResponse' :: Maybe Text
applicationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:author:GetApplicationResponse' :: Maybe Text
author = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:GetApplicationResponse' :: Maybe Text
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetApplicationResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:homePageUrl:GetApplicationResponse' :: Maybe Text
homePageUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:isVerifiedAuthor:GetApplicationResponse' :: Maybe Bool
isVerifiedAuthor = forall a. Maybe a
Prelude.Nothing,
      $sel:labels:GetApplicationResponse' :: Maybe [Text]
labels = forall a. Maybe a
Prelude.Nothing,
      $sel:licenseUrl:GetApplicationResponse' :: Maybe Text
licenseUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetApplicationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:readmeUrl:GetApplicationResponse' :: Maybe Text
readmeUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:spdxLicenseId:GetApplicationResponse' :: Maybe Text
spdxLicenseId = forall a. Maybe a
Prelude.Nothing,
      $sel:verifiedAuthorUrl:GetApplicationResponse' :: Maybe Text
verifiedAuthorUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:version:GetApplicationResponse' :: Maybe Version
version = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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

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

-- | 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.
getApplicationResponse_isVerifiedAuthor :: Lens.Lens' GetApplicationResponse (Prelude.Maybe Prelude.Bool)
getApplicationResponse_isVerifiedAuthor :: Lens' GetApplicationResponse (Maybe Bool)
getApplicationResponse_isVerifiedAuthor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe Bool
isVerifiedAuthor :: Maybe Bool
$sel:isVerifiedAuthor:GetApplicationResponse' :: GetApplicationResponse -> Maybe Bool
isVerifiedAuthor} -> Maybe Bool
isVerifiedAuthor) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe Bool
a -> GetApplicationResponse
s {$sel:isVerifiedAuthor:GetApplicationResponse' :: Maybe Bool
isVerifiedAuthor = Maybe Bool
a} :: GetApplicationResponse)

-- | 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+\\\\-_:\\\\\/\@]+$\";
getApplicationResponse_labels :: Lens.Lens' GetApplicationResponse (Prelude.Maybe [Prelude.Text])
getApplicationResponse_labels :: Lens' GetApplicationResponse (Maybe [Text])
getApplicationResponse_labels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe [Text]
labels :: Maybe [Text]
$sel:labels:GetApplicationResponse' :: GetApplicationResponse -> Maybe [Text]
labels} -> Maybe [Text]
labels) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe [Text]
a -> GetApplicationResponse
s {$sel:labels:GetApplicationResponse' :: Maybe [Text]
labels = Maybe [Text]
a} :: GetApplicationResponse) 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
getApplicationResponse_licenseUrl :: Lens.Lens' GetApplicationResponse (Prelude.Maybe Prelude.Text)
getApplicationResponse_licenseUrl :: Lens' GetApplicationResponse (Maybe Text)
getApplicationResponse_licenseUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe Text
licenseUrl :: Maybe Text
$sel:licenseUrl:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
licenseUrl} -> Maybe Text
licenseUrl) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe Text
a -> GetApplicationResponse
s {$sel:licenseUrl:GetApplicationResponse' :: Maybe Text
licenseUrl = Maybe Text
a} :: GetApplicationResponse)

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

-- | 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
getApplicationResponse_readmeUrl :: Lens.Lens' GetApplicationResponse (Prelude.Maybe Prelude.Text)
getApplicationResponse_readmeUrl :: Lens' GetApplicationResponse (Maybe Text)
getApplicationResponse_readmeUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe Text
readmeUrl :: Maybe Text
$sel:readmeUrl:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
readmeUrl} -> Maybe Text
readmeUrl) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe Text
a -> GetApplicationResponse
s {$sel:readmeUrl:GetApplicationResponse' :: Maybe Text
readmeUrl = Maybe Text
a} :: GetApplicationResponse)

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

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

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

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

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