{-# 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.ElasticBeanstalk.CreatePlatformVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a new version of your custom platform.
module Amazonka.ElasticBeanstalk.CreatePlatformVersion
  ( -- * Creating a Request
    CreatePlatformVersion (..),
    newCreatePlatformVersion,

    -- * Request Lenses
    createPlatformVersion_environmentName,
    createPlatformVersion_optionSettings,
    createPlatformVersion_tags,
    createPlatformVersion_platformName,
    createPlatformVersion_platformVersion,
    createPlatformVersion_platformDefinitionBundle,

    -- * Destructuring the Response
    CreatePlatformVersionResponse (..),
    newCreatePlatformVersionResponse,

    -- * Response Lenses
    createPlatformVersionResponse_builder,
    createPlatformVersionResponse_platformSummary,
    createPlatformVersionResponse_httpStatus,
  )
where

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

-- | Request to create a new platform version.
--
-- /See:/ 'newCreatePlatformVersion' smart constructor.
data CreatePlatformVersion = CreatePlatformVersion'
  { -- | The name of the builder environment.
    CreatePlatformVersion -> Maybe Text
environmentName :: Prelude.Maybe Prelude.Text,
    -- | The configuration option settings to apply to the builder environment.
    CreatePlatformVersion -> Maybe [ConfigurationOptionSetting]
optionSettings :: Prelude.Maybe [ConfigurationOptionSetting],
    -- | Specifies the tags applied to the new platform version.
    --
    -- Elastic Beanstalk applies these tags only to the platform version.
    -- Environments that you create using the platform version don\'t inherit
    -- the tags.
    CreatePlatformVersion -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of your custom platform.
    CreatePlatformVersion -> Text
platformName :: Prelude.Text,
    -- | The number, such as 1.0.2, for the new platform version.
    CreatePlatformVersion -> Text
platformVersion :: Prelude.Text,
    -- | The location of the platform definition archive in Amazon S3.
    CreatePlatformVersion -> S3Location
platformDefinitionBundle :: S3Location
  }
  deriving (CreatePlatformVersion -> CreatePlatformVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlatformVersion -> CreatePlatformVersion -> Bool
$c/= :: CreatePlatformVersion -> CreatePlatformVersion -> Bool
== :: CreatePlatformVersion -> CreatePlatformVersion -> Bool
$c== :: CreatePlatformVersion -> CreatePlatformVersion -> Bool
Prelude.Eq, ReadPrec [CreatePlatformVersion]
ReadPrec CreatePlatformVersion
Int -> ReadS CreatePlatformVersion
ReadS [CreatePlatformVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlatformVersion]
$creadListPrec :: ReadPrec [CreatePlatformVersion]
readPrec :: ReadPrec CreatePlatformVersion
$creadPrec :: ReadPrec CreatePlatformVersion
readList :: ReadS [CreatePlatformVersion]
$creadList :: ReadS [CreatePlatformVersion]
readsPrec :: Int -> ReadS CreatePlatformVersion
$creadsPrec :: Int -> ReadS CreatePlatformVersion
Prelude.Read, Int -> CreatePlatformVersion -> ShowS
[CreatePlatformVersion] -> ShowS
CreatePlatformVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlatformVersion] -> ShowS
$cshowList :: [CreatePlatformVersion] -> ShowS
show :: CreatePlatformVersion -> String
$cshow :: CreatePlatformVersion -> String
showsPrec :: Int -> CreatePlatformVersion -> ShowS
$cshowsPrec :: Int -> CreatePlatformVersion -> ShowS
Prelude.Show, forall x. Rep CreatePlatformVersion x -> CreatePlatformVersion
forall x. CreatePlatformVersion -> Rep CreatePlatformVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePlatformVersion x -> CreatePlatformVersion
$cfrom :: forall x. CreatePlatformVersion -> Rep CreatePlatformVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlatformVersion' 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:
--
-- 'environmentName', 'createPlatformVersion_environmentName' - The name of the builder environment.
--
-- 'optionSettings', 'createPlatformVersion_optionSettings' - The configuration option settings to apply to the builder environment.
--
-- 'tags', 'createPlatformVersion_tags' - Specifies the tags applied to the new platform version.
--
-- Elastic Beanstalk applies these tags only to the platform version.
-- Environments that you create using the platform version don\'t inherit
-- the tags.
--
-- 'platformName', 'createPlatformVersion_platformName' - The name of your custom platform.
--
-- 'platformVersion', 'createPlatformVersion_platformVersion' - The number, such as 1.0.2, for the new platform version.
--
-- 'platformDefinitionBundle', 'createPlatformVersion_platformDefinitionBundle' - The location of the platform definition archive in Amazon S3.
newCreatePlatformVersion ::
  -- | 'platformName'
  Prelude.Text ->
  -- | 'platformVersion'
  Prelude.Text ->
  -- | 'platformDefinitionBundle'
  S3Location ->
  CreatePlatformVersion
newCreatePlatformVersion :: Text -> Text -> S3Location -> CreatePlatformVersion
newCreatePlatformVersion
  Text
pPlatformName_
  Text
pPlatformVersion_
  S3Location
pPlatformDefinitionBundle_ =
    CreatePlatformVersion'
      { $sel:environmentName:CreatePlatformVersion' :: Maybe Text
environmentName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:optionSettings:CreatePlatformVersion' :: Maybe [ConfigurationOptionSetting]
optionSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreatePlatformVersion' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:platformName:CreatePlatformVersion' :: Text
platformName = Text
pPlatformName_,
        $sel:platformVersion:CreatePlatformVersion' :: Text
platformVersion = Text
pPlatformVersion_,
        $sel:platformDefinitionBundle:CreatePlatformVersion' :: S3Location
platformDefinitionBundle =
          S3Location
pPlatformDefinitionBundle_
      }

-- | The name of the builder environment.
createPlatformVersion_environmentName :: Lens.Lens' CreatePlatformVersion (Prelude.Maybe Prelude.Text)
createPlatformVersion_environmentName :: Lens' CreatePlatformVersion (Maybe Text)
createPlatformVersion_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersion' {Maybe Text
environmentName :: Maybe Text
$sel:environmentName:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe Text
environmentName} -> Maybe Text
environmentName) (\s :: CreatePlatformVersion
s@CreatePlatformVersion' {} Maybe Text
a -> CreatePlatformVersion
s {$sel:environmentName:CreatePlatformVersion' :: Maybe Text
environmentName = Maybe Text
a} :: CreatePlatformVersion)

-- | The configuration option settings to apply to the builder environment.
createPlatformVersion_optionSettings :: Lens.Lens' CreatePlatformVersion (Prelude.Maybe [ConfigurationOptionSetting])
createPlatformVersion_optionSettings :: Lens' CreatePlatformVersion (Maybe [ConfigurationOptionSetting])
createPlatformVersion_optionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersion' {Maybe [ConfigurationOptionSetting]
optionSettings :: Maybe [ConfigurationOptionSetting]
$sel:optionSettings:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [ConfigurationOptionSetting]
optionSettings} -> Maybe [ConfigurationOptionSetting]
optionSettings) (\s :: CreatePlatformVersion
s@CreatePlatformVersion' {} Maybe [ConfigurationOptionSetting]
a -> CreatePlatformVersion
s {$sel:optionSettings:CreatePlatformVersion' :: Maybe [ConfigurationOptionSetting]
optionSettings = Maybe [ConfigurationOptionSetting]
a} :: CreatePlatformVersion) 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

-- | Specifies the tags applied to the new platform version.
--
-- Elastic Beanstalk applies these tags only to the platform version.
-- Environments that you create using the platform version don\'t inherit
-- the tags.
createPlatformVersion_tags :: Lens.Lens' CreatePlatformVersion (Prelude.Maybe [Tag])
createPlatformVersion_tags :: Lens' CreatePlatformVersion (Maybe [Tag])
createPlatformVersion_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersion' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreatePlatformVersion
s@CreatePlatformVersion' {} Maybe [Tag]
a -> CreatePlatformVersion
s {$sel:tags:CreatePlatformVersion' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreatePlatformVersion) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of your custom platform.
createPlatformVersion_platformName :: Lens.Lens' CreatePlatformVersion Prelude.Text
createPlatformVersion_platformName :: Lens' CreatePlatformVersion Text
createPlatformVersion_platformName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersion' {Text
platformName :: Text
$sel:platformName:CreatePlatformVersion' :: CreatePlatformVersion -> Text
platformName} -> Text
platformName) (\s :: CreatePlatformVersion
s@CreatePlatformVersion' {} Text
a -> CreatePlatformVersion
s {$sel:platformName:CreatePlatformVersion' :: Text
platformName = Text
a} :: CreatePlatformVersion)

-- | The number, such as 1.0.2, for the new platform version.
createPlatformVersion_platformVersion :: Lens.Lens' CreatePlatformVersion Prelude.Text
createPlatformVersion_platformVersion :: Lens' CreatePlatformVersion Text
createPlatformVersion_platformVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersion' {Text
platformVersion :: Text
$sel:platformVersion:CreatePlatformVersion' :: CreatePlatformVersion -> Text
platformVersion} -> Text
platformVersion) (\s :: CreatePlatformVersion
s@CreatePlatformVersion' {} Text
a -> CreatePlatformVersion
s {$sel:platformVersion:CreatePlatformVersion' :: Text
platformVersion = Text
a} :: CreatePlatformVersion)

-- | The location of the platform definition archive in Amazon S3.
createPlatformVersion_platformDefinitionBundle :: Lens.Lens' CreatePlatformVersion S3Location
createPlatformVersion_platformDefinitionBundle :: Lens' CreatePlatformVersion S3Location
createPlatformVersion_platformDefinitionBundle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersion' {S3Location
platformDefinitionBundle :: S3Location
$sel:platformDefinitionBundle:CreatePlatformVersion' :: CreatePlatformVersion -> S3Location
platformDefinitionBundle} -> S3Location
platformDefinitionBundle) (\s :: CreatePlatformVersion
s@CreatePlatformVersion' {} S3Location
a -> CreatePlatformVersion
s {$sel:platformDefinitionBundle:CreatePlatformVersion' :: S3Location
platformDefinitionBundle = S3Location
a} :: CreatePlatformVersion)

instance Core.AWSRequest CreatePlatformVersion where
  type
    AWSResponse CreatePlatformVersion =
      CreatePlatformVersionResponse
  request :: (Service -> Service)
-> CreatePlatformVersion -> Request CreatePlatformVersion
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreatePlatformVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePlatformVersion)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreatePlatformVersionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Builder
-> Maybe PlatformSummary -> Int -> CreatePlatformVersionResponse
CreatePlatformVersionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Builder")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PlatformSummary")
            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 CreatePlatformVersion where
  hashWithSalt :: Int -> CreatePlatformVersion -> Int
hashWithSalt Int
_salt CreatePlatformVersion' {Maybe [ConfigurationOptionSetting]
Maybe [Tag]
Maybe Text
Text
S3Location
platformDefinitionBundle :: S3Location
platformVersion :: Text
platformName :: Text
tags :: Maybe [Tag]
optionSettings :: Maybe [ConfigurationOptionSetting]
environmentName :: Maybe Text
$sel:platformDefinitionBundle:CreatePlatformVersion' :: CreatePlatformVersion -> S3Location
$sel:platformVersion:CreatePlatformVersion' :: CreatePlatformVersion -> Text
$sel:platformName:CreatePlatformVersion' :: CreatePlatformVersion -> Text
$sel:tags:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [Tag]
$sel:optionSettings:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [ConfigurationOptionSetting]
$sel:environmentName:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ConfigurationOptionSetting]
optionSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
platformName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
platformVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Location
platformDefinitionBundle

instance Prelude.NFData CreatePlatformVersion where
  rnf :: CreatePlatformVersion -> ()
rnf CreatePlatformVersion' {Maybe [ConfigurationOptionSetting]
Maybe [Tag]
Maybe Text
Text
S3Location
platformDefinitionBundle :: S3Location
platformVersion :: Text
platformName :: Text
tags :: Maybe [Tag]
optionSettings :: Maybe [ConfigurationOptionSetting]
environmentName :: Maybe Text
$sel:platformDefinitionBundle:CreatePlatformVersion' :: CreatePlatformVersion -> S3Location
$sel:platformVersion:CreatePlatformVersion' :: CreatePlatformVersion -> Text
$sel:platformName:CreatePlatformVersion' :: CreatePlatformVersion -> Text
$sel:tags:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [Tag]
$sel:optionSettings:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [ConfigurationOptionSetting]
$sel:environmentName:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ConfigurationOptionSetting]
optionSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
platformName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
platformVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3Location
platformDefinitionBundle

instance Data.ToHeaders CreatePlatformVersion where
  toHeaders :: CreatePlatformVersion -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery CreatePlatformVersion where
  toQuery :: CreatePlatformVersion -> QueryString
toQuery CreatePlatformVersion' {Maybe [ConfigurationOptionSetting]
Maybe [Tag]
Maybe Text
Text
S3Location
platformDefinitionBundle :: S3Location
platformVersion :: Text
platformName :: Text
tags :: Maybe [Tag]
optionSettings :: Maybe [ConfigurationOptionSetting]
environmentName :: Maybe Text
$sel:platformDefinitionBundle:CreatePlatformVersion' :: CreatePlatformVersion -> S3Location
$sel:platformVersion:CreatePlatformVersion' :: CreatePlatformVersion -> Text
$sel:platformName:CreatePlatformVersion' :: CreatePlatformVersion -> Text
$sel:tags:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [Tag]
$sel:optionSettings:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe [ConfigurationOptionSetting]
$sel:environmentName:CreatePlatformVersion' :: CreatePlatformVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreatePlatformVersion" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"EnvironmentName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
environmentName,
        ByteString
"OptionSettings"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ConfigurationOptionSetting]
optionSettings
            ),
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"PlatformName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
platformName,
        ByteString
"PlatformVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
platformVersion,
        ByteString
"PlatformDefinitionBundle"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: S3Location
platformDefinitionBundle
      ]

-- | /See:/ 'newCreatePlatformVersionResponse' smart constructor.
data CreatePlatformVersionResponse = CreatePlatformVersionResponse'
  { -- | The builder used to create the custom platform.
    CreatePlatformVersionResponse -> Maybe Builder
builder :: Prelude.Maybe Builder,
    -- | Detailed information about the new version of the custom platform.
    CreatePlatformVersionResponse -> Maybe PlatformSummary
platformSummary :: Prelude.Maybe PlatformSummary,
    -- | The response's http status code.
    CreatePlatformVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreatePlatformVersionResponse
-> CreatePlatformVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlatformVersionResponse
-> CreatePlatformVersionResponse -> Bool
$c/= :: CreatePlatformVersionResponse
-> CreatePlatformVersionResponse -> Bool
== :: CreatePlatformVersionResponse
-> CreatePlatformVersionResponse -> Bool
$c== :: CreatePlatformVersionResponse
-> CreatePlatformVersionResponse -> Bool
Prelude.Eq, ReadPrec [CreatePlatformVersionResponse]
ReadPrec CreatePlatformVersionResponse
Int -> ReadS CreatePlatformVersionResponse
ReadS [CreatePlatformVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlatformVersionResponse]
$creadListPrec :: ReadPrec [CreatePlatformVersionResponse]
readPrec :: ReadPrec CreatePlatformVersionResponse
$creadPrec :: ReadPrec CreatePlatformVersionResponse
readList :: ReadS [CreatePlatformVersionResponse]
$creadList :: ReadS [CreatePlatformVersionResponse]
readsPrec :: Int -> ReadS CreatePlatformVersionResponse
$creadsPrec :: Int -> ReadS CreatePlatformVersionResponse
Prelude.Read, Int -> CreatePlatformVersionResponse -> ShowS
[CreatePlatformVersionResponse] -> ShowS
CreatePlatformVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlatformVersionResponse] -> ShowS
$cshowList :: [CreatePlatformVersionResponse] -> ShowS
show :: CreatePlatformVersionResponse -> String
$cshow :: CreatePlatformVersionResponse -> String
showsPrec :: Int -> CreatePlatformVersionResponse -> ShowS
$cshowsPrec :: Int -> CreatePlatformVersionResponse -> ShowS
Prelude.Show, forall x.
Rep CreatePlatformVersionResponse x
-> CreatePlatformVersionResponse
forall x.
CreatePlatformVersionResponse
-> Rep CreatePlatformVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePlatformVersionResponse x
-> CreatePlatformVersionResponse
$cfrom :: forall x.
CreatePlatformVersionResponse
-> Rep CreatePlatformVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlatformVersionResponse' 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:
--
-- 'builder', 'createPlatformVersionResponse_builder' - The builder used to create the custom platform.
--
-- 'platformSummary', 'createPlatformVersionResponse_platformSummary' - Detailed information about the new version of the custom platform.
--
-- 'httpStatus', 'createPlatformVersionResponse_httpStatus' - The response's http status code.
newCreatePlatformVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePlatformVersionResponse
newCreatePlatformVersionResponse :: Int -> CreatePlatformVersionResponse
newCreatePlatformVersionResponse Int
pHttpStatus_ =
  CreatePlatformVersionResponse'
    { $sel:builder:CreatePlatformVersionResponse' :: Maybe Builder
builder =
        forall a. Maybe a
Prelude.Nothing,
      $sel:platformSummary:CreatePlatformVersionResponse' :: Maybe PlatformSummary
platformSummary = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePlatformVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The builder used to create the custom platform.
createPlatformVersionResponse_builder :: Lens.Lens' CreatePlatformVersionResponse (Prelude.Maybe Builder)
createPlatformVersionResponse_builder :: Lens' CreatePlatformVersionResponse (Maybe Builder)
createPlatformVersionResponse_builder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersionResponse' {Maybe Builder
builder :: Maybe Builder
$sel:builder:CreatePlatformVersionResponse' :: CreatePlatformVersionResponse -> Maybe Builder
builder} -> Maybe Builder
builder) (\s :: CreatePlatformVersionResponse
s@CreatePlatformVersionResponse' {} Maybe Builder
a -> CreatePlatformVersionResponse
s {$sel:builder:CreatePlatformVersionResponse' :: Maybe Builder
builder = Maybe Builder
a} :: CreatePlatformVersionResponse)

-- | Detailed information about the new version of the custom platform.
createPlatformVersionResponse_platformSummary :: Lens.Lens' CreatePlatformVersionResponse (Prelude.Maybe PlatformSummary)
createPlatformVersionResponse_platformSummary :: Lens' CreatePlatformVersionResponse (Maybe PlatformSummary)
createPlatformVersionResponse_platformSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlatformVersionResponse' {Maybe PlatformSummary
platformSummary :: Maybe PlatformSummary
$sel:platformSummary:CreatePlatformVersionResponse' :: CreatePlatformVersionResponse -> Maybe PlatformSummary
platformSummary} -> Maybe PlatformSummary
platformSummary) (\s :: CreatePlatformVersionResponse
s@CreatePlatformVersionResponse' {} Maybe PlatformSummary
a -> CreatePlatformVersionResponse
s {$sel:platformSummary:CreatePlatformVersionResponse' :: Maybe PlatformSummary
platformSummary = Maybe PlatformSummary
a} :: CreatePlatformVersionResponse)

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

instance Prelude.NFData CreatePlatformVersionResponse where
  rnf :: CreatePlatformVersionResponse -> ()
rnf CreatePlatformVersionResponse' {Int
Maybe Builder
Maybe PlatformSummary
httpStatus :: Int
platformSummary :: Maybe PlatformSummary
builder :: Maybe Builder
$sel:httpStatus:CreatePlatformVersionResponse' :: CreatePlatformVersionResponse -> Int
$sel:platformSummary:CreatePlatformVersionResponse' :: CreatePlatformVersionResponse -> Maybe PlatformSummary
$sel:builder:CreatePlatformVersionResponse' :: CreatePlatformVersionResponse -> Maybe Builder
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Builder
builder
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PlatformSummary
platformSummary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus