{-# 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.AmplifyUiBuilder.UpdateForm
-- 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 an existing form.
module Amazonka.AmplifyUiBuilder.UpdateForm
  ( -- * Creating a Request
    UpdateForm (..),
    newUpdateForm,

    -- * Request Lenses
    updateForm_clientToken,
    updateForm_appId,
    updateForm_environmentName,
    updateForm_id,
    updateForm_updatedForm,

    -- * Destructuring the Response
    UpdateFormResponse (..),
    newUpdateFormResponse,

    -- * Response Lenses
    updateFormResponse_entity,
    updateFormResponse_httpStatus,
  )
where

import Amazonka.AmplifyUiBuilder.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:/ 'newUpdateForm' smart constructor.
data UpdateForm = UpdateForm'
  { -- | The unique client token.
    UpdateForm -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The unique ID for the Amplify app.
    UpdateForm -> Text
appId :: Prelude.Text,
    -- | The name of the backend environment that is part of the Amplify app.
    UpdateForm -> Text
environmentName :: Prelude.Text,
    -- | The unique ID for the form.
    UpdateForm -> Text
id :: Prelude.Text,
    -- | The request accepts the following data in JSON format.
    UpdateForm -> UpdateFormData
updatedForm :: UpdateFormData
  }
  deriving (UpdateForm -> UpdateForm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateForm -> UpdateForm -> Bool
$c/= :: UpdateForm -> UpdateForm -> Bool
== :: UpdateForm -> UpdateForm -> Bool
$c== :: UpdateForm -> UpdateForm -> Bool
Prelude.Eq, ReadPrec [UpdateForm]
ReadPrec UpdateForm
Int -> ReadS UpdateForm
ReadS [UpdateForm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateForm]
$creadListPrec :: ReadPrec [UpdateForm]
readPrec :: ReadPrec UpdateForm
$creadPrec :: ReadPrec UpdateForm
readList :: ReadS [UpdateForm]
$creadList :: ReadS [UpdateForm]
readsPrec :: Int -> ReadS UpdateForm
$creadsPrec :: Int -> ReadS UpdateForm
Prelude.Read, Int -> UpdateForm -> ShowS
[UpdateForm] -> ShowS
UpdateForm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateForm] -> ShowS
$cshowList :: [UpdateForm] -> ShowS
show :: UpdateForm -> String
$cshow :: UpdateForm -> String
showsPrec :: Int -> UpdateForm -> ShowS
$cshowsPrec :: Int -> UpdateForm -> ShowS
Prelude.Show, forall x. Rep UpdateForm x -> UpdateForm
forall x. UpdateForm -> Rep UpdateForm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateForm x -> UpdateForm
$cfrom :: forall x. UpdateForm -> Rep UpdateForm x
Prelude.Generic)

-- |
-- Create a value of 'UpdateForm' 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:
--
-- 'clientToken', 'updateForm_clientToken' - The unique client token.
--
-- 'appId', 'updateForm_appId' - The unique ID for the Amplify app.
--
-- 'environmentName', 'updateForm_environmentName' - The name of the backend environment that is part of the Amplify app.
--
-- 'id', 'updateForm_id' - The unique ID for the form.
--
-- 'updatedForm', 'updateForm_updatedForm' - The request accepts the following data in JSON format.
newUpdateForm ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'environmentName'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'updatedForm'
  UpdateFormData ->
  UpdateForm
newUpdateForm :: Text -> Text -> Text -> UpdateFormData -> UpdateForm
newUpdateForm
  Text
pAppId_
  Text
pEnvironmentName_
  Text
pId_
  UpdateFormData
pUpdatedForm_ =
    UpdateForm'
      { $sel:clientToken:UpdateForm' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:appId:UpdateForm' :: Text
appId = Text
pAppId_,
        $sel:environmentName:UpdateForm' :: Text
environmentName = Text
pEnvironmentName_,
        $sel:id:UpdateForm' :: Text
id = Text
pId_,
        $sel:updatedForm:UpdateForm' :: UpdateFormData
updatedForm = UpdateFormData
pUpdatedForm_
      }

-- | The unique client token.
updateForm_clientToken :: Lens.Lens' UpdateForm (Prelude.Maybe Prelude.Text)
updateForm_clientToken :: Lens' UpdateForm (Maybe Text)
updateForm_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateForm' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateForm' :: UpdateForm -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateForm
s@UpdateForm' {} Maybe Text
a -> UpdateForm
s {$sel:clientToken:UpdateForm' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateForm)

-- | The unique ID for the Amplify app.
updateForm_appId :: Lens.Lens' UpdateForm Prelude.Text
updateForm_appId :: Lens' UpdateForm Text
updateForm_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateForm' {Text
appId :: Text
$sel:appId:UpdateForm' :: UpdateForm -> Text
appId} -> Text
appId) (\s :: UpdateForm
s@UpdateForm' {} Text
a -> UpdateForm
s {$sel:appId:UpdateForm' :: Text
appId = Text
a} :: UpdateForm)

-- | The name of the backend environment that is part of the Amplify app.
updateForm_environmentName :: Lens.Lens' UpdateForm Prelude.Text
updateForm_environmentName :: Lens' UpdateForm Text
updateForm_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateForm' {Text
environmentName :: Text
$sel:environmentName:UpdateForm' :: UpdateForm -> Text
environmentName} -> Text
environmentName) (\s :: UpdateForm
s@UpdateForm' {} Text
a -> UpdateForm
s {$sel:environmentName:UpdateForm' :: Text
environmentName = Text
a} :: UpdateForm)

-- | The unique ID for the form.
updateForm_id :: Lens.Lens' UpdateForm Prelude.Text
updateForm_id :: Lens' UpdateForm Text
updateForm_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateForm' {Text
id :: Text
$sel:id:UpdateForm' :: UpdateForm -> Text
id} -> Text
id) (\s :: UpdateForm
s@UpdateForm' {} Text
a -> UpdateForm
s {$sel:id:UpdateForm' :: Text
id = Text
a} :: UpdateForm)

-- | The request accepts the following data in JSON format.
updateForm_updatedForm :: Lens.Lens' UpdateForm UpdateFormData
updateForm_updatedForm :: Lens' UpdateForm UpdateFormData
updateForm_updatedForm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateForm' {UpdateFormData
updatedForm :: UpdateFormData
$sel:updatedForm:UpdateForm' :: UpdateForm -> UpdateFormData
updatedForm} -> UpdateFormData
updatedForm) (\s :: UpdateForm
s@UpdateForm' {} UpdateFormData
a -> UpdateForm
s {$sel:updatedForm:UpdateForm' :: UpdateFormData
updatedForm = UpdateFormData
a} :: UpdateForm)

instance Core.AWSRequest UpdateForm where
  type AWSResponse UpdateForm = UpdateFormResponse
  request :: (Service -> Service) -> UpdateForm -> Request UpdateForm
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateForm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateForm)))
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 Form -> Int -> UpdateFormResponse
UpdateFormResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
            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 UpdateForm where
  hashWithSalt :: Int -> UpdateForm -> Int
hashWithSalt Int
_salt UpdateForm' {Maybe Text
Text
UpdateFormData
updatedForm :: UpdateFormData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedForm:UpdateForm' :: UpdateForm -> UpdateFormData
$sel:id:UpdateForm' :: UpdateForm -> Text
$sel:environmentName:UpdateForm' :: UpdateForm -> Text
$sel:appId:UpdateForm' :: UpdateForm -> Text
$sel:clientToken:UpdateForm' :: UpdateForm -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateFormData
updatedForm

instance Prelude.NFData UpdateForm where
  rnf :: UpdateForm -> ()
rnf UpdateForm' {Maybe Text
Text
UpdateFormData
updatedForm :: UpdateFormData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedForm:UpdateForm' :: UpdateForm -> UpdateFormData
$sel:id:UpdateForm' :: UpdateForm -> Text
$sel:environmentName:UpdateForm' :: UpdateForm -> Text
$sel:appId:UpdateForm' :: UpdateForm -> Text
$sel:clientToken:UpdateForm' :: UpdateForm -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UpdateFormData
updatedForm

instance Data.ToHeaders UpdateForm where
  toHeaders :: UpdateForm -> 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 UpdateForm where
  toJSON :: UpdateForm -> Value
toJSON UpdateForm' {Maybe Text
Text
UpdateFormData
updatedForm :: UpdateFormData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedForm:UpdateForm' :: UpdateForm -> UpdateFormData
$sel:id:UpdateForm' :: UpdateForm -> Text
$sel:environmentName:UpdateForm' :: UpdateForm -> Text
$sel:appId:UpdateForm' :: UpdateForm -> Text
$sel:clientToken:UpdateForm' :: UpdateForm -> Maybe Text
..} = forall a. ToJSON a => a -> Value
Data.toJSON UpdateFormData
updatedForm

instance Data.ToPath UpdateForm where
  toPath :: UpdateForm -> ByteString
toPath UpdateForm' {Maybe Text
Text
UpdateFormData
updatedForm :: UpdateFormData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedForm:UpdateForm' :: UpdateForm -> UpdateFormData
$sel:id:UpdateForm' :: UpdateForm -> Text
$sel:environmentName:UpdateForm' :: UpdateForm -> Text
$sel:appId:UpdateForm' :: UpdateForm -> Text
$sel:clientToken:UpdateForm' :: UpdateForm -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/app/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
appId,
        ByteString
"/environment/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
environmentName,
        ByteString
"/forms/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
id
      ]

instance Data.ToQuery UpdateForm where
  toQuery :: UpdateForm -> QueryString
toQuery UpdateForm' {Maybe Text
Text
UpdateFormData
updatedForm :: UpdateFormData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedForm:UpdateForm' :: UpdateForm -> UpdateFormData
$sel:id:UpdateForm' :: UpdateForm -> Text
$sel:environmentName:UpdateForm' :: UpdateForm -> Text
$sel:appId:UpdateForm' :: UpdateForm -> Text
$sel:clientToken:UpdateForm' :: UpdateForm -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"clientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken]

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

-- |
-- Create a value of 'UpdateFormResponse' 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:
--
-- 'entity', 'updateFormResponse_entity' - Describes the configuration of the updated form.
--
-- 'httpStatus', 'updateFormResponse_httpStatus' - The response's http status code.
newUpdateFormResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFormResponse
newUpdateFormResponse :: Int -> UpdateFormResponse
newUpdateFormResponse Int
pHttpStatus_ =
  UpdateFormResponse'
    { $sel:entity:UpdateFormResponse' :: Maybe Form
entity = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFormResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Describes the configuration of the updated form.
updateFormResponse_entity :: Lens.Lens' UpdateFormResponse (Prelude.Maybe Form)
updateFormResponse_entity :: Lens' UpdateFormResponse (Maybe Form)
updateFormResponse_entity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFormResponse' {Maybe Form
entity :: Maybe Form
$sel:entity:UpdateFormResponse' :: UpdateFormResponse -> Maybe Form
entity} -> Maybe Form
entity) (\s :: UpdateFormResponse
s@UpdateFormResponse' {} Maybe Form
a -> UpdateFormResponse
s {$sel:entity:UpdateFormResponse' :: Maybe Form
entity = Maybe Form
a} :: UpdateFormResponse)

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

instance Prelude.NFData UpdateFormResponse where
  rnf :: UpdateFormResponse -> ()
rnf UpdateFormResponse' {Int
Maybe Form
httpStatus :: Int
entity :: Maybe Form
$sel:httpStatus:UpdateFormResponse' :: UpdateFormResponse -> Int
$sel:entity:UpdateFormResponse' :: UpdateFormResponse -> Maybe Form
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Form
entity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus