{-# 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.Schedule
-- 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.Schedule 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.CampaignEventFilter
import Amazonka.Pinpoint.Types.Frequency
import Amazonka.Pinpoint.Types.QuietTime
import qualified Amazonka.Prelude as Prelude

-- | Specifies the schedule settings for a campaign.
--
-- /See:/ 'newSchedule' smart constructor.
data Schedule = Schedule'
  { -- | The scheduled time, in ISO 8601 format, when the campaign ended or will
    -- end.
    Schedule -> Maybe Text
endTime :: Prelude.Maybe Prelude.Text,
    -- | The type of event that causes the campaign to be sent, if the value of
    -- the Frequency property is EVENT.
    Schedule -> Maybe CampaignEventFilter
eventFilter :: Prelude.Maybe CampaignEventFilter,
    -- | Specifies how often the campaign is sent or whether the campaign is sent
    -- in response to a specific event.
    Schedule -> Maybe Frequency
frequency :: Prelude.Maybe Frequency,
    -- | Specifies whether the start and end times for the campaign schedule use
    -- each recipient\'s local time. To base the schedule on each recipient\'s
    -- local time, set this value to true.
    Schedule -> Maybe Bool
isLocalTime :: Prelude.Maybe Prelude.Bool,
    -- | The default quiet time for the campaign. Quiet time is a specific time
    -- range when a campaign doesn\'t send messages to endpoints, if all the
    -- following conditions are met:
    --
    -- -   The EndpointDemographic.Timezone property of the endpoint is set to
    --     a valid value.
    --
    -- -   The current time in the endpoint\'s time zone is later than or equal
    --     to the time specified by the QuietTime.Start property for the
    --     campaign.
    --
    -- -   The current time in the endpoint\'s time zone is earlier than or
    --     equal to the time specified by the QuietTime.End property for the
    --     campaign.
    --
    -- If any of the preceding conditions isn\'t met, the endpoint will receive
    -- messages from the campaign, even if quiet time is enabled.
    Schedule -> Maybe QuietTime
quietTime :: Prelude.Maybe QuietTime,
    -- | The starting UTC offset for the campaign schedule, if the value of the
    -- IsLocalTime property is true. Valid values are: UTC, UTC+01, UTC+02,
    -- UTC+03, UTC+03:30, UTC+04, UTC+04:30, UTC+05, UTC+05:30, UTC+05:45,
    -- UTC+06, UTC+06:30, UTC+07, UTC+08, UTC+09, UTC+09:30, UTC+10, UTC+10:30,
    -- UTC+11, UTC+12, UTC+13, UTC-02, UTC-03, UTC-04, UTC-05, UTC-06, UTC-07,
    -- UTC-08, UTC-09, UTC-10, and UTC-11.
    Schedule -> Maybe Text
timezone :: Prelude.Maybe Prelude.Text,
    -- | The scheduled time when the campaign began or will begin. Valid values
    -- are: IMMEDIATE, to start the campaign immediately; or, a specific time
    -- in ISO 8601 format.
    Schedule -> Text
startTime :: Prelude.Text
  }
  deriving (Schedule -> Schedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c== :: Schedule -> Schedule -> Bool
Prelude.Eq, ReadPrec [Schedule]
ReadPrec Schedule
Int -> ReadS Schedule
ReadS [Schedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Schedule]
$creadListPrec :: ReadPrec [Schedule]
readPrec :: ReadPrec Schedule
$creadPrec :: ReadPrec Schedule
readList :: ReadS [Schedule]
$creadList :: ReadS [Schedule]
readsPrec :: Int -> ReadS Schedule
$creadsPrec :: Int -> ReadS Schedule
Prelude.Read, Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schedule] -> ShowS
$cshowList :: [Schedule] -> ShowS
show :: Schedule -> String
$cshow :: Schedule -> String
showsPrec :: Int -> Schedule -> ShowS
$cshowsPrec :: Int -> Schedule -> ShowS
Prelude.Show, forall x. Rep Schedule x -> Schedule
forall x. Schedule -> Rep Schedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Schedule x -> Schedule
$cfrom :: forall x. Schedule -> Rep Schedule x
Prelude.Generic)

-- |
-- Create a value of 'Schedule' 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:
--
-- 'endTime', 'schedule_endTime' - The scheduled time, in ISO 8601 format, when the campaign ended or will
-- end.
--
-- 'eventFilter', 'schedule_eventFilter' - The type of event that causes the campaign to be sent, if the value of
-- the Frequency property is EVENT.
--
-- 'frequency', 'schedule_frequency' - Specifies how often the campaign is sent or whether the campaign is sent
-- in response to a specific event.
--
-- 'isLocalTime', 'schedule_isLocalTime' - Specifies whether the start and end times for the campaign schedule use
-- each recipient\'s local time. To base the schedule on each recipient\'s
-- local time, set this value to true.
--
-- 'quietTime', 'schedule_quietTime' - The default quiet time for the campaign. Quiet time is a specific time
-- range when a campaign doesn\'t send messages to endpoints, if all the
-- following conditions are met:
--
-- -   The EndpointDemographic.Timezone property of the endpoint is set to
--     a valid value.
--
-- -   The current time in the endpoint\'s time zone is later than or equal
--     to the time specified by the QuietTime.Start property for the
--     campaign.
--
-- -   The current time in the endpoint\'s time zone is earlier than or
--     equal to the time specified by the QuietTime.End property for the
--     campaign.
--
-- If any of the preceding conditions isn\'t met, the endpoint will receive
-- messages from the campaign, even if quiet time is enabled.
--
-- 'timezone', 'schedule_timezone' - The starting UTC offset for the campaign schedule, if the value of the
-- IsLocalTime property is true. Valid values are: UTC, UTC+01, UTC+02,
-- UTC+03, UTC+03:30, UTC+04, UTC+04:30, UTC+05, UTC+05:30, UTC+05:45,
-- UTC+06, UTC+06:30, UTC+07, UTC+08, UTC+09, UTC+09:30, UTC+10, UTC+10:30,
-- UTC+11, UTC+12, UTC+13, UTC-02, UTC-03, UTC-04, UTC-05, UTC-06, UTC-07,
-- UTC-08, UTC-09, UTC-10, and UTC-11.
--
-- 'startTime', 'schedule_startTime' - The scheduled time when the campaign began or will begin. Valid values
-- are: IMMEDIATE, to start the campaign immediately; or, a specific time
-- in ISO 8601 format.
newSchedule ::
  -- | 'startTime'
  Prelude.Text ->
  Schedule
newSchedule :: Text -> Schedule
newSchedule Text
pStartTime_ =
  Schedule'
    { $sel:endTime:Schedule' :: Maybe Text
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:eventFilter:Schedule' :: Maybe CampaignEventFilter
eventFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:frequency:Schedule' :: Maybe Frequency
frequency = forall a. Maybe a
Prelude.Nothing,
      $sel:isLocalTime:Schedule' :: Maybe Bool
isLocalTime = forall a. Maybe a
Prelude.Nothing,
      $sel:quietTime:Schedule' :: Maybe QuietTime
quietTime = forall a. Maybe a
Prelude.Nothing,
      $sel:timezone:Schedule' :: Maybe Text
timezone = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:Schedule' :: Text
startTime = Text
pStartTime_
    }

-- | The scheduled time, in ISO 8601 format, when the campaign ended or will
-- end.
schedule_endTime :: Lens.Lens' Schedule (Prelude.Maybe Prelude.Text)
schedule_endTime :: Lens' Schedule (Maybe Text)
schedule_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Schedule' {Maybe Text
endTime :: Maybe Text
$sel:endTime:Schedule' :: Schedule -> Maybe Text
endTime} -> Maybe Text
endTime) (\s :: Schedule
s@Schedule' {} Maybe Text
a -> Schedule
s {$sel:endTime:Schedule' :: Maybe Text
endTime = Maybe Text
a} :: Schedule)

-- | The type of event that causes the campaign to be sent, if the value of
-- the Frequency property is EVENT.
schedule_eventFilter :: Lens.Lens' Schedule (Prelude.Maybe CampaignEventFilter)
schedule_eventFilter :: Lens' Schedule (Maybe CampaignEventFilter)
schedule_eventFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Schedule' {Maybe CampaignEventFilter
eventFilter :: Maybe CampaignEventFilter
$sel:eventFilter:Schedule' :: Schedule -> Maybe CampaignEventFilter
eventFilter} -> Maybe CampaignEventFilter
eventFilter) (\s :: Schedule
s@Schedule' {} Maybe CampaignEventFilter
a -> Schedule
s {$sel:eventFilter:Schedule' :: Maybe CampaignEventFilter
eventFilter = Maybe CampaignEventFilter
a} :: Schedule)

-- | Specifies how often the campaign is sent or whether the campaign is sent
-- in response to a specific event.
schedule_frequency :: Lens.Lens' Schedule (Prelude.Maybe Frequency)
schedule_frequency :: Lens' Schedule (Maybe Frequency)
schedule_frequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Schedule' {Maybe Frequency
frequency :: Maybe Frequency
$sel:frequency:Schedule' :: Schedule -> Maybe Frequency
frequency} -> Maybe Frequency
frequency) (\s :: Schedule
s@Schedule' {} Maybe Frequency
a -> Schedule
s {$sel:frequency:Schedule' :: Maybe Frequency
frequency = Maybe Frequency
a} :: Schedule)

-- | Specifies whether the start and end times for the campaign schedule use
-- each recipient\'s local time. To base the schedule on each recipient\'s
-- local time, set this value to true.
schedule_isLocalTime :: Lens.Lens' Schedule (Prelude.Maybe Prelude.Bool)
schedule_isLocalTime :: Lens' Schedule (Maybe Bool)
schedule_isLocalTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Schedule' {Maybe Bool
isLocalTime :: Maybe Bool
$sel:isLocalTime:Schedule' :: Schedule -> Maybe Bool
isLocalTime} -> Maybe Bool
isLocalTime) (\s :: Schedule
s@Schedule' {} Maybe Bool
a -> Schedule
s {$sel:isLocalTime:Schedule' :: Maybe Bool
isLocalTime = Maybe Bool
a} :: Schedule)

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

-- | The starting UTC offset for the campaign schedule, if the value of the
-- IsLocalTime property is true. Valid values are: UTC, UTC+01, UTC+02,
-- UTC+03, UTC+03:30, UTC+04, UTC+04:30, UTC+05, UTC+05:30, UTC+05:45,
-- UTC+06, UTC+06:30, UTC+07, UTC+08, UTC+09, UTC+09:30, UTC+10, UTC+10:30,
-- UTC+11, UTC+12, UTC+13, UTC-02, UTC-03, UTC-04, UTC-05, UTC-06, UTC-07,
-- UTC-08, UTC-09, UTC-10, and UTC-11.
schedule_timezone :: Lens.Lens' Schedule (Prelude.Maybe Prelude.Text)
schedule_timezone :: Lens' Schedule (Maybe Text)
schedule_timezone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Schedule' {Maybe Text
timezone :: Maybe Text
$sel:timezone:Schedule' :: Schedule -> Maybe Text
timezone} -> Maybe Text
timezone) (\s :: Schedule
s@Schedule' {} Maybe Text
a -> Schedule
s {$sel:timezone:Schedule' :: Maybe Text
timezone = Maybe Text
a} :: Schedule)

-- | The scheduled time when the campaign began or will begin. Valid values
-- are: IMMEDIATE, to start the campaign immediately; or, a specific time
-- in ISO 8601 format.
schedule_startTime :: Lens.Lens' Schedule Prelude.Text
schedule_startTime :: Lens' Schedule Text
schedule_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Schedule' {Text
startTime :: Text
$sel:startTime:Schedule' :: Schedule -> Text
startTime} -> Text
startTime) (\s :: Schedule
s@Schedule' {} Text
a -> Schedule
s {$sel:startTime:Schedule' :: Text
startTime = Text
a} :: Schedule)

instance Data.FromJSON Schedule where
  parseJSON :: Value -> Parser Schedule
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Schedule"
      ( \Object
x ->
          Maybe Text
-> Maybe CampaignEventFilter
-> Maybe Frequency
-> Maybe Bool
-> Maybe QuietTime
-> Maybe Text
-> Text
-> Schedule
Schedule'
            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
"EndTime")
            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
"EventFilter")
            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
"Frequency")
            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
"IsLocalTime")
            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
"Timezone")
            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
"StartTime")
      )

instance Prelude.Hashable Schedule where
  hashWithSalt :: Int -> Schedule -> Int
hashWithSalt Int
_salt Schedule' {Maybe Bool
Maybe Text
Maybe Frequency
Maybe QuietTime
Maybe CampaignEventFilter
Text
startTime :: Text
timezone :: Maybe Text
quietTime :: Maybe QuietTime
isLocalTime :: Maybe Bool
frequency :: Maybe Frequency
eventFilter :: Maybe CampaignEventFilter
endTime :: Maybe Text
$sel:startTime:Schedule' :: Schedule -> Text
$sel:timezone:Schedule' :: Schedule -> Maybe Text
$sel:quietTime:Schedule' :: Schedule -> Maybe QuietTime
$sel:isLocalTime:Schedule' :: Schedule -> Maybe Bool
$sel:frequency:Schedule' :: Schedule -> Maybe Frequency
$sel:eventFilter:Schedule' :: Schedule -> Maybe CampaignEventFilter
$sel:endTime:Schedule' :: Schedule -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CampaignEventFilter
eventFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Frequency
frequency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isLocalTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QuietTime
quietTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timezone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
startTime

instance Prelude.NFData Schedule where
  rnf :: Schedule -> ()
rnf Schedule' {Maybe Bool
Maybe Text
Maybe Frequency
Maybe QuietTime
Maybe CampaignEventFilter
Text
startTime :: Text
timezone :: Maybe Text
quietTime :: Maybe QuietTime
isLocalTime :: Maybe Bool
frequency :: Maybe Frequency
eventFilter :: Maybe CampaignEventFilter
endTime :: Maybe Text
$sel:startTime:Schedule' :: Schedule -> Text
$sel:timezone:Schedule' :: Schedule -> Maybe Text
$sel:quietTime:Schedule' :: Schedule -> Maybe QuietTime
$sel:isLocalTime:Schedule' :: Schedule -> Maybe Bool
$sel:frequency:Schedule' :: Schedule -> Maybe Frequency
$sel:eventFilter:Schedule' :: Schedule -> Maybe CampaignEventFilter
$sel:endTime:Schedule' :: Schedule -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CampaignEventFilter
eventFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Frequency
frequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isLocalTime
      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
timezone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
startTime

instance Data.ToJSON Schedule where
  toJSON :: Schedule -> Value
toJSON Schedule' {Maybe Bool
Maybe Text
Maybe Frequency
Maybe QuietTime
Maybe CampaignEventFilter
Text
startTime :: Text
timezone :: Maybe Text
quietTime :: Maybe QuietTime
isLocalTime :: Maybe Bool
frequency :: Maybe Frequency
eventFilter :: Maybe CampaignEventFilter
endTime :: Maybe Text
$sel:startTime:Schedule' :: Schedule -> Text
$sel:timezone:Schedule' :: Schedule -> Maybe Text
$sel:quietTime:Schedule' :: Schedule -> Maybe QuietTime
$sel:isLocalTime:Schedule' :: Schedule -> Maybe Bool
$sel:frequency:Schedule' :: Schedule -> Maybe Frequency
$sel:eventFilter:Schedule' :: Schedule -> Maybe CampaignEventFilter
$sel:endTime:Schedule' :: Schedule -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EndTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
endTime,
            (Key
"EventFilter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CampaignEventFilter
eventFilter,
            (Key
"Frequency" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Frequency
frequency,
            (Key
"IsLocalTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
isLocalTime,
            (Key
"QuietTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe QuietTime
quietTime,
            (Key
"Timezone" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
timezone,
            forall a. a -> Maybe a
Prelude.Just (Key
"StartTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
startTime)
          ]
      )