{-# 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.Pinpoint.Types.JourneyResponse
-- 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.Pinpoint.Types.JourneyResponse where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Pinpoint.Types.Activity
import Amazonka.Pinpoint.Types.ClosedDays
import Amazonka.Pinpoint.Types.JourneyChannelSettings
import Amazonka.Pinpoint.Types.JourneyLimits
import Amazonka.Pinpoint.Types.JourneySchedule
import Amazonka.Pinpoint.Types.OpenHours
import Amazonka.Pinpoint.Types.QuietTime
import Amazonka.Pinpoint.Types.StartCondition
import Amazonka.Pinpoint.Types.State
import qualified Amazonka.Prelude as Prelude

-- | Provides information about the status, configuration, and other settings
-- for a journey.
--
-- /See:/ 'newJourneyResponse' smart constructor.
data JourneyResponse = JourneyResponse'
  { -- | A map that contains a set of Activity objects, one object for each
    -- activity in the journey. For each Activity object, the key is the unique
    -- identifier (string) for an activity and the value is the settings for
    -- the activity.
    JourneyResponse -> Maybe (HashMap Text Activity)
activities :: Prelude.Maybe (Prelude.HashMap Prelude.Text Activity),
    -- | The time when journey will stop sending messages. QuietTime should be
    -- configured first and SendingSchedule should be set to true.
    JourneyResponse -> Maybe ClosedDays
closedDays :: Prelude.Maybe ClosedDays,
    -- | The date, in ISO 8601 format, when the journey was created.
    JourneyResponse -> Maybe Text
creationDate :: Prelude.Maybe Prelude.Text,
    -- | The channel-specific configurations for the journey.
    JourneyResponse -> Maybe JourneyChannelSettings
journeyChannelSettings :: Prelude.Maybe JourneyChannelSettings,
    -- | The date, in ISO 8601 format, when the journey was last modified.
    JourneyResponse -> Maybe Text
lastModifiedDate :: Prelude.Maybe Prelude.Text,
    -- | The messaging and entry limits for the journey.
    JourneyResponse -> Maybe JourneyLimits
limits :: Prelude.Maybe JourneyLimits,
    -- | Specifies whether the journey\'s scheduled start and end times use each
    -- participant\'s local time. If this value is true, the schedule uses each
    -- participant\'s local time.
    JourneyResponse -> Maybe Bool
localTime :: Prelude.Maybe Prelude.Bool,
    -- | The time when journey allow to send messages. QuietTime should be
    -- configured first and SendingSchedule should be set to true.
    JourneyResponse -> Maybe OpenHours
openHours :: Prelude.Maybe OpenHours,
    -- | The quiet time settings for the journey. Quiet time is a specific time
    -- range when a journey doesn\'t send messages to participants, if all the
    -- following conditions are met:
    --
    -- -   The EndpointDemographic.Timezone property of the endpoint for the
    --     participant is set to a valid value.
    --
    -- -   The current time in the participant\'s time zone is later than or
    --     equal to the time specified by the QuietTime.Start property for the
    --     journey.
    --
    -- -   The current time in the participant\'s time zone is earlier than or
    --     equal to the time specified by the QuietTime.End property for the
    --     journey.
    --
    -- If any of the preceding conditions isn\'t met, the participant will
    -- receive messages from the journey, even if quiet time is enabled.
    JourneyResponse -> Maybe QuietTime
quietTime :: Prelude.Maybe QuietTime,
    -- | The frequency with which Amazon Pinpoint evaluates segment and event
    -- data for the journey, as a duration in ISO 8601 format.
    JourneyResponse -> Maybe Text
refreshFrequency :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether a journey should be refreshed on segment update.
    JourneyResponse -> Maybe Bool
refreshOnSegmentUpdate :: Prelude.Maybe Prelude.Bool,
    -- | The schedule settings for the journey.
    JourneyResponse -> Maybe JourneySchedule
schedule :: Prelude.Maybe JourneySchedule,
    -- | Indicates if journey have Advance Quiet Time (OpenHours and ClosedDays).
    -- This flag should be set to true in order to allow (OpenHours and
    -- ClosedDays)
    JourneyResponse -> Maybe Bool
sendingSchedule :: Prelude.Maybe Prelude.Bool,
    -- | The unique identifier for the first activity in the journey.
    JourneyResponse -> Maybe Text
startActivity :: Prelude.Maybe Prelude.Text,
    -- | The segment that defines which users are participants in the journey.
    JourneyResponse -> Maybe StartCondition
startCondition :: Prelude.Maybe StartCondition,
    -- | The current status of the journey. Possible values are:
    --
    -- -   DRAFT - The journey is being developed and hasn\'t been published
    --     yet.
    --
    -- -   ACTIVE - The journey has been developed and published. Depending on
    --     the journey\'s schedule, the journey may currently be running or
    --     scheduled to start running at a later time. If a journey\'s status
    --     is ACTIVE, you can\'t add, change, or remove activities from it.
    --
    -- -   COMPLETED - The journey has been published and has finished running.
    --     All participants have entered the journey and no participants are
    --     waiting to complete the journey or any activities in the journey.
    --
    -- -   CANCELLED - The journey has been stopped. If a journey\'s status is
    --     CANCELLED, you can\'t add, change, or remove activities or segment
    --     settings from the journey.
    --
    -- -   CLOSED - The journey has been published and has started running. It
    --     may have also passed its scheduled end time, or passed its scheduled
    --     start time and a refresh frequency hasn\'t been specified for it. If
    --     a journey\'s status is CLOSED, you can\'t add participants to it,
    --     and no existing participants can enter the journey for the first
    --     time. However, any existing participants who are currently waiting
    --     to start an activity may continue the journey.
    JourneyResponse -> Maybe State
state :: Prelude.Maybe State,
    -- | Specifies whether endpoints in quiet hours should enter a wait till the
    -- end of their quiet hours.
    JourneyResponse -> Maybe Bool
waitForQuietTime :: Prelude.Maybe Prelude.Bool,
    -- | This object is not used or supported.
    JourneyResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the journey.
    JourneyResponse -> Text
name :: Prelude.Text,
    -- | The unique identifier for the journey.
    JourneyResponse -> Text
id :: Prelude.Text,
    -- | The unique identifier for the application that the journey applies to.
    JourneyResponse -> Text
applicationId :: Prelude.Text
  }
  deriving (JourneyResponse -> JourneyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JourneyResponse -> JourneyResponse -> Bool
$c/= :: JourneyResponse -> JourneyResponse -> Bool
== :: JourneyResponse -> JourneyResponse -> Bool
$c== :: JourneyResponse -> JourneyResponse -> Bool
Prelude.Eq, ReadPrec [JourneyResponse]
ReadPrec JourneyResponse
Int -> ReadS JourneyResponse
ReadS [JourneyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JourneyResponse]
$creadListPrec :: ReadPrec [JourneyResponse]
readPrec :: ReadPrec JourneyResponse
$creadPrec :: ReadPrec JourneyResponse
readList :: ReadS [JourneyResponse]
$creadList :: ReadS [JourneyResponse]
readsPrec :: Int -> ReadS JourneyResponse
$creadsPrec :: Int -> ReadS JourneyResponse
Prelude.Read, Int -> JourneyResponse -> ShowS
[JourneyResponse] -> ShowS
JourneyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JourneyResponse] -> ShowS
$cshowList :: [JourneyResponse] -> ShowS
show :: JourneyResponse -> String
$cshow :: JourneyResponse -> String
showsPrec :: Int -> JourneyResponse -> ShowS
$cshowsPrec :: Int -> JourneyResponse -> ShowS
Prelude.Show, forall x. Rep JourneyResponse x -> JourneyResponse
forall x. JourneyResponse -> Rep JourneyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JourneyResponse x -> JourneyResponse
$cfrom :: forall x. JourneyResponse -> Rep JourneyResponse x
Prelude.Generic)

-- |
-- Create a value of 'JourneyResponse' 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:
--
-- 'activities', 'journeyResponse_activities' - A map that contains a set of Activity objects, one object for each
-- activity in the journey. For each Activity object, the key is the unique
-- identifier (string) for an activity and the value is the settings for
-- the activity.
--
-- 'closedDays', 'journeyResponse_closedDays' - The time when journey will stop sending messages. QuietTime should be
-- configured first and SendingSchedule should be set to true.
--
-- 'creationDate', 'journeyResponse_creationDate' - The date, in ISO 8601 format, when the journey was created.
--
-- 'journeyChannelSettings', 'journeyResponse_journeyChannelSettings' - The channel-specific configurations for the journey.
--
-- 'lastModifiedDate', 'journeyResponse_lastModifiedDate' - The date, in ISO 8601 format, when the journey was last modified.
--
-- 'limits', 'journeyResponse_limits' - The messaging and entry limits for the journey.
--
-- 'localTime', 'journeyResponse_localTime' - Specifies whether the journey\'s scheduled start and end times use each
-- participant\'s local time. If this value is true, the schedule uses each
-- participant\'s local time.
--
-- 'openHours', 'journeyResponse_openHours' - The time when journey allow to send messages. QuietTime should be
-- configured first and SendingSchedule should be set to true.
--
-- 'quietTime', 'journeyResponse_quietTime' - The quiet time settings for the journey. Quiet time is a specific time
-- range when a journey doesn\'t send messages to participants, if all the
-- following conditions are met:
--
-- -   The EndpointDemographic.Timezone property of the endpoint for the
--     participant is set to a valid value.
--
-- -   The current time in the participant\'s time zone is later than or
--     equal to the time specified by the QuietTime.Start property for the
--     journey.
--
-- -   The current time in the participant\'s time zone is earlier than or
--     equal to the time specified by the QuietTime.End property for the
--     journey.
--
-- If any of the preceding conditions isn\'t met, the participant will
-- receive messages from the journey, even if quiet time is enabled.
--
-- 'refreshFrequency', 'journeyResponse_refreshFrequency' - The frequency with which Amazon Pinpoint evaluates segment and event
-- data for the journey, as a duration in ISO 8601 format.
--
-- 'refreshOnSegmentUpdate', 'journeyResponse_refreshOnSegmentUpdate' - Specifies whether a journey should be refreshed on segment update.
--
-- 'schedule', 'journeyResponse_schedule' - The schedule settings for the journey.
--
-- 'sendingSchedule', 'journeyResponse_sendingSchedule' - Indicates if journey have Advance Quiet Time (OpenHours and ClosedDays).
-- This flag should be set to true in order to allow (OpenHours and
-- ClosedDays)
--
-- 'startActivity', 'journeyResponse_startActivity' - The unique identifier for the first activity in the journey.
--
-- 'startCondition', 'journeyResponse_startCondition' - The segment that defines which users are participants in the journey.
--
-- 'state', 'journeyResponse_state' - The current status of the journey. Possible values are:
--
-- -   DRAFT - The journey is being developed and hasn\'t been published
--     yet.
--
-- -   ACTIVE - The journey has been developed and published. Depending on
--     the journey\'s schedule, the journey may currently be running or
--     scheduled to start running at a later time. If a journey\'s status
--     is ACTIVE, you can\'t add, change, or remove activities from it.
--
-- -   COMPLETED - The journey has been published and has finished running.
--     All participants have entered the journey and no participants are
--     waiting to complete the journey or any activities in the journey.
--
-- -   CANCELLED - The journey has been stopped. If a journey\'s status is
--     CANCELLED, you can\'t add, change, or remove activities or segment
--     settings from the journey.
--
-- -   CLOSED - The journey has been published and has started running. It
--     may have also passed its scheduled end time, or passed its scheduled
--     start time and a refresh frequency hasn\'t been specified for it. If
--     a journey\'s status is CLOSED, you can\'t add participants to it,
--     and no existing participants can enter the journey for the first
--     time. However, any existing participants who are currently waiting
--     to start an activity may continue the journey.
--
-- 'waitForQuietTime', 'journeyResponse_waitForQuietTime' - Specifies whether endpoints in quiet hours should enter a wait till the
-- end of their quiet hours.
--
-- 'tags', 'journeyResponse_tags' - This object is not used or supported.
--
-- 'name', 'journeyResponse_name' - The name of the journey.
--
-- 'id', 'journeyResponse_id' - The unique identifier for the journey.
--
-- 'applicationId', 'journeyResponse_applicationId' - The unique identifier for the application that the journey applies to.
newJourneyResponse ::
  -- | 'name'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'applicationId'
  Prelude.Text ->
  JourneyResponse
newJourneyResponse :: Text -> Text -> Text -> JourneyResponse
newJourneyResponse Text
pName_ Text
pId_ Text
pApplicationId_ =
  JourneyResponse'
    { $sel:activities:JourneyResponse' :: Maybe (HashMap Text Activity)
activities = forall a. Maybe a
Prelude.Nothing,
      $sel:closedDays:JourneyResponse' :: Maybe ClosedDays
closedDays = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:JourneyResponse' :: Maybe Text
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:journeyChannelSettings:JourneyResponse' :: Maybe JourneyChannelSettings
journeyChannelSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDate:JourneyResponse' :: Maybe Text
lastModifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:limits:JourneyResponse' :: Maybe JourneyLimits
limits = forall a. Maybe a
Prelude.Nothing,
      $sel:localTime:JourneyResponse' :: Maybe Bool
localTime = forall a. Maybe a
Prelude.Nothing,
      $sel:openHours:JourneyResponse' :: Maybe OpenHours
openHours = forall a. Maybe a
Prelude.Nothing,
      $sel:quietTime:JourneyResponse' :: Maybe QuietTime
quietTime = forall a. Maybe a
Prelude.Nothing,
      $sel:refreshFrequency:JourneyResponse' :: Maybe Text
refreshFrequency = forall a. Maybe a
Prelude.Nothing,
      $sel:refreshOnSegmentUpdate:JourneyResponse' :: Maybe Bool
refreshOnSegmentUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:schedule:JourneyResponse' :: Maybe JourneySchedule
schedule = forall a. Maybe a
Prelude.Nothing,
      $sel:sendingSchedule:JourneyResponse' :: Maybe Bool
sendingSchedule = forall a. Maybe a
Prelude.Nothing,
      $sel:startActivity:JourneyResponse' :: Maybe Text
startActivity = forall a. Maybe a
Prelude.Nothing,
      $sel:startCondition:JourneyResponse' :: Maybe StartCondition
startCondition = forall a. Maybe a
Prelude.Nothing,
      $sel:state:JourneyResponse' :: Maybe State
state = forall a. Maybe a
Prelude.Nothing,
      $sel:waitForQuietTime:JourneyResponse' :: Maybe Bool
waitForQuietTime = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:JourneyResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:JourneyResponse' :: Text
name = Text
pName_,
      $sel:id:JourneyResponse' :: Text
id = Text
pId_,
      $sel:applicationId:JourneyResponse' :: Text
applicationId = Text
pApplicationId_
    }

-- | A map that contains a set of Activity objects, one object for each
-- activity in the journey. For each Activity object, the key is the unique
-- identifier (string) for an activity and the value is the settings for
-- the activity.
journeyResponse_activities :: Lens.Lens' JourneyResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Activity))
journeyResponse_activities :: Lens' JourneyResponse (Maybe (HashMap Text Activity))
journeyResponse_activities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe (HashMap Text Activity)
activities :: Maybe (HashMap Text Activity)
$sel:activities:JourneyResponse' :: JourneyResponse -> Maybe (HashMap Text Activity)
activities} -> Maybe (HashMap Text Activity)
activities) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe (HashMap Text Activity)
a -> JourneyResponse
s {$sel:activities:JourneyResponse' :: Maybe (HashMap Text Activity)
activities = Maybe (HashMap Text Activity)
a} :: JourneyResponse) 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 time when journey will stop sending messages. QuietTime should be
-- configured first and SendingSchedule should be set to true.
journeyResponse_closedDays :: Lens.Lens' JourneyResponse (Prelude.Maybe ClosedDays)
journeyResponse_closedDays :: Lens' JourneyResponse (Maybe ClosedDays)
journeyResponse_closedDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe ClosedDays
closedDays :: Maybe ClosedDays
$sel:closedDays:JourneyResponse' :: JourneyResponse -> Maybe ClosedDays
closedDays} -> Maybe ClosedDays
closedDays) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe ClosedDays
a -> JourneyResponse
s {$sel:closedDays:JourneyResponse' :: Maybe ClosedDays
closedDays = Maybe ClosedDays
a} :: JourneyResponse)

-- | The date, in ISO 8601 format, when the journey was created.
journeyResponse_creationDate :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Text)
journeyResponse_creationDate :: Lens' JourneyResponse (Maybe Text)
journeyResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Text
creationDate :: Maybe Text
$sel:creationDate:JourneyResponse' :: JourneyResponse -> Maybe Text
creationDate} -> Maybe Text
creationDate) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Text
a -> JourneyResponse
s {$sel:creationDate:JourneyResponse' :: Maybe Text
creationDate = Maybe Text
a} :: JourneyResponse)

-- | The channel-specific configurations for the journey.
journeyResponse_journeyChannelSettings :: Lens.Lens' JourneyResponse (Prelude.Maybe JourneyChannelSettings)
journeyResponse_journeyChannelSettings :: Lens' JourneyResponse (Maybe JourneyChannelSettings)
journeyResponse_journeyChannelSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe JourneyChannelSettings
journeyChannelSettings :: Maybe JourneyChannelSettings
$sel:journeyChannelSettings:JourneyResponse' :: JourneyResponse -> Maybe JourneyChannelSettings
journeyChannelSettings} -> Maybe JourneyChannelSettings
journeyChannelSettings) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe JourneyChannelSettings
a -> JourneyResponse
s {$sel:journeyChannelSettings:JourneyResponse' :: Maybe JourneyChannelSettings
journeyChannelSettings = Maybe JourneyChannelSettings
a} :: JourneyResponse)

-- | The date, in ISO 8601 format, when the journey was last modified.
journeyResponse_lastModifiedDate :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Text)
journeyResponse_lastModifiedDate :: Lens' JourneyResponse (Maybe Text)
journeyResponse_lastModifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Text
lastModifiedDate :: Maybe Text
$sel:lastModifiedDate:JourneyResponse' :: JourneyResponse -> Maybe Text
lastModifiedDate} -> Maybe Text
lastModifiedDate) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Text
a -> JourneyResponse
s {$sel:lastModifiedDate:JourneyResponse' :: Maybe Text
lastModifiedDate = Maybe Text
a} :: JourneyResponse)

-- | The messaging and entry limits for the journey.
journeyResponse_limits :: Lens.Lens' JourneyResponse (Prelude.Maybe JourneyLimits)
journeyResponse_limits :: Lens' JourneyResponse (Maybe JourneyLimits)
journeyResponse_limits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe JourneyLimits
limits :: Maybe JourneyLimits
$sel:limits:JourneyResponse' :: JourneyResponse -> Maybe JourneyLimits
limits} -> Maybe JourneyLimits
limits) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe JourneyLimits
a -> JourneyResponse
s {$sel:limits:JourneyResponse' :: Maybe JourneyLimits
limits = Maybe JourneyLimits
a} :: JourneyResponse)

-- | Specifies whether the journey\'s scheduled start and end times use each
-- participant\'s local time. If this value is true, the schedule uses each
-- participant\'s local time.
journeyResponse_localTime :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Bool)
journeyResponse_localTime :: Lens' JourneyResponse (Maybe Bool)
journeyResponse_localTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Bool
localTime :: Maybe Bool
$sel:localTime:JourneyResponse' :: JourneyResponse -> Maybe Bool
localTime} -> Maybe Bool
localTime) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Bool
a -> JourneyResponse
s {$sel:localTime:JourneyResponse' :: Maybe Bool
localTime = Maybe Bool
a} :: JourneyResponse)

-- | The time when journey allow to send messages. QuietTime should be
-- configured first and SendingSchedule should be set to true.
journeyResponse_openHours :: Lens.Lens' JourneyResponse (Prelude.Maybe OpenHours)
journeyResponse_openHours :: Lens' JourneyResponse (Maybe OpenHours)
journeyResponse_openHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe OpenHours
openHours :: Maybe OpenHours
$sel:openHours:JourneyResponse' :: JourneyResponse -> Maybe OpenHours
openHours} -> Maybe OpenHours
openHours) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe OpenHours
a -> JourneyResponse
s {$sel:openHours:JourneyResponse' :: Maybe OpenHours
openHours = Maybe OpenHours
a} :: JourneyResponse)

-- | The quiet time settings for the journey. Quiet time is a specific time
-- range when a journey doesn\'t send messages to participants, if all the
-- following conditions are met:
--
-- -   The EndpointDemographic.Timezone property of the endpoint for the
--     participant is set to a valid value.
--
-- -   The current time in the participant\'s time zone is later than or
--     equal to the time specified by the QuietTime.Start property for the
--     journey.
--
-- -   The current time in the participant\'s time zone is earlier than or
--     equal to the time specified by the QuietTime.End property for the
--     journey.
--
-- If any of the preceding conditions isn\'t met, the participant will
-- receive messages from the journey, even if quiet time is enabled.
journeyResponse_quietTime :: Lens.Lens' JourneyResponse (Prelude.Maybe QuietTime)
journeyResponse_quietTime :: Lens' JourneyResponse (Maybe QuietTime)
journeyResponse_quietTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe QuietTime
quietTime :: Maybe QuietTime
$sel:quietTime:JourneyResponse' :: JourneyResponse -> Maybe QuietTime
quietTime} -> Maybe QuietTime
quietTime) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe QuietTime
a -> JourneyResponse
s {$sel:quietTime:JourneyResponse' :: Maybe QuietTime
quietTime = Maybe QuietTime
a} :: JourneyResponse)

-- | The frequency with which Amazon Pinpoint evaluates segment and event
-- data for the journey, as a duration in ISO 8601 format.
journeyResponse_refreshFrequency :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Text)
journeyResponse_refreshFrequency :: Lens' JourneyResponse (Maybe Text)
journeyResponse_refreshFrequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Text
refreshFrequency :: Maybe Text
$sel:refreshFrequency:JourneyResponse' :: JourneyResponse -> Maybe Text
refreshFrequency} -> Maybe Text
refreshFrequency) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Text
a -> JourneyResponse
s {$sel:refreshFrequency:JourneyResponse' :: Maybe Text
refreshFrequency = Maybe Text
a} :: JourneyResponse)

-- | Specifies whether a journey should be refreshed on segment update.
journeyResponse_refreshOnSegmentUpdate :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Bool)
journeyResponse_refreshOnSegmentUpdate :: Lens' JourneyResponse (Maybe Bool)
journeyResponse_refreshOnSegmentUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Bool
refreshOnSegmentUpdate :: Maybe Bool
$sel:refreshOnSegmentUpdate:JourneyResponse' :: JourneyResponse -> Maybe Bool
refreshOnSegmentUpdate} -> Maybe Bool
refreshOnSegmentUpdate) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Bool
a -> JourneyResponse
s {$sel:refreshOnSegmentUpdate:JourneyResponse' :: Maybe Bool
refreshOnSegmentUpdate = Maybe Bool
a} :: JourneyResponse)

-- | The schedule settings for the journey.
journeyResponse_schedule :: Lens.Lens' JourneyResponse (Prelude.Maybe JourneySchedule)
journeyResponse_schedule :: Lens' JourneyResponse (Maybe JourneySchedule)
journeyResponse_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe JourneySchedule
schedule :: Maybe JourneySchedule
$sel:schedule:JourneyResponse' :: JourneyResponse -> Maybe JourneySchedule
schedule} -> Maybe JourneySchedule
schedule) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe JourneySchedule
a -> JourneyResponse
s {$sel:schedule:JourneyResponse' :: Maybe JourneySchedule
schedule = Maybe JourneySchedule
a} :: JourneyResponse)

-- | Indicates if journey have Advance Quiet Time (OpenHours and ClosedDays).
-- This flag should be set to true in order to allow (OpenHours and
-- ClosedDays)
journeyResponse_sendingSchedule :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Bool)
journeyResponse_sendingSchedule :: Lens' JourneyResponse (Maybe Bool)
journeyResponse_sendingSchedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Bool
sendingSchedule :: Maybe Bool
$sel:sendingSchedule:JourneyResponse' :: JourneyResponse -> Maybe Bool
sendingSchedule} -> Maybe Bool
sendingSchedule) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Bool
a -> JourneyResponse
s {$sel:sendingSchedule:JourneyResponse' :: Maybe Bool
sendingSchedule = Maybe Bool
a} :: JourneyResponse)

-- | The unique identifier for the first activity in the journey.
journeyResponse_startActivity :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Text)
journeyResponse_startActivity :: Lens' JourneyResponse (Maybe Text)
journeyResponse_startActivity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Text
startActivity :: Maybe Text
$sel:startActivity:JourneyResponse' :: JourneyResponse -> Maybe Text
startActivity} -> Maybe Text
startActivity) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Text
a -> JourneyResponse
s {$sel:startActivity:JourneyResponse' :: Maybe Text
startActivity = Maybe Text
a} :: JourneyResponse)

-- | The segment that defines which users are participants in the journey.
journeyResponse_startCondition :: Lens.Lens' JourneyResponse (Prelude.Maybe StartCondition)
journeyResponse_startCondition :: Lens' JourneyResponse (Maybe StartCondition)
journeyResponse_startCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe StartCondition
startCondition :: Maybe StartCondition
$sel:startCondition:JourneyResponse' :: JourneyResponse -> Maybe StartCondition
startCondition} -> Maybe StartCondition
startCondition) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe StartCondition
a -> JourneyResponse
s {$sel:startCondition:JourneyResponse' :: Maybe StartCondition
startCondition = Maybe StartCondition
a} :: JourneyResponse)

-- | The current status of the journey. Possible values are:
--
-- -   DRAFT - The journey is being developed and hasn\'t been published
--     yet.
--
-- -   ACTIVE - The journey has been developed and published. Depending on
--     the journey\'s schedule, the journey may currently be running or
--     scheduled to start running at a later time. If a journey\'s status
--     is ACTIVE, you can\'t add, change, or remove activities from it.
--
-- -   COMPLETED - The journey has been published and has finished running.
--     All participants have entered the journey and no participants are
--     waiting to complete the journey or any activities in the journey.
--
-- -   CANCELLED - The journey has been stopped. If a journey\'s status is
--     CANCELLED, you can\'t add, change, or remove activities or segment
--     settings from the journey.
--
-- -   CLOSED - The journey has been published and has started running. It
--     may have also passed its scheduled end time, or passed its scheduled
--     start time and a refresh frequency hasn\'t been specified for it. If
--     a journey\'s status is CLOSED, you can\'t add participants to it,
--     and no existing participants can enter the journey for the first
--     time. However, any existing participants who are currently waiting
--     to start an activity may continue the journey.
journeyResponse_state :: Lens.Lens' JourneyResponse (Prelude.Maybe State)
journeyResponse_state :: Lens' JourneyResponse (Maybe State)
journeyResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe State
state :: Maybe State
$sel:state:JourneyResponse' :: JourneyResponse -> Maybe State
state} -> Maybe State
state) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe State
a -> JourneyResponse
s {$sel:state:JourneyResponse' :: Maybe State
state = Maybe State
a} :: JourneyResponse)

-- | Specifies whether endpoints in quiet hours should enter a wait till the
-- end of their quiet hours.
journeyResponse_waitForQuietTime :: Lens.Lens' JourneyResponse (Prelude.Maybe Prelude.Bool)
journeyResponse_waitForQuietTime :: Lens' JourneyResponse (Maybe Bool)
journeyResponse_waitForQuietTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe Bool
waitForQuietTime :: Maybe Bool
$sel:waitForQuietTime:JourneyResponse' :: JourneyResponse -> Maybe Bool
waitForQuietTime} -> Maybe Bool
waitForQuietTime) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe Bool
a -> JourneyResponse
s {$sel:waitForQuietTime:JourneyResponse' :: Maybe Bool
waitForQuietTime = Maybe Bool
a} :: JourneyResponse)

-- | This object is not used or supported.
journeyResponse_tags :: Lens.Lens' JourneyResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
journeyResponse_tags :: Lens' JourneyResponse (Maybe (HashMap Text Text))
journeyResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:JourneyResponse' :: JourneyResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: JourneyResponse
s@JourneyResponse' {} Maybe (HashMap Text Text)
a -> JourneyResponse
s {$sel:tags:JourneyResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: JourneyResponse) 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 name of the journey.
journeyResponse_name :: Lens.Lens' JourneyResponse Prelude.Text
journeyResponse_name :: Lens' JourneyResponse Text
journeyResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Text
name :: Text
$sel:name:JourneyResponse' :: JourneyResponse -> Text
name} -> Text
name) (\s :: JourneyResponse
s@JourneyResponse' {} Text
a -> JourneyResponse
s {$sel:name:JourneyResponse' :: Text
name = Text
a} :: JourneyResponse)

-- | The unique identifier for the journey.
journeyResponse_id :: Lens.Lens' JourneyResponse Prelude.Text
journeyResponse_id :: Lens' JourneyResponse Text
journeyResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Text
id :: Text
$sel:id:JourneyResponse' :: JourneyResponse -> Text
id} -> Text
id) (\s :: JourneyResponse
s@JourneyResponse' {} Text
a -> JourneyResponse
s {$sel:id:JourneyResponse' :: Text
id = Text
a} :: JourneyResponse)

-- | The unique identifier for the application that the journey applies to.
journeyResponse_applicationId :: Lens.Lens' JourneyResponse Prelude.Text
journeyResponse_applicationId :: Lens' JourneyResponse Text
journeyResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JourneyResponse' {Text
applicationId :: Text
$sel:applicationId:JourneyResponse' :: JourneyResponse -> Text
applicationId} -> Text
applicationId) (\s :: JourneyResponse
s@JourneyResponse' {} Text
a -> JourneyResponse
s {$sel:applicationId:JourneyResponse' :: Text
applicationId = Text
a} :: JourneyResponse)

instance Data.FromJSON JourneyResponse where
  parseJSON :: Value -> Parser JourneyResponse
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"JourneyResponse"
      ( \Object
x ->
          Maybe (HashMap Text Activity)
-> Maybe ClosedDays
-> Maybe Text
-> Maybe JourneyChannelSettings
-> Maybe Text
-> Maybe JourneyLimits
-> Maybe Bool
-> Maybe OpenHours
-> Maybe QuietTime
-> Maybe Text
-> Maybe Bool
-> Maybe JourneySchedule
-> Maybe Bool
-> Maybe Text
-> Maybe StartCondition
-> Maybe State
-> Maybe Bool
-> Maybe (HashMap Text Text)
-> Text
-> Text
-> Text
-> JourneyResponse
JourneyResponse'
            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
"Activities" 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
"ClosedDays")
            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
"CreationDate")
            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
"JourneyChannelSettings")
            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
"LastModifiedDate")
            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
"Limits")
            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
"LocalTime")
            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
"OpenHours")
            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
"QuietTime")
            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
"RefreshFrequency")
            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
"RefreshOnSegmentUpdate")
            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
"Schedule")
            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
"SendingSchedule")
            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
"StartActivity")
            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
"StartCondition")
            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
"State")
            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
"WaitForQuietTime")
            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
"tags" 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 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 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 a
Data..: Key
"ApplicationId")
      )

instance Prelude.Hashable JourneyResponse where
  hashWithSalt :: Int -> JourneyResponse -> Int
hashWithSalt Int
_salt JourneyResponse' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text Activity)
Maybe ClosedDays
Maybe JourneyChannelSettings
Maybe JourneyLimits
Maybe JourneySchedule
Maybe OpenHours
Maybe QuietTime
Maybe StartCondition
Maybe State
Text
applicationId :: Text
id :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
waitForQuietTime :: Maybe Bool
state :: Maybe State
startCondition :: Maybe StartCondition
startActivity :: Maybe Text
sendingSchedule :: Maybe Bool
schedule :: Maybe JourneySchedule
refreshOnSegmentUpdate :: Maybe Bool
refreshFrequency :: Maybe Text
quietTime :: Maybe QuietTime
openHours :: Maybe OpenHours
localTime :: Maybe Bool
limits :: Maybe JourneyLimits
lastModifiedDate :: Maybe Text
journeyChannelSettings :: Maybe JourneyChannelSettings
creationDate :: Maybe Text
closedDays :: Maybe ClosedDays
activities :: Maybe (HashMap Text Activity)
$sel:applicationId:JourneyResponse' :: JourneyResponse -> Text
$sel:id:JourneyResponse' :: JourneyResponse -> Text
$sel:name:JourneyResponse' :: JourneyResponse -> Text
$sel:tags:JourneyResponse' :: JourneyResponse -> Maybe (HashMap Text Text)
$sel:waitForQuietTime:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:state:JourneyResponse' :: JourneyResponse -> Maybe State
$sel:startCondition:JourneyResponse' :: JourneyResponse -> Maybe StartCondition
$sel:startActivity:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:sendingSchedule:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:schedule:JourneyResponse' :: JourneyResponse -> Maybe JourneySchedule
$sel:refreshOnSegmentUpdate:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:refreshFrequency:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:quietTime:JourneyResponse' :: JourneyResponse -> Maybe QuietTime
$sel:openHours:JourneyResponse' :: JourneyResponse -> Maybe OpenHours
$sel:localTime:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:limits:JourneyResponse' :: JourneyResponse -> Maybe JourneyLimits
$sel:lastModifiedDate:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:journeyChannelSettings:JourneyResponse' :: JourneyResponse -> Maybe JourneyChannelSettings
$sel:creationDate:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:closedDays:JourneyResponse' :: JourneyResponse -> Maybe ClosedDays
$sel:activities:JourneyResponse' :: JourneyResponse -> Maybe (HashMap Text Activity)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Activity)
activities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClosedDays
closedDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
creationDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JourneyChannelSettings
journeyChannelSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lastModifiedDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JourneyLimits
limits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
localTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OpenHours
openHours
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QuietTime
quietTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
refreshFrequency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
refreshOnSegmentUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JourneySchedule
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
sendingSchedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startActivity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StartCondition
startCondition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe State
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
waitForQuietTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId

instance Prelude.NFData JourneyResponse where
  rnf :: JourneyResponse -> ()
rnf JourneyResponse' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text Activity)
Maybe ClosedDays
Maybe JourneyChannelSettings
Maybe JourneyLimits
Maybe JourneySchedule
Maybe OpenHours
Maybe QuietTime
Maybe StartCondition
Maybe State
Text
applicationId :: Text
id :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
waitForQuietTime :: Maybe Bool
state :: Maybe State
startCondition :: Maybe StartCondition
startActivity :: Maybe Text
sendingSchedule :: Maybe Bool
schedule :: Maybe JourneySchedule
refreshOnSegmentUpdate :: Maybe Bool
refreshFrequency :: Maybe Text
quietTime :: Maybe QuietTime
openHours :: Maybe OpenHours
localTime :: Maybe Bool
limits :: Maybe JourneyLimits
lastModifiedDate :: Maybe Text
journeyChannelSettings :: Maybe JourneyChannelSettings
creationDate :: Maybe Text
closedDays :: Maybe ClosedDays
activities :: Maybe (HashMap Text Activity)
$sel:applicationId:JourneyResponse' :: JourneyResponse -> Text
$sel:id:JourneyResponse' :: JourneyResponse -> Text
$sel:name:JourneyResponse' :: JourneyResponse -> Text
$sel:tags:JourneyResponse' :: JourneyResponse -> Maybe (HashMap Text Text)
$sel:waitForQuietTime:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:state:JourneyResponse' :: JourneyResponse -> Maybe State
$sel:startCondition:JourneyResponse' :: JourneyResponse -> Maybe StartCondition
$sel:startActivity:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:sendingSchedule:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:schedule:JourneyResponse' :: JourneyResponse -> Maybe JourneySchedule
$sel:refreshOnSegmentUpdate:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:refreshFrequency:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:quietTime:JourneyResponse' :: JourneyResponse -> Maybe QuietTime
$sel:openHours:JourneyResponse' :: JourneyResponse -> Maybe OpenHours
$sel:localTime:JourneyResponse' :: JourneyResponse -> Maybe Bool
$sel:limits:JourneyResponse' :: JourneyResponse -> Maybe JourneyLimits
$sel:lastModifiedDate:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:journeyChannelSettings:JourneyResponse' :: JourneyResponse -> Maybe JourneyChannelSettings
$sel:creationDate:JourneyResponse' :: JourneyResponse -> Maybe Text
$sel:closedDays:JourneyResponse' :: JourneyResponse -> Maybe ClosedDays
$sel:activities:JourneyResponse' :: JourneyResponse -> Maybe (HashMap Text Activity)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Activity)
activities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClosedDays
closedDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JourneyChannelSettings
journeyChannelSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastModifiedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JourneyLimits
limits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
localTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OpenHours
openHours
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QuietTime
quietTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
refreshFrequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
refreshOnSegmentUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JourneySchedule
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
sendingSchedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
startActivity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StartCondition
startCondition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe State
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
waitForQuietTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId