{-# 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.GetLayout
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the details for the requested layout.
module Amazonka.ConnectCases.GetLayout
  ( -- * Creating a Request
    GetLayout (..),
    newGetLayout,

    -- * Request Lenses
    getLayout_domainId,
    getLayout_layoutId,

    -- * Destructuring the Response
    GetLayoutResponse (..),
    newGetLayoutResponse,

    -- * Response Lenses
    getLayoutResponse_tags,
    getLayoutResponse_httpStatus,
    getLayoutResponse_content,
    getLayoutResponse_layoutArn,
    getLayoutResponse_layoutId,
    getLayoutResponse_name,
  )
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:/ 'newGetLayout' smart constructor.
data GetLayout = GetLayout'
  { -- | The unique identifier of the Cases domain.
    GetLayout -> Text
domainId :: Prelude.Text,
    -- | The unique identifier of the layout.
    GetLayout -> Text
layoutId :: Prelude.Text
  }
  deriving (GetLayout -> GetLayout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLayout -> GetLayout -> Bool
$c/= :: GetLayout -> GetLayout -> Bool
== :: GetLayout -> GetLayout -> Bool
$c== :: GetLayout -> GetLayout -> Bool
Prelude.Eq, ReadPrec [GetLayout]
ReadPrec GetLayout
Int -> ReadS GetLayout
ReadS [GetLayout]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLayout]
$creadListPrec :: ReadPrec [GetLayout]
readPrec :: ReadPrec GetLayout
$creadPrec :: ReadPrec GetLayout
readList :: ReadS [GetLayout]
$creadList :: ReadS [GetLayout]
readsPrec :: Int -> ReadS GetLayout
$creadsPrec :: Int -> ReadS GetLayout
Prelude.Read, Int -> GetLayout -> ShowS
[GetLayout] -> ShowS
GetLayout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLayout] -> ShowS
$cshowList :: [GetLayout] -> ShowS
show :: GetLayout -> String
$cshow :: GetLayout -> String
showsPrec :: Int -> GetLayout -> ShowS
$cshowsPrec :: Int -> GetLayout -> ShowS
Prelude.Show, forall x. Rep GetLayout x -> GetLayout
forall x. GetLayout -> Rep GetLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLayout x -> GetLayout
$cfrom :: forall x. GetLayout -> Rep GetLayout x
Prelude.Generic)

-- |
-- Create a value of 'GetLayout' 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:
--
-- 'domainId', 'getLayout_domainId' - The unique identifier of the Cases domain.
--
-- 'layoutId', 'getLayout_layoutId' - The unique identifier of the layout.
newGetLayout ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'layoutId'
  Prelude.Text ->
  GetLayout
newGetLayout :: Text -> Text -> GetLayout
newGetLayout Text
pDomainId_ Text
pLayoutId_ =
  GetLayout'
    { $sel:domainId:GetLayout' :: Text
domainId = Text
pDomainId_,
      $sel:layoutId:GetLayout' :: Text
layoutId = Text
pLayoutId_
    }

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

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

instance Core.AWSRequest GetLayout where
  type AWSResponse GetLayout = GetLayoutResponse
  request :: (Service -> Service) -> GetLayout -> Request GetLayout
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 GetLayout
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetLayout)))
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 (HashMap Text Text)
-> Int
-> LayoutContent
-> Text
-> Text
-> Text
-> GetLayoutResponse
GetLayoutResponse'
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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))
            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
"content")
            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")
            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
"name")
      )

instance Prelude.Hashable GetLayout where
  hashWithSalt :: Int -> GetLayout -> Int
hashWithSalt Int
_salt GetLayout' {Text
layoutId :: Text
domainId :: Text
$sel:layoutId:GetLayout' :: GetLayout -> Text
$sel:domainId:GetLayout' :: GetLayout -> Text
..} =
    Int
_salt
      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 GetLayout where
  rnf :: GetLayout -> ()
rnf GetLayout' {Text
layoutId :: Text
domainId :: Text
$sel:layoutId:GetLayout' :: GetLayout -> Text
$sel:domainId:GetLayout' :: GetLayout -> Text
..} =
    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 GetLayout where
  toHeaders :: GetLayout -> 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 GetLayout where
  toJSON :: GetLayout -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath GetLayout where
  toPath :: GetLayout -> ByteString
toPath GetLayout' {Text
layoutId :: Text
domainId :: Text
$sel:layoutId:GetLayout' :: GetLayout -> Text
$sel:domainId:GetLayout' :: GetLayout -> Text
..} =
    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 GetLayout where
  toQuery :: GetLayout -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetLayoutResponse' smart constructor.
data GetLayoutResponse = GetLayoutResponse'
  { -- | A map of of key-value pairs that represent tags on a resource. Tags are
    -- used to organize, track, or control access for this resource.
    GetLayoutResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetLayoutResponse -> Int
httpStatus :: Prelude.Int,
    -- | Information about which fields will be present in the layout, the order
    -- of the fields, and read-only attribute of the field.
    GetLayoutResponse -> LayoutContent
content :: LayoutContent,
    -- | The Amazon Resource Name (ARN) of the newly created layout.
    GetLayoutResponse -> Text
layoutArn :: Prelude.Text,
    -- | The unique identifier of the layout.
    GetLayoutResponse -> Text
layoutId :: Prelude.Text,
    -- | The name of the layout. It must be unique.
    GetLayoutResponse -> Text
name :: Prelude.Text
  }
  deriving (GetLayoutResponse -> GetLayoutResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLayoutResponse -> GetLayoutResponse -> Bool
$c/= :: GetLayoutResponse -> GetLayoutResponse -> Bool
== :: GetLayoutResponse -> GetLayoutResponse -> Bool
$c== :: GetLayoutResponse -> GetLayoutResponse -> Bool
Prelude.Eq, ReadPrec [GetLayoutResponse]
ReadPrec GetLayoutResponse
Int -> ReadS GetLayoutResponse
ReadS [GetLayoutResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLayoutResponse]
$creadListPrec :: ReadPrec [GetLayoutResponse]
readPrec :: ReadPrec GetLayoutResponse
$creadPrec :: ReadPrec GetLayoutResponse
readList :: ReadS [GetLayoutResponse]
$creadList :: ReadS [GetLayoutResponse]
readsPrec :: Int -> ReadS GetLayoutResponse
$creadsPrec :: Int -> ReadS GetLayoutResponse
Prelude.Read, Int -> GetLayoutResponse -> ShowS
[GetLayoutResponse] -> ShowS
GetLayoutResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLayoutResponse] -> ShowS
$cshowList :: [GetLayoutResponse] -> ShowS
show :: GetLayoutResponse -> String
$cshow :: GetLayoutResponse -> String
showsPrec :: Int -> GetLayoutResponse -> ShowS
$cshowsPrec :: Int -> GetLayoutResponse -> ShowS
Prelude.Show, forall x. Rep GetLayoutResponse x -> GetLayoutResponse
forall x. GetLayoutResponse -> Rep GetLayoutResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLayoutResponse x -> GetLayoutResponse
$cfrom :: forall x. GetLayoutResponse -> Rep GetLayoutResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetLayoutResponse' 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:
--
-- 'tags', 'getLayoutResponse_tags' - A map of of key-value pairs that represent tags on a resource. Tags are
-- used to organize, track, or control access for this resource.
--
-- 'httpStatus', 'getLayoutResponse_httpStatus' - The response's http status code.
--
-- 'content', 'getLayoutResponse_content' - Information about which fields will be present in the layout, the order
-- of the fields, and read-only attribute of the field.
--
-- 'layoutArn', 'getLayoutResponse_layoutArn' - The Amazon Resource Name (ARN) of the newly created layout.
--
-- 'layoutId', 'getLayoutResponse_layoutId' - The unique identifier of the layout.
--
-- 'name', 'getLayoutResponse_name' - The name of the layout. It must be unique.
newGetLayoutResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'content'
  LayoutContent ->
  -- | 'layoutArn'
  Prelude.Text ->
  -- | 'layoutId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  GetLayoutResponse
newGetLayoutResponse :: Int -> LayoutContent -> Text -> Text -> Text -> GetLayoutResponse
newGetLayoutResponse
  Int
pHttpStatus_
  LayoutContent
pContent_
  Text
pLayoutArn_
  Text
pLayoutId_
  Text
pName_ =
    GetLayoutResponse'
      { $sel:tags:GetLayoutResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetLayoutResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:content:GetLayoutResponse' :: LayoutContent
content = LayoutContent
pContent_,
        $sel:layoutArn:GetLayoutResponse' :: Text
layoutArn = Text
pLayoutArn_,
        $sel:layoutId:GetLayoutResponse' :: Text
layoutId = Text
pLayoutId_,
        $sel:name:GetLayoutResponse' :: Text
name = Text
pName_
      }

-- | A map of of key-value pairs that represent tags on a resource. Tags are
-- used to organize, track, or control access for this resource.
getLayoutResponse_tags :: Lens.Lens' GetLayoutResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getLayoutResponse_tags :: Lens' GetLayoutResponse (Maybe (HashMap Text Text))
getLayoutResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLayoutResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetLayoutResponse' :: GetLayoutResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetLayoutResponse
s@GetLayoutResponse' {} Maybe (HashMap Text Text)
a -> GetLayoutResponse
s {$sel:tags:GetLayoutResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetLayoutResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

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

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

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

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

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