{-# 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.CreateForm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new form for an Amplify app.
module Amazonka.AmplifyUiBuilder.CreateForm
  ( -- * Creating a Request
    CreateForm (..),
    newCreateForm,

    -- * Request Lenses
    createForm_clientToken,
    createForm_appId,
    createForm_environmentName,
    createForm_formToCreate,

    -- * Destructuring the Response
    CreateFormResponse (..),
    newCreateFormResponse,

    -- * Response Lenses
    createFormResponse_entity,
    createFormResponse_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:/ 'newCreateForm' smart constructor.
data CreateForm = CreateForm'
  { -- | The unique client token.
    CreateForm -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The unique ID of the Amplify app to associate with the form.
    CreateForm -> Text
appId :: Prelude.Text,
    -- | The name of the backend environment that is a part of the Amplify app.
    CreateForm -> Text
environmentName :: Prelude.Text,
    -- | Represents the configuration of the form to create.
    CreateForm -> CreateFormData
formToCreate :: CreateFormData
  }
  deriving (CreateForm -> CreateForm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateForm -> CreateForm -> Bool
$c/= :: CreateForm -> CreateForm -> Bool
== :: CreateForm -> CreateForm -> Bool
$c== :: CreateForm -> CreateForm -> Bool
Prelude.Eq, ReadPrec [CreateForm]
ReadPrec CreateForm
Int -> ReadS CreateForm
ReadS [CreateForm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateForm]
$creadListPrec :: ReadPrec [CreateForm]
readPrec :: ReadPrec CreateForm
$creadPrec :: ReadPrec CreateForm
readList :: ReadS [CreateForm]
$creadList :: ReadS [CreateForm]
readsPrec :: Int -> ReadS CreateForm
$creadsPrec :: Int -> ReadS CreateForm
Prelude.Read, Int -> CreateForm -> ShowS
[CreateForm] -> ShowS
CreateForm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateForm] -> ShowS
$cshowList :: [CreateForm] -> ShowS
show :: CreateForm -> String
$cshow :: CreateForm -> String
showsPrec :: Int -> CreateForm -> ShowS
$cshowsPrec :: Int -> CreateForm -> ShowS
Prelude.Show, forall x. Rep CreateForm x -> CreateForm
forall x. CreateForm -> Rep CreateForm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateForm x -> CreateForm
$cfrom :: forall x. CreateForm -> Rep CreateForm x
Prelude.Generic)

-- |
-- Create a value of 'CreateForm' 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', 'createForm_clientToken' - The unique client token.
--
-- 'appId', 'createForm_appId' - The unique ID of the Amplify app to associate with the form.
--
-- 'environmentName', 'createForm_environmentName' - The name of the backend environment that is a part of the Amplify app.
--
-- 'formToCreate', 'createForm_formToCreate' - Represents the configuration of the form to create.
newCreateForm ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'environmentName'
  Prelude.Text ->
  -- | 'formToCreate'
  CreateFormData ->
  CreateForm
newCreateForm :: Text -> Text -> CreateFormData -> CreateForm
newCreateForm
  Text
pAppId_
  Text
pEnvironmentName_
  CreateFormData
pFormToCreate_ =
    CreateForm'
      { $sel:clientToken:CreateForm' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:appId:CreateForm' :: Text
appId = Text
pAppId_,
        $sel:environmentName:CreateForm' :: Text
environmentName = Text
pEnvironmentName_,
        $sel:formToCreate:CreateForm' :: CreateFormData
formToCreate = CreateFormData
pFormToCreate_
      }

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

-- | The unique ID of the Amplify app to associate with the form.
createForm_appId :: Lens.Lens' CreateForm Prelude.Text
createForm_appId :: Lens' CreateForm Text
createForm_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateForm' {Text
appId :: Text
$sel:appId:CreateForm' :: CreateForm -> Text
appId} -> Text
appId) (\s :: CreateForm
s@CreateForm' {} Text
a -> CreateForm
s {$sel:appId:CreateForm' :: Text
appId = Text
a} :: CreateForm)

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

-- | Represents the configuration of the form to create.
createForm_formToCreate :: Lens.Lens' CreateForm CreateFormData
createForm_formToCreate :: Lens' CreateForm CreateFormData
createForm_formToCreate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateForm' {CreateFormData
formToCreate :: CreateFormData
$sel:formToCreate:CreateForm' :: CreateForm -> CreateFormData
formToCreate} -> CreateFormData
formToCreate) (\s :: CreateForm
s@CreateForm' {} CreateFormData
a -> CreateForm
s {$sel:formToCreate:CreateForm' :: CreateFormData
formToCreate = CreateFormData
a} :: CreateForm)

instance Core.AWSRequest CreateForm where
  type AWSResponse CreateForm = CreateFormResponse
  request :: (Service -> Service) -> CreateForm -> Request CreateForm
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 CreateForm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateForm)))
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 -> CreateFormResponse
CreateFormResponse'
            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 CreateForm where
  hashWithSalt :: Int -> CreateForm -> Int
hashWithSalt Int
_salt CreateForm' {Maybe Text
Text
CreateFormData
formToCreate :: CreateFormData
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:formToCreate:CreateForm' :: CreateForm -> CreateFormData
$sel:environmentName:CreateForm' :: CreateForm -> Text
$sel:appId:CreateForm' :: CreateForm -> Text
$sel:clientToken:CreateForm' :: CreateForm -> 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` CreateFormData
formToCreate

instance Prelude.NFData CreateForm where
  rnf :: CreateForm -> ()
rnf CreateForm' {Maybe Text
Text
CreateFormData
formToCreate :: CreateFormData
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:formToCreate:CreateForm' :: CreateForm -> CreateFormData
$sel:environmentName:CreateForm' :: CreateForm -> Text
$sel:appId:CreateForm' :: CreateForm -> Text
$sel:clientToken:CreateForm' :: CreateForm -> 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 CreateFormData
formToCreate

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

instance Data.ToPath CreateForm where
  toPath :: CreateForm -> ByteString
toPath CreateForm' {Maybe Text
Text
CreateFormData
formToCreate :: CreateFormData
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:formToCreate:CreateForm' :: CreateForm -> CreateFormData
$sel:environmentName:CreateForm' :: CreateForm -> Text
$sel:appId:CreateForm' :: CreateForm -> Text
$sel:clientToken:CreateForm' :: CreateForm -> 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"
      ]

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

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

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

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

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

instance Prelude.NFData CreateFormResponse where
  rnf :: CreateFormResponse -> ()
rnf CreateFormResponse' {Int
Maybe Form
httpStatus :: Int
entity :: Maybe Form
$sel:httpStatus:CreateFormResponse' :: CreateFormResponse -> Int
$sel:entity:CreateFormResponse' :: CreateFormResponse -> 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