{-# 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.Greengrass.CreateFunctionDefinitionVersion
-- 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 version of a Lambda function definition that has already been
-- defined.
module Amazonka.Greengrass.CreateFunctionDefinitionVersion
  ( -- * Creating a Request
    CreateFunctionDefinitionVersion (..),
    newCreateFunctionDefinitionVersion,

    -- * Request Lenses
    createFunctionDefinitionVersion_amznClientToken,
    createFunctionDefinitionVersion_defaultConfig,
    createFunctionDefinitionVersion_functions,
    createFunctionDefinitionVersion_functionDefinitionId,

    -- * Destructuring the Response
    CreateFunctionDefinitionVersionResponse (..),
    newCreateFunctionDefinitionVersionResponse,

    -- * Response Lenses
    createFunctionDefinitionVersionResponse_arn,
    createFunctionDefinitionVersionResponse_creationTimestamp,
    createFunctionDefinitionVersionResponse_id,
    createFunctionDefinitionVersionResponse_version,
    createFunctionDefinitionVersionResponse_httpStatus,
  )
where

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

-- | Information needed to create a function definition version.
--
-- /See:/ 'newCreateFunctionDefinitionVersion' smart constructor.
data CreateFunctionDefinitionVersion = CreateFunctionDefinitionVersion'
  { -- | A client token used to correlate requests and responses.
    CreateFunctionDefinitionVersion -> Maybe Text
amznClientToken :: Prelude.Maybe Prelude.Text,
    -- | The default configuration that applies to all Lambda functions in this
    -- function definition version. Individual Lambda functions can override
    -- these settings.
    CreateFunctionDefinitionVersion -> Maybe FunctionDefaultConfig
defaultConfig :: Prelude.Maybe FunctionDefaultConfig,
    -- | A list of Lambda functions in this function definition version.
    CreateFunctionDefinitionVersion -> Maybe [Function]
functions :: Prelude.Maybe [Function],
    -- | The ID of the Lambda function definition.
    CreateFunctionDefinitionVersion -> Text
functionDefinitionId :: Prelude.Text
  }
  deriving (CreateFunctionDefinitionVersion
-> CreateFunctionDefinitionVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFunctionDefinitionVersion
-> CreateFunctionDefinitionVersion -> Bool
$c/= :: CreateFunctionDefinitionVersion
-> CreateFunctionDefinitionVersion -> Bool
== :: CreateFunctionDefinitionVersion
-> CreateFunctionDefinitionVersion -> Bool
$c== :: CreateFunctionDefinitionVersion
-> CreateFunctionDefinitionVersion -> Bool
Prelude.Eq, ReadPrec [CreateFunctionDefinitionVersion]
ReadPrec CreateFunctionDefinitionVersion
Int -> ReadS CreateFunctionDefinitionVersion
ReadS [CreateFunctionDefinitionVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFunctionDefinitionVersion]
$creadListPrec :: ReadPrec [CreateFunctionDefinitionVersion]
readPrec :: ReadPrec CreateFunctionDefinitionVersion
$creadPrec :: ReadPrec CreateFunctionDefinitionVersion
readList :: ReadS [CreateFunctionDefinitionVersion]
$creadList :: ReadS [CreateFunctionDefinitionVersion]
readsPrec :: Int -> ReadS CreateFunctionDefinitionVersion
$creadsPrec :: Int -> ReadS CreateFunctionDefinitionVersion
Prelude.Read, Int -> CreateFunctionDefinitionVersion -> ShowS
[CreateFunctionDefinitionVersion] -> ShowS
CreateFunctionDefinitionVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFunctionDefinitionVersion] -> ShowS
$cshowList :: [CreateFunctionDefinitionVersion] -> ShowS
show :: CreateFunctionDefinitionVersion -> String
$cshow :: CreateFunctionDefinitionVersion -> String
showsPrec :: Int -> CreateFunctionDefinitionVersion -> ShowS
$cshowsPrec :: Int -> CreateFunctionDefinitionVersion -> ShowS
Prelude.Show, forall x.
Rep CreateFunctionDefinitionVersion x
-> CreateFunctionDefinitionVersion
forall x.
CreateFunctionDefinitionVersion
-> Rep CreateFunctionDefinitionVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateFunctionDefinitionVersion x
-> CreateFunctionDefinitionVersion
$cfrom :: forall x.
CreateFunctionDefinitionVersion
-> Rep CreateFunctionDefinitionVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateFunctionDefinitionVersion' 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:
--
-- 'amznClientToken', 'createFunctionDefinitionVersion_amznClientToken' - A client token used to correlate requests and responses.
--
-- 'defaultConfig', 'createFunctionDefinitionVersion_defaultConfig' - The default configuration that applies to all Lambda functions in this
-- function definition version. Individual Lambda functions can override
-- these settings.
--
-- 'functions', 'createFunctionDefinitionVersion_functions' - A list of Lambda functions in this function definition version.
--
-- 'functionDefinitionId', 'createFunctionDefinitionVersion_functionDefinitionId' - The ID of the Lambda function definition.
newCreateFunctionDefinitionVersion ::
  -- | 'functionDefinitionId'
  Prelude.Text ->
  CreateFunctionDefinitionVersion
newCreateFunctionDefinitionVersion :: Text -> CreateFunctionDefinitionVersion
newCreateFunctionDefinitionVersion
  Text
pFunctionDefinitionId_ =
    CreateFunctionDefinitionVersion'
      { $sel:amznClientToken:CreateFunctionDefinitionVersion' :: Maybe Text
amznClientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:defaultConfig:CreateFunctionDefinitionVersion' :: Maybe FunctionDefaultConfig
defaultConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:functions:CreateFunctionDefinitionVersion' :: Maybe [Function]
functions = forall a. Maybe a
Prelude.Nothing,
        $sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: Text
functionDefinitionId =
          Text
pFunctionDefinitionId_
      }

-- | A client token used to correlate requests and responses.
createFunctionDefinitionVersion_amznClientToken :: Lens.Lens' CreateFunctionDefinitionVersion (Prelude.Maybe Prelude.Text)
createFunctionDefinitionVersion_amznClientToken :: Lens' CreateFunctionDefinitionVersion (Maybe Text)
createFunctionDefinitionVersion_amznClientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersion' {Maybe Text
amznClientToken :: Maybe Text
$sel:amznClientToken:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe Text
amznClientToken} -> Maybe Text
amznClientToken) (\s :: CreateFunctionDefinitionVersion
s@CreateFunctionDefinitionVersion' {} Maybe Text
a -> CreateFunctionDefinitionVersion
s {$sel:amznClientToken:CreateFunctionDefinitionVersion' :: Maybe Text
amznClientToken = Maybe Text
a} :: CreateFunctionDefinitionVersion)

-- | The default configuration that applies to all Lambda functions in this
-- function definition version. Individual Lambda functions can override
-- these settings.
createFunctionDefinitionVersion_defaultConfig :: Lens.Lens' CreateFunctionDefinitionVersion (Prelude.Maybe FunctionDefaultConfig)
createFunctionDefinitionVersion_defaultConfig :: Lens' CreateFunctionDefinitionVersion (Maybe FunctionDefaultConfig)
createFunctionDefinitionVersion_defaultConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersion' {Maybe FunctionDefaultConfig
defaultConfig :: Maybe FunctionDefaultConfig
$sel:defaultConfig:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe FunctionDefaultConfig
defaultConfig} -> Maybe FunctionDefaultConfig
defaultConfig) (\s :: CreateFunctionDefinitionVersion
s@CreateFunctionDefinitionVersion' {} Maybe FunctionDefaultConfig
a -> CreateFunctionDefinitionVersion
s {$sel:defaultConfig:CreateFunctionDefinitionVersion' :: Maybe FunctionDefaultConfig
defaultConfig = Maybe FunctionDefaultConfig
a} :: CreateFunctionDefinitionVersion)

-- | A list of Lambda functions in this function definition version.
createFunctionDefinitionVersion_functions :: Lens.Lens' CreateFunctionDefinitionVersion (Prelude.Maybe [Function])
createFunctionDefinitionVersion_functions :: Lens' CreateFunctionDefinitionVersion (Maybe [Function])
createFunctionDefinitionVersion_functions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersion' {Maybe [Function]
functions :: Maybe [Function]
$sel:functions:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe [Function]
functions} -> Maybe [Function]
functions) (\s :: CreateFunctionDefinitionVersion
s@CreateFunctionDefinitionVersion' {} Maybe [Function]
a -> CreateFunctionDefinitionVersion
s {$sel:functions:CreateFunctionDefinitionVersion' :: Maybe [Function]
functions = Maybe [Function]
a} :: CreateFunctionDefinitionVersion) 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 ID of the Lambda function definition.
createFunctionDefinitionVersion_functionDefinitionId :: Lens.Lens' CreateFunctionDefinitionVersion Prelude.Text
createFunctionDefinitionVersion_functionDefinitionId :: Lens' CreateFunctionDefinitionVersion Text
createFunctionDefinitionVersion_functionDefinitionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersion' {Text
functionDefinitionId :: Text
$sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Text
functionDefinitionId} -> Text
functionDefinitionId) (\s :: CreateFunctionDefinitionVersion
s@CreateFunctionDefinitionVersion' {} Text
a -> CreateFunctionDefinitionVersion
s {$sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: Text
functionDefinitionId = Text
a} :: CreateFunctionDefinitionVersion)

instance
  Core.AWSRequest
    CreateFunctionDefinitionVersion
  where
  type
    AWSResponse CreateFunctionDefinitionVersion =
      CreateFunctionDefinitionVersionResponse
  request :: (Service -> Service)
-> CreateFunctionDefinitionVersion
-> Request CreateFunctionDefinitionVersion
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateFunctionDefinitionVersion
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateFunctionDefinitionVersion)))
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
-> Int
-> CreateFunctionDefinitionVersionResponse
CreateFunctionDefinitionVersionResponse'
            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
"Arn")
            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
"CreationTimestamp")
            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
"Id")
            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
    CreateFunctionDefinitionVersion
  where
  hashWithSalt :: Int -> CreateFunctionDefinitionVersion -> Int
hashWithSalt
    Int
_salt
    CreateFunctionDefinitionVersion' {Maybe [Function]
Maybe Text
Maybe FunctionDefaultConfig
Text
functionDefinitionId :: Text
functions :: Maybe [Function]
defaultConfig :: Maybe FunctionDefaultConfig
amznClientToken :: Maybe Text
$sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Text
$sel:functions:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe [Function]
$sel:defaultConfig:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe FunctionDefaultConfig
$sel:amznClientToken:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
amznClientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FunctionDefaultConfig
defaultConfig
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Function]
functions
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
functionDefinitionId

instance
  Prelude.NFData
    CreateFunctionDefinitionVersion
  where
  rnf :: CreateFunctionDefinitionVersion -> ()
rnf CreateFunctionDefinitionVersion' {Maybe [Function]
Maybe Text
Maybe FunctionDefaultConfig
Text
functionDefinitionId :: Text
functions :: Maybe [Function]
defaultConfig :: Maybe FunctionDefaultConfig
amznClientToken :: Maybe Text
$sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Text
$sel:functions:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe [Function]
$sel:defaultConfig:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe FunctionDefaultConfig
$sel:amznClientToken:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
amznClientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FunctionDefaultConfig
defaultConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Function]
functions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
functionDefinitionId

instance
  Data.ToHeaders
    CreateFunctionDefinitionVersion
  where
  toHeaders :: CreateFunctionDefinitionVersion -> ResponseHeaders
toHeaders CreateFunctionDefinitionVersion' {Maybe [Function]
Maybe Text
Maybe FunctionDefaultConfig
Text
functionDefinitionId :: Text
functions :: Maybe [Function]
defaultConfig :: Maybe FunctionDefaultConfig
amznClientToken :: Maybe Text
$sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Text
$sel:functions:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe [Function]
$sel:defaultConfig:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe FunctionDefaultConfig
$sel:amznClientToken:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amzn-Client-Token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
amznClientToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON CreateFunctionDefinitionVersion where
  toJSON :: CreateFunctionDefinitionVersion -> Value
toJSON CreateFunctionDefinitionVersion' {Maybe [Function]
Maybe Text
Maybe FunctionDefaultConfig
Text
functionDefinitionId :: Text
functions :: Maybe [Function]
defaultConfig :: Maybe FunctionDefaultConfig
amznClientToken :: Maybe Text
$sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Text
$sel:functions:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe [Function]
$sel:defaultConfig:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe FunctionDefaultConfig
$sel:amznClientToken:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DefaultConfig" 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 FunctionDefaultConfig
defaultConfig,
            (Key
"Functions" 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 [Function]
functions
          ]
      )

instance Data.ToPath CreateFunctionDefinitionVersion where
  toPath :: CreateFunctionDefinitionVersion -> ByteString
toPath CreateFunctionDefinitionVersion' {Maybe [Function]
Maybe Text
Maybe FunctionDefaultConfig
Text
functionDefinitionId :: Text
functions :: Maybe [Function]
defaultConfig :: Maybe FunctionDefaultConfig
amznClientToken :: Maybe Text
$sel:functionDefinitionId:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Text
$sel:functions:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe [Function]
$sel:defaultConfig:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe FunctionDefaultConfig
$sel:amznClientToken:CreateFunctionDefinitionVersion' :: CreateFunctionDefinitionVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/greengrass/definition/functions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
functionDefinitionId,
        ByteString
"/versions"
      ]

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

-- | /See:/ 'newCreateFunctionDefinitionVersionResponse' smart constructor.
data CreateFunctionDefinitionVersionResponse = CreateFunctionDefinitionVersionResponse'
  { -- | The ARN of the version.
    CreateFunctionDefinitionVersionResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time, in milliseconds since the epoch, when the version was created.
    CreateFunctionDefinitionVersionResponse -> Maybe Text
creationTimestamp :: Prelude.Maybe Prelude.Text,
    -- | The ID of the parent definition that the version is associated with.
    CreateFunctionDefinitionVersionResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The ID of the version.
    CreateFunctionDefinitionVersionResponse -> Maybe Text
version :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateFunctionDefinitionVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateFunctionDefinitionVersionResponse
-> CreateFunctionDefinitionVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFunctionDefinitionVersionResponse
-> CreateFunctionDefinitionVersionResponse -> Bool
$c/= :: CreateFunctionDefinitionVersionResponse
-> CreateFunctionDefinitionVersionResponse -> Bool
== :: CreateFunctionDefinitionVersionResponse
-> CreateFunctionDefinitionVersionResponse -> Bool
$c== :: CreateFunctionDefinitionVersionResponse
-> CreateFunctionDefinitionVersionResponse -> Bool
Prelude.Eq, ReadPrec [CreateFunctionDefinitionVersionResponse]
ReadPrec CreateFunctionDefinitionVersionResponse
Int -> ReadS CreateFunctionDefinitionVersionResponse
ReadS [CreateFunctionDefinitionVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFunctionDefinitionVersionResponse]
$creadListPrec :: ReadPrec [CreateFunctionDefinitionVersionResponse]
readPrec :: ReadPrec CreateFunctionDefinitionVersionResponse
$creadPrec :: ReadPrec CreateFunctionDefinitionVersionResponse
readList :: ReadS [CreateFunctionDefinitionVersionResponse]
$creadList :: ReadS [CreateFunctionDefinitionVersionResponse]
readsPrec :: Int -> ReadS CreateFunctionDefinitionVersionResponse
$creadsPrec :: Int -> ReadS CreateFunctionDefinitionVersionResponse
Prelude.Read, Int -> CreateFunctionDefinitionVersionResponse -> ShowS
[CreateFunctionDefinitionVersionResponse] -> ShowS
CreateFunctionDefinitionVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFunctionDefinitionVersionResponse] -> ShowS
$cshowList :: [CreateFunctionDefinitionVersionResponse] -> ShowS
show :: CreateFunctionDefinitionVersionResponse -> String
$cshow :: CreateFunctionDefinitionVersionResponse -> String
showsPrec :: Int -> CreateFunctionDefinitionVersionResponse -> ShowS
$cshowsPrec :: Int -> CreateFunctionDefinitionVersionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateFunctionDefinitionVersionResponse x
-> CreateFunctionDefinitionVersionResponse
forall x.
CreateFunctionDefinitionVersionResponse
-> Rep CreateFunctionDefinitionVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateFunctionDefinitionVersionResponse x
-> CreateFunctionDefinitionVersionResponse
$cfrom :: forall x.
CreateFunctionDefinitionVersionResponse
-> Rep CreateFunctionDefinitionVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateFunctionDefinitionVersionResponse' 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:
--
-- 'arn', 'createFunctionDefinitionVersionResponse_arn' - The ARN of the version.
--
-- 'creationTimestamp', 'createFunctionDefinitionVersionResponse_creationTimestamp' - The time, in milliseconds since the epoch, when the version was created.
--
-- 'id', 'createFunctionDefinitionVersionResponse_id' - The ID of the parent definition that the version is associated with.
--
-- 'version', 'createFunctionDefinitionVersionResponse_version' - The ID of the version.
--
-- 'httpStatus', 'createFunctionDefinitionVersionResponse_httpStatus' - The response's http status code.
newCreateFunctionDefinitionVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFunctionDefinitionVersionResponse
newCreateFunctionDefinitionVersionResponse :: Int -> CreateFunctionDefinitionVersionResponse
newCreateFunctionDefinitionVersionResponse
  Int
pHttpStatus_ =
    CreateFunctionDefinitionVersionResponse'
      { $sel:arn:CreateFunctionDefinitionVersionResponse' :: Maybe Text
arn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:creationTimestamp:CreateFunctionDefinitionVersionResponse' :: Maybe Text
creationTimestamp =
          forall a. Maybe a
Prelude.Nothing,
        $sel:id:CreateFunctionDefinitionVersionResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
        $sel:version:CreateFunctionDefinitionVersionResponse' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateFunctionDefinitionVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The ARN of the version.
createFunctionDefinitionVersionResponse_arn :: Lens.Lens' CreateFunctionDefinitionVersionResponse (Prelude.Maybe Prelude.Text)
createFunctionDefinitionVersionResponse_arn :: Lens' CreateFunctionDefinitionVersionResponse (Maybe Text)
createFunctionDefinitionVersionResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersionResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateFunctionDefinitionVersionResponse
s@CreateFunctionDefinitionVersionResponse' {} Maybe Text
a -> CreateFunctionDefinitionVersionResponse
s {$sel:arn:CreateFunctionDefinitionVersionResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateFunctionDefinitionVersionResponse)

-- | The time, in milliseconds since the epoch, when the version was created.
createFunctionDefinitionVersionResponse_creationTimestamp :: Lens.Lens' CreateFunctionDefinitionVersionResponse (Prelude.Maybe Prelude.Text)
createFunctionDefinitionVersionResponse_creationTimestamp :: Lens' CreateFunctionDefinitionVersionResponse (Maybe Text)
createFunctionDefinitionVersionResponse_creationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersionResponse' {Maybe Text
creationTimestamp :: Maybe Text
$sel:creationTimestamp:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
creationTimestamp} -> Maybe Text
creationTimestamp) (\s :: CreateFunctionDefinitionVersionResponse
s@CreateFunctionDefinitionVersionResponse' {} Maybe Text
a -> CreateFunctionDefinitionVersionResponse
s {$sel:creationTimestamp:CreateFunctionDefinitionVersionResponse' :: Maybe Text
creationTimestamp = Maybe Text
a} :: CreateFunctionDefinitionVersionResponse)

-- | The ID of the parent definition that the version is associated with.
createFunctionDefinitionVersionResponse_id :: Lens.Lens' CreateFunctionDefinitionVersionResponse (Prelude.Maybe Prelude.Text)
createFunctionDefinitionVersionResponse_id :: Lens' CreateFunctionDefinitionVersionResponse (Maybe Text)
createFunctionDefinitionVersionResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersionResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateFunctionDefinitionVersionResponse
s@CreateFunctionDefinitionVersionResponse' {} Maybe Text
a -> CreateFunctionDefinitionVersionResponse
s {$sel:id:CreateFunctionDefinitionVersionResponse' :: Maybe Text
id = Maybe Text
a} :: CreateFunctionDefinitionVersionResponse)

-- | The ID of the version.
createFunctionDefinitionVersionResponse_version :: Lens.Lens' CreateFunctionDefinitionVersionResponse (Prelude.Maybe Prelude.Text)
createFunctionDefinitionVersionResponse_version :: Lens' CreateFunctionDefinitionVersionResponse (Maybe Text)
createFunctionDefinitionVersionResponse_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionDefinitionVersionResponse' {Maybe Text
version :: Maybe Text
$sel:version:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
version} -> Maybe Text
version) (\s :: CreateFunctionDefinitionVersionResponse
s@CreateFunctionDefinitionVersionResponse' {} Maybe Text
a -> CreateFunctionDefinitionVersionResponse
s {$sel:version:CreateFunctionDefinitionVersionResponse' :: Maybe Text
version = Maybe Text
a} :: CreateFunctionDefinitionVersionResponse)

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

instance
  Prelude.NFData
    CreateFunctionDefinitionVersionResponse
  where
  rnf :: CreateFunctionDefinitionVersionResponse -> ()
rnf CreateFunctionDefinitionVersionResponse' {Int
Maybe Text
httpStatus :: Int
version :: Maybe Text
id :: Maybe Text
creationTimestamp :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Int
$sel:version:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
$sel:id:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
$sel:creationTimestamp:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
$sel:arn:CreateFunctionDefinitionVersionResponse' :: CreateFunctionDefinitionVersionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
creationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus