{-# 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.CheckSchemaVersionValidity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Validates the supplied schema. This call has no side effects, it simply
-- validates using the supplied schema using @DataFormat@ as the format.
-- Since it does not take a schema set name, no compatibility checks are
-- performed.
module Amazonka.Glue.CheckSchemaVersionValidity
  ( -- * Creating a Request
    CheckSchemaVersionValidity (..),
    newCheckSchemaVersionValidity,

    -- * Request Lenses
    checkSchemaVersionValidity_dataFormat,
    checkSchemaVersionValidity_schemaDefinition,

    -- * Destructuring the Response
    CheckSchemaVersionValidityResponse (..),
    newCheckSchemaVersionValidityResponse,

    -- * Response Lenses
    checkSchemaVersionValidityResponse_error,
    checkSchemaVersionValidityResponse_valid,
    checkSchemaVersionValidityResponse_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:/ 'newCheckSchemaVersionValidity' smart constructor.
data CheckSchemaVersionValidity = CheckSchemaVersionValidity'
  { -- | The data format of the schema definition. Currently @AVRO@, @JSON@ and
    -- @PROTOBUF@ are supported.
    CheckSchemaVersionValidity -> DataFormat
dataFormat :: DataFormat,
    -- | The definition of the schema that has to be validated.
    CheckSchemaVersionValidity -> Text
schemaDefinition :: Prelude.Text
  }
  deriving (CheckSchemaVersionValidity -> CheckSchemaVersionValidity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckSchemaVersionValidity -> CheckSchemaVersionValidity -> Bool
$c/= :: CheckSchemaVersionValidity -> CheckSchemaVersionValidity -> Bool
== :: CheckSchemaVersionValidity -> CheckSchemaVersionValidity -> Bool
$c== :: CheckSchemaVersionValidity -> CheckSchemaVersionValidity -> Bool
Prelude.Eq, ReadPrec [CheckSchemaVersionValidity]
ReadPrec CheckSchemaVersionValidity
Int -> ReadS CheckSchemaVersionValidity
ReadS [CheckSchemaVersionValidity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckSchemaVersionValidity]
$creadListPrec :: ReadPrec [CheckSchemaVersionValidity]
readPrec :: ReadPrec CheckSchemaVersionValidity
$creadPrec :: ReadPrec CheckSchemaVersionValidity
readList :: ReadS [CheckSchemaVersionValidity]
$creadList :: ReadS [CheckSchemaVersionValidity]
readsPrec :: Int -> ReadS CheckSchemaVersionValidity
$creadsPrec :: Int -> ReadS CheckSchemaVersionValidity
Prelude.Read, Int -> CheckSchemaVersionValidity -> ShowS
[CheckSchemaVersionValidity] -> ShowS
CheckSchemaVersionValidity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckSchemaVersionValidity] -> ShowS
$cshowList :: [CheckSchemaVersionValidity] -> ShowS
show :: CheckSchemaVersionValidity -> String
$cshow :: CheckSchemaVersionValidity -> String
showsPrec :: Int -> CheckSchemaVersionValidity -> ShowS
$cshowsPrec :: Int -> CheckSchemaVersionValidity -> ShowS
Prelude.Show, forall x.
Rep CheckSchemaVersionValidity x -> CheckSchemaVersionValidity
forall x.
CheckSchemaVersionValidity -> Rep CheckSchemaVersionValidity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CheckSchemaVersionValidity x -> CheckSchemaVersionValidity
$cfrom :: forall x.
CheckSchemaVersionValidity -> Rep CheckSchemaVersionValidity x
Prelude.Generic)

-- |
-- Create a value of 'CheckSchemaVersionValidity' 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:
--
-- 'dataFormat', 'checkSchemaVersionValidity_dataFormat' - The data format of the schema definition. Currently @AVRO@, @JSON@ and
-- @PROTOBUF@ are supported.
--
-- 'schemaDefinition', 'checkSchemaVersionValidity_schemaDefinition' - The definition of the schema that has to be validated.
newCheckSchemaVersionValidity ::
  -- | 'dataFormat'
  DataFormat ->
  -- | 'schemaDefinition'
  Prelude.Text ->
  CheckSchemaVersionValidity
newCheckSchemaVersionValidity :: DataFormat -> Text -> CheckSchemaVersionValidity
newCheckSchemaVersionValidity
  DataFormat
pDataFormat_
  Text
pSchemaDefinition_ =
    CheckSchemaVersionValidity'
      { $sel:dataFormat:CheckSchemaVersionValidity' :: DataFormat
dataFormat =
          DataFormat
pDataFormat_,
        $sel:schemaDefinition:CheckSchemaVersionValidity' :: Text
schemaDefinition = Text
pSchemaDefinition_
      }

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

-- | The definition of the schema that has to be validated.
checkSchemaVersionValidity_schemaDefinition :: Lens.Lens' CheckSchemaVersionValidity Prelude.Text
checkSchemaVersionValidity_schemaDefinition :: Lens' CheckSchemaVersionValidity Text
checkSchemaVersionValidity_schemaDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckSchemaVersionValidity' {Text
schemaDefinition :: Text
$sel:schemaDefinition:CheckSchemaVersionValidity' :: CheckSchemaVersionValidity -> Text
schemaDefinition} -> Text
schemaDefinition) (\s :: CheckSchemaVersionValidity
s@CheckSchemaVersionValidity' {} Text
a -> CheckSchemaVersionValidity
s {$sel:schemaDefinition:CheckSchemaVersionValidity' :: Text
schemaDefinition = Text
a} :: CheckSchemaVersionValidity)

instance Core.AWSRequest CheckSchemaVersionValidity where
  type
    AWSResponse CheckSchemaVersionValidity =
      CheckSchemaVersionValidityResponse
  request :: (Service -> Service)
-> CheckSchemaVersionValidity -> Request CheckSchemaVersionValidity
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 CheckSchemaVersionValidity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CheckSchemaVersionValidity)))
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 Bool -> Int -> CheckSchemaVersionValidityResponse
CheckSchemaVersionValidityResponse'
            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
"Error")
            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
"Valid")
            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 CheckSchemaVersionValidity where
  hashWithSalt :: Int -> CheckSchemaVersionValidity -> Int
hashWithSalt Int
_salt CheckSchemaVersionValidity' {Text
DataFormat
schemaDefinition :: Text
dataFormat :: DataFormat
$sel:schemaDefinition:CheckSchemaVersionValidity' :: CheckSchemaVersionValidity -> Text
$sel:dataFormat:CheckSchemaVersionValidity' :: CheckSchemaVersionValidity -> DataFormat
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataFormat
dataFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaDefinition

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

instance Data.ToHeaders CheckSchemaVersionValidity where
  toHeaders :: CheckSchemaVersionValidity -> 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.CheckSchemaVersionValidity" ::
                          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 CheckSchemaVersionValidity where
  toJSON :: CheckSchemaVersionValidity -> Value
toJSON CheckSchemaVersionValidity' {Text
DataFormat
schemaDefinition :: Text
dataFormat :: DataFormat
$sel:schemaDefinition:CheckSchemaVersionValidity' :: CheckSchemaVersionValidity -> Text
$sel:dataFormat:CheckSchemaVersionValidity' :: CheckSchemaVersionValidity -> DataFormat
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DataFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataFormat
dataFormat),
            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 CheckSchemaVersionValidity where
  toPath :: CheckSchemaVersionValidity -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCheckSchemaVersionValidityResponse' smart constructor.
data CheckSchemaVersionValidityResponse = CheckSchemaVersionValidityResponse'
  { -- | A validation failure error message.
    CheckSchemaVersionValidityResponse -> Maybe Text
error :: Prelude.Maybe Prelude.Text,
    -- | Return true, if the schema is valid and false otherwise.
    CheckSchemaVersionValidityResponse -> Maybe Bool
valid :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    CheckSchemaVersionValidityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CheckSchemaVersionValidityResponse
-> CheckSchemaVersionValidityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckSchemaVersionValidityResponse
-> CheckSchemaVersionValidityResponse -> Bool
$c/= :: CheckSchemaVersionValidityResponse
-> CheckSchemaVersionValidityResponse -> Bool
== :: CheckSchemaVersionValidityResponse
-> CheckSchemaVersionValidityResponse -> Bool
$c== :: CheckSchemaVersionValidityResponse
-> CheckSchemaVersionValidityResponse -> Bool
Prelude.Eq, ReadPrec [CheckSchemaVersionValidityResponse]
ReadPrec CheckSchemaVersionValidityResponse
Int -> ReadS CheckSchemaVersionValidityResponse
ReadS [CheckSchemaVersionValidityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckSchemaVersionValidityResponse]
$creadListPrec :: ReadPrec [CheckSchemaVersionValidityResponse]
readPrec :: ReadPrec CheckSchemaVersionValidityResponse
$creadPrec :: ReadPrec CheckSchemaVersionValidityResponse
readList :: ReadS [CheckSchemaVersionValidityResponse]
$creadList :: ReadS [CheckSchemaVersionValidityResponse]
readsPrec :: Int -> ReadS CheckSchemaVersionValidityResponse
$creadsPrec :: Int -> ReadS CheckSchemaVersionValidityResponse
Prelude.Read, Int -> CheckSchemaVersionValidityResponse -> ShowS
[CheckSchemaVersionValidityResponse] -> ShowS
CheckSchemaVersionValidityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckSchemaVersionValidityResponse] -> ShowS
$cshowList :: [CheckSchemaVersionValidityResponse] -> ShowS
show :: CheckSchemaVersionValidityResponse -> String
$cshow :: CheckSchemaVersionValidityResponse -> String
showsPrec :: Int -> CheckSchemaVersionValidityResponse -> ShowS
$cshowsPrec :: Int -> CheckSchemaVersionValidityResponse -> ShowS
Prelude.Show, forall x.
Rep CheckSchemaVersionValidityResponse x
-> CheckSchemaVersionValidityResponse
forall x.
CheckSchemaVersionValidityResponse
-> Rep CheckSchemaVersionValidityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CheckSchemaVersionValidityResponse x
-> CheckSchemaVersionValidityResponse
$cfrom :: forall x.
CheckSchemaVersionValidityResponse
-> Rep CheckSchemaVersionValidityResponse x
Prelude.Generic)

-- |
-- Create a value of 'CheckSchemaVersionValidityResponse' 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:
--
-- 'error', 'checkSchemaVersionValidityResponse_error' - A validation failure error message.
--
-- 'valid', 'checkSchemaVersionValidityResponse_valid' - Return true, if the schema is valid and false otherwise.
--
-- 'httpStatus', 'checkSchemaVersionValidityResponse_httpStatus' - The response's http status code.
newCheckSchemaVersionValidityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CheckSchemaVersionValidityResponse
newCheckSchemaVersionValidityResponse :: Int -> CheckSchemaVersionValidityResponse
newCheckSchemaVersionValidityResponse Int
pHttpStatus_ =
  CheckSchemaVersionValidityResponse'
    { $sel:error:CheckSchemaVersionValidityResponse' :: Maybe Text
error =
        forall a. Maybe a
Prelude.Nothing,
      $sel:valid:CheckSchemaVersionValidityResponse' :: Maybe Bool
valid = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CheckSchemaVersionValidityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A validation failure error message.
checkSchemaVersionValidityResponse_error :: Lens.Lens' CheckSchemaVersionValidityResponse (Prelude.Maybe Prelude.Text)
checkSchemaVersionValidityResponse_error :: Lens' CheckSchemaVersionValidityResponse (Maybe Text)
checkSchemaVersionValidityResponse_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckSchemaVersionValidityResponse' {Maybe Text
error :: Maybe Text
$sel:error:CheckSchemaVersionValidityResponse' :: CheckSchemaVersionValidityResponse -> Maybe Text
error} -> Maybe Text
error) (\s :: CheckSchemaVersionValidityResponse
s@CheckSchemaVersionValidityResponse' {} Maybe Text
a -> CheckSchemaVersionValidityResponse
s {$sel:error:CheckSchemaVersionValidityResponse' :: Maybe Text
error = Maybe Text
a} :: CheckSchemaVersionValidityResponse)

-- | Return true, if the schema is valid and false otherwise.
checkSchemaVersionValidityResponse_valid :: Lens.Lens' CheckSchemaVersionValidityResponse (Prelude.Maybe Prelude.Bool)
checkSchemaVersionValidityResponse_valid :: Lens' CheckSchemaVersionValidityResponse (Maybe Bool)
checkSchemaVersionValidityResponse_valid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckSchemaVersionValidityResponse' {Maybe Bool
valid :: Maybe Bool
$sel:valid:CheckSchemaVersionValidityResponse' :: CheckSchemaVersionValidityResponse -> Maybe Bool
valid} -> Maybe Bool
valid) (\s :: CheckSchemaVersionValidityResponse
s@CheckSchemaVersionValidityResponse' {} Maybe Bool
a -> CheckSchemaVersionValidityResponse
s {$sel:valid:CheckSchemaVersionValidityResponse' :: Maybe Bool
valid = Maybe Bool
a} :: CheckSchemaVersionValidityResponse)

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

instance
  Prelude.NFData
    CheckSchemaVersionValidityResponse
  where
  rnf :: CheckSchemaVersionValidityResponse -> ()
rnf CheckSchemaVersionValidityResponse' {Int
Maybe Bool
Maybe Text
httpStatus :: Int
valid :: Maybe Bool
error :: Maybe Text
$sel:httpStatus:CheckSchemaVersionValidityResponse' :: CheckSchemaVersionValidityResponse -> Int
$sel:valid:CheckSchemaVersionValidityResponse' :: CheckSchemaVersionValidityResponse -> Maybe Bool
$sel:error:CheckSchemaVersionValidityResponse' :: CheckSchemaVersionValidityResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
error
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
valid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus