{-# 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.Glue.CreateSchema
-- 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 schema set and registers the schema definition. Returns an
-- error if the schema set already exists without actually registering the
-- version.
--
-- When the schema set is created, a version checkpoint will be set to the
-- first version. Compatibility mode \"DISABLED\" restricts any additional
-- schema versions from being added after the first schema version. For all
-- other compatibility modes, validation of compatibility settings will be
-- applied only from the second version onwards when the
-- @RegisterSchemaVersion@ API is used.
--
-- When this API is called without a @RegistryId@, this will create an
-- entry for a \"default-registry\" in the registry database tables, if it
-- is not already present.
module Amazonka.Glue.CreateSchema
  ( -- * Creating a Request
    CreateSchema (..),
    newCreateSchema,

    -- * Request Lenses
    createSchema_compatibility,
    createSchema_description,
    createSchema_registryId,
    createSchema_schemaDefinition,
    createSchema_tags,
    createSchema_schemaName,
    createSchema_dataFormat,

    -- * Destructuring the Response
    CreateSchemaResponse (..),
    newCreateSchemaResponse,

    -- * Response Lenses
    createSchemaResponse_compatibility,
    createSchemaResponse_dataFormat,
    createSchemaResponse_description,
    createSchemaResponse_latestSchemaVersion,
    createSchemaResponse_nextSchemaVersion,
    createSchemaResponse_registryArn,
    createSchemaResponse_registryName,
    createSchemaResponse_schemaArn,
    createSchemaResponse_schemaCheckpoint,
    createSchemaResponse_schemaName,
    createSchemaResponse_schemaStatus,
    createSchemaResponse_schemaVersionId,
    createSchemaResponse_schemaVersionStatus,
    createSchemaResponse_tags,
    createSchemaResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateSchema' smart constructor.
data CreateSchema = CreateSchema'
  { -- | The compatibility mode of the schema. The possible values are:
    --
    -- -   /NONE/: No compatibility mode applies. You can use this choice in
    --     development scenarios or if you do not know the compatibility mode
    --     that you want to apply to schemas. Any new version added will be
    --     accepted without undergoing a compatibility check.
    --
    -- -   /DISABLED/: This compatibility choice prevents versioning for a
    --     particular schema. You can use this choice to prevent future
    --     versioning of a schema.
    --
    -- -   /BACKWARD/: This compatibility choice is recommended as it allows
    --     data receivers to read both the current and one previous schema
    --     version. This means that for instance, a new schema version cannot
    --     drop data fields or change the type of these fields, so they can\'t
    --     be read by readers using the previous version.
    --
    -- -   /BACKWARD_ALL/: This compatibility choice allows data receivers to
    --     read both the current and all previous schema versions. You can use
    --     this choice when you need to delete fields or add optional fields,
    --     and check compatibility against all previous schema versions.
    --
    -- -   /FORWARD/: This compatibility choice allows data receivers to read
    --     both the current and one next schema version, but not necessarily
    --     later versions. You can use this choice when you need to add fields
    --     or delete optional fields, but only check compatibility against the
    --     last schema version.
    --
    -- -   /FORWARD_ALL/: This compatibility choice allows data receivers to
    --     read written by producers of any new registered schema. You can use
    --     this choice when you need to add fields or delete optional fields,
    --     and check compatibility against all previous schema versions.
    --
    -- -   /FULL/: This compatibility choice allows data receivers to read data
    --     written by producers using the previous or next version of the
    --     schema, but not necessarily earlier or later versions. You can use
    --     this choice when you need to add or remove optional fields, but only
    --     check compatibility against the last schema version.
    --
    -- -   /FULL_ALL/: This compatibility choice allows data receivers to read
    --     data written by producers using all previous schema versions. You
    --     can use this choice when you need to add or remove optional fields,
    --     and check compatibility against all previous schema versions.
    CreateSchema -> Maybe Compatibility
compatibility :: Prelude.Maybe Compatibility,
    -- | An optional description of the schema. If description is not provided,
    -- there will not be any automatic default value for this.
    CreateSchema -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | This is a wrapper shape to contain the registry identity fields. If this
    -- is not provided, the default registry will be used. The ARN format for
    -- the same will be:
    -- @arn:aws:glue:us-east-2:\<customer id>:registry\/default-registry:random-5-letter-id@.
    CreateSchema -> Maybe RegistryId
registryId :: Prelude.Maybe RegistryId,
    -- | The schema definition using the @DataFormat@ setting for @SchemaName@.
    CreateSchema -> Maybe Text
schemaDefinition :: Prelude.Maybe Prelude.Text,
    -- | Amazon Web Services tags that contain a key value pair and may be
    -- searched by console, command line, or API. If specified, follows the
    -- Amazon Web Services tags-on-create pattern.
    CreateSchema -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Name of the schema to be created of max length of 255, and may only
    -- contain letters, numbers, hyphen, underscore, dollar sign, or hash mark.
    -- No whitespace.
    CreateSchema -> Text
schemaName :: Prelude.Text,
    -- | The data format of the schema definition. Currently @AVRO@, @JSON@ and
    -- @PROTOBUF@ are supported.
    CreateSchema -> DataFormat
dataFormat :: DataFormat
  }
  deriving (CreateSchema -> CreateSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSchema -> CreateSchema -> Bool
$c/= :: CreateSchema -> CreateSchema -> Bool
== :: CreateSchema -> CreateSchema -> Bool
$c== :: CreateSchema -> CreateSchema -> Bool
Prelude.Eq, ReadPrec [CreateSchema]
ReadPrec CreateSchema
Int -> ReadS CreateSchema
ReadS [CreateSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSchema]
$creadListPrec :: ReadPrec [CreateSchema]
readPrec :: ReadPrec CreateSchema
$creadPrec :: ReadPrec CreateSchema
readList :: ReadS [CreateSchema]
$creadList :: ReadS [CreateSchema]
readsPrec :: Int -> ReadS CreateSchema
$creadsPrec :: Int -> ReadS CreateSchema
Prelude.Read, Int -> CreateSchema -> ShowS
[CreateSchema] -> ShowS
CreateSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSchema] -> ShowS
$cshowList :: [CreateSchema] -> ShowS
show :: CreateSchema -> String
$cshow :: CreateSchema -> String
showsPrec :: Int -> CreateSchema -> ShowS
$cshowsPrec :: Int -> CreateSchema -> ShowS
Prelude.Show, forall x. Rep CreateSchema x -> CreateSchema
forall x. CreateSchema -> Rep CreateSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSchema x -> CreateSchema
$cfrom :: forall x. CreateSchema -> Rep CreateSchema x
Prelude.Generic)

-- |
-- Create a value of 'CreateSchema' 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:
--
-- 'compatibility', 'createSchema_compatibility' - The compatibility mode of the schema. The possible values are:
--
-- -   /NONE/: No compatibility mode applies. You can use this choice in
--     development scenarios or if you do not know the compatibility mode
--     that you want to apply to schemas. Any new version added will be
--     accepted without undergoing a compatibility check.
--
-- -   /DISABLED/: This compatibility choice prevents versioning for a
--     particular schema. You can use this choice to prevent future
--     versioning of a schema.
--
-- -   /BACKWARD/: This compatibility choice is recommended as it allows
--     data receivers to read both the current and one previous schema
--     version. This means that for instance, a new schema version cannot
--     drop data fields or change the type of these fields, so they can\'t
--     be read by readers using the previous version.
--
-- -   /BACKWARD_ALL/: This compatibility choice allows data receivers to
--     read both the current and all previous schema versions. You can use
--     this choice when you need to delete fields or add optional fields,
--     and check compatibility against all previous schema versions.
--
-- -   /FORWARD/: This compatibility choice allows data receivers to read
--     both the current and one next schema version, but not necessarily
--     later versions. You can use this choice when you need to add fields
--     or delete optional fields, but only check compatibility against the
--     last schema version.
--
-- -   /FORWARD_ALL/: This compatibility choice allows data receivers to
--     read written by producers of any new registered schema. You can use
--     this choice when you need to add fields or delete optional fields,
--     and check compatibility against all previous schema versions.
--
-- -   /FULL/: This compatibility choice allows data receivers to read data
--     written by producers using the previous or next version of the
--     schema, but not necessarily earlier or later versions. You can use
--     this choice when you need to add or remove optional fields, but only
--     check compatibility against the last schema version.
--
-- -   /FULL_ALL/: This compatibility choice allows data receivers to read
--     data written by producers using all previous schema versions. You
--     can use this choice when you need to add or remove optional fields,
--     and check compatibility against all previous schema versions.
--
-- 'description', 'createSchema_description' - An optional description of the schema. If description is not provided,
-- there will not be any automatic default value for this.
--
-- 'registryId', 'createSchema_registryId' - This is a wrapper shape to contain the registry identity fields. If this
-- is not provided, the default registry will be used. The ARN format for
-- the same will be:
-- @arn:aws:glue:us-east-2:\<customer id>:registry\/default-registry:random-5-letter-id@.
--
-- 'schemaDefinition', 'createSchema_schemaDefinition' - The schema definition using the @DataFormat@ setting for @SchemaName@.
--
-- 'tags', 'createSchema_tags' - Amazon Web Services tags that contain a key value pair and may be
-- searched by console, command line, or API. If specified, follows the
-- Amazon Web Services tags-on-create pattern.
--
-- 'schemaName', 'createSchema_schemaName' - Name of the schema to be created of max length of 255, and may only
-- contain letters, numbers, hyphen, underscore, dollar sign, or hash mark.
-- No whitespace.
--
-- 'dataFormat', 'createSchema_dataFormat' - The data format of the schema definition. Currently @AVRO@, @JSON@ and
-- @PROTOBUF@ are supported.
newCreateSchema ::
  -- | 'schemaName'
  Prelude.Text ->
  -- | 'dataFormat'
  DataFormat ->
  CreateSchema
newCreateSchema :: Text -> DataFormat -> CreateSchema
newCreateSchema Text
pSchemaName_ DataFormat
pDataFormat_ =
  CreateSchema'
    { $sel:compatibility:CreateSchema' :: Maybe Compatibility
compatibility = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateSchema' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:registryId:CreateSchema' :: Maybe RegistryId
registryId = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaDefinition:CreateSchema' :: Maybe Text
schemaDefinition = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSchema' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaName:CreateSchema' :: Text
schemaName = Text
pSchemaName_,
      $sel:dataFormat:CreateSchema' :: DataFormat
dataFormat = DataFormat
pDataFormat_
    }

-- | The compatibility mode of the schema. The possible values are:
--
-- -   /NONE/: No compatibility mode applies. You can use this choice in
--     development scenarios or if you do not know the compatibility mode
--     that you want to apply to schemas. Any new version added will be
--     accepted without undergoing a compatibility check.
--
-- -   /DISABLED/: This compatibility choice prevents versioning for a
--     particular schema. You can use this choice to prevent future
--     versioning of a schema.
--
-- -   /BACKWARD/: This compatibility choice is recommended as it allows
--     data receivers to read both the current and one previous schema
--     version. This means that for instance, a new schema version cannot
--     drop data fields or change the type of these fields, so they can\'t
--     be read by readers using the previous version.
--
-- -   /BACKWARD_ALL/: This compatibility choice allows data receivers to
--     read both the current and all previous schema versions. You can use
--     this choice when you need to delete fields or add optional fields,
--     and check compatibility against all previous schema versions.
--
-- -   /FORWARD/: This compatibility choice allows data receivers to read
--     both the current and one next schema version, but not necessarily
--     later versions. You can use this choice when you need to add fields
--     or delete optional fields, but only check compatibility against the
--     last schema version.
--
-- -   /FORWARD_ALL/: This compatibility choice allows data receivers to
--     read written by producers of any new registered schema. You can use
--     this choice when you need to add fields or delete optional fields,
--     and check compatibility against all previous schema versions.
--
-- -   /FULL/: This compatibility choice allows data receivers to read data
--     written by producers using the previous or next version of the
--     schema, but not necessarily earlier or later versions. You can use
--     this choice when you need to add or remove optional fields, but only
--     check compatibility against the last schema version.
--
-- -   /FULL_ALL/: This compatibility choice allows data receivers to read
--     data written by producers using all previous schema versions. You
--     can use this choice when you need to add or remove optional fields,
--     and check compatibility against all previous schema versions.
createSchema_compatibility :: Lens.Lens' CreateSchema (Prelude.Maybe Compatibility)
createSchema_compatibility :: Lens' CreateSchema (Maybe Compatibility)
createSchema_compatibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchema' {Maybe Compatibility
compatibility :: Maybe Compatibility
$sel:compatibility:CreateSchema' :: CreateSchema -> Maybe Compatibility
compatibility} -> Maybe Compatibility
compatibility) (\s :: CreateSchema
s@CreateSchema' {} Maybe Compatibility
a -> CreateSchema
s {$sel:compatibility:CreateSchema' :: Maybe Compatibility
compatibility = Maybe Compatibility
a} :: CreateSchema)

-- | An optional description of the schema. If description is not provided,
-- there will not be any automatic default value for this.
createSchema_description :: Lens.Lens' CreateSchema (Prelude.Maybe Prelude.Text)
createSchema_description :: Lens' CreateSchema (Maybe Text)
createSchema_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchema' {Maybe Text
description :: Maybe Text
$sel:description:CreateSchema' :: CreateSchema -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateSchema
s@CreateSchema' {} Maybe Text
a -> CreateSchema
s {$sel:description:CreateSchema' :: Maybe Text
description = Maybe Text
a} :: CreateSchema)

-- | This is a wrapper shape to contain the registry identity fields. If this
-- is not provided, the default registry will be used. The ARN format for
-- the same will be:
-- @arn:aws:glue:us-east-2:\<customer id>:registry\/default-registry:random-5-letter-id@.
createSchema_registryId :: Lens.Lens' CreateSchema (Prelude.Maybe RegistryId)
createSchema_registryId :: Lens' CreateSchema (Maybe RegistryId)
createSchema_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchema' {Maybe RegistryId
registryId :: Maybe RegistryId
$sel:registryId:CreateSchema' :: CreateSchema -> Maybe RegistryId
registryId} -> Maybe RegistryId
registryId) (\s :: CreateSchema
s@CreateSchema' {} Maybe RegistryId
a -> CreateSchema
s {$sel:registryId:CreateSchema' :: Maybe RegistryId
registryId = Maybe RegistryId
a} :: CreateSchema)

-- | The schema definition using the @DataFormat@ setting for @SchemaName@.
createSchema_schemaDefinition :: Lens.Lens' CreateSchema (Prelude.Maybe Prelude.Text)
createSchema_schemaDefinition :: Lens' CreateSchema (Maybe Text)
createSchema_schemaDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchema' {Maybe Text
schemaDefinition :: Maybe Text
$sel:schemaDefinition:CreateSchema' :: CreateSchema -> Maybe Text
schemaDefinition} -> Maybe Text
schemaDefinition) (\s :: CreateSchema
s@CreateSchema' {} Maybe Text
a -> CreateSchema
s {$sel:schemaDefinition:CreateSchema' :: Maybe Text
schemaDefinition = Maybe Text
a} :: CreateSchema)

-- | Amazon Web Services tags that contain a key value pair and may be
-- searched by console, command line, or API. If specified, follows the
-- Amazon Web Services tags-on-create pattern.
createSchema_tags :: Lens.Lens' CreateSchema (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSchema_tags :: Lens' CreateSchema (Maybe (HashMap Text Text))
createSchema_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchema' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSchema' :: CreateSchema -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSchema
s@CreateSchema' {} Maybe (HashMap Text Text)
a -> CreateSchema
s {$sel:tags:CreateSchema' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSchema) 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

-- | Name of the schema to be created of max length of 255, and may only
-- contain letters, numbers, hyphen, underscore, dollar sign, or hash mark.
-- No whitespace.
createSchema_schemaName :: Lens.Lens' CreateSchema Prelude.Text
createSchema_schemaName :: Lens' CreateSchema Text
createSchema_schemaName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchema' {Text
schemaName :: Text
$sel:schemaName:CreateSchema' :: CreateSchema -> Text
schemaName} -> Text
schemaName) (\s :: CreateSchema
s@CreateSchema' {} Text
a -> CreateSchema
s {$sel:schemaName:CreateSchema' :: Text
schemaName = Text
a} :: CreateSchema)

-- | The data format of the schema definition. Currently @AVRO@, @JSON@ and
-- @PROTOBUF@ are supported.
createSchema_dataFormat :: Lens.Lens' CreateSchema DataFormat
createSchema_dataFormat :: Lens' CreateSchema DataFormat
createSchema_dataFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchema' {DataFormat
dataFormat :: DataFormat
$sel:dataFormat:CreateSchema' :: CreateSchema -> DataFormat
dataFormat} -> DataFormat
dataFormat) (\s :: CreateSchema
s@CreateSchema' {} DataFormat
a -> CreateSchema
s {$sel:dataFormat:CreateSchema' :: DataFormat
dataFormat = DataFormat
a} :: CreateSchema)

instance Core.AWSRequest CreateSchema where
  type AWSResponse CreateSchema = CreateSchemaResponse
  request :: (Service -> Service) -> CreateSchema -> Request CreateSchema
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 CreateSchema
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSchema)))
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 Compatibility
-> Maybe DataFormat
-> Maybe Text
-> Maybe Natural
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe SchemaStatus
-> Maybe Text
-> Maybe SchemaVersionStatus
-> Maybe (HashMap Text Text)
-> Int
-> CreateSchemaResponse
CreateSchemaResponse'
            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
"Compatibility")
            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
"DataFormat")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LatestSchemaVersion")
            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
"NextSchemaVersion")
            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
"RegistryArn")
            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
"RegistryName")
            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
"SchemaArn")
            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
"SchemaCheckpoint")
            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
"SchemaName")
            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
"SchemaStatus")
            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
"SchemaVersionId")
            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
"SchemaVersionStatus")
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateSchema where
  hashWithSalt :: Int -> CreateSchema -> Int
hashWithSalt Int
_salt CreateSchema' {Maybe Text
Maybe (HashMap Text Text)
Maybe Compatibility
Maybe RegistryId
Text
DataFormat
dataFormat :: DataFormat
schemaName :: Text
tags :: Maybe (HashMap Text Text)
schemaDefinition :: Maybe Text
registryId :: Maybe RegistryId
description :: Maybe Text
compatibility :: Maybe Compatibility
$sel:dataFormat:CreateSchema' :: CreateSchema -> DataFormat
$sel:schemaName:CreateSchema' :: CreateSchema -> Text
$sel:tags:CreateSchema' :: CreateSchema -> Maybe (HashMap Text Text)
$sel:schemaDefinition:CreateSchema' :: CreateSchema -> Maybe Text
$sel:registryId:CreateSchema' :: CreateSchema -> Maybe RegistryId
$sel:description:CreateSchema' :: CreateSchema -> Maybe Text
$sel:compatibility:CreateSchema' :: CreateSchema -> Maybe Compatibility
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Compatibility
compatibility
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RegistryId
registryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
schemaDefinition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataFormat
dataFormat

instance Prelude.NFData CreateSchema where
  rnf :: CreateSchema -> ()
rnf CreateSchema' {Maybe Text
Maybe (HashMap Text Text)
Maybe Compatibility
Maybe RegistryId
Text
DataFormat
dataFormat :: DataFormat
schemaName :: Text
tags :: Maybe (HashMap Text Text)
schemaDefinition :: Maybe Text
registryId :: Maybe RegistryId
description :: Maybe Text
compatibility :: Maybe Compatibility
$sel:dataFormat:CreateSchema' :: CreateSchema -> DataFormat
$sel:schemaName:CreateSchema' :: CreateSchema -> Text
$sel:tags:CreateSchema' :: CreateSchema -> Maybe (HashMap Text Text)
$sel:schemaDefinition:CreateSchema' :: CreateSchema -> Maybe Text
$sel:registryId:CreateSchema' :: CreateSchema -> Maybe RegistryId
$sel:description:CreateSchema' :: CreateSchema -> Maybe Text
$sel:compatibility:CreateSchema' :: CreateSchema -> Maybe Compatibility
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Compatibility
compatibility
      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 RegistryId
registryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaDefinition
      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 Text
schemaName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DataFormat
dataFormat

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

instance Data.ToJSON CreateSchema where
  toJSON :: CreateSchema -> Value
toJSON CreateSchema' {Maybe Text
Maybe (HashMap Text Text)
Maybe Compatibility
Maybe RegistryId
Text
DataFormat
dataFormat :: DataFormat
schemaName :: Text
tags :: Maybe (HashMap Text Text)
schemaDefinition :: Maybe Text
registryId :: Maybe RegistryId
description :: Maybe Text
compatibility :: Maybe Compatibility
$sel:dataFormat:CreateSchema' :: CreateSchema -> DataFormat
$sel:schemaName:CreateSchema' :: CreateSchema -> Text
$sel:tags:CreateSchema' :: CreateSchema -> Maybe (HashMap Text Text)
$sel:schemaDefinition:CreateSchema' :: CreateSchema -> Maybe Text
$sel:registryId:CreateSchema' :: CreateSchema -> Maybe RegistryId
$sel:description:CreateSchema' :: CreateSchema -> Maybe Text
$sel:compatibility:CreateSchema' :: CreateSchema -> Maybe Compatibility
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Compatibility" 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 Compatibility
compatibility,
            (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
"RegistryId" 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 RegistryId
registryId,
            (Key
"SchemaDefinition" 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
schemaDefinition,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"SchemaName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
schemaName),
            forall a. a -> Maybe a
Prelude.Just (Key
"DataFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataFormat
dataFormat)
          ]
      )

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

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

-- | /See:/ 'newCreateSchemaResponse' smart constructor.
data CreateSchemaResponse = CreateSchemaResponse'
  { -- | The schema compatibility mode.
    CreateSchemaResponse -> Maybe Compatibility
compatibility :: Prelude.Maybe Compatibility,
    -- | The data format of the schema definition. Currently @AVRO@, @JSON@ and
    -- @PROTOBUF@ are supported.
    CreateSchemaResponse -> Maybe DataFormat
dataFormat :: Prelude.Maybe DataFormat,
    -- | A description of the schema if specified when created.
    CreateSchemaResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The latest version of the schema associated with the returned schema
    -- definition.
    CreateSchemaResponse -> Maybe Natural
latestSchemaVersion :: Prelude.Maybe Prelude.Natural,
    -- | The next version of the schema associated with the returned schema
    -- definition.
    CreateSchemaResponse -> Maybe Natural
nextSchemaVersion :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) of the registry.
    CreateSchemaResponse -> Maybe Text
registryArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the registry.
    CreateSchemaResponse -> Maybe Text
registryName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the schema.
    CreateSchemaResponse -> Maybe Text
schemaArn :: Prelude.Maybe Prelude.Text,
    -- | The version number of the checkpoint (the last time the compatibility
    -- mode was changed).
    CreateSchemaResponse -> Maybe Natural
schemaCheckpoint :: Prelude.Maybe Prelude.Natural,
    -- | The name of the schema.
    CreateSchemaResponse -> Maybe Text
schemaName :: Prelude.Maybe Prelude.Text,
    -- | The status of the schema.
    CreateSchemaResponse -> Maybe SchemaStatus
schemaStatus :: Prelude.Maybe SchemaStatus,
    -- | The unique identifier of the first schema version.
    CreateSchemaResponse -> Maybe Text
schemaVersionId :: Prelude.Maybe Prelude.Text,
    -- | The status of the first schema version created.
    CreateSchemaResponse -> Maybe SchemaVersionStatus
schemaVersionStatus :: Prelude.Maybe SchemaVersionStatus,
    -- | The tags for the schema.
    CreateSchemaResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateSchemaResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSchemaResponse -> CreateSchemaResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSchemaResponse -> CreateSchemaResponse -> Bool
$c/= :: CreateSchemaResponse -> CreateSchemaResponse -> Bool
== :: CreateSchemaResponse -> CreateSchemaResponse -> Bool
$c== :: CreateSchemaResponse -> CreateSchemaResponse -> Bool
Prelude.Eq, ReadPrec [CreateSchemaResponse]
ReadPrec CreateSchemaResponse
Int -> ReadS CreateSchemaResponse
ReadS [CreateSchemaResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSchemaResponse]
$creadListPrec :: ReadPrec [CreateSchemaResponse]
readPrec :: ReadPrec CreateSchemaResponse
$creadPrec :: ReadPrec CreateSchemaResponse
readList :: ReadS [CreateSchemaResponse]
$creadList :: ReadS [CreateSchemaResponse]
readsPrec :: Int -> ReadS CreateSchemaResponse
$creadsPrec :: Int -> ReadS CreateSchemaResponse
Prelude.Read, Int -> CreateSchemaResponse -> ShowS
[CreateSchemaResponse] -> ShowS
CreateSchemaResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSchemaResponse] -> ShowS
$cshowList :: [CreateSchemaResponse] -> ShowS
show :: CreateSchemaResponse -> String
$cshow :: CreateSchemaResponse -> String
showsPrec :: Int -> CreateSchemaResponse -> ShowS
$cshowsPrec :: Int -> CreateSchemaResponse -> ShowS
Prelude.Show, forall x. Rep CreateSchemaResponse x -> CreateSchemaResponse
forall x. CreateSchemaResponse -> Rep CreateSchemaResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSchemaResponse x -> CreateSchemaResponse
$cfrom :: forall x. CreateSchemaResponse -> Rep CreateSchemaResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSchemaResponse' 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:
--
-- 'compatibility', 'createSchemaResponse_compatibility' - The schema compatibility mode.
--
-- 'dataFormat', 'createSchemaResponse_dataFormat' - The data format of the schema definition. Currently @AVRO@, @JSON@ and
-- @PROTOBUF@ are supported.
--
-- 'description', 'createSchemaResponse_description' - A description of the schema if specified when created.
--
-- 'latestSchemaVersion', 'createSchemaResponse_latestSchemaVersion' - The latest version of the schema associated with the returned schema
-- definition.
--
-- 'nextSchemaVersion', 'createSchemaResponse_nextSchemaVersion' - The next version of the schema associated with the returned schema
-- definition.
--
-- 'registryArn', 'createSchemaResponse_registryArn' - The Amazon Resource Name (ARN) of the registry.
--
-- 'registryName', 'createSchemaResponse_registryName' - The name of the registry.
--
-- 'schemaArn', 'createSchemaResponse_schemaArn' - The Amazon Resource Name (ARN) of the schema.
--
-- 'schemaCheckpoint', 'createSchemaResponse_schemaCheckpoint' - The version number of the checkpoint (the last time the compatibility
-- mode was changed).
--
-- 'schemaName', 'createSchemaResponse_schemaName' - The name of the schema.
--
-- 'schemaStatus', 'createSchemaResponse_schemaStatus' - The status of the schema.
--
-- 'schemaVersionId', 'createSchemaResponse_schemaVersionId' - The unique identifier of the first schema version.
--
-- 'schemaVersionStatus', 'createSchemaResponse_schemaVersionStatus' - The status of the first schema version created.
--
-- 'tags', 'createSchemaResponse_tags' - The tags for the schema.
--
-- 'httpStatus', 'createSchemaResponse_httpStatus' - The response's http status code.
newCreateSchemaResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSchemaResponse
newCreateSchemaResponse :: Int -> CreateSchemaResponse
newCreateSchemaResponse Int
pHttpStatus_ =
  CreateSchemaResponse'
    { $sel:compatibility:CreateSchemaResponse' :: Maybe Compatibility
compatibility =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dataFormat:CreateSchemaResponse' :: Maybe DataFormat
dataFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateSchemaResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:latestSchemaVersion:CreateSchemaResponse' :: Maybe Natural
latestSchemaVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:nextSchemaVersion:CreateSchemaResponse' :: Maybe Natural
nextSchemaVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:registryArn:CreateSchemaResponse' :: Maybe Text
registryArn = forall a. Maybe a
Prelude.Nothing,
      $sel:registryName:CreateSchemaResponse' :: Maybe Text
registryName = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaArn:CreateSchemaResponse' :: Maybe Text
schemaArn = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaCheckpoint:CreateSchemaResponse' :: Maybe Natural
schemaCheckpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaName:CreateSchemaResponse' :: Maybe Text
schemaName = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaStatus:CreateSchemaResponse' :: Maybe SchemaStatus
schemaStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaVersionId:CreateSchemaResponse' :: Maybe Text
schemaVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaVersionStatus:CreateSchemaResponse' :: Maybe SchemaVersionStatus
schemaVersionStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSchemaResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSchemaResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The schema compatibility mode.
createSchemaResponse_compatibility :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Compatibility)
createSchemaResponse_compatibility :: Lens' CreateSchemaResponse (Maybe Compatibility)
createSchemaResponse_compatibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Compatibility
compatibility :: Maybe Compatibility
$sel:compatibility:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Compatibility
compatibility} -> Maybe Compatibility
compatibility) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Compatibility
a -> CreateSchemaResponse
s {$sel:compatibility:CreateSchemaResponse' :: Maybe Compatibility
compatibility = Maybe Compatibility
a} :: CreateSchemaResponse)

-- | The data format of the schema definition. Currently @AVRO@, @JSON@ and
-- @PROTOBUF@ are supported.
createSchemaResponse_dataFormat :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe DataFormat)
createSchemaResponse_dataFormat :: Lens' CreateSchemaResponse (Maybe DataFormat)
createSchemaResponse_dataFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe DataFormat
dataFormat :: Maybe DataFormat
$sel:dataFormat:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe DataFormat
dataFormat} -> Maybe DataFormat
dataFormat) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe DataFormat
a -> CreateSchemaResponse
s {$sel:dataFormat:CreateSchemaResponse' :: Maybe DataFormat
dataFormat = Maybe DataFormat
a} :: CreateSchemaResponse)

-- | A description of the schema if specified when created.
createSchemaResponse_description :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Text)
createSchemaResponse_description :: Lens' CreateSchemaResponse (Maybe Text)
createSchemaResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Text
a -> CreateSchemaResponse
s {$sel:description:CreateSchemaResponse' :: Maybe Text
description = Maybe Text
a} :: CreateSchemaResponse)

-- | The latest version of the schema associated with the returned schema
-- definition.
createSchemaResponse_latestSchemaVersion :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Natural)
createSchemaResponse_latestSchemaVersion :: Lens' CreateSchemaResponse (Maybe Natural)
createSchemaResponse_latestSchemaVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Natural
latestSchemaVersion :: Maybe Natural
$sel:latestSchemaVersion:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Natural
latestSchemaVersion} -> Maybe Natural
latestSchemaVersion) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Natural
a -> CreateSchemaResponse
s {$sel:latestSchemaVersion:CreateSchemaResponse' :: Maybe Natural
latestSchemaVersion = Maybe Natural
a} :: CreateSchemaResponse)

-- | The next version of the schema associated with the returned schema
-- definition.
createSchemaResponse_nextSchemaVersion :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Natural)
createSchemaResponse_nextSchemaVersion :: Lens' CreateSchemaResponse (Maybe Natural)
createSchemaResponse_nextSchemaVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Natural
nextSchemaVersion :: Maybe Natural
$sel:nextSchemaVersion:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Natural
nextSchemaVersion} -> Maybe Natural
nextSchemaVersion) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Natural
a -> CreateSchemaResponse
s {$sel:nextSchemaVersion:CreateSchemaResponse' :: Maybe Natural
nextSchemaVersion = Maybe Natural
a} :: CreateSchemaResponse)

-- | The Amazon Resource Name (ARN) of the registry.
createSchemaResponse_registryArn :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Text)
createSchemaResponse_registryArn :: Lens' CreateSchemaResponse (Maybe Text)
createSchemaResponse_registryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Text
registryArn :: Maybe Text
$sel:registryArn:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
registryArn} -> Maybe Text
registryArn) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Text
a -> CreateSchemaResponse
s {$sel:registryArn:CreateSchemaResponse' :: Maybe Text
registryArn = Maybe Text
a} :: CreateSchemaResponse)

-- | The name of the registry.
createSchemaResponse_registryName :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Text)
createSchemaResponse_registryName :: Lens' CreateSchemaResponse (Maybe Text)
createSchemaResponse_registryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Text
registryName :: Maybe Text
$sel:registryName:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
registryName} -> Maybe Text
registryName) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Text
a -> CreateSchemaResponse
s {$sel:registryName:CreateSchemaResponse' :: Maybe Text
registryName = Maybe Text
a} :: CreateSchemaResponse)

-- | The Amazon Resource Name (ARN) of the schema.
createSchemaResponse_schemaArn :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Text)
createSchemaResponse_schemaArn :: Lens' CreateSchemaResponse (Maybe Text)
createSchemaResponse_schemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Text
schemaArn :: Maybe Text
$sel:schemaArn:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
schemaArn} -> Maybe Text
schemaArn) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Text
a -> CreateSchemaResponse
s {$sel:schemaArn:CreateSchemaResponse' :: Maybe Text
schemaArn = Maybe Text
a} :: CreateSchemaResponse)

-- | The version number of the checkpoint (the last time the compatibility
-- mode was changed).
createSchemaResponse_schemaCheckpoint :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Natural)
createSchemaResponse_schemaCheckpoint :: Lens' CreateSchemaResponse (Maybe Natural)
createSchemaResponse_schemaCheckpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Natural
schemaCheckpoint :: Maybe Natural
$sel:schemaCheckpoint:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Natural
schemaCheckpoint} -> Maybe Natural
schemaCheckpoint) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Natural
a -> CreateSchemaResponse
s {$sel:schemaCheckpoint:CreateSchemaResponse' :: Maybe Natural
schemaCheckpoint = Maybe Natural
a} :: CreateSchemaResponse)

-- | The name of the schema.
createSchemaResponse_schemaName :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Text)
createSchemaResponse_schemaName :: Lens' CreateSchemaResponse (Maybe Text)
createSchemaResponse_schemaName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Text
schemaName :: Maybe Text
$sel:schemaName:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
schemaName} -> Maybe Text
schemaName) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Text
a -> CreateSchemaResponse
s {$sel:schemaName:CreateSchemaResponse' :: Maybe Text
schemaName = Maybe Text
a} :: CreateSchemaResponse)

-- | The status of the schema.
createSchemaResponse_schemaStatus :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe SchemaStatus)
createSchemaResponse_schemaStatus :: Lens' CreateSchemaResponse (Maybe SchemaStatus)
createSchemaResponse_schemaStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe SchemaStatus
schemaStatus :: Maybe SchemaStatus
$sel:schemaStatus:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe SchemaStatus
schemaStatus} -> Maybe SchemaStatus
schemaStatus) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe SchemaStatus
a -> CreateSchemaResponse
s {$sel:schemaStatus:CreateSchemaResponse' :: Maybe SchemaStatus
schemaStatus = Maybe SchemaStatus
a} :: CreateSchemaResponse)

-- | The unique identifier of the first schema version.
createSchemaResponse_schemaVersionId :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe Prelude.Text)
createSchemaResponse_schemaVersionId :: Lens' CreateSchemaResponse (Maybe Text)
createSchemaResponse_schemaVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe Text
schemaVersionId :: Maybe Text
$sel:schemaVersionId:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
schemaVersionId} -> Maybe Text
schemaVersionId) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe Text
a -> CreateSchemaResponse
s {$sel:schemaVersionId:CreateSchemaResponse' :: Maybe Text
schemaVersionId = Maybe Text
a} :: CreateSchemaResponse)

-- | The status of the first schema version created.
createSchemaResponse_schemaVersionStatus :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe SchemaVersionStatus)
createSchemaResponse_schemaVersionStatus :: Lens' CreateSchemaResponse (Maybe SchemaVersionStatus)
createSchemaResponse_schemaVersionStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe SchemaVersionStatus
schemaVersionStatus :: Maybe SchemaVersionStatus
$sel:schemaVersionStatus:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe SchemaVersionStatus
schemaVersionStatus} -> Maybe SchemaVersionStatus
schemaVersionStatus) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe SchemaVersionStatus
a -> CreateSchemaResponse
s {$sel:schemaVersionStatus:CreateSchemaResponse' :: Maybe SchemaVersionStatus
schemaVersionStatus = Maybe SchemaVersionStatus
a} :: CreateSchemaResponse)

-- | The tags for the schema.
createSchemaResponse_tags :: Lens.Lens' CreateSchemaResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSchemaResponse_tags :: Lens' CreateSchemaResponse (Maybe (HashMap Text Text))
createSchemaResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Maybe (HashMap Text Text)
a -> CreateSchemaResponse
s {$sel:tags:CreateSchemaResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSchemaResponse) 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 response's http status code.
createSchemaResponse_httpStatus :: Lens.Lens' CreateSchemaResponse Prelude.Int
createSchemaResponse_httpStatus :: Lens' CreateSchemaResponse Int
createSchemaResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSchemaResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateSchemaResponse' :: CreateSchemaResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateSchemaResponse
s@CreateSchemaResponse' {} Int
a -> CreateSchemaResponse
s {$sel:httpStatus:CreateSchemaResponse' :: Int
httpStatus = Int
a} :: CreateSchemaResponse)

instance Prelude.NFData CreateSchemaResponse where
  rnf :: CreateSchemaResponse -> ()
rnf CreateSchemaResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe Compatibility
Maybe DataFormat
Maybe SchemaStatus
Maybe SchemaVersionStatus
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
schemaVersionStatus :: Maybe SchemaVersionStatus
schemaVersionId :: Maybe Text
schemaStatus :: Maybe SchemaStatus
schemaName :: Maybe Text
schemaCheckpoint :: Maybe Natural
schemaArn :: Maybe Text
registryName :: Maybe Text
registryArn :: Maybe Text
nextSchemaVersion :: Maybe Natural
latestSchemaVersion :: Maybe Natural
description :: Maybe Text
dataFormat :: Maybe DataFormat
compatibility :: Maybe Compatibility
$sel:httpStatus:CreateSchemaResponse' :: CreateSchemaResponse -> Int
$sel:tags:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe (HashMap Text Text)
$sel:schemaVersionStatus:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe SchemaVersionStatus
$sel:schemaVersionId:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
$sel:schemaStatus:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe SchemaStatus
$sel:schemaName:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
$sel:schemaCheckpoint:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Natural
$sel:schemaArn:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
$sel:registryName:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
$sel:registryArn:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
$sel:nextSchemaVersion:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Natural
$sel:latestSchemaVersion:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Natural
$sel:description:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Text
$sel:dataFormat:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe DataFormat
$sel:compatibility:CreateSchemaResponse' :: CreateSchemaResponse -> Maybe Compatibility
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Compatibility
compatibility
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataFormat
dataFormat
      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 Natural
latestSchemaVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
nextSchemaVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
schemaCheckpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SchemaStatus
schemaStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SchemaVersionStatus
schemaVersionStatus
      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 Int
httpStatus