{-# 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.ImageBuilder.CreateComponent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new component that can be used to build, validate, test, and
-- assess your image. The component is based on a YAML document that you
-- specify using exactly one of the following methods:
--
-- -   Inline, using the @data@ property in the request body.
--
-- -   A URL that points to a YAML document file stored in Amazon S3, using
--     the @uri@ property in the request body.
module Amazonka.ImageBuilder.CreateComponent
  ( -- * Creating a Request
    CreateComponent (..),
    newCreateComponent,

    -- * Request Lenses
    createComponent_changeDescription,
    createComponent_data,
    createComponent_description,
    createComponent_kmsKeyId,
    createComponent_supportedOsVersions,
    createComponent_tags,
    createComponent_uri,
    createComponent_name,
    createComponent_semanticVersion,
    createComponent_platform,
    createComponent_clientToken,

    -- * Destructuring the Response
    CreateComponentResponse (..),
    newCreateComponentResponse,

    -- * Response Lenses
    createComponentResponse_clientToken,
    createComponentResponse_componentBuildVersionArn,
    createComponentResponse_requestId,
    createComponentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateComponent' smart constructor.
data CreateComponent = CreateComponent'
  { -- | The change description of the component. Describes what change has been
    -- made in this version, or what makes this version different from other
    -- versions of this component.
    CreateComponent -> Maybe Text
changeDescription :: Prelude.Maybe Prelude.Text,
    -- | Component @data@ contains inline YAML document content for the
    -- component. Alternatively, you can specify the @uri@ of a YAML document
    -- file stored in Amazon S3. However, you cannot specify both properties.
    CreateComponent -> Maybe Text
data' :: Prelude.Maybe Prelude.Text,
    -- | The description of the component. Describes the contents of the
    -- component.
    CreateComponent -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ID of the KMS key that should be used to encrypt this component.
    CreateComponent -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The operating system (OS) version supported by the component. If the OS
    -- information is available, a prefix match is performed against the base
    -- image OS version during image recipe creation.
    CreateComponent -> Maybe (NonEmpty Text)
supportedOsVersions :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The tags of the component.
    CreateComponent -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The @uri@ of a YAML component document file. This must be an S3 URL
    -- (@s3:\/\/bucket\/key@), and the requester must have permission to access
    -- the S3 bucket it points to. If you use Amazon S3, you can specify
    -- component content up to your service quota.
    --
    -- Alternatively, you can specify the YAML document inline, using the
    -- component @data@ property. You cannot specify both properties.
    CreateComponent -> Maybe Text
uri :: Prelude.Maybe Prelude.Text,
    -- | The name of the component.
    CreateComponent -> Text
name :: Prelude.Text,
    -- | The semantic version of the component. This version follows the semantic
    -- version syntax.
    --
    -- The semantic version has four nodes:
    -- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
    -- first three, and can filter on all of them.
    --
    -- __Assignment:__ For the first three nodes you can assign any positive
    -- integer value, including zero, with an upper limit of 2^30-1, or
    -- 1073741823 for each node. Image Builder automatically assigns the build
    -- number to the fourth node.
    --
    -- __Patterns:__ You can use any numeric pattern that adheres to the
    -- assignment requirements for the nodes that you can assign. For example,
    -- you might choose a software version pattern, such as 1.0.0, or a date,
    -- such as 2021.01.01.
    CreateComponent -> Text
semanticVersion :: Prelude.Text,
    -- | The platform of the component.
    CreateComponent -> Platform
platform :: Platform,
    -- | The idempotency token of the component.
    CreateComponent -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateComponent -> CreateComponent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateComponent -> CreateComponent -> Bool
$c/= :: CreateComponent -> CreateComponent -> Bool
== :: CreateComponent -> CreateComponent -> Bool
$c== :: CreateComponent -> CreateComponent -> Bool
Prelude.Eq, ReadPrec [CreateComponent]
ReadPrec CreateComponent
Int -> ReadS CreateComponent
ReadS [CreateComponent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateComponent]
$creadListPrec :: ReadPrec [CreateComponent]
readPrec :: ReadPrec CreateComponent
$creadPrec :: ReadPrec CreateComponent
readList :: ReadS [CreateComponent]
$creadList :: ReadS [CreateComponent]
readsPrec :: Int -> ReadS CreateComponent
$creadsPrec :: Int -> ReadS CreateComponent
Prelude.Read, Int -> CreateComponent -> ShowS
[CreateComponent] -> ShowS
CreateComponent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateComponent] -> ShowS
$cshowList :: [CreateComponent] -> ShowS
show :: CreateComponent -> String
$cshow :: CreateComponent -> String
showsPrec :: Int -> CreateComponent -> ShowS
$cshowsPrec :: Int -> CreateComponent -> ShowS
Prelude.Show, forall x. Rep CreateComponent x -> CreateComponent
forall x. CreateComponent -> Rep CreateComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateComponent x -> CreateComponent
$cfrom :: forall x. CreateComponent -> Rep CreateComponent x
Prelude.Generic)

-- |
-- Create a value of 'CreateComponent' 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:
--
-- 'changeDescription', 'createComponent_changeDescription' - The change description of the component. Describes what change has been
-- made in this version, or what makes this version different from other
-- versions of this component.
--
-- 'data'', 'createComponent_data' - Component @data@ contains inline YAML document content for the
-- component. Alternatively, you can specify the @uri@ of a YAML document
-- file stored in Amazon S3. However, you cannot specify both properties.
--
-- 'description', 'createComponent_description' - The description of the component. Describes the contents of the
-- component.
--
-- 'kmsKeyId', 'createComponent_kmsKeyId' - The ID of the KMS key that should be used to encrypt this component.
--
-- 'supportedOsVersions', 'createComponent_supportedOsVersions' - The operating system (OS) version supported by the component. If the OS
-- information is available, a prefix match is performed against the base
-- image OS version during image recipe creation.
--
-- 'tags', 'createComponent_tags' - The tags of the component.
--
-- 'uri', 'createComponent_uri' - The @uri@ of a YAML component document file. This must be an S3 URL
-- (@s3:\/\/bucket\/key@), and the requester must have permission to access
-- the S3 bucket it points to. If you use Amazon S3, you can specify
-- component content up to your service quota.
--
-- Alternatively, you can specify the YAML document inline, using the
-- component @data@ property. You cannot specify both properties.
--
-- 'name', 'createComponent_name' - The name of the component.
--
-- 'semanticVersion', 'createComponent_semanticVersion' - The semantic version of the component. This version follows the semantic
-- version syntax.
--
-- The semantic version has four nodes:
-- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
-- first three, and can filter on all of them.
--
-- __Assignment:__ For the first three nodes you can assign any positive
-- integer value, including zero, with an upper limit of 2^30-1, or
-- 1073741823 for each node. Image Builder automatically assigns the build
-- number to the fourth node.
--
-- __Patterns:__ You can use any numeric pattern that adheres to the
-- assignment requirements for the nodes that you can assign. For example,
-- you might choose a software version pattern, such as 1.0.0, or a date,
-- such as 2021.01.01.
--
-- 'platform', 'createComponent_platform' - The platform of the component.
--
-- 'clientToken', 'createComponent_clientToken' - The idempotency token of the component.
newCreateComponent ::
  -- | 'name'
  Prelude.Text ->
  -- | 'semanticVersion'
  Prelude.Text ->
  -- | 'platform'
  Platform ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateComponent
newCreateComponent :: Text -> Text -> Platform -> Text -> CreateComponent
newCreateComponent
  Text
pName_
  Text
pSemanticVersion_
  Platform
pPlatform_
  Text
pClientToken_ =
    CreateComponent'
      { $sel:changeDescription:CreateComponent' :: Maybe Text
changeDescription =
          forall a. Maybe a
Prelude.Nothing,
        $sel:data':CreateComponent' :: Maybe Text
data' = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateComponent' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CreateComponent' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:supportedOsVersions:CreateComponent' :: Maybe (NonEmpty Text)
supportedOsVersions = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateComponent' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:uri:CreateComponent' :: Maybe Text
uri = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateComponent' :: Text
name = Text
pName_,
        $sel:semanticVersion:CreateComponent' :: Text
semanticVersion = Text
pSemanticVersion_,
        $sel:platform:CreateComponent' :: Platform
platform = Platform
pPlatform_,
        $sel:clientToken:CreateComponent' :: Text
clientToken = Text
pClientToken_
      }

-- | The change description of the component. Describes what change has been
-- made in this version, or what makes this version different from other
-- versions of this component.
createComponent_changeDescription :: Lens.Lens' CreateComponent (Prelude.Maybe Prelude.Text)
createComponent_changeDescription :: Lens' CreateComponent (Maybe Text)
createComponent_changeDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Maybe Text
changeDescription :: Maybe Text
$sel:changeDescription:CreateComponent' :: CreateComponent -> Maybe Text
changeDescription} -> Maybe Text
changeDescription) (\s :: CreateComponent
s@CreateComponent' {} Maybe Text
a -> CreateComponent
s {$sel:changeDescription:CreateComponent' :: Maybe Text
changeDescription = Maybe Text
a} :: CreateComponent)

-- | Component @data@ contains inline YAML document content for the
-- component. Alternatively, you can specify the @uri@ of a YAML document
-- file stored in Amazon S3. However, you cannot specify both properties.
createComponent_data :: Lens.Lens' CreateComponent (Prelude.Maybe Prelude.Text)
createComponent_data :: Lens' CreateComponent (Maybe Text)
createComponent_data = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Maybe Text
data' :: Maybe Text
$sel:data':CreateComponent' :: CreateComponent -> Maybe Text
data'} -> Maybe Text
data') (\s :: CreateComponent
s@CreateComponent' {} Maybe Text
a -> CreateComponent
s {$sel:data':CreateComponent' :: Maybe Text
data' = Maybe Text
a} :: CreateComponent)

-- | The description of the component. Describes the contents of the
-- component.
createComponent_description :: Lens.Lens' CreateComponent (Prelude.Maybe Prelude.Text)
createComponent_description :: Lens' CreateComponent (Maybe Text)
createComponent_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Maybe Text
description :: Maybe Text
$sel:description:CreateComponent' :: CreateComponent -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateComponent
s@CreateComponent' {} Maybe Text
a -> CreateComponent
s {$sel:description:CreateComponent' :: Maybe Text
description = Maybe Text
a} :: CreateComponent)

-- | The ID of the KMS key that should be used to encrypt this component.
createComponent_kmsKeyId :: Lens.Lens' CreateComponent (Prelude.Maybe Prelude.Text)
createComponent_kmsKeyId :: Lens' CreateComponent (Maybe Text)
createComponent_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateComponent' :: CreateComponent -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateComponent
s@CreateComponent' {} Maybe Text
a -> CreateComponent
s {$sel:kmsKeyId:CreateComponent' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateComponent)

-- | The operating system (OS) version supported by the component. If the OS
-- information is available, a prefix match is performed against the base
-- image OS version during image recipe creation.
createComponent_supportedOsVersions :: Lens.Lens' CreateComponent (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createComponent_supportedOsVersions :: Lens' CreateComponent (Maybe (NonEmpty Text))
createComponent_supportedOsVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Maybe (NonEmpty Text)
supportedOsVersions :: Maybe (NonEmpty Text)
$sel:supportedOsVersions:CreateComponent' :: CreateComponent -> Maybe (NonEmpty Text)
supportedOsVersions} -> Maybe (NonEmpty Text)
supportedOsVersions) (\s :: CreateComponent
s@CreateComponent' {} Maybe (NonEmpty Text)
a -> CreateComponent
s {$sel:supportedOsVersions:CreateComponent' :: Maybe (NonEmpty Text)
supportedOsVersions = Maybe (NonEmpty Text)
a} :: CreateComponent) 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 tags of the component.
createComponent_tags :: Lens.Lens' CreateComponent (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createComponent_tags :: Lens' CreateComponent (Maybe (HashMap Text Text))
createComponent_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateComponent' :: CreateComponent -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateComponent
s@CreateComponent' {} Maybe (HashMap Text Text)
a -> CreateComponent
s {$sel:tags:CreateComponent' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateComponent) 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 @uri@ of a YAML component document file. This must be an S3 URL
-- (@s3:\/\/bucket\/key@), and the requester must have permission to access
-- the S3 bucket it points to. If you use Amazon S3, you can specify
-- component content up to your service quota.
--
-- Alternatively, you can specify the YAML document inline, using the
-- component @data@ property. You cannot specify both properties.
createComponent_uri :: Lens.Lens' CreateComponent (Prelude.Maybe Prelude.Text)
createComponent_uri :: Lens' CreateComponent (Maybe Text)
createComponent_uri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Maybe Text
uri :: Maybe Text
$sel:uri:CreateComponent' :: CreateComponent -> Maybe Text
uri} -> Maybe Text
uri) (\s :: CreateComponent
s@CreateComponent' {} Maybe Text
a -> CreateComponent
s {$sel:uri:CreateComponent' :: Maybe Text
uri = Maybe Text
a} :: CreateComponent)

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

-- | The semantic version of the component. This version follows the semantic
-- version syntax.
--
-- The semantic version has four nodes:
-- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
-- first three, and can filter on all of them.
--
-- __Assignment:__ For the first three nodes you can assign any positive
-- integer value, including zero, with an upper limit of 2^30-1, or
-- 1073741823 for each node. Image Builder automatically assigns the build
-- number to the fourth node.
--
-- __Patterns:__ You can use any numeric pattern that adheres to the
-- assignment requirements for the nodes that you can assign. For example,
-- you might choose a software version pattern, such as 1.0.0, or a date,
-- such as 2021.01.01.
createComponent_semanticVersion :: Lens.Lens' CreateComponent Prelude.Text
createComponent_semanticVersion :: Lens' CreateComponent Text
createComponent_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Text
semanticVersion :: Text
$sel:semanticVersion:CreateComponent' :: CreateComponent -> Text
semanticVersion} -> Text
semanticVersion) (\s :: CreateComponent
s@CreateComponent' {} Text
a -> CreateComponent
s {$sel:semanticVersion:CreateComponent' :: Text
semanticVersion = Text
a} :: CreateComponent)

-- | The platform of the component.
createComponent_platform :: Lens.Lens' CreateComponent Platform
createComponent_platform :: Lens' CreateComponent Platform
createComponent_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Platform
platform :: Platform
$sel:platform:CreateComponent' :: CreateComponent -> Platform
platform} -> Platform
platform) (\s :: CreateComponent
s@CreateComponent' {} Platform
a -> CreateComponent
s {$sel:platform:CreateComponent' :: Platform
platform = Platform
a} :: CreateComponent)

-- | The idempotency token of the component.
createComponent_clientToken :: Lens.Lens' CreateComponent Prelude.Text
createComponent_clientToken :: Lens' CreateComponent Text
createComponent_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponent' {Text
clientToken :: Text
$sel:clientToken:CreateComponent' :: CreateComponent -> Text
clientToken} -> Text
clientToken) (\s :: CreateComponent
s@CreateComponent' {} Text
a -> CreateComponent
s {$sel:clientToken:CreateComponent' :: Text
clientToken = Text
a} :: CreateComponent)

instance Core.AWSRequest CreateComponent where
  type
    AWSResponse CreateComponent =
      CreateComponentResponse
  request :: (Service -> Service) -> CreateComponent -> Request CreateComponent
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateComponent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateComponent)))
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 -> Int -> CreateComponentResponse
CreateComponentResponse'
            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
"clientToken")
            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
"componentBuildVersionArn")
            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
"requestId")
            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 CreateComponent where
  hashWithSalt :: Int -> CreateComponent -> Int
hashWithSalt Int
_salt CreateComponent' {Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Text
Platform
clientToken :: Text
platform :: Platform
semanticVersion :: Text
name :: Text
uri :: Maybe Text
tags :: Maybe (HashMap Text Text)
supportedOsVersions :: Maybe (NonEmpty Text)
kmsKeyId :: Maybe Text
description :: Maybe Text
data' :: Maybe Text
changeDescription :: Maybe Text
$sel:clientToken:CreateComponent' :: CreateComponent -> Text
$sel:platform:CreateComponent' :: CreateComponent -> Platform
$sel:semanticVersion:CreateComponent' :: CreateComponent -> Text
$sel:name:CreateComponent' :: CreateComponent -> Text
$sel:uri:CreateComponent' :: CreateComponent -> Maybe Text
$sel:tags:CreateComponent' :: CreateComponent -> Maybe (HashMap Text Text)
$sel:supportedOsVersions:CreateComponent' :: CreateComponent -> Maybe (NonEmpty Text)
$sel:kmsKeyId:CreateComponent' :: CreateComponent -> Maybe Text
$sel:description:CreateComponent' :: CreateComponent -> Maybe Text
$sel:data':CreateComponent' :: CreateComponent -> Maybe Text
$sel:changeDescription:CreateComponent' :: CreateComponent -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
changeDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
data'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
supportedOsVersions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
uri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
semanticVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Platform
platform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateComponent where
  rnf :: CreateComponent -> ()
rnf CreateComponent' {Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Text
Platform
clientToken :: Text
platform :: Platform
semanticVersion :: Text
name :: Text
uri :: Maybe Text
tags :: Maybe (HashMap Text Text)
supportedOsVersions :: Maybe (NonEmpty Text)
kmsKeyId :: Maybe Text
description :: Maybe Text
data' :: Maybe Text
changeDescription :: Maybe Text
$sel:clientToken:CreateComponent' :: CreateComponent -> Text
$sel:platform:CreateComponent' :: CreateComponent -> Platform
$sel:semanticVersion:CreateComponent' :: CreateComponent -> Text
$sel:name:CreateComponent' :: CreateComponent -> Text
$sel:uri:CreateComponent' :: CreateComponent -> Maybe Text
$sel:tags:CreateComponent' :: CreateComponent -> Maybe (HashMap Text Text)
$sel:supportedOsVersions:CreateComponent' :: CreateComponent -> Maybe (NonEmpty Text)
$sel:kmsKeyId:CreateComponent' :: CreateComponent -> Maybe Text
$sel:description:CreateComponent' :: CreateComponent -> Maybe Text
$sel:data':CreateComponent' :: CreateComponent -> Maybe Text
$sel:changeDescription:CreateComponent' :: CreateComponent -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
changeDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
data'
      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
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
supportedOsVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
uri
      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
semanticVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Platform
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateComponent where
  toHeaders :: CreateComponent -> 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 CreateComponent where
  toJSON :: CreateComponent -> Value
toJSON CreateComponent' {Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Text
Platform
clientToken :: Text
platform :: Platform
semanticVersion :: Text
name :: Text
uri :: Maybe Text
tags :: Maybe (HashMap Text Text)
supportedOsVersions :: Maybe (NonEmpty Text)
kmsKeyId :: Maybe Text
description :: Maybe Text
data' :: Maybe Text
changeDescription :: Maybe Text
$sel:clientToken:CreateComponent' :: CreateComponent -> Text
$sel:platform:CreateComponent' :: CreateComponent -> Platform
$sel:semanticVersion:CreateComponent' :: CreateComponent -> Text
$sel:name:CreateComponent' :: CreateComponent -> Text
$sel:uri:CreateComponent' :: CreateComponent -> Maybe Text
$sel:tags:CreateComponent' :: CreateComponent -> Maybe (HashMap Text Text)
$sel:supportedOsVersions:CreateComponent' :: CreateComponent -> Maybe (NonEmpty Text)
$sel:kmsKeyId:CreateComponent' :: CreateComponent -> Maybe Text
$sel:description:CreateComponent' :: CreateComponent -> Maybe Text
$sel:data':CreateComponent' :: CreateComponent -> Maybe Text
$sel:changeDescription:CreateComponent' :: CreateComponent -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"changeDescription" 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
changeDescription,
            (Key
"data" 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
data',
            (Key
"description" 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
description,
            (Key
"kmsKeyId" 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
kmsKeyId,
            (Key
"supportedOsVersions" 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 (NonEmpty Text)
supportedOsVersions,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            (Key
"uri" 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
uri,
            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
"semanticVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
semanticVersion),
            forall a. a -> Maybe a
Prelude.Just (Key
"platform" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Platform
platform),
            forall a. a -> Maybe a
Prelude.Just (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

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

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

-- | /See:/ 'newCreateComponentResponse' smart constructor.
data CreateComponentResponse = CreateComponentResponse'
  { -- | The idempotency token used to make this request idempotent.
    CreateComponentResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the component that was created by this
    -- request.
    CreateComponentResponse -> Maybe Text
componentBuildVersionArn :: Prelude.Maybe Prelude.Text,
    -- | The request ID that uniquely identifies this request.
    CreateComponentResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateComponentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateComponentResponse -> CreateComponentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateComponentResponse -> CreateComponentResponse -> Bool
$c/= :: CreateComponentResponse -> CreateComponentResponse -> Bool
== :: CreateComponentResponse -> CreateComponentResponse -> Bool
$c== :: CreateComponentResponse -> CreateComponentResponse -> Bool
Prelude.Eq, ReadPrec [CreateComponentResponse]
ReadPrec CreateComponentResponse
Int -> ReadS CreateComponentResponse
ReadS [CreateComponentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateComponentResponse]
$creadListPrec :: ReadPrec [CreateComponentResponse]
readPrec :: ReadPrec CreateComponentResponse
$creadPrec :: ReadPrec CreateComponentResponse
readList :: ReadS [CreateComponentResponse]
$creadList :: ReadS [CreateComponentResponse]
readsPrec :: Int -> ReadS CreateComponentResponse
$creadsPrec :: Int -> ReadS CreateComponentResponse
Prelude.Read, Int -> CreateComponentResponse -> ShowS
[CreateComponentResponse] -> ShowS
CreateComponentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateComponentResponse] -> ShowS
$cshowList :: [CreateComponentResponse] -> ShowS
show :: CreateComponentResponse -> String
$cshow :: CreateComponentResponse -> String
showsPrec :: Int -> CreateComponentResponse -> ShowS
$cshowsPrec :: Int -> CreateComponentResponse -> ShowS
Prelude.Show, forall x. Rep CreateComponentResponse x -> CreateComponentResponse
forall x. CreateComponentResponse -> Rep CreateComponentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateComponentResponse x -> CreateComponentResponse
$cfrom :: forall x. CreateComponentResponse -> Rep CreateComponentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateComponentResponse' 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:
--
-- 'clientToken', 'createComponentResponse_clientToken' - The idempotency token used to make this request idempotent.
--
-- 'componentBuildVersionArn', 'createComponentResponse_componentBuildVersionArn' - The Amazon Resource Name (ARN) of the component that was created by this
-- request.
--
-- 'requestId', 'createComponentResponse_requestId' - The request ID that uniquely identifies this request.
--
-- 'httpStatus', 'createComponentResponse_httpStatus' - The response's http status code.
newCreateComponentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateComponentResponse
newCreateComponentResponse :: Int -> CreateComponentResponse
newCreateComponentResponse Int
pHttpStatus_ =
  CreateComponentResponse'
    { $sel:clientToken:CreateComponentResponse' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:componentBuildVersionArn:CreateComponentResponse' :: Maybe Text
componentBuildVersionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:CreateComponentResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateComponentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The idempotency token used to make this request idempotent.
createComponentResponse_clientToken :: Lens.Lens' CreateComponentResponse (Prelude.Maybe Prelude.Text)
createComponentResponse_clientToken :: Lens' CreateComponentResponse (Maybe Text)
createComponentResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponentResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateComponentResponse' :: CreateComponentResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateComponentResponse
s@CreateComponentResponse' {} Maybe Text
a -> CreateComponentResponse
s {$sel:clientToken:CreateComponentResponse' :: Maybe Text
clientToken = Maybe Text
a} :: CreateComponentResponse)

-- | The Amazon Resource Name (ARN) of the component that was created by this
-- request.
createComponentResponse_componentBuildVersionArn :: Lens.Lens' CreateComponentResponse (Prelude.Maybe Prelude.Text)
createComponentResponse_componentBuildVersionArn :: Lens' CreateComponentResponse (Maybe Text)
createComponentResponse_componentBuildVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponentResponse' {Maybe Text
componentBuildVersionArn :: Maybe Text
$sel:componentBuildVersionArn:CreateComponentResponse' :: CreateComponentResponse -> Maybe Text
componentBuildVersionArn} -> Maybe Text
componentBuildVersionArn) (\s :: CreateComponentResponse
s@CreateComponentResponse' {} Maybe Text
a -> CreateComponentResponse
s {$sel:componentBuildVersionArn:CreateComponentResponse' :: Maybe Text
componentBuildVersionArn = Maybe Text
a} :: CreateComponentResponse)

-- | The request ID that uniquely identifies this request.
createComponentResponse_requestId :: Lens.Lens' CreateComponentResponse (Prelude.Maybe Prelude.Text)
createComponentResponse_requestId :: Lens' CreateComponentResponse (Maybe Text)
createComponentResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateComponentResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:CreateComponentResponse' :: CreateComponentResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: CreateComponentResponse
s@CreateComponentResponse' {} Maybe Text
a -> CreateComponentResponse
s {$sel:requestId:CreateComponentResponse' :: Maybe Text
requestId = Maybe Text
a} :: CreateComponentResponse)

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

instance Prelude.NFData CreateComponentResponse where
  rnf :: CreateComponentResponse -> ()
rnf CreateComponentResponse' {Int
Maybe Text
httpStatus :: Int
requestId :: Maybe Text
componentBuildVersionArn :: Maybe Text
clientToken :: Maybe Text
$sel:httpStatus:CreateComponentResponse' :: CreateComponentResponse -> Int
$sel:requestId:CreateComponentResponse' :: CreateComponentResponse -> Maybe Text
$sel:componentBuildVersionArn:CreateComponentResponse' :: CreateComponentResponse -> Maybe Text
$sel:clientToken:CreateComponentResponse' :: CreateComponentResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
componentBuildVersionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus