{-# 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.UpdateLayout
-- 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 the attributes of an existing layout.
--
-- If the action is successful, the service sends back an HTTP 200 response
-- with an empty HTTP body.
--
-- A @ValidationException@ is returned when you add non-existent @fieldIds@
-- to a layout.
--
-- Title and Status fields cannot be part of layouts because they are not
-- configurable.
module Amazonka.ConnectCases.UpdateLayout
  ( -- * Creating a Request
    UpdateLayout (..),
    newUpdateLayout,

    -- * Request Lenses
    updateLayout_content,
    updateLayout_name,
    updateLayout_domainId,
    updateLayout_layoutId,

    -- * Destructuring the Response
    UpdateLayoutResponse (..),
    newUpdateLayoutResponse,

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

-- |
-- Create a value of 'UpdateLayout' 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', 'updateLayout_content' - Information about which fields will be present in the layout, the order
-- of the fields, and a read-only attribute of the field.
--
-- 'name', 'updateLayout_name' - The name of the layout. It must be unique per domain.
--
-- 'domainId', 'updateLayout_domainId' - The unique identifier of the Cases domain.
--
-- 'layoutId', 'updateLayout_layoutId' - The unique identifier of the layout.
newUpdateLayout ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'layoutId'
  Prelude.Text ->
  UpdateLayout
newUpdateLayout :: Text -> Text -> UpdateLayout
newUpdateLayout Text
pDomainId_ Text
pLayoutId_ =
  UpdateLayout'
    { $sel:content:UpdateLayout' :: Maybe LayoutContent
content = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateLayout' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:UpdateLayout' :: Text
domainId = Text
pDomainId_,
      $sel:layoutId:UpdateLayout' :: Text
layoutId = Text
pLayoutId_
    }

-- | Information about which fields will be present in the layout, the order
-- of the fields, and a read-only attribute of the field.
updateLayout_content :: Lens.Lens' UpdateLayout (Prelude.Maybe LayoutContent)
updateLayout_content :: Lens' UpdateLayout (Maybe LayoutContent)
updateLayout_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLayout' {Maybe LayoutContent
content :: Maybe LayoutContent
$sel:content:UpdateLayout' :: UpdateLayout -> Maybe LayoutContent
content} -> Maybe LayoutContent
content) (\s :: UpdateLayout
s@UpdateLayout' {} Maybe LayoutContent
a -> UpdateLayout
s {$sel:content:UpdateLayout' :: Maybe LayoutContent
content = Maybe LayoutContent
a} :: UpdateLayout)

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

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

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

instance Core.AWSRequest UpdateLayout where
  type AWSResponse UpdateLayout = UpdateLayoutResponse
  request :: (Service -> Service) -> UpdateLayout -> Request UpdateLayout
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateLayout
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateLayout)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateLayoutResponse
UpdateLayoutResponse'
            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))
      )

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

instance Prelude.NFData UpdateLayout where
  rnf :: UpdateLayout -> ()
rnf UpdateLayout' {Maybe Text
Maybe LayoutContent
Text
layoutId :: Text
domainId :: Text
name :: Maybe Text
content :: Maybe LayoutContent
$sel:layoutId:UpdateLayout' :: UpdateLayout -> Text
$sel:domainId:UpdateLayout' :: UpdateLayout -> Text
$sel:name:UpdateLayout' :: UpdateLayout -> Maybe Text
$sel:content:UpdateLayout' :: UpdateLayout -> Maybe LayoutContent
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LayoutContent
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      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
layoutId

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

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

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

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

-- |
-- Create a value of 'UpdateLayoutResponse' 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', 'updateLayoutResponse_httpStatus' - The response's http status code.
newUpdateLayoutResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateLayoutResponse
newUpdateLayoutResponse :: Int -> UpdateLayoutResponse
newUpdateLayoutResponse Int
pHttpStatus_ =
  UpdateLayoutResponse' {$sel:httpStatus:UpdateLayoutResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateLayoutResponse where
  rnf :: UpdateLayoutResponse -> ()
rnf UpdateLayoutResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateLayoutResponse' :: UpdateLayoutResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus