{-# 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.ConnectCases.CreateLayout
-- 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 layout in the Cases domain. Layouts define the following
-- configuration in the top section and More Info tab of the Cases user
-- interface:
--
-- -   Fields to display to the users
--
-- -   Field ordering
--
-- Title and Status fields cannot be part of layouts since they are not
-- configurable.
module Amazonka.ConnectCases.CreateLayout
  ( -- * Creating a Request
    CreateLayout (..),
    newCreateLayout,

    -- * Request Lenses
    createLayout_content,
    createLayout_domainId,
    createLayout_name,

    -- * Destructuring the Response
    CreateLayoutResponse (..),
    newCreateLayoutResponse,

    -- * Response Lenses
    createLayoutResponse_httpStatus,
    createLayoutResponse_layoutArn,
    createLayoutResponse_layoutId,
  )
where

import Amazonka.ConnectCases.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:/ 'newCreateLayout' smart constructor.
data CreateLayout = CreateLayout'
  { -- | Information about which fields will be present in the layout, and
    -- information about the order of the fields.
    CreateLayout -> LayoutContent
content :: LayoutContent,
    -- | The unique identifier of the Cases domain.
    CreateLayout -> Text
domainId :: Prelude.Text,
    -- | The name of the layout. It must be unique for the Cases domain.
    CreateLayout -> Text
name :: Prelude.Text
  }
  deriving (CreateLayout -> CreateLayout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLayout -> CreateLayout -> Bool
$c/= :: CreateLayout -> CreateLayout -> Bool
== :: CreateLayout -> CreateLayout -> Bool
$c== :: CreateLayout -> CreateLayout -> Bool
Prelude.Eq, ReadPrec [CreateLayout]
ReadPrec CreateLayout
Int -> ReadS CreateLayout
ReadS [CreateLayout]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLayout]
$creadListPrec :: ReadPrec [CreateLayout]
readPrec :: ReadPrec CreateLayout
$creadPrec :: ReadPrec CreateLayout
readList :: ReadS [CreateLayout]
$creadList :: ReadS [CreateLayout]
readsPrec :: Int -> ReadS CreateLayout
$creadsPrec :: Int -> ReadS CreateLayout
Prelude.Read, Int -> CreateLayout -> ShowS
[CreateLayout] -> ShowS
CreateLayout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLayout] -> ShowS
$cshowList :: [CreateLayout] -> ShowS
show :: CreateLayout -> String
$cshow :: CreateLayout -> String
showsPrec :: Int -> CreateLayout -> ShowS
$cshowsPrec :: Int -> CreateLayout -> ShowS
Prelude.Show, forall x. Rep CreateLayout x -> CreateLayout
forall x. CreateLayout -> Rep CreateLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLayout x -> CreateLayout
$cfrom :: forall x. CreateLayout -> Rep CreateLayout x
Prelude.Generic)

-- |
-- Create a value of 'CreateLayout' 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:
--
-- 'content', 'createLayout_content' - Information about which fields will be present in the layout, and
-- information about the order of the fields.
--
-- 'domainId', 'createLayout_domainId' - The unique identifier of the Cases domain.
--
-- 'name', 'createLayout_name' - The name of the layout. It must be unique for the Cases domain.
newCreateLayout ::
  -- | 'content'
  LayoutContent ->
  -- | 'domainId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateLayout
newCreateLayout :: LayoutContent -> Text -> Text -> CreateLayout
newCreateLayout LayoutContent
pContent_ Text
pDomainId_ Text
pName_ =
  CreateLayout'
    { $sel:content:CreateLayout' :: LayoutContent
content = LayoutContent
pContent_,
      $sel:domainId:CreateLayout' :: Text
domainId = Text
pDomainId_,
      $sel:name:CreateLayout' :: Text
name = Text
pName_
    }

-- | Information about which fields will be present in the layout, and
-- information about the order of the fields.
createLayout_content :: Lens.Lens' CreateLayout LayoutContent
createLayout_content :: Lens' CreateLayout LayoutContent
createLayout_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayout' {LayoutContent
content :: LayoutContent
$sel:content:CreateLayout' :: CreateLayout -> LayoutContent
content} -> LayoutContent
content) (\s :: CreateLayout
s@CreateLayout' {} LayoutContent
a -> CreateLayout
s {$sel:content:CreateLayout' :: LayoutContent
content = LayoutContent
a} :: CreateLayout)

-- | The unique identifier of the Cases domain.
createLayout_domainId :: Lens.Lens' CreateLayout Prelude.Text
createLayout_domainId :: Lens' CreateLayout Text
createLayout_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayout' {Text
domainId :: Text
$sel:domainId:CreateLayout' :: CreateLayout -> Text
domainId} -> Text
domainId) (\s :: CreateLayout
s@CreateLayout' {} Text
a -> CreateLayout
s {$sel:domainId:CreateLayout' :: Text
domainId = Text
a} :: CreateLayout)

-- | The name of the layout. It must be unique for the Cases domain.
createLayout_name :: Lens.Lens' CreateLayout Prelude.Text
createLayout_name :: Lens' CreateLayout Text
createLayout_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayout' {Text
name :: Text
$sel:name:CreateLayout' :: CreateLayout -> Text
name} -> Text
name) (\s :: CreateLayout
s@CreateLayout' {} Text
a -> CreateLayout
s {$sel:name:CreateLayout' :: Text
name = Text
a} :: CreateLayout)

instance Core.AWSRequest CreateLayout where
  type AWSResponse CreateLayout = CreateLayoutResponse
  request :: (Service -> Service) -> CreateLayout -> Request CreateLayout
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 CreateLayout
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLayout)))
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 ->
          Int -> Text -> Text -> CreateLayoutResponse
CreateLayoutResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"layoutArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"layoutId")
      )

instance Prelude.Hashable CreateLayout where
  hashWithSalt :: Int -> CreateLayout -> Int
hashWithSalt Int
_salt CreateLayout' {Text
LayoutContent
name :: Text
domainId :: Text
content :: LayoutContent
$sel:name:CreateLayout' :: CreateLayout -> Text
$sel:domainId:CreateLayout' :: CreateLayout -> Text
$sel:content:CreateLayout' :: CreateLayout -> LayoutContent
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LayoutContent
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateLayout where
  rnf :: CreateLayout -> ()
rnf CreateLayout' {Text
LayoutContent
name :: Text
domainId :: Text
content :: LayoutContent
$sel:name:CreateLayout' :: CreateLayout -> Text
$sel:domainId:CreateLayout' :: CreateLayout -> Text
$sel:content:CreateLayout' :: CreateLayout -> LayoutContent
..} =
    forall a. NFData a => a -> ()
Prelude.rnf LayoutContent
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

instance Data.ToPath CreateLayout where
  toPath :: CreateLayout -> ByteString
toPath CreateLayout' {Text
LayoutContent
name :: Text
domainId :: Text
content :: LayoutContent
$sel:name:CreateLayout' :: CreateLayout -> Text
$sel:domainId:CreateLayout' :: CreateLayout -> Text
$sel:content:CreateLayout' :: CreateLayout -> LayoutContent
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/domains/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainId, ByteString
"/layouts"]

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

-- | /See:/ 'newCreateLayoutResponse' smart constructor.
data CreateLayoutResponse = CreateLayoutResponse'
  { -- | The response's http status code.
    CreateLayoutResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the newly created layout.
    CreateLayoutResponse -> Text
layoutArn :: Prelude.Text,
    -- | The unique identifier of the layout.
    CreateLayoutResponse -> Text
layoutId :: Prelude.Text
  }
  deriving (CreateLayoutResponse -> CreateLayoutResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLayoutResponse -> CreateLayoutResponse -> Bool
$c/= :: CreateLayoutResponse -> CreateLayoutResponse -> Bool
== :: CreateLayoutResponse -> CreateLayoutResponse -> Bool
$c== :: CreateLayoutResponse -> CreateLayoutResponse -> Bool
Prelude.Eq, ReadPrec [CreateLayoutResponse]
ReadPrec CreateLayoutResponse
Int -> ReadS CreateLayoutResponse
ReadS [CreateLayoutResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLayoutResponse]
$creadListPrec :: ReadPrec [CreateLayoutResponse]
readPrec :: ReadPrec CreateLayoutResponse
$creadPrec :: ReadPrec CreateLayoutResponse
readList :: ReadS [CreateLayoutResponse]
$creadList :: ReadS [CreateLayoutResponse]
readsPrec :: Int -> ReadS CreateLayoutResponse
$creadsPrec :: Int -> ReadS CreateLayoutResponse
Prelude.Read, Int -> CreateLayoutResponse -> ShowS
[CreateLayoutResponse] -> ShowS
CreateLayoutResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLayoutResponse] -> ShowS
$cshowList :: [CreateLayoutResponse] -> ShowS
show :: CreateLayoutResponse -> String
$cshow :: CreateLayoutResponse -> String
showsPrec :: Int -> CreateLayoutResponse -> ShowS
$cshowsPrec :: Int -> CreateLayoutResponse -> ShowS
Prelude.Show, forall x. Rep CreateLayoutResponse x -> CreateLayoutResponse
forall x. CreateLayoutResponse -> Rep CreateLayoutResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLayoutResponse x -> CreateLayoutResponse
$cfrom :: forall x. CreateLayoutResponse -> Rep CreateLayoutResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLayoutResponse' 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:
--
-- 'httpStatus', 'createLayoutResponse_httpStatus' - The response's http status code.
--
-- 'layoutArn', 'createLayoutResponse_layoutArn' - The Amazon Resource Name (ARN) of the newly created layout.
--
-- 'layoutId', 'createLayoutResponse_layoutId' - The unique identifier of the layout.
newCreateLayoutResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'layoutArn'
  Prelude.Text ->
  -- | 'layoutId'
  Prelude.Text ->
  CreateLayoutResponse
newCreateLayoutResponse :: Int -> Text -> Text -> CreateLayoutResponse
newCreateLayoutResponse
  Int
pHttpStatus_
  Text
pLayoutArn_
  Text
pLayoutId_ =
    CreateLayoutResponse'
      { $sel:httpStatus:CreateLayoutResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:layoutArn:CreateLayoutResponse' :: Text
layoutArn = Text
pLayoutArn_,
        $sel:layoutId:CreateLayoutResponse' :: Text
layoutId = Text
pLayoutId_
      }

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

-- | The Amazon Resource Name (ARN) of the newly created layout.
createLayoutResponse_layoutArn :: Lens.Lens' CreateLayoutResponse Prelude.Text
createLayoutResponse_layoutArn :: Lens' CreateLayoutResponse Text
createLayoutResponse_layoutArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayoutResponse' {Text
layoutArn :: Text
$sel:layoutArn:CreateLayoutResponse' :: CreateLayoutResponse -> Text
layoutArn} -> Text
layoutArn) (\s :: CreateLayoutResponse
s@CreateLayoutResponse' {} Text
a -> CreateLayoutResponse
s {$sel:layoutArn:CreateLayoutResponse' :: Text
layoutArn = Text
a} :: CreateLayoutResponse)

-- | The unique identifier of the layout.
createLayoutResponse_layoutId :: Lens.Lens' CreateLayoutResponse Prelude.Text
createLayoutResponse_layoutId :: Lens' CreateLayoutResponse Text
createLayoutResponse_layoutId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayoutResponse' {Text
layoutId :: Text
$sel:layoutId:CreateLayoutResponse' :: CreateLayoutResponse -> Text
layoutId} -> Text
layoutId) (\s :: CreateLayoutResponse
s@CreateLayoutResponse' {} Text
a -> CreateLayoutResponse
s {$sel:layoutId:CreateLayoutResponse' :: Text
layoutId = Text
a} :: CreateLayoutResponse)

instance Prelude.NFData CreateLayoutResponse where
  rnf :: CreateLayoutResponse -> ()
rnf CreateLayoutResponse' {Int
Text
layoutId :: Text
layoutArn :: Text
httpStatus :: Int
$sel:layoutId:CreateLayoutResponse' :: CreateLayoutResponse -> Text
$sel:layoutArn:CreateLayoutResponse' :: CreateLayoutResponse -> Text
$sel:httpStatus:CreateLayoutResponse' :: CreateLayoutResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
layoutArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
layoutId