{-# 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.Connect.Types.Contact
-- 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.Connect.Types.Contact where

import Amazonka.Connect.Types.AgentInfo
import Amazonka.Connect.Types.Channel
import Amazonka.Connect.Types.ContactInitiationMethod
import Amazonka.Connect.Types.QueueInfo
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

-- | Contains information about a contact.
--
-- /See:/ 'newContact' smart constructor.
data Contact = Contact'
  { -- | Information about the agent who accepted the contact.
    Contact -> Maybe AgentInfo
agentInfo :: Prelude.Maybe AgentInfo,
    -- | The Amazon Resource Name (ARN) for the contact.
    Contact -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | How the contact reached your contact center.
    Contact -> Maybe Channel
channel :: Prelude.Maybe Channel,
    -- | The description of the contact.
    Contact -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The timestamp when the customer endpoint disconnected from Amazon
    -- Connect.
    Contact -> Maybe POSIX
disconnectTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The identifier for the contact.
    Contact -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | If this contact is related to other contacts, this is the ID of the
    -- initial contact.
    Contact -> Maybe Text
initialContactId :: Prelude.Maybe Prelude.Text,
    -- | Indicates how the contact was initiated.
    Contact -> Maybe ContactInitiationMethod
initiationMethod :: Prelude.Maybe ContactInitiationMethod,
    -- | The date and time this contact was initiated, in UTC time. For
    -- @INBOUND@, this is when the contact arrived. For @OUTBOUND@, this is
    -- when the agent began dialing. For @CALLBACK@, this is when the callback
    -- contact was created. For @TRANSFER@ and @QUEUE_TRANSFER@, this is when
    -- the transfer was initiated. For @API@, this is when the request arrived.
    Contact -> Maybe POSIX
initiationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The timestamp when contact was last updated.
    Contact -> Maybe POSIX
lastUpdateTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The name of the contact.
    Contact -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | If this contact is not the first contact, this is the ID of the previous
    -- contact.
    Contact -> Maybe Text
previousContactId :: Prelude.Maybe Prelude.Text,
    -- | If this contact was queued, this contains information about the queue.
    Contact -> Maybe QueueInfo
queueInfo :: Prelude.Maybe QueueInfo,
    -- | The timestamp, in Unix epoch time format, at which to start running the
    -- inbound flow.
    Contact -> Maybe POSIX
scheduledTimestamp :: Prelude.Maybe Data.POSIX
  }
  deriving (Contact -> Contact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contact -> Contact -> Bool
$c/= :: Contact -> Contact -> Bool
== :: Contact -> Contact -> Bool
$c== :: Contact -> Contact -> Bool
Prelude.Eq, ReadPrec [Contact]
ReadPrec Contact
Int -> ReadS Contact
ReadS [Contact]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Contact]
$creadListPrec :: ReadPrec [Contact]
readPrec :: ReadPrec Contact
$creadPrec :: ReadPrec Contact
readList :: ReadS [Contact]
$creadList :: ReadS [Contact]
readsPrec :: Int -> ReadS Contact
$creadsPrec :: Int -> ReadS Contact
Prelude.Read, Int -> Contact -> ShowS
[Contact] -> ShowS
Contact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contact] -> ShowS
$cshowList :: [Contact] -> ShowS
show :: Contact -> String
$cshow :: Contact -> String
showsPrec :: Int -> Contact -> ShowS
$cshowsPrec :: Int -> Contact -> ShowS
Prelude.Show, forall x. Rep Contact x -> Contact
forall x. Contact -> Rep Contact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Contact x -> Contact
$cfrom :: forall x. Contact -> Rep Contact x
Prelude.Generic)

-- |
-- Create a value of 'Contact' 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:
--
-- 'agentInfo', 'contact_agentInfo' - Information about the agent who accepted the contact.
--
-- 'arn', 'contact_arn' - The Amazon Resource Name (ARN) for the contact.
--
-- 'channel', 'contact_channel' - How the contact reached your contact center.
--
-- 'description', 'contact_description' - The description of the contact.
--
-- 'disconnectTimestamp', 'contact_disconnectTimestamp' - The timestamp when the customer endpoint disconnected from Amazon
-- Connect.
--
-- 'id', 'contact_id' - The identifier for the contact.
--
-- 'initialContactId', 'contact_initialContactId' - If this contact is related to other contacts, this is the ID of the
-- initial contact.
--
-- 'initiationMethod', 'contact_initiationMethod' - Indicates how the contact was initiated.
--
-- 'initiationTimestamp', 'contact_initiationTimestamp' - The date and time this contact was initiated, in UTC time. For
-- @INBOUND@, this is when the contact arrived. For @OUTBOUND@, this is
-- when the agent began dialing. For @CALLBACK@, this is when the callback
-- contact was created. For @TRANSFER@ and @QUEUE_TRANSFER@, this is when
-- the transfer was initiated. For @API@, this is when the request arrived.
--
-- 'lastUpdateTimestamp', 'contact_lastUpdateTimestamp' - The timestamp when contact was last updated.
--
-- 'name', 'contact_name' - The name of the contact.
--
-- 'previousContactId', 'contact_previousContactId' - If this contact is not the first contact, this is the ID of the previous
-- contact.
--
-- 'queueInfo', 'contact_queueInfo' - If this contact was queued, this contains information about the queue.
--
-- 'scheduledTimestamp', 'contact_scheduledTimestamp' - The timestamp, in Unix epoch time format, at which to start running the
-- inbound flow.
newContact ::
  Contact
newContact :: Contact
newContact =
  Contact'
    { $sel:agentInfo:Contact' :: Maybe AgentInfo
agentInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:Contact' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:channel:Contact' :: Maybe Channel
channel = forall a. Maybe a
Prelude.Nothing,
      $sel:description:Contact' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:disconnectTimestamp:Contact' :: Maybe POSIX
disconnectTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Contact' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:initialContactId:Contact' :: Maybe Text
initialContactId = forall a. Maybe a
Prelude.Nothing,
      $sel:initiationMethod:Contact' :: Maybe ContactInitiationMethod
initiationMethod = forall a. Maybe a
Prelude.Nothing,
      $sel:initiationTimestamp:Contact' :: Maybe POSIX
initiationTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdateTimestamp:Contact' :: Maybe POSIX
lastUpdateTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Contact' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:previousContactId:Contact' :: Maybe Text
previousContactId = forall a. Maybe a
Prelude.Nothing,
      $sel:queueInfo:Contact' :: Maybe QueueInfo
queueInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduledTimestamp:Contact' :: Maybe POSIX
scheduledTimestamp = forall a. Maybe a
Prelude.Nothing
    }

-- | Information about the agent who accepted the contact.
contact_agentInfo :: Lens.Lens' Contact (Prelude.Maybe AgentInfo)
contact_agentInfo :: Lens' Contact (Maybe AgentInfo)
contact_agentInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe AgentInfo
agentInfo :: Maybe AgentInfo
$sel:agentInfo:Contact' :: Contact -> Maybe AgentInfo
agentInfo} -> Maybe AgentInfo
agentInfo) (\s :: Contact
s@Contact' {} Maybe AgentInfo
a -> Contact
s {$sel:agentInfo:Contact' :: Maybe AgentInfo
agentInfo = Maybe AgentInfo
a} :: Contact)

-- | The Amazon Resource Name (ARN) for the contact.
contact_arn :: Lens.Lens' Contact (Prelude.Maybe Prelude.Text)
contact_arn :: Lens' Contact (Maybe Text)
contact_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe Text
arn :: Maybe Text
$sel:arn:Contact' :: Contact -> Maybe Text
arn} -> Maybe Text
arn) (\s :: Contact
s@Contact' {} Maybe Text
a -> Contact
s {$sel:arn:Contact' :: Maybe Text
arn = Maybe Text
a} :: Contact)

-- | How the contact reached your contact center.
contact_channel :: Lens.Lens' Contact (Prelude.Maybe Channel)
contact_channel :: Lens' Contact (Maybe Channel)
contact_channel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe Channel
channel :: Maybe Channel
$sel:channel:Contact' :: Contact -> Maybe Channel
channel} -> Maybe Channel
channel) (\s :: Contact
s@Contact' {} Maybe Channel
a -> Contact
s {$sel:channel:Contact' :: Maybe Channel
channel = Maybe Channel
a} :: Contact)

-- | The description of the contact.
contact_description :: Lens.Lens' Contact (Prelude.Maybe Prelude.Text)
contact_description :: Lens' Contact (Maybe Text)
contact_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe Text
description :: Maybe Text
$sel:description:Contact' :: Contact -> Maybe Text
description} -> Maybe Text
description) (\s :: Contact
s@Contact' {} Maybe Text
a -> Contact
s {$sel:description:Contact' :: Maybe Text
description = Maybe Text
a} :: Contact)

-- | The timestamp when the customer endpoint disconnected from Amazon
-- Connect.
contact_disconnectTimestamp :: Lens.Lens' Contact (Prelude.Maybe Prelude.UTCTime)
contact_disconnectTimestamp :: Lens' Contact (Maybe UTCTime)
contact_disconnectTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe POSIX
disconnectTimestamp :: Maybe POSIX
$sel:disconnectTimestamp:Contact' :: Contact -> Maybe POSIX
disconnectTimestamp} -> Maybe POSIX
disconnectTimestamp) (\s :: Contact
s@Contact' {} Maybe POSIX
a -> Contact
s {$sel:disconnectTimestamp:Contact' :: Maybe POSIX
disconnectTimestamp = Maybe POSIX
a} :: Contact) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The identifier for the contact.
contact_id :: Lens.Lens' Contact (Prelude.Maybe Prelude.Text)
contact_id :: Lens' Contact (Maybe Text)
contact_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe Text
id :: Maybe Text
$sel:id:Contact' :: Contact -> Maybe Text
id} -> Maybe Text
id) (\s :: Contact
s@Contact' {} Maybe Text
a -> Contact
s {$sel:id:Contact' :: Maybe Text
id = Maybe Text
a} :: Contact)

-- | If this contact is related to other contacts, this is the ID of the
-- initial contact.
contact_initialContactId :: Lens.Lens' Contact (Prelude.Maybe Prelude.Text)
contact_initialContactId :: Lens' Contact (Maybe Text)
contact_initialContactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe Text
initialContactId :: Maybe Text
$sel:initialContactId:Contact' :: Contact -> Maybe Text
initialContactId} -> Maybe Text
initialContactId) (\s :: Contact
s@Contact' {} Maybe Text
a -> Contact
s {$sel:initialContactId:Contact' :: Maybe Text
initialContactId = Maybe Text
a} :: Contact)

-- | Indicates how the contact was initiated.
contact_initiationMethod :: Lens.Lens' Contact (Prelude.Maybe ContactInitiationMethod)
contact_initiationMethod :: Lens' Contact (Maybe ContactInitiationMethod)
contact_initiationMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe ContactInitiationMethod
initiationMethod :: Maybe ContactInitiationMethod
$sel:initiationMethod:Contact' :: Contact -> Maybe ContactInitiationMethod
initiationMethod} -> Maybe ContactInitiationMethod
initiationMethod) (\s :: Contact
s@Contact' {} Maybe ContactInitiationMethod
a -> Contact
s {$sel:initiationMethod:Contact' :: Maybe ContactInitiationMethod
initiationMethod = Maybe ContactInitiationMethod
a} :: Contact)

-- | The date and time this contact was initiated, in UTC time. For
-- @INBOUND@, this is when the contact arrived. For @OUTBOUND@, this is
-- when the agent began dialing. For @CALLBACK@, this is when the callback
-- contact was created. For @TRANSFER@ and @QUEUE_TRANSFER@, this is when
-- the transfer was initiated. For @API@, this is when the request arrived.
contact_initiationTimestamp :: Lens.Lens' Contact (Prelude.Maybe Prelude.UTCTime)
contact_initiationTimestamp :: Lens' Contact (Maybe UTCTime)
contact_initiationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe POSIX
initiationTimestamp :: Maybe POSIX
$sel:initiationTimestamp:Contact' :: Contact -> Maybe POSIX
initiationTimestamp} -> Maybe POSIX
initiationTimestamp) (\s :: Contact
s@Contact' {} Maybe POSIX
a -> Contact
s {$sel:initiationTimestamp:Contact' :: Maybe POSIX
initiationTimestamp = Maybe POSIX
a} :: Contact) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The timestamp when contact was last updated.
contact_lastUpdateTimestamp :: Lens.Lens' Contact (Prelude.Maybe Prelude.UTCTime)
contact_lastUpdateTimestamp :: Lens' Contact (Maybe UTCTime)
contact_lastUpdateTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe POSIX
lastUpdateTimestamp :: Maybe POSIX
$sel:lastUpdateTimestamp:Contact' :: Contact -> Maybe POSIX
lastUpdateTimestamp} -> Maybe POSIX
lastUpdateTimestamp) (\s :: Contact
s@Contact' {} Maybe POSIX
a -> Contact
s {$sel:lastUpdateTimestamp:Contact' :: Maybe POSIX
lastUpdateTimestamp = Maybe POSIX
a} :: Contact) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the contact.
contact_name :: Lens.Lens' Contact (Prelude.Maybe Prelude.Text)
contact_name :: Lens' Contact (Maybe Text)
contact_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe Text
name :: Maybe Text
$sel:name:Contact' :: Contact -> Maybe Text
name} -> Maybe Text
name) (\s :: Contact
s@Contact' {} Maybe Text
a -> Contact
s {$sel:name:Contact' :: Maybe Text
name = Maybe Text
a} :: Contact)

-- | If this contact is not the first contact, this is the ID of the previous
-- contact.
contact_previousContactId :: Lens.Lens' Contact (Prelude.Maybe Prelude.Text)
contact_previousContactId :: Lens' Contact (Maybe Text)
contact_previousContactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe Text
previousContactId :: Maybe Text
$sel:previousContactId:Contact' :: Contact -> Maybe Text
previousContactId} -> Maybe Text
previousContactId) (\s :: Contact
s@Contact' {} Maybe Text
a -> Contact
s {$sel:previousContactId:Contact' :: Maybe Text
previousContactId = Maybe Text
a} :: Contact)

-- | If this contact was queued, this contains information about the queue.
contact_queueInfo :: Lens.Lens' Contact (Prelude.Maybe QueueInfo)
contact_queueInfo :: Lens' Contact (Maybe QueueInfo)
contact_queueInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe QueueInfo
queueInfo :: Maybe QueueInfo
$sel:queueInfo:Contact' :: Contact -> Maybe QueueInfo
queueInfo} -> Maybe QueueInfo
queueInfo) (\s :: Contact
s@Contact' {} Maybe QueueInfo
a -> Contact
s {$sel:queueInfo:Contact' :: Maybe QueueInfo
queueInfo = Maybe QueueInfo
a} :: Contact)

-- | The timestamp, in Unix epoch time format, at which to start running the
-- inbound flow.
contact_scheduledTimestamp :: Lens.Lens' Contact (Prelude.Maybe Prelude.UTCTime)
contact_scheduledTimestamp :: Lens' Contact (Maybe UTCTime)
contact_scheduledTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Contact' {Maybe POSIX
scheduledTimestamp :: Maybe POSIX
$sel:scheduledTimestamp:Contact' :: Contact -> Maybe POSIX
scheduledTimestamp} -> Maybe POSIX
scheduledTimestamp) (\s :: Contact
s@Contact' {} Maybe POSIX
a -> Contact
s {$sel:scheduledTimestamp:Contact' :: Maybe POSIX
scheduledTimestamp = Maybe POSIX
a} :: Contact) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromJSON Contact where
  parseJSON :: Value -> Parser Contact
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Contact"
      ( \Object
x ->
          Maybe AgentInfo
-> Maybe Text
-> Maybe Channel
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe ContactInitiationMethod
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe QueueInfo
-> Maybe POSIX
-> Contact
Contact'
            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
"AgentInfo")
            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
"Arn")
            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
"Channel")
            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
"Description")
            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
"DisconnectTimestamp")
            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
"InitialContactId")
            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
"InitiationMethod")
            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
"InitiationTimestamp")
            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
"LastUpdateTimestamp")
            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
"Name")
            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
"PreviousContactId")
            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
"QueueInfo")
            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
"ScheduledTimestamp")
      )

instance Prelude.Hashable Contact where
  hashWithSalt :: Int -> Contact -> Int
hashWithSalt Int
_salt Contact' {Maybe Text
Maybe POSIX
Maybe AgentInfo
Maybe Channel
Maybe ContactInitiationMethod
Maybe QueueInfo
scheduledTimestamp :: Maybe POSIX
queueInfo :: Maybe QueueInfo
previousContactId :: Maybe Text
name :: Maybe Text
lastUpdateTimestamp :: Maybe POSIX
initiationTimestamp :: Maybe POSIX
initiationMethod :: Maybe ContactInitiationMethod
initialContactId :: Maybe Text
id :: Maybe Text
disconnectTimestamp :: Maybe POSIX
description :: Maybe Text
channel :: Maybe Channel
arn :: Maybe Text
agentInfo :: Maybe AgentInfo
$sel:scheduledTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:queueInfo:Contact' :: Contact -> Maybe QueueInfo
$sel:previousContactId:Contact' :: Contact -> Maybe Text
$sel:name:Contact' :: Contact -> Maybe Text
$sel:lastUpdateTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:initiationTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:initiationMethod:Contact' :: Contact -> Maybe ContactInitiationMethod
$sel:initialContactId:Contact' :: Contact -> Maybe Text
$sel:id:Contact' :: Contact -> Maybe Text
$sel:disconnectTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:description:Contact' :: Contact -> Maybe Text
$sel:channel:Contact' :: Contact -> Maybe Channel
$sel:arn:Contact' :: Contact -> Maybe Text
$sel:agentInfo:Contact' :: Contact -> Maybe AgentInfo
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AgentInfo
agentInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Channel
channel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
disconnectTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
initialContactId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContactInitiationMethod
initiationMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
initiationTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdateTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
previousContactId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QueueInfo
queueInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
scheduledTimestamp

instance Prelude.NFData Contact where
  rnf :: Contact -> ()
rnf Contact' {Maybe Text
Maybe POSIX
Maybe AgentInfo
Maybe Channel
Maybe ContactInitiationMethod
Maybe QueueInfo
scheduledTimestamp :: Maybe POSIX
queueInfo :: Maybe QueueInfo
previousContactId :: Maybe Text
name :: Maybe Text
lastUpdateTimestamp :: Maybe POSIX
initiationTimestamp :: Maybe POSIX
initiationMethod :: Maybe ContactInitiationMethod
initialContactId :: Maybe Text
id :: Maybe Text
disconnectTimestamp :: Maybe POSIX
description :: Maybe Text
channel :: Maybe Channel
arn :: Maybe Text
agentInfo :: Maybe AgentInfo
$sel:scheduledTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:queueInfo:Contact' :: Contact -> Maybe QueueInfo
$sel:previousContactId:Contact' :: Contact -> Maybe Text
$sel:name:Contact' :: Contact -> Maybe Text
$sel:lastUpdateTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:initiationTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:initiationMethod:Contact' :: Contact -> Maybe ContactInitiationMethod
$sel:initialContactId:Contact' :: Contact -> Maybe Text
$sel:id:Contact' :: Contact -> Maybe Text
$sel:disconnectTimestamp:Contact' :: Contact -> Maybe POSIX
$sel:description:Contact' :: Contact -> Maybe Text
$sel:channel:Contact' :: Contact -> Maybe Channel
$sel:arn:Contact' :: Contact -> Maybe Text
$sel:agentInfo:Contact' :: Contact -> Maybe AgentInfo
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AgentInfo
agentInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Channel
channel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
disconnectTimestamp
      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 Text
initialContactId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContactInitiationMethod
initiationMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
initiationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdateTimestamp
      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 Maybe Text
previousContactId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QueueInfo
queueInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
scheduledTimestamp