{-# 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.Schemas.UpdateSchema
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the schema definition
--
-- Inactive schemas will be deleted after two years.
module Amazonka.Schemas.UpdateSchema
  ( -- * Creating a Request
    UpdateSchema (..),
    newUpdateSchema,

    -- * Request Lenses
    updateSchema_clientTokenId,
    updateSchema_content,
    updateSchema_description,
    updateSchema_type,
    updateSchema_registryName,
    updateSchema_schemaName,

    -- * Destructuring the Response
    UpdateSchemaResponse (..),
    newUpdateSchemaResponse,

    -- * Response Lenses
    updateSchemaResponse_description,
    updateSchemaResponse_lastModified,
    updateSchemaResponse_schemaArn,
    updateSchemaResponse_schemaName,
    updateSchemaResponse_schemaVersion,
    updateSchemaResponse_tags,
    updateSchemaResponse_type,
    updateSchemaResponse_versionCreatedDate,
    updateSchemaResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateSchema' smart constructor.
data UpdateSchema = UpdateSchema'
  { -- | The ID of the client token.
    UpdateSchema -> Maybe Text
clientTokenId :: Prelude.Maybe Prelude.Text,
    -- | The source of the schema definition.
    UpdateSchema -> Maybe Text
content :: Prelude.Maybe Prelude.Text,
    -- | The description of the schema.
    UpdateSchema -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The schema type for the events schema.
    UpdateSchema -> Maybe Type
type' :: Prelude.Maybe Type,
    -- | The name of the registry.
    UpdateSchema -> Text
registryName :: Prelude.Text,
    -- | The name of the schema.
    UpdateSchema -> Text
schemaName :: Prelude.Text
  }
  deriving (UpdateSchema -> UpdateSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSchema -> UpdateSchema -> Bool
$c/= :: UpdateSchema -> UpdateSchema -> Bool
== :: UpdateSchema -> UpdateSchema -> Bool
$c== :: UpdateSchema -> UpdateSchema -> Bool
Prelude.Eq, ReadPrec [UpdateSchema]
ReadPrec UpdateSchema
Int -> ReadS UpdateSchema
ReadS [UpdateSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSchema]
$creadListPrec :: ReadPrec [UpdateSchema]
readPrec :: ReadPrec UpdateSchema
$creadPrec :: ReadPrec UpdateSchema
readList :: ReadS [UpdateSchema]
$creadList :: ReadS [UpdateSchema]
readsPrec :: Int -> ReadS UpdateSchema
$creadsPrec :: Int -> ReadS UpdateSchema
Prelude.Read, Int -> UpdateSchema -> ShowS
[UpdateSchema] -> ShowS
UpdateSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSchema] -> ShowS
$cshowList :: [UpdateSchema] -> ShowS
show :: UpdateSchema -> String
$cshow :: UpdateSchema -> String
showsPrec :: Int -> UpdateSchema -> ShowS
$cshowsPrec :: Int -> UpdateSchema -> ShowS
Prelude.Show, forall x. Rep UpdateSchema x -> UpdateSchema
forall x. UpdateSchema -> Rep UpdateSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSchema x -> UpdateSchema
$cfrom :: forall x. UpdateSchema -> Rep UpdateSchema x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSchema' 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:
--
-- 'clientTokenId', 'updateSchema_clientTokenId' - The ID of the client token.
--
-- 'content', 'updateSchema_content' - The source of the schema definition.
--
-- 'description', 'updateSchema_description' - The description of the schema.
--
-- 'type'', 'updateSchema_type' - The schema type for the events schema.
--
-- 'registryName', 'updateSchema_registryName' - The name of the registry.
--
-- 'schemaName', 'updateSchema_schemaName' - The name of the schema.
newUpdateSchema ::
  -- | 'registryName'
  Prelude.Text ->
  -- | 'schemaName'
  Prelude.Text ->
  UpdateSchema
newUpdateSchema :: Text -> Text -> UpdateSchema
newUpdateSchema Text
pRegistryName_ Text
pSchemaName_ =
  UpdateSchema'
    { $sel:clientTokenId:UpdateSchema' :: Maybe Text
clientTokenId = forall a. Maybe a
Prelude.Nothing,
      $sel:content:UpdateSchema' :: Maybe Text
content = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateSchema' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateSchema' :: Maybe Type
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:registryName:UpdateSchema' :: Text
registryName = Text
pRegistryName_,
      $sel:schemaName:UpdateSchema' :: Text
schemaName = Text
pSchemaName_
    }

-- | The ID of the client token.
updateSchema_clientTokenId :: Lens.Lens' UpdateSchema (Prelude.Maybe Prelude.Text)
updateSchema_clientTokenId :: Lens' UpdateSchema (Maybe Text)
updateSchema_clientTokenId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchema' {Maybe Text
clientTokenId :: Maybe Text
$sel:clientTokenId:UpdateSchema' :: UpdateSchema -> Maybe Text
clientTokenId} -> Maybe Text
clientTokenId) (\s :: UpdateSchema
s@UpdateSchema' {} Maybe Text
a -> UpdateSchema
s {$sel:clientTokenId:UpdateSchema' :: Maybe Text
clientTokenId = Maybe Text
a} :: UpdateSchema)

-- | The source of the schema definition.
updateSchema_content :: Lens.Lens' UpdateSchema (Prelude.Maybe Prelude.Text)
updateSchema_content :: Lens' UpdateSchema (Maybe Text)
updateSchema_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchema' {Maybe Text
content :: Maybe Text
$sel:content:UpdateSchema' :: UpdateSchema -> Maybe Text
content} -> Maybe Text
content) (\s :: UpdateSchema
s@UpdateSchema' {} Maybe Text
a -> UpdateSchema
s {$sel:content:UpdateSchema' :: Maybe Text
content = Maybe Text
a} :: UpdateSchema)

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

-- | The schema type for the events schema.
updateSchema_type :: Lens.Lens' UpdateSchema (Prelude.Maybe Type)
updateSchema_type :: Lens' UpdateSchema (Maybe Type)
updateSchema_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchema' {Maybe Type
type' :: Maybe Type
$sel:type':UpdateSchema' :: UpdateSchema -> Maybe Type
type'} -> Maybe Type
type') (\s :: UpdateSchema
s@UpdateSchema' {} Maybe Type
a -> UpdateSchema
s {$sel:type':UpdateSchema' :: Maybe Type
type' = Maybe Type
a} :: UpdateSchema)

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

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

instance Core.AWSRequest UpdateSchema where
  type AWSResponse UpdateSchema = UpdateSchemaResponse
  request :: (Service -> Service) -> UpdateSchema -> Request UpdateSchema
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 UpdateSchema
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateSchema)))
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 ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe ISO8601
-> Int
-> UpdateSchemaResponse
UpdateSchemaResponse'
            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
"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
"LastModified")
            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
"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
"SchemaVersion")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Type")
            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
"VersionCreatedDate")
            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 UpdateSchema where
  hashWithSalt :: Int -> UpdateSchema -> Int
hashWithSalt Int
_salt UpdateSchema' {Maybe Text
Maybe Type
Text
schemaName :: Text
registryName :: Text
type' :: Maybe Type
description :: Maybe Text
content :: Maybe Text
clientTokenId :: Maybe Text
$sel:schemaName:UpdateSchema' :: UpdateSchema -> Text
$sel:registryName:UpdateSchema' :: UpdateSchema -> Text
$sel:type':UpdateSchema' :: UpdateSchema -> Maybe Type
$sel:description:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:content:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:clientTokenId:UpdateSchema' :: UpdateSchema -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientTokenId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Type
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
registryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaName

instance Prelude.NFData UpdateSchema where
  rnf :: UpdateSchema -> ()
rnf UpdateSchema' {Maybe Text
Maybe Type
Text
schemaName :: Text
registryName :: Text
type' :: Maybe Type
description :: Maybe Text
content :: Maybe Text
clientTokenId :: Maybe Text
$sel:schemaName:UpdateSchema' :: UpdateSchema -> Text
$sel:registryName:UpdateSchema' :: UpdateSchema -> Text
$sel:type':UpdateSchema' :: UpdateSchema -> Maybe Type
$sel:description:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:content:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:clientTokenId:UpdateSchema' :: UpdateSchema -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientTokenId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
content
      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 Type
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
registryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schemaName

instance Data.ToHeaders UpdateSchema where
  toHeaders :: UpdateSchema -> 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 UpdateSchema where
  toJSON :: UpdateSchema -> Value
toJSON UpdateSchema' {Maybe Text
Maybe Type
Text
schemaName :: Text
registryName :: Text
type' :: Maybe Type
description :: Maybe Text
content :: Maybe Text
clientTokenId :: Maybe Text
$sel:schemaName:UpdateSchema' :: UpdateSchema -> Text
$sel:registryName:UpdateSchema' :: UpdateSchema -> Text
$sel:type':UpdateSchema' :: UpdateSchema -> Maybe Type
$sel:description:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:content:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:clientTokenId:UpdateSchema' :: UpdateSchema -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientTokenId" 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
clientTokenId,
            (Key
"Content" 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
content,
            (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
"Type" 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 Type
type'
          ]
      )

instance Data.ToPath UpdateSchema where
  toPath :: UpdateSchema -> ByteString
toPath UpdateSchema' {Maybe Text
Maybe Type
Text
schemaName :: Text
registryName :: Text
type' :: Maybe Type
description :: Maybe Text
content :: Maybe Text
clientTokenId :: Maybe Text
$sel:schemaName:UpdateSchema' :: UpdateSchema -> Text
$sel:registryName:UpdateSchema' :: UpdateSchema -> Text
$sel:type':UpdateSchema' :: UpdateSchema -> Maybe Type
$sel:description:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:content:UpdateSchema' :: UpdateSchema -> Maybe Text
$sel:clientTokenId:UpdateSchema' :: UpdateSchema -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/registries/name/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
registryName,
        ByteString
"/schemas/name/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
schemaName
      ]

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

-- | /See:/ 'newUpdateSchemaResponse' smart constructor.
data UpdateSchemaResponse = UpdateSchemaResponse'
  { -- | The description of the schema.
    UpdateSchemaResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The date and time that schema was modified.
    UpdateSchemaResponse -> Maybe ISO8601
lastModified :: Prelude.Maybe Data.ISO8601,
    -- | The ARN of the schema.
    UpdateSchemaResponse -> Maybe Text
schemaArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the schema.
    UpdateSchemaResponse -> Maybe Text
schemaName :: Prelude.Maybe Prelude.Text,
    -- | The version number of the schema
    UpdateSchemaResponse -> Maybe Text
schemaVersion :: Prelude.Maybe Prelude.Text,
    UpdateSchemaResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The type of the schema.
    UpdateSchemaResponse -> Maybe Text
type' :: Prelude.Maybe Prelude.Text,
    -- | The date the schema version was created.
    UpdateSchemaResponse -> Maybe ISO8601
versionCreatedDate :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    UpdateSchemaResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateSchemaResponse -> UpdateSchemaResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSchemaResponse -> UpdateSchemaResponse -> Bool
$c/= :: UpdateSchemaResponse -> UpdateSchemaResponse -> Bool
== :: UpdateSchemaResponse -> UpdateSchemaResponse -> Bool
$c== :: UpdateSchemaResponse -> UpdateSchemaResponse -> Bool
Prelude.Eq, ReadPrec [UpdateSchemaResponse]
ReadPrec UpdateSchemaResponse
Int -> ReadS UpdateSchemaResponse
ReadS [UpdateSchemaResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSchemaResponse]
$creadListPrec :: ReadPrec [UpdateSchemaResponse]
readPrec :: ReadPrec UpdateSchemaResponse
$creadPrec :: ReadPrec UpdateSchemaResponse
readList :: ReadS [UpdateSchemaResponse]
$creadList :: ReadS [UpdateSchemaResponse]
readsPrec :: Int -> ReadS UpdateSchemaResponse
$creadsPrec :: Int -> ReadS UpdateSchemaResponse
Prelude.Read, Int -> UpdateSchemaResponse -> ShowS
[UpdateSchemaResponse] -> ShowS
UpdateSchemaResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSchemaResponse] -> ShowS
$cshowList :: [UpdateSchemaResponse] -> ShowS
show :: UpdateSchemaResponse -> String
$cshow :: UpdateSchemaResponse -> String
showsPrec :: Int -> UpdateSchemaResponse -> ShowS
$cshowsPrec :: Int -> UpdateSchemaResponse -> ShowS
Prelude.Show, forall x. Rep UpdateSchemaResponse x -> UpdateSchemaResponse
forall x. UpdateSchemaResponse -> Rep UpdateSchemaResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSchemaResponse x -> UpdateSchemaResponse
$cfrom :: forall x. UpdateSchemaResponse -> Rep UpdateSchemaResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSchemaResponse' 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:
--
-- 'description', 'updateSchemaResponse_description' - The description of the schema.
--
-- 'lastModified', 'updateSchemaResponse_lastModified' - The date and time that schema was modified.
--
-- 'schemaArn', 'updateSchemaResponse_schemaArn' - The ARN of the schema.
--
-- 'schemaName', 'updateSchemaResponse_schemaName' - The name of the schema.
--
-- 'schemaVersion', 'updateSchemaResponse_schemaVersion' - The version number of the schema
--
-- 'tags', 'updateSchemaResponse_tags' - Undocumented member.
--
-- 'type'', 'updateSchemaResponse_type' - The type of the schema.
--
-- 'versionCreatedDate', 'updateSchemaResponse_versionCreatedDate' - The date the schema version was created.
--
-- 'httpStatus', 'updateSchemaResponse_httpStatus' - The response's http status code.
newUpdateSchemaResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSchemaResponse
newUpdateSchemaResponse :: Int -> UpdateSchemaResponse
newUpdateSchemaResponse Int
pHttpStatus_ =
  UpdateSchemaResponse'
    { $sel:description:UpdateSchemaResponse' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lastModified:UpdateSchemaResponse' :: Maybe ISO8601
lastModified = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaArn:UpdateSchemaResponse' :: Maybe Text
schemaArn = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaName:UpdateSchemaResponse' :: Maybe Text
schemaName = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaVersion:UpdateSchemaResponse' :: Maybe Text
schemaVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UpdateSchemaResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateSchemaResponse' :: Maybe Text
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:versionCreatedDate:UpdateSchemaResponse' :: Maybe ISO8601
versionCreatedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateSchemaResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The date and time that schema was modified.
updateSchemaResponse_lastModified :: Lens.Lens' UpdateSchemaResponse (Prelude.Maybe Prelude.UTCTime)
updateSchemaResponse_lastModified :: Lens' UpdateSchemaResponse (Maybe UTCTime)
updateSchemaResponse_lastModified = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchemaResponse' {Maybe ISO8601
lastModified :: Maybe ISO8601
$sel:lastModified:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe ISO8601
lastModified} -> Maybe ISO8601
lastModified) (\s :: UpdateSchemaResponse
s@UpdateSchemaResponse' {} Maybe ISO8601
a -> UpdateSchemaResponse
s {$sel:lastModified:UpdateSchemaResponse' :: Maybe ISO8601
lastModified = Maybe ISO8601
a} :: UpdateSchemaResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

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

-- | The version number of the schema
updateSchemaResponse_schemaVersion :: Lens.Lens' UpdateSchemaResponse (Prelude.Maybe Prelude.Text)
updateSchemaResponse_schemaVersion :: Lens' UpdateSchemaResponse (Maybe Text)
updateSchemaResponse_schemaVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchemaResponse' {Maybe Text
schemaVersion :: Maybe Text
$sel:schemaVersion:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe Text
schemaVersion} -> Maybe Text
schemaVersion) (\s :: UpdateSchemaResponse
s@UpdateSchemaResponse' {} Maybe Text
a -> UpdateSchemaResponse
s {$sel:schemaVersion:UpdateSchemaResponse' :: Maybe Text
schemaVersion = Maybe Text
a} :: UpdateSchemaResponse)

-- | Undocumented member.
updateSchemaResponse_tags :: Lens.Lens' UpdateSchemaResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateSchemaResponse_tags :: Lens' UpdateSchemaResponse (Maybe (HashMap Text Text))
updateSchemaResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchemaResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: UpdateSchemaResponse
s@UpdateSchemaResponse' {} Maybe (HashMap Text Text)
a -> UpdateSchemaResponse
s {$sel:tags:UpdateSchemaResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: UpdateSchemaResponse) 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 type of the schema.
updateSchemaResponse_type :: Lens.Lens' UpdateSchemaResponse (Prelude.Maybe Prelude.Text)
updateSchemaResponse_type :: Lens' UpdateSchemaResponse (Maybe Text)
updateSchemaResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchemaResponse' {Maybe Text
type' :: Maybe Text
$sel:type':UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe Text
type'} -> Maybe Text
type') (\s :: UpdateSchemaResponse
s@UpdateSchemaResponse' {} Maybe Text
a -> UpdateSchemaResponse
s {$sel:type':UpdateSchemaResponse' :: Maybe Text
type' = Maybe Text
a} :: UpdateSchemaResponse)

-- | The date the schema version was created.
updateSchemaResponse_versionCreatedDate :: Lens.Lens' UpdateSchemaResponse (Prelude.Maybe Prelude.UTCTime)
updateSchemaResponse_versionCreatedDate :: Lens' UpdateSchemaResponse (Maybe UTCTime)
updateSchemaResponse_versionCreatedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSchemaResponse' {Maybe ISO8601
versionCreatedDate :: Maybe ISO8601
$sel:versionCreatedDate:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe ISO8601
versionCreatedDate} -> Maybe ISO8601
versionCreatedDate) (\s :: UpdateSchemaResponse
s@UpdateSchemaResponse' {} Maybe ISO8601
a -> UpdateSchemaResponse
s {$sel:versionCreatedDate:UpdateSchemaResponse' :: Maybe ISO8601
versionCreatedDate = Maybe ISO8601
a} :: UpdateSchemaResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData UpdateSchemaResponse where
  rnf :: UpdateSchemaResponse -> ()
rnf UpdateSchemaResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe ISO8601
httpStatus :: Int
versionCreatedDate :: Maybe ISO8601
type' :: Maybe Text
tags :: Maybe (HashMap Text Text)
schemaVersion :: Maybe Text
schemaName :: Maybe Text
schemaArn :: Maybe Text
lastModified :: Maybe ISO8601
description :: Maybe Text
$sel:httpStatus:UpdateSchemaResponse' :: UpdateSchemaResponse -> Int
$sel:versionCreatedDate:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe ISO8601
$sel:type':UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe Text
$sel:tags:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe (HashMap Text Text)
$sel:schemaVersion:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe Text
$sel:schemaName:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe Text
$sel:schemaArn:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe Text
$sel:lastModified:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe ISO8601
$sel:description:UpdateSchemaResponse' :: UpdateSchemaResponse -> Maybe Text
..} =
    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 ISO8601
lastModified
      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 Text
schemaName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaVersion
      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
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
versionCreatedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus