{-# 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.GetSchemaByDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a schema by the @SchemaDefinition@. The schema definition is
-- sent to the Schema Registry, canonicalized, and hashed. If the hash is
-- matched within the scope of the @SchemaName@ or ARN (or the default
-- registry, if none is supplied), that schema’s metadata is returned.
-- Otherwise, a 404 or NotFound error is returned. Schema versions in
-- @Deleted@ statuses will not be included in the results.
module Amazonka.Glue.GetSchemaByDefinition
  ( -- * Creating a Request
    GetSchemaByDefinition (..),
    newGetSchemaByDefinition,

    -- * Request Lenses
    getSchemaByDefinition_schemaId,
    getSchemaByDefinition_schemaDefinition,

    -- * Destructuring the Response
    GetSchemaByDefinitionResponse (..),
    newGetSchemaByDefinitionResponse,

    -- * Response Lenses
    getSchemaByDefinitionResponse_createdTime,
    getSchemaByDefinitionResponse_dataFormat,
    getSchemaByDefinitionResponse_schemaArn,
    getSchemaByDefinitionResponse_schemaVersionId,
    getSchemaByDefinitionResponse_status,
    getSchemaByDefinitionResponse_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:/ 'newGetSchemaByDefinition' smart constructor.
data GetSchemaByDefinition = GetSchemaByDefinition'
  { -- | This is a wrapper structure to contain schema identity fields. The
    -- structure contains:
    --
    -- -   SchemaId$SchemaArn: The Amazon Resource Name (ARN) of the schema.
    --     One of @SchemaArn@ or @SchemaName@ has to be provided.
    --
    -- -   SchemaId$SchemaName: The name of the schema. One of @SchemaArn@ or
    --     @SchemaName@ has to be provided.
    GetSchemaByDefinition -> SchemaId
schemaId :: SchemaId,
    -- | The definition of the schema for which schema details are required.
    GetSchemaByDefinition -> Text
schemaDefinition :: Prelude.Text
  }
  deriving (GetSchemaByDefinition -> GetSchemaByDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSchemaByDefinition -> GetSchemaByDefinition -> Bool
$c/= :: GetSchemaByDefinition -> GetSchemaByDefinition -> Bool
== :: GetSchemaByDefinition -> GetSchemaByDefinition -> Bool
$c== :: GetSchemaByDefinition -> GetSchemaByDefinition -> Bool
Prelude.Eq, ReadPrec [GetSchemaByDefinition]
ReadPrec GetSchemaByDefinition
Int -> ReadS GetSchemaByDefinition
ReadS [GetSchemaByDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSchemaByDefinition]
$creadListPrec :: ReadPrec [GetSchemaByDefinition]
readPrec :: ReadPrec GetSchemaByDefinition
$creadPrec :: ReadPrec GetSchemaByDefinition
readList :: ReadS [GetSchemaByDefinition]
$creadList :: ReadS [GetSchemaByDefinition]
readsPrec :: Int -> ReadS GetSchemaByDefinition
$creadsPrec :: Int -> ReadS GetSchemaByDefinition
Prelude.Read, Int -> GetSchemaByDefinition -> ShowS
[GetSchemaByDefinition] -> ShowS
GetSchemaByDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSchemaByDefinition] -> ShowS
$cshowList :: [GetSchemaByDefinition] -> ShowS
show :: GetSchemaByDefinition -> String
$cshow :: GetSchemaByDefinition -> String
showsPrec :: Int -> GetSchemaByDefinition -> ShowS
$cshowsPrec :: Int -> GetSchemaByDefinition -> ShowS
Prelude.Show, forall x. Rep GetSchemaByDefinition x -> GetSchemaByDefinition
forall x. GetSchemaByDefinition -> Rep GetSchemaByDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSchemaByDefinition x -> GetSchemaByDefinition
$cfrom :: forall x. GetSchemaByDefinition -> Rep GetSchemaByDefinition x
Prelude.Generic)

-- |
-- Create a value of 'GetSchemaByDefinition' 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:
--
-- 'schemaId', 'getSchemaByDefinition_schemaId' - This is a wrapper structure to contain schema identity fields. The
-- structure contains:
--
-- -   SchemaId$SchemaArn: The Amazon Resource Name (ARN) of the schema.
--     One of @SchemaArn@ or @SchemaName@ has to be provided.
--
-- -   SchemaId$SchemaName: The name of the schema. One of @SchemaArn@ or
--     @SchemaName@ has to be provided.
--
-- 'schemaDefinition', 'getSchemaByDefinition_schemaDefinition' - The definition of the schema for which schema details are required.
newGetSchemaByDefinition ::
  -- | 'schemaId'
  SchemaId ->
  -- | 'schemaDefinition'
  Prelude.Text ->
  GetSchemaByDefinition
newGetSchemaByDefinition :: SchemaId -> Text -> GetSchemaByDefinition
newGetSchemaByDefinition
  SchemaId
pSchemaId_
  Text
pSchemaDefinition_ =
    GetSchemaByDefinition'
      { $sel:schemaId:GetSchemaByDefinition' :: SchemaId
schemaId = SchemaId
pSchemaId_,
        $sel:schemaDefinition:GetSchemaByDefinition' :: Text
schemaDefinition = Text
pSchemaDefinition_
      }

-- | This is a wrapper structure to contain schema identity fields. The
-- structure contains:
--
-- -   SchemaId$SchemaArn: The Amazon Resource Name (ARN) of the schema.
--     One of @SchemaArn@ or @SchemaName@ has to be provided.
--
-- -   SchemaId$SchemaName: The name of the schema. One of @SchemaArn@ or
--     @SchemaName@ has to be provided.
getSchemaByDefinition_schemaId :: Lens.Lens' GetSchemaByDefinition SchemaId
getSchemaByDefinition_schemaId :: Lens' GetSchemaByDefinition SchemaId
getSchemaByDefinition_schemaId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSchemaByDefinition' {SchemaId
schemaId :: SchemaId
$sel:schemaId:GetSchemaByDefinition' :: GetSchemaByDefinition -> SchemaId
schemaId} -> SchemaId
schemaId) (\s :: GetSchemaByDefinition
s@GetSchemaByDefinition' {} SchemaId
a -> GetSchemaByDefinition
s {$sel:schemaId:GetSchemaByDefinition' :: SchemaId
schemaId = SchemaId
a} :: GetSchemaByDefinition)

-- | The definition of the schema for which schema details are required.
getSchemaByDefinition_schemaDefinition :: Lens.Lens' GetSchemaByDefinition Prelude.Text
getSchemaByDefinition_schemaDefinition :: Lens' GetSchemaByDefinition Text
getSchemaByDefinition_schemaDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSchemaByDefinition' {Text
schemaDefinition :: Text
$sel:schemaDefinition:GetSchemaByDefinition' :: GetSchemaByDefinition -> Text
schemaDefinition} -> Text
schemaDefinition) (\s :: GetSchemaByDefinition
s@GetSchemaByDefinition' {} Text
a -> GetSchemaByDefinition
s {$sel:schemaDefinition:GetSchemaByDefinition' :: Text
schemaDefinition = Text
a} :: GetSchemaByDefinition)

instance Core.AWSRequest GetSchemaByDefinition where
  type
    AWSResponse GetSchemaByDefinition =
      GetSchemaByDefinitionResponse
  request :: (Service -> Service)
-> GetSchemaByDefinition -> Request GetSchemaByDefinition
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 GetSchemaByDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSchemaByDefinition)))
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 DataFormat
-> Maybe Text
-> Maybe Text
-> Maybe SchemaVersionStatus
-> Int
-> GetSchemaByDefinitionResponse
GetSchemaByDefinitionResponse'
            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
"CreatedTime")
            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
"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
"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
"Status")
            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 GetSchemaByDefinition where
  hashWithSalt :: Int -> GetSchemaByDefinition -> Int
hashWithSalt Int
_salt GetSchemaByDefinition' {Text
SchemaId
schemaDefinition :: Text
schemaId :: SchemaId
$sel:schemaDefinition:GetSchemaByDefinition' :: GetSchemaByDefinition -> Text
$sel:schemaId:GetSchemaByDefinition' :: GetSchemaByDefinition -> SchemaId
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SchemaId
schemaId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaDefinition

instance Prelude.NFData GetSchemaByDefinition where
  rnf :: GetSchemaByDefinition -> ()
rnf GetSchemaByDefinition' {Text
SchemaId
schemaDefinition :: Text
schemaId :: SchemaId
$sel:schemaDefinition:GetSchemaByDefinition' :: GetSchemaByDefinition -> Text
$sel:schemaId:GetSchemaByDefinition' :: GetSchemaByDefinition -> SchemaId
..} =
    forall a. NFData a => a -> ()
Prelude.rnf SchemaId
schemaId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schemaDefinition

instance Data.ToHeaders GetSchemaByDefinition where
  toHeaders :: GetSchemaByDefinition -> 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.GetSchemaByDefinition" ::
                          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 GetSchemaByDefinition where
  toJSON :: GetSchemaByDefinition -> Value
toJSON GetSchemaByDefinition' {Text
SchemaId
schemaDefinition :: Text
schemaId :: SchemaId
$sel:schemaDefinition:GetSchemaByDefinition' :: GetSchemaByDefinition -> Text
$sel:schemaId:GetSchemaByDefinition' :: GetSchemaByDefinition -> SchemaId
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"SchemaId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SchemaId
schemaId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SchemaDefinition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
schemaDefinition)
          ]
      )

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

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

-- | /See:/ 'newGetSchemaByDefinitionResponse' smart constructor.
data GetSchemaByDefinitionResponse = GetSchemaByDefinitionResponse'
  { -- | The date and time the schema was created.
    GetSchemaByDefinitionResponse -> Maybe Text
createdTime :: Prelude.Maybe Prelude.Text,
    -- | The data format of the schema definition. Currently @AVRO@, @JSON@ and
    -- @PROTOBUF@ are supported.
    GetSchemaByDefinitionResponse -> Maybe DataFormat
dataFormat :: Prelude.Maybe DataFormat,
    -- | The Amazon Resource Name (ARN) of the schema.
    GetSchemaByDefinitionResponse -> Maybe Text
schemaArn :: Prelude.Maybe Prelude.Text,
    -- | The schema ID of the schema version.
    GetSchemaByDefinitionResponse -> Maybe Text
schemaVersionId :: Prelude.Maybe Prelude.Text,
    -- | The status of the schema version.
    GetSchemaByDefinitionResponse -> Maybe SchemaVersionStatus
status :: Prelude.Maybe SchemaVersionStatus,
    -- | The response's http status code.
    GetSchemaByDefinitionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSchemaByDefinitionResponse
-> GetSchemaByDefinitionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSchemaByDefinitionResponse
-> GetSchemaByDefinitionResponse -> Bool
$c/= :: GetSchemaByDefinitionResponse
-> GetSchemaByDefinitionResponse -> Bool
== :: GetSchemaByDefinitionResponse
-> GetSchemaByDefinitionResponse -> Bool
$c== :: GetSchemaByDefinitionResponse
-> GetSchemaByDefinitionResponse -> Bool
Prelude.Eq, ReadPrec [GetSchemaByDefinitionResponse]
ReadPrec GetSchemaByDefinitionResponse
Int -> ReadS GetSchemaByDefinitionResponse
ReadS [GetSchemaByDefinitionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSchemaByDefinitionResponse]
$creadListPrec :: ReadPrec [GetSchemaByDefinitionResponse]
readPrec :: ReadPrec GetSchemaByDefinitionResponse
$creadPrec :: ReadPrec GetSchemaByDefinitionResponse
readList :: ReadS [GetSchemaByDefinitionResponse]
$creadList :: ReadS [GetSchemaByDefinitionResponse]
readsPrec :: Int -> ReadS GetSchemaByDefinitionResponse
$creadsPrec :: Int -> ReadS GetSchemaByDefinitionResponse
Prelude.Read, Int -> GetSchemaByDefinitionResponse -> ShowS
[GetSchemaByDefinitionResponse] -> ShowS
GetSchemaByDefinitionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSchemaByDefinitionResponse] -> ShowS
$cshowList :: [GetSchemaByDefinitionResponse] -> ShowS
show :: GetSchemaByDefinitionResponse -> String
$cshow :: GetSchemaByDefinitionResponse -> String
showsPrec :: Int -> GetSchemaByDefinitionResponse -> ShowS
$cshowsPrec :: Int -> GetSchemaByDefinitionResponse -> ShowS
Prelude.Show, forall x.
Rep GetSchemaByDefinitionResponse x
-> GetSchemaByDefinitionResponse
forall x.
GetSchemaByDefinitionResponse
-> Rep GetSchemaByDefinitionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSchemaByDefinitionResponse x
-> GetSchemaByDefinitionResponse
$cfrom :: forall x.
GetSchemaByDefinitionResponse
-> Rep GetSchemaByDefinitionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSchemaByDefinitionResponse' 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:
--
-- 'createdTime', 'getSchemaByDefinitionResponse_createdTime' - The date and time the schema was created.
--
-- 'dataFormat', 'getSchemaByDefinitionResponse_dataFormat' - The data format of the schema definition. Currently @AVRO@, @JSON@ and
-- @PROTOBUF@ are supported.
--
-- 'schemaArn', 'getSchemaByDefinitionResponse_schemaArn' - The Amazon Resource Name (ARN) of the schema.
--
-- 'schemaVersionId', 'getSchemaByDefinitionResponse_schemaVersionId' - The schema ID of the schema version.
--
-- 'status', 'getSchemaByDefinitionResponse_status' - The status of the schema version.
--
-- 'httpStatus', 'getSchemaByDefinitionResponse_httpStatus' - The response's http status code.
newGetSchemaByDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSchemaByDefinitionResponse
newGetSchemaByDefinitionResponse :: Int -> GetSchemaByDefinitionResponse
newGetSchemaByDefinitionResponse Int
pHttpStatus_ =
  GetSchemaByDefinitionResponse'
    { $sel:createdTime:GetSchemaByDefinitionResponse' :: Maybe Text
createdTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dataFormat:GetSchemaByDefinitionResponse' :: Maybe DataFormat
dataFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaArn:GetSchemaByDefinitionResponse' :: Maybe Text
schemaArn = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaVersionId:GetSchemaByDefinitionResponse' :: Maybe Text
schemaVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetSchemaByDefinitionResponse' :: Maybe SchemaVersionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSchemaByDefinitionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time the schema was created.
getSchemaByDefinitionResponse_createdTime :: Lens.Lens' GetSchemaByDefinitionResponse (Prelude.Maybe Prelude.Text)
getSchemaByDefinitionResponse_createdTime :: Lens' GetSchemaByDefinitionResponse (Maybe Text)
getSchemaByDefinitionResponse_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSchemaByDefinitionResponse' {Maybe Text
createdTime :: Maybe Text
$sel:createdTime:GetSchemaByDefinitionResponse' :: GetSchemaByDefinitionResponse -> Maybe Text
createdTime} -> Maybe Text
createdTime) (\s :: GetSchemaByDefinitionResponse
s@GetSchemaByDefinitionResponse' {} Maybe Text
a -> GetSchemaByDefinitionResponse
s {$sel:createdTime:GetSchemaByDefinitionResponse' :: Maybe Text
createdTime = Maybe Text
a} :: GetSchemaByDefinitionResponse)

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

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

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

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

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

instance Prelude.NFData GetSchemaByDefinitionResponse where
  rnf :: GetSchemaByDefinitionResponse -> ()
rnf GetSchemaByDefinitionResponse' {Int
Maybe Text
Maybe DataFormat
Maybe SchemaVersionStatus
httpStatus :: Int
status :: Maybe SchemaVersionStatus
schemaVersionId :: Maybe Text
schemaArn :: Maybe Text
dataFormat :: Maybe DataFormat
createdTime :: Maybe Text
$sel:httpStatus:GetSchemaByDefinitionResponse' :: GetSchemaByDefinitionResponse -> Int
$sel:status:GetSchemaByDefinitionResponse' :: GetSchemaByDefinitionResponse -> Maybe SchemaVersionStatus
$sel:schemaVersionId:GetSchemaByDefinitionResponse' :: GetSchemaByDefinitionResponse -> Maybe Text
$sel:schemaArn:GetSchemaByDefinitionResponse' :: GetSchemaByDefinitionResponse -> Maybe Text
$sel:dataFormat:GetSchemaByDefinitionResponse' :: GetSchemaByDefinitionResponse -> Maybe DataFormat
$sel:createdTime:GetSchemaByDefinitionResponse' :: GetSchemaByDefinitionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
createdTime
      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
schemaArn
      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
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus