{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.ConnectParticipant.Types.Item
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.ConnectParticipant.Types.Item where

import Amazonka.ConnectParticipant.Types.AttachmentItem
import Amazonka.ConnectParticipant.Types.ChatItemType
import Amazonka.ConnectParticipant.Types.MessageMetadata
import Amazonka.ConnectParticipant.Types.ParticipantRole
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

-- | An item - message or event - that has been sent.
--
-- /See:/ 'newItem' smart constructor.
data Item = Item'
  { -- | The time when the message or event was sent.
    --
    -- It\'s specified in ISO 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For
    -- example, 2019-11-08T02:41:28.172Z.
    Item -> Maybe Text
absoluteTime :: Prelude.Maybe Prelude.Text,
    -- | Provides information about the attachments.
    Item -> Maybe [AttachmentItem]
attachments :: Prelude.Maybe [AttachmentItem],
    -- | The content of the message or event.
    Item -> Maybe Text
content :: Prelude.Maybe Prelude.Text,
    -- | The type of content of the item.
    Item -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The chat display name of the sender.
    Item -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the item.
    Item -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The metadata related to the message. Currently this supports only
    -- information related to message receipts.
    Item -> Maybe MessageMetadata
messageMetadata :: Prelude.Maybe MessageMetadata,
    -- | The ID of the sender in the session.
    Item -> Maybe Text
participantId :: Prelude.Maybe Prelude.Text,
    -- | The role of the sender. For example, is it a customer, agent, or system.
    Item -> Maybe ParticipantRole
participantRole :: Prelude.Maybe ParticipantRole,
    -- | Type of the item: message or event.
    Item -> Maybe ChatItemType
type' :: Prelude.Maybe ChatItemType
  }
  deriving (Item -> Item -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Prelude.Eq, ReadPrec [Item]
ReadPrec Item
Int -> ReadS Item
ReadS [Item]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Item]
$creadListPrec :: ReadPrec [Item]
readPrec :: ReadPrec Item
$creadPrec :: ReadPrec Item
readList :: ReadS [Item]
$creadList :: ReadS [Item]
readsPrec :: Int -> ReadS Item
$creadsPrec :: Int -> ReadS Item
Prelude.Read, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Prelude.Show, forall x. Rep Item x -> Item
forall x. Item -> Rep Item x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Item x -> Item
$cfrom :: forall x. Item -> Rep Item x
Prelude.Generic)

-- |
-- Create a value of 'Item' 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:
--
-- 'absoluteTime', 'item_absoluteTime' - The time when the message or event was sent.
--
-- It\'s specified in ISO 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For
-- example, 2019-11-08T02:41:28.172Z.
--
-- 'attachments', 'item_attachments' - Provides information about the attachments.
--
-- 'content', 'item_content' - The content of the message or event.
--
-- 'contentType', 'item_contentType' - The type of content of the item.
--
-- 'displayName', 'item_displayName' - The chat display name of the sender.
--
-- 'id', 'item_id' - The ID of the item.
--
-- 'messageMetadata', 'item_messageMetadata' - The metadata related to the message. Currently this supports only
-- information related to message receipts.
--
-- 'participantId', 'item_participantId' - The ID of the sender in the session.
--
-- 'participantRole', 'item_participantRole' - The role of the sender. For example, is it a customer, agent, or system.
--
-- 'type'', 'item_type' - Type of the item: message or event.
newItem ::
  Item
newItem :: Item
newItem =
  Item'
    { $sel:absoluteTime:Item' :: Maybe Text
absoluteTime = forall a. Maybe a
Prelude.Nothing,
      $sel:attachments:Item' :: Maybe [AttachmentItem]
attachments = forall a. Maybe a
Prelude.Nothing,
      $sel:content:Item' :: Maybe Text
content = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:Item' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:Item' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Item' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:messageMetadata:Item' :: Maybe MessageMetadata
messageMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:participantId:Item' :: Maybe Text
participantId = forall a. Maybe a
Prelude.Nothing,
      $sel:participantRole:Item' :: Maybe ParticipantRole
participantRole = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Item' :: Maybe ChatItemType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The time when the message or event was sent.
--
-- It\'s specified in ISO 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For
-- example, 2019-11-08T02:41:28.172Z.
item_absoluteTime :: Lens.Lens' Item (Prelude.Maybe Prelude.Text)
item_absoluteTime :: Lens' Item (Maybe Text)
item_absoluteTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe Text
absoluteTime :: Maybe Text
$sel:absoluteTime:Item' :: Item -> Maybe Text
absoluteTime} -> Maybe Text
absoluteTime) (\s :: Item
s@Item' {} Maybe Text
a -> Item
s {$sel:absoluteTime:Item' :: Maybe Text
absoluteTime = Maybe Text
a} :: Item)

-- | Provides information about the attachments.
item_attachments :: Lens.Lens' Item (Prelude.Maybe [AttachmentItem])
item_attachments :: Lens' Item (Maybe [AttachmentItem])
item_attachments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe [AttachmentItem]
attachments :: Maybe [AttachmentItem]
$sel:attachments:Item' :: Item -> Maybe [AttachmentItem]
attachments} -> Maybe [AttachmentItem]
attachments) (\s :: Item
s@Item' {} Maybe [AttachmentItem]
a -> Item
s {$sel:attachments:Item' :: Maybe [AttachmentItem]
attachments = Maybe [AttachmentItem]
a} :: Item) 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 content of the message or event.
item_content :: Lens.Lens' Item (Prelude.Maybe Prelude.Text)
item_content :: Lens' Item (Maybe Text)
item_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe Text
content :: Maybe Text
$sel:content:Item' :: Item -> Maybe Text
content} -> Maybe Text
content) (\s :: Item
s@Item' {} Maybe Text
a -> Item
s {$sel:content:Item' :: Maybe Text
content = Maybe Text
a} :: Item)

-- | The type of content of the item.
item_contentType :: Lens.Lens' Item (Prelude.Maybe Prelude.Text)
item_contentType :: Lens' Item (Maybe Text)
item_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe Text
contentType :: Maybe Text
$sel:contentType:Item' :: Item -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: Item
s@Item' {} Maybe Text
a -> Item
s {$sel:contentType:Item' :: Maybe Text
contentType = Maybe Text
a} :: Item)

-- | The chat display name of the sender.
item_displayName :: Lens.Lens' Item (Prelude.Maybe Prelude.Text)
item_displayName :: Lens' Item (Maybe Text)
item_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe Text
displayName :: Maybe Text
$sel:displayName:Item' :: Item -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: Item
s@Item' {} Maybe Text
a -> Item
s {$sel:displayName:Item' :: Maybe Text
displayName = Maybe Text
a} :: Item)

-- | The ID of the item.
item_id :: Lens.Lens' Item (Prelude.Maybe Prelude.Text)
item_id :: Lens' Item (Maybe Text)
item_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe Text
id :: Maybe Text
$sel:id:Item' :: Item -> Maybe Text
id} -> Maybe Text
id) (\s :: Item
s@Item' {} Maybe Text
a -> Item
s {$sel:id:Item' :: Maybe Text
id = Maybe Text
a} :: Item)

-- | The metadata related to the message. Currently this supports only
-- information related to message receipts.
item_messageMetadata :: Lens.Lens' Item (Prelude.Maybe MessageMetadata)
item_messageMetadata :: Lens' Item (Maybe MessageMetadata)
item_messageMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe MessageMetadata
messageMetadata :: Maybe MessageMetadata
$sel:messageMetadata:Item' :: Item -> Maybe MessageMetadata
messageMetadata} -> Maybe MessageMetadata
messageMetadata) (\s :: Item
s@Item' {} Maybe MessageMetadata
a -> Item
s {$sel:messageMetadata:Item' :: Maybe MessageMetadata
messageMetadata = Maybe MessageMetadata
a} :: Item)

-- | The ID of the sender in the session.
item_participantId :: Lens.Lens' Item (Prelude.Maybe Prelude.Text)
item_participantId :: Lens' Item (Maybe Text)
item_participantId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe Text
participantId :: Maybe Text
$sel:participantId:Item' :: Item -> Maybe Text
participantId} -> Maybe Text
participantId) (\s :: Item
s@Item' {} Maybe Text
a -> Item
s {$sel:participantId:Item' :: Maybe Text
participantId = Maybe Text
a} :: Item)

-- | The role of the sender. For example, is it a customer, agent, or system.
item_participantRole :: Lens.Lens' Item (Prelude.Maybe ParticipantRole)
item_participantRole :: Lens' Item (Maybe ParticipantRole)
item_participantRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe ParticipantRole
participantRole :: Maybe ParticipantRole
$sel:participantRole:Item' :: Item -> Maybe ParticipantRole
participantRole} -> Maybe ParticipantRole
participantRole) (\s :: Item
s@Item' {} Maybe ParticipantRole
a -> Item
s {$sel:participantRole:Item' :: Maybe ParticipantRole
participantRole = Maybe ParticipantRole
a} :: Item)

-- | Type of the item: message or event.
item_type :: Lens.Lens' Item (Prelude.Maybe ChatItemType)
item_type :: Lens' Item (Maybe ChatItemType)
item_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Item' {Maybe ChatItemType
type' :: Maybe ChatItemType
$sel:type':Item' :: Item -> Maybe ChatItemType
type'} -> Maybe ChatItemType
type') (\s :: Item
s@Item' {} Maybe ChatItemType
a -> Item
s {$sel:type':Item' :: Maybe ChatItemType
type' = Maybe ChatItemType
a} :: Item)

instance Data.FromJSON Item where
  parseJSON :: Value -> Parser Item
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Item"
      ( \Object
x ->
          Maybe Text
-> Maybe [AttachmentItem]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe MessageMetadata
-> Maybe Text
-> Maybe ParticipantRole
-> Maybe ChatItemType
-> Item
Item'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AbsoluteTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Attachments" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe 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 -> Parser (Maybe a)
Data..:? Key
"ContentType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DisplayName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"MessageMetadata")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ParticipantId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ParticipantRole")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Type")
      )

instance Prelude.Hashable Item where
  hashWithSalt :: Int -> Item -> Int
hashWithSalt Int
_salt Item' {Maybe [AttachmentItem]
Maybe Text
Maybe ChatItemType
Maybe ParticipantRole
Maybe MessageMetadata
type' :: Maybe ChatItemType
participantRole :: Maybe ParticipantRole
participantId :: Maybe Text
messageMetadata :: Maybe MessageMetadata
id :: Maybe Text
displayName :: Maybe Text
contentType :: Maybe Text
content :: Maybe Text
attachments :: Maybe [AttachmentItem]
absoluteTime :: Maybe Text
$sel:type':Item' :: Item -> Maybe ChatItemType
$sel:participantRole:Item' :: Item -> Maybe ParticipantRole
$sel:participantId:Item' :: Item -> Maybe Text
$sel:messageMetadata:Item' :: Item -> Maybe MessageMetadata
$sel:id:Item' :: Item -> Maybe Text
$sel:displayName:Item' :: Item -> Maybe Text
$sel:contentType:Item' :: Item -> Maybe Text
$sel:content:Item' :: Item -> Maybe Text
$sel:attachments:Item' :: Item -> Maybe [AttachmentItem]
$sel:absoluteTime:Item' :: Item -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
absoluteTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AttachmentItem]
attachments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MessageMetadata
messageMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
participantId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ParticipantRole
participantRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChatItemType
type'

instance Prelude.NFData Item where
  rnf :: Item -> ()
rnf Item' {Maybe [AttachmentItem]
Maybe Text
Maybe ChatItemType
Maybe ParticipantRole
Maybe MessageMetadata
type' :: Maybe ChatItemType
participantRole :: Maybe ParticipantRole
participantId :: Maybe Text
messageMetadata :: Maybe MessageMetadata
id :: Maybe Text
displayName :: Maybe Text
contentType :: Maybe Text
content :: Maybe Text
attachments :: Maybe [AttachmentItem]
absoluteTime :: Maybe Text
$sel:type':Item' :: Item -> Maybe ChatItemType
$sel:participantRole:Item' :: Item -> Maybe ParticipantRole
$sel:participantId:Item' :: Item -> Maybe Text
$sel:messageMetadata:Item' :: Item -> Maybe MessageMetadata
$sel:id:Item' :: Item -> Maybe Text
$sel:displayName:Item' :: Item -> Maybe Text
$sel:contentType:Item' :: Item -> Maybe Text
$sel:content:Item' :: Item -> Maybe Text
$sel:attachments:Item' :: Item -> Maybe [AttachmentItem]
$sel:absoluteTime:Item' :: Item -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
absoluteTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttachmentItem]
attachments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MessageMetadata
messageMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
participantId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ParticipantRole
participantRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChatItemType
type'