{-# 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.AppSync.UpdateType
-- 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 a @Type@ object.
module Amazonka.AppSync.UpdateType
  ( -- * Creating a Request
    UpdateType (..),
    newUpdateType,

    -- * Request Lenses
    updateType_definition,
    updateType_apiId,
    updateType_typeName,
    updateType_format,

    -- * Destructuring the Response
    UpdateTypeResponse (..),
    newUpdateTypeResponse,

    -- * Response Lenses
    updateTypeResponse_type,
    updateTypeResponse_httpStatus,
  )
where

import Amazonka.AppSync.Types
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

-- | /See:/ 'newUpdateType' smart constructor.
data UpdateType = UpdateType'
  { -- | The new definition.
    UpdateType -> Maybe Text
definition :: Prelude.Maybe Prelude.Text,
    -- | The API ID.
    UpdateType -> Text
apiId :: Prelude.Text,
    -- | The new type name.
    UpdateType -> Text
typeName :: Prelude.Text,
    -- | The new type format: SDL or JSON.
    UpdateType -> TypeDefinitionFormat
format :: TypeDefinitionFormat
  }
  deriving (UpdateType -> UpdateType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateType -> UpdateType -> Bool
$c/= :: UpdateType -> UpdateType -> Bool
== :: UpdateType -> UpdateType -> Bool
$c== :: UpdateType -> UpdateType -> Bool
Prelude.Eq, ReadPrec [UpdateType]
ReadPrec UpdateType
Int -> ReadS UpdateType
ReadS [UpdateType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateType]
$creadListPrec :: ReadPrec [UpdateType]
readPrec :: ReadPrec UpdateType
$creadPrec :: ReadPrec UpdateType
readList :: ReadS [UpdateType]
$creadList :: ReadS [UpdateType]
readsPrec :: Int -> ReadS UpdateType
$creadsPrec :: Int -> ReadS UpdateType
Prelude.Read, Int -> UpdateType -> ShowS
[UpdateType] -> ShowS
UpdateType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateType] -> ShowS
$cshowList :: [UpdateType] -> ShowS
show :: UpdateType -> String
$cshow :: UpdateType -> String
showsPrec :: Int -> UpdateType -> ShowS
$cshowsPrec :: Int -> UpdateType -> ShowS
Prelude.Show, forall x. Rep UpdateType x -> UpdateType
forall x. UpdateType -> Rep UpdateType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateType x -> UpdateType
$cfrom :: forall x. UpdateType -> Rep UpdateType x
Prelude.Generic)

-- |
-- Create a value of 'UpdateType' 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:
--
-- 'definition', 'updateType_definition' - The new definition.
--
-- 'apiId', 'updateType_apiId' - The API ID.
--
-- 'typeName', 'updateType_typeName' - The new type name.
--
-- 'format', 'updateType_format' - The new type format: SDL or JSON.
newUpdateType ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'typeName'
  Prelude.Text ->
  -- | 'format'
  TypeDefinitionFormat ->
  UpdateType
newUpdateType :: Text -> Text -> TypeDefinitionFormat -> UpdateType
newUpdateType Text
pApiId_ Text
pTypeName_ TypeDefinitionFormat
pFormat_ =
  UpdateType'
    { $sel:definition:UpdateType' :: Maybe Text
definition = forall a. Maybe a
Prelude.Nothing,
      $sel:apiId:UpdateType' :: Text
apiId = Text
pApiId_,
      $sel:typeName:UpdateType' :: Text
typeName = Text
pTypeName_,
      $sel:format:UpdateType' :: TypeDefinitionFormat
format = TypeDefinitionFormat
pFormat_
    }

-- | The new definition.
updateType_definition :: Lens.Lens' UpdateType (Prelude.Maybe Prelude.Text)
updateType_definition :: Lens' UpdateType (Maybe Text)
updateType_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateType' {Maybe Text
definition :: Maybe Text
$sel:definition:UpdateType' :: UpdateType -> Maybe Text
definition} -> Maybe Text
definition) (\s :: UpdateType
s@UpdateType' {} Maybe Text
a -> UpdateType
s {$sel:definition:UpdateType' :: Maybe Text
definition = Maybe Text
a} :: UpdateType)

-- | The API ID.
updateType_apiId :: Lens.Lens' UpdateType Prelude.Text
updateType_apiId :: Lens' UpdateType Text
updateType_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateType' {Text
apiId :: Text
$sel:apiId:UpdateType' :: UpdateType -> Text
apiId} -> Text
apiId) (\s :: UpdateType
s@UpdateType' {} Text
a -> UpdateType
s {$sel:apiId:UpdateType' :: Text
apiId = Text
a} :: UpdateType)

-- | The new type name.
updateType_typeName :: Lens.Lens' UpdateType Prelude.Text
updateType_typeName :: Lens' UpdateType Text
updateType_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateType' {Text
typeName :: Text
$sel:typeName:UpdateType' :: UpdateType -> Text
typeName} -> Text
typeName) (\s :: UpdateType
s@UpdateType' {} Text
a -> UpdateType
s {$sel:typeName:UpdateType' :: Text
typeName = Text
a} :: UpdateType)

-- | The new type format: SDL or JSON.
updateType_format :: Lens.Lens' UpdateType TypeDefinitionFormat
updateType_format :: Lens' UpdateType TypeDefinitionFormat
updateType_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateType' {TypeDefinitionFormat
format :: TypeDefinitionFormat
$sel:format:UpdateType' :: UpdateType -> TypeDefinitionFormat
format} -> TypeDefinitionFormat
format) (\s :: UpdateType
s@UpdateType' {} TypeDefinitionFormat
a -> UpdateType
s {$sel:format:UpdateType' :: TypeDefinitionFormat
format = TypeDefinitionFormat
a} :: UpdateType)

instance Core.AWSRequest UpdateType where
  type AWSResponse UpdateType = UpdateTypeResponse
  request :: (Service -> Service) -> UpdateType -> Request UpdateType
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 UpdateType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateType)))
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 Type -> Int -> UpdateTypeResponse
UpdateTypeResponse'
            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
"type")
            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 UpdateType where
  hashWithSalt :: Int -> UpdateType -> Int
hashWithSalt Int
_salt UpdateType' {Maybe Text
Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
definition :: Maybe Text
$sel:format:UpdateType' :: UpdateType -> TypeDefinitionFormat
$sel:typeName:UpdateType' :: UpdateType -> Text
$sel:apiId:UpdateType' :: UpdateType -> Text
$sel:definition:UpdateType' :: UpdateType -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
definition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TypeDefinitionFormat
format

instance Prelude.NFData UpdateType where
  rnf :: UpdateType -> ()
rnf UpdateType' {Maybe Text
Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
definition :: Maybe Text
$sel:format:UpdateType' :: UpdateType -> TypeDefinitionFormat
$sel:typeName:UpdateType' :: UpdateType -> Text
$sel:apiId:UpdateType' :: UpdateType -> Text
$sel:definition:UpdateType' :: UpdateType -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
definition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TypeDefinitionFormat
format

instance Data.ToHeaders UpdateType where
  toHeaders :: UpdateType -> 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 UpdateType where
  toJSON :: UpdateType -> Value
toJSON UpdateType' {Maybe Text
Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
definition :: Maybe Text
$sel:format:UpdateType' :: UpdateType -> TypeDefinitionFormat
$sel:typeName:UpdateType' :: UpdateType -> Text
$sel:apiId:UpdateType' :: UpdateType -> Text
$sel:definition:UpdateType' :: UpdateType -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"definition" 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
definition,
            forall a. a -> Maybe a
Prelude.Just (Key
"format" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TypeDefinitionFormat
format)
          ]
      )

instance Data.ToPath UpdateType where
  toPath :: UpdateType -> ByteString
toPath UpdateType' {Maybe Text
Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
definition :: Maybe Text
$sel:format:UpdateType' :: UpdateType -> TypeDefinitionFormat
$sel:typeName:UpdateType' :: UpdateType -> Text
$sel:apiId:UpdateType' :: UpdateType -> Text
$sel:definition:UpdateType' :: UpdateType -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/types/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
typeName
      ]

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

-- | /See:/ 'newUpdateTypeResponse' smart constructor.
data UpdateTypeResponse = UpdateTypeResponse'
  { -- | The updated @Type@ object.
    UpdateTypeResponse -> Maybe Type
type' :: Prelude.Maybe Type,
    -- | The response's http status code.
    UpdateTypeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateTypeResponse -> UpdateTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTypeResponse -> UpdateTypeResponse -> Bool
$c/= :: UpdateTypeResponse -> UpdateTypeResponse -> Bool
== :: UpdateTypeResponse -> UpdateTypeResponse -> Bool
$c== :: UpdateTypeResponse -> UpdateTypeResponse -> Bool
Prelude.Eq, ReadPrec [UpdateTypeResponse]
ReadPrec UpdateTypeResponse
Int -> ReadS UpdateTypeResponse
ReadS [UpdateTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTypeResponse]
$creadListPrec :: ReadPrec [UpdateTypeResponse]
readPrec :: ReadPrec UpdateTypeResponse
$creadPrec :: ReadPrec UpdateTypeResponse
readList :: ReadS [UpdateTypeResponse]
$creadList :: ReadS [UpdateTypeResponse]
readsPrec :: Int -> ReadS UpdateTypeResponse
$creadsPrec :: Int -> ReadS UpdateTypeResponse
Prelude.Read, Int -> UpdateTypeResponse -> ShowS
[UpdateTypeResponse] -> ShowS
UpdateTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTypeResponse] -> ShowS
$cshowList :: [UpdateTypeResponse] -> ShowS
show :: UpdateTypeResponse -> String
$cshow :: UpdateTypeResponse -> String
showsPrec :: Int -> UpdateTypeResponse -> ShowS
$cshowsPrec :: Int -> UpdateTypeResponse -> ShowS
Prelude.Show, forall x. Rep UpdateTypeResponse x -> UpdateTypeResponse
forall x. UpdateTypeResponse -> Rep UpdateTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTypeResponse x -> UpdateTypeResponse
$cfrom :: forall x. UpdateTypeResponse -> Rep UpdateTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTypeResponse' 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:
--
-- 'type'', 'updateTypeResponse_type' - The updated @Type@ object.
--
-- 'httpStatus', 'updateTypeResponse_httpStatus' - The response's http status code.
newUpdateTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTypeResponse
newUpdateTypeResponse :: Int -> UpdateTypeResponse
newUpdateTypeResponse Int
pHttpStatus_ =
  UpdateTypeResponse'
    { $sel:type':UpdateTypeResponse' :: Maybe Type
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated @Type@ object.
updateTypeResponse_type :: Lens.Lens' UpdateTypeResponse (Prelude.Maybe Type)
updateTypeResponse_type :: Lens' UpdateTypeResponse (Maybe Type)
updateTypeResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTypeResponse' {Maybe Type
type' :: Maybe Type
$sel:type':UpdateTypeResponse' :: UpdateTypeResponse -> Maybe Type
type'} -> Maybe Type
type') (\s :: UpdateTypeResponse
s@UpdateTypeResponse' {} Maybe Type
a -> UpdateTypeResponse
s {$sel:type':UpdateTypeResponse' :: Maybe Type
type' = Maybe Type
a} :: UpdateTypeResponse)

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

instance Prelude.NFData UpdateTypeResponse where
  rnf :: UpdateTypeResponse -> ()
rnf UpdateTypeResponse' {Int
Maybe Type
httpStatus :: Int
type' :: Maybe Type
$sel:httpStatus:UpdateTypeResponse' :: UpdateTypeResponse -> Int
$sel:type':UpdateTypeResponse' :: UpdateTypeResponse -> Maybe Type
..} =
    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 Int
httpStatus