{-# 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.Evidently.Types.ScheduledSplitConfig
-- 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.Evidently.Types.ScheduledSplitConfig where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Evidently.Types.SegmentOverride
import qualified Amazonka.Prelude as Prelude

-- | This structure defines the traffic allocation percentages among the
-- feature variations during one step of a launch, and the start time of
-- that step.
--
-- /See:/ 'newScheduledSplitConfig' smart constructor.
data ScheduledSplitConfig = ScheduledSplitConfig'
  { -- | Use this parameter to specify different traffic splits for one or more
    -- audience /segments/. A segment is a portion of your audience that share
    -- one or more characteristics. Examples could be Chrome browser users,
    -- users in Europe, or Firefox browser users in Europe who also fit other
    -- criteria that your application collects, such as age.
    --
    -- This parameter is an array of up to six segment override objects. Each
    -- of these objects specifies a segment that you have already created, and
    -- defines the traffic split for that segment.
    ScheduledSplitConfig -> Maybe [SegmentOverride]
segmentOverrides :: Prelude.Maybe [SegmentOverride],
    -- | The traffic allocation percentages among the feature variations during
    -- one step of a launch. This is a set of key-value pairs. The keys are
    -- variation names. The values represent the percentage of traffic to
    -- allocate to that variation during this step.
    --
    -- >  <p>The values is expressed in thousandths of a percent, so assigning a weight of 50000 assigns 50% of traffic to that variation.</p> <p>If the sum of the weights for all the variations in a segment override does not add up to 100,000, then the remaining traffic that matches this segment is not assigned by this segment override, and instead moves on to the next segment override or the default traffic split.</p>
    ScheduledSplitConfig -> HashMap Text Natural
groupWeights :: Prelude.HashMap Prelude.Text Prelude.Natural,
    -- | The date and time that this step of the launch starts.
    ScheduledSplitConfig -> POSIX
startTime :: Data.POSIX
  }
  deriving (ScheduledSplitConfig -> ScheduledSplitConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScheduledSplitConfig -> ScheduledSplitConfig -> Bool
$c/= :: ScheduledSplitConfig -> ScheduledSplitConfig -> Bool
== :: ScheduledSplitConfig -> ScheduledSplitConfig -> Bool
$c== :: ScheduledSplitConfig -> ScheduledSplitConfig -> Bool
Prelude.Eq, ReadPrec [ScheduledSplitConfig]
ReadPrec ScheduledSplitConfig
Int -> ReadS ScheduledSplitConfig
ReadS [ScheduledSplitConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScheduledSplitConfig]
$creadListPrec :: ReadPrec [ScheduledSplitConfig]
readPrec :: ReadPrec ScheduledSplitConfig
$creadPrec :: ReadPrec ScheduledSplitConfig
readList :: ReadS [ScheduledSplitConfig]
$creadList :: ReadS [ScheduledSplitConfig]
readsPrec :: Int -> ReadS ScheduledSplitConfig
$creadsPrec :: Int -> ReadS ScheduledSplitConfig
Prelude.Read, Int -> ScheduledSplitConfig -> ShowS
[ScheduledSplitConfig] -> ShowS
ScheduledSplitConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScheduledSplitConfig] -> ShowS
$cshowList :: [ScheduledSplitConfig] -> ShowS
show :: ScheduledSplitConfig -> String
$cshow :: ScheduledSplitConfig -> String
showsPrec :: Int -> ScheduledSplitConfig -> ShowS
$cshowsPrec :: Int -> ScheduledSplitConfig -> ShowS
Prelude.Show, forall x. Rep ScheduledSplitConfig x -> ScheduledSplitConfig
forall x. ScheduledSplitConfig -> Rep ScheduledSplitConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScheduledSplitConfig x -> ScheduledSplitConfig
$cfrom :: forall x. ScheduledSplitConfig -> Rep ScheduledSplitConfig x
Prelude.Generic)

-- |
-- Create a value of 'ScheduledSplitConfig' 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:
--
-- 'segmentOverrides', 'scheduledSplitConfig_segmentOverrides' - Use this parameter to specify different traffic splits for one or more
-- audience /segments/. A segment is a portion of your audience that share
-- one or more characteristics. Examples could be Chrome browser users,
-- users in Europe, or Firefox browser users in Europe who also fit other
-- criteria that your application collects, such as age.
--
-- This parameter is an array of up to six segment override objects. Each
-- of these objects specifies a segment that you have already created, and
-- defines the traffic split for that segment.
--
-- 'groupWeights', 'scheduledSplitConfig_groupWeights' - The traffic allocation percentages among the feature variations during
-- one step of a launch. This is a set of key-value pairs. The keys are
-- variation names. The values represent the percentage of traffic to
-- allocate to that variation during this step.
--
-- >  <p>The values is expressed in thousandths of a percent, so assigning a weight of 50000 assigns 50% of traffic to that variation.</p> <p>If the sum of the weights for all the variations in a segment override does not add up to 100,000, then the remaining traffic that matches this segment is not assigned by this segment override, and instead moves on to the next segment override or the default traffic split.</p>
--
-- 'startTime', 'scheduledSplitConfig_startTime' - The date and time that this step of the launch starts.
newScheduledSplitConfig ::
  -- | 'startTime'
  Prelude.UTCTime ->
  ScheduledSplitConfig
newScheduledSplitConfig :: UTCTime -> ScheduledSplitConfig
newScheduledSplitConfig UTCTime
pStartTime_ =
  ScheduledSplitConfig'
    { $sel:segmentOverrides:ScheduledSplitConfig' :: Maybe [SegmentOverride]
segmentOverrides =
        forall a. Maybe a
Prelude.Nothing,
      $sel:groupWeights:ScheduledSplitConfig' :: HashMap Text Natural
groupWeights = forall a. Monoid a => a
Prelude.mempty,
      $sel:startTime:ScheduledSplitConfig' :: POSIX
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_
    }

-- | Use this parameter to specify different traffic splits for one or more
-- audience /segments/. A segment is a portion of your audience that share
-- one or more characteristics. Examples could be Chrome browser users,
-- users in Europe, or Firefox browser users in Europe who also fit other
-- criteria that your application collects, such as age.
--
-- This parameter is an array of up to six segment override objects. Each
-- of these objects specifies a segment that you have already created, and
-- defines the traffic split for that segment.
scheduledSplitConfig_segmentOverrides :: Lens.Lens' ScheduledSplitConfig (Prelude.Maybe [SegmentOverride])
scheduledSplitConfig_segmentOverrides :: Lens' ScheduledSplitConfig (Maybe [SegmentOverride])
scheduledSplitConfig_segmentOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ScheduledSplitConfig' {Maybe [SegmentOverride]
segmentOverrides :: Maybe [SegmentOverride]
$sel:segmentOverrides:ScheduledSplitConfig' :: ScheduledSplitConfig -> Maybe [SegmentOverride]
segmentOverrides} -> Maybe [SegmentOverride]
segmentOverrides) (\s :: ScheduledSplitConfig
s@ScheduledSplitConfig' {} Maybe [SegmentOverride]
a -> ScheduledSplitConfig
s {$sel:segmentOverrides:ScheduledSplitConfig' :: Maybe [SegmentOverride]
segmentOverrides = Maybe [SegmentOverride]
a} :: ScheduledSplitConfig) 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 traffic allocation percentages among the feature variations during
-- one step of a launch. This is a set of key-value pairs. The keys are
-- variation names. The values represent the percentage of traffic to
-- allocate to that variation during this step.
--
-- >  <p>The values is expressed in thousandths of a percent, so assigning a weight of 50000 assigns 50% of traffic to that variation.</p> <p>If the sum of the weights for all the variations in a segment override does not add up to 100,000, then the remaining traffic that matches this segment is not assigned by this segment override, and instead moves on to the next segment override or the default traffic split.</p>
scheduledSplitConfig_groupWeights :: Lens.Lens' ScheduledSplitConfig (Prelude.HashMap Prelude.Text Prelude.Natural)
scheduledSplitConfig_groupWeights :: Lens' ScheduledSplitConfig (HashMap Text Natural)
scheduledSplitConfig_groupWeights = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ScheduledSplitConfig' {HashMap Text Natural
groupWeights :: HashMap Text Natural
$sel:groupWeights:ScheduledSplitConfig' :: ScheduledSplitConfig -> HashMap Text Natural
groupWeights} -> HashMap Text Natural
groupWeights) (\s :: ScheduledSplitConfig
s@ScheduledSplitConfig' {} HashMap Text Natural
a -> ScheduledSplitConfig
s {$sel:groupWeights:ScheduledSplitConfig' :: HashMap Text Natural
groupWeights = HashMap Text Natural
a} :: ScheduledSplitConfig) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The date and time that this step of the launch starts.
scheduledSplitConfig_startTime :: Lens.Lens' ScheduledSplitConfig Prelude.UTCTime
scheduledSplitConfig_startTime :: Lens' ScheduledSplitConfig UTCTime
scheduledSplitConfig_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ScheduledSplitConfig' {POSIX
startTime :: POSIX
$sel:startTime:ScheduledSplitConfig' :: ScheduledSplitConfig -> POSIX
startTime} -> POSIX
startTime) (\s :: ScheduledSplitConfig
s@ScheduledSplitConfig' {} POSIX
a -> ScheduledSplitConfig
s {$sel:startTime:ScheduledSplitConfig' :: POSIX
startTime = POSIX
a} :: ScheduledSplitConfig) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.Hashable ScheduledSplitConfig where
  hashWithSalt :: Int -> ScheduledSplitConfig -> Int
hashWithSalt Int
_salt ScheduledSplitConfig' {Maybe [SegmentOverride]
HashMap Text Natural
POSIX
startTime :: POSIX
groupWeights :: HashMap Text Natural
segmentOverrides :: Maybe [SegmentOverride]
$sel:startTime:ScheduledSplitConfig' :: ScheduledSplitConfig -> POSIX
$sel:groupWeights:ScheduledSplitConfig' :: ScheduledSplitConfig -> HashMap Text Natural
$sel:segmentOverrides:ScheduledSplitConfig' :: ScheduledSplitConfig -> Maybe [SegmentOverride]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SegmentOverride]
segmentOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Natural
groupWeights
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTime

instance Prelude.NFData ScheduledSplitConfig where
  rnf :: ScheduledSplitConfig -> ()
rnf ScheduledSplitConfig' {Maybe [SegmentOverride]
HashMap Text Natural
POSIX
startTime :: POSIX
groupWeights :: HashMap Text Natural
segmentOverrides :: Maybe [SegmentOverride]
$sel:startTime:ScheduledSplitConfig' :: ScheduledSplitConfig -> POSIX
$sel:groupWeights:ScheduledSplitConfig' :: ScheduledSplitConfig -> HashMap Text Natural
$sel:segmentOverrides:ScheduledSplitConfig' :: ScheduledSplitConfig -> Maybe [SegmentOverride]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [SegmentOverride]
segmentOverrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Natural
groupWeights
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTime

instance Data.ToJSON ScheduledSplitConfig where
  toJSON :: ScheduledSplitConfig -> Value
toJSON ScheduledSplitConfig' {Maybe [SegmentOverride]
HashMap Text Natural
POSIX
startTime :: POSIX
groupWeights :: HashMap Text Natural
segmentOverrides :: Maybe [SegmentOverride]
$sel:startTime:ScheduledSplitConfig' :: ScheduledSplitConfig -> POSIX
$sel:groupWeights:ScheduledSplitConfig' :: ScheduledSplitConfig -> HashMap Text Natural
$sel:segmentOverrides:ScheduledSplitConfig' :: ScheduledSplitConfig -> Maybe [SegmentOverride]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"segmentOverrides" 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 [SegmentOverride]
segmentOverrides,
            forall a. a -> Maybe a
Prelude.Just (Key
"groupWeights" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text Natural
groupWeights),
            forall a. a -> Maybe a
Prelude.Just (Key
"startTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
startTime)
          ]
      )