{-# 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.EventDimensions
-- 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.EventDimensions 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.AttributeDimension
import Amazonka.Pinpoint.Types.MetricDimension
import Amazonka.Pinpoint.Types.SetDimension
import qualified Amazonka.Prelude as Prelude

-- | Specifies the dimensions for an event filter that determines when a
-- campaign is sent or a journey activity is performed.
--
-- /See:/ 'newEventDimensions' smart constructor.
data EventDimensions = EventDimensions'
  { -- | One or more custom attributes that your application reports to Amazon
    -- Pinpoint. You can use these attributes as selection criteria when you
    -- create an event filter.
    EventDimensions -> Maybe (HashMap Text AttributeDimension)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeDimension),
    -- | The name of the event that causes the campaign to be sent or the journey
    -- activity to be performed. This can be a standard event that Amazon
    -- Pinpoint generates, such as _email.delivered. For campaigns, this can
    -- also be a custom event that\'s specific to your application. For
    -- information about standard events, see
    -- <https://docs.aws.amazon.com/pinpoint/latest/developerguide/event-streams.html Streaming Amazon Pinpoint Events>
    -- in the /Amazon Pinpoint Developer Guide/.
    EventDimensions -> Maybe SetDimension
eventType :: Prelude.Maybe SetDimension,
    -- | One or more custom metrics that your application reports to Amazon
    -- Pinpoint. You can use these metrics as selection criteria when you
    -- create an event filter.
    EventDimensions -> Maybe (HashMap Text MetricDimension)
metrics :: Prelude.Maybe (Prelude.HashMap Prelude.Text MetricDimension)
  }
  deriving (EventDimensions -> EventDimensions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventDimensions -> EventDimensions -> Bool
$c/= :: EventDimensions -> EventDimensions -> Bool
== :: EventDimensions -> EventDimensions -> Bool
$c== :: EventDimensions -> EventDimensions -> Bool
Prelude.Eq, ReadPrec [EventDimensions]
ReadPrec EventDimensions
Int -> ReadS EventDimensions
ReadS [EventDimensions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EventDimensions]
$creadListPrec :: ReadPrec [EventDimensions]
readPrec :: ReadPrec EventDimensions
$creadPrec :: ReadPrec EventDimensions
readList :: ReadS [EventDimensions]
$creadList :: ReadS [EventDimensions]
readsPrec :: Int -> ReadS EventDimensions
$creadsPrec :: Int -> ReadS EventDimensions
Prelude.Read, Int -> EventDimensions -> ShowS
[EventDimensions] -> ShowS
EventDimensions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventDimensions] -> ShowS
$cshowList :: [EventDimensions] -> ShowS
show :: EventDimensions -> String
$cshow :: EventDimensions -> String
showsPrec :: Int -> EventDimensions -> ShowS
$cshowsPrec :: Int -> EventDimensions -> ShowS
Prelude.Show, forall x. Rep EventDimensions x -> EventDimensions
forall x. EventDimensions -> Rep EventDimensions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventDimensions x -> EventDimensions
$cfrom :: forall x. EventDimensions -> Rep EventDimensions x
Prelude.Generic)

-- |
-- Create a value of 'EventDimensions' 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:
--
-- 'attributes', 'eventDimensions_attributes' - One or more custom attributes that your application reports to Amazon
-- Pinpoint. You can use these attributes as selection criteria when you
-- create an event filter.
--
-- 'eventType', 'eventDimensions_eventType' - The name of the event that causes the campaign to be sent or the journey
-- activity to be performed. This can be a standard event that Amazon
-- Pinpoint generates, such as _email.delivered. For campaigns, this can
-- also be a custom event that\'s specific to your application. For
-- information about standard events, see
-- <https://docs.aws.amazon.com/pinpoint/latest/developerguide/event-streams.html Streaming Amazon Pinpoint Events>
-- in the /Amazon Pinpoint Developer Guide/.
--
-- 'metrics', 'eventDimensions_metrics' - One or more custom metrics that your application reports to Amazon
-- Pinpoint. You can use these metrics as selection criteria when you
-- create an event filter.
newEventDimensions ::
  EventDimensions
newEventDimensions :: EventDimensions
newEventDimensions =
  EventDimensions'
    { $sel:attributes:EventDimensions' :: Maybe (HashMap Text AttributeDimension)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:eventType:EventDimensions' :: Maybe SetDimension
eventType = forall a. Maybe a
Prelude.Nothing,
      $sel:metrics:EventDimensions' :: Maybe (HashMap Text MetricDimension)
metrics = forall a. Maybe a
Prelude.Nothing
    }

-- | One or more custom attributes that your application reports to Amazon
-- Pinpoint. You can use these attributes as selection criteria when you
-- create an event filter.
eventDimensions_attributes :: Lens.Lens' EventDimensions (Prelude.Maybe (Prelude.HashMap Prelude.Text AttributeDimension))
eventDimensions_attributes :: Lens' EventDimensions (Maybe (HashMap Text AttributeDimension))
eventDimensions_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDimensions' {Maybe (HashMap Text AttributeDimension)
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:attributes:EventDimensions' :: EventDimensions -> Maybe (HashMap Text AttributeDimension)
attributes} -> Maybe (HashMap Text AttributeDimension)
attributes) (\s :: EventDimensions
s@EventDimensions' {} Maybe (HashMap Text AttributeDimension)
a -> EventDimensions
s {$sel:attributes:EventDimensions' :: Maybe (HashMap Text AttributeDimension)
attributes = Maybe (HashMap Text AttributeDimension)
a} :: EventDimensions) 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 event that causes the campaign to be sent or the journey
-- activity to be performed. This can be a standard event that Amazon
-- Pinpoint generates, such as _email.delivered. For campaigns, this can
-- also be a custom event that\'s specific to your application. For
-- information about standard events, see
-- <https://docs.aws.amazon.com/pinpoint/latest/developerguide/event-streams.html Streaming Amazon Pinpoint Events>
-- in the /Amazon Pinpoint Developer Guide/.
eventDimensions_eventType :: Lens.Lens' EventDimensions (Prelude.Maybe SetDimension)
eventDimensions_eventType :: Lens' EventDimensions (Maybe SetDimension)
eventDimensions_eventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDimensions' {Maybe SetDimension
eventType :: Maybe SetDimension
$sel:eventType:EventDimensions' :: EventDimensions -> Maybe SetDimension
eventType} -> Maybe SetDimension
eventType) (\s :: EventDimensions
s@EventDimensions' {} Maybe SetDimension
a -> EventDimensions
s {$sel:eventType:EventDimensions' :: Maybe SetDimension
eventType = Maybe SetDimension
a} :: EventDimensions)

-- | One or more custom metrics that your application reports to Amazon
-- Pinpoint. You can use these metrics as selection criteria when you
-- create an event filter.
eventDimensions_metrics :: Lens.Lens' EventDimensions (Prelude.Maybe (Prelude.HashMap Prelude.Text MetricDimension))
eventDimensions_metrics :: Lens' EventDimensions (Maybe (HashMap Text MetricDimension))
eventDimensions_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDimensions' {Maybe (HashMap Text MetricDimension)
metrics :: Maybe (HashMap Text MetricDimension)
$sel:metrics:EventDimensions' :: EventDimensions -> Maybe (HashMap Text MetricDimension)
metrics} -> Maybe (HashMap Text MetricDimension)
metrics) (\s :: EventDimensions
s@EventDimensions' {} Maybe (HashMap Text MetricDimension)
a -> EventDimensions
s {$sel:metrics:EventDimensions' :: Maybe (HashMap Text MetricDimension)
metrics = Maybe (HashMap Text MetricDimension)
a} :: EventDimensions) 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

instance Data.FromJSON EventDimensions where
  parseJSON :: Value -> Parser EventDimensions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"EventDimensions"
      ( \Object
x ->
          Maybe (HashMap Text AttributeDimension)
-> Maybe SetDimension
-> Maybe (HashMap Text MetricDimension)
-> EventDimensions
EventDimensions'
            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
"Attributes" 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
"EventType")
            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
"Metrics" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable EventDimensions where
  hashWithSalt :: Int -> EventDimensions -> Int
hashWithSalt Int
_salt EventDimensions' {Maybe (HashMap Text AttributeDimension)
Maybe (HashMap Text MetricDimension)
Maybe SetDimension
metrics :: Maybe (HashMap Text MetricDimension)
eventType :: Maybe SetDimension
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:metrics:EventDimensions' :: EventDimensions -> Maybe (HashMap Text MetricDimension)
$sel:eventType:EventDimensions' :: EventDimensions -> Maybe SetDimension
$sel:attributes:EventDimensions' :: EventDimensions -> Maybe (HashMap Text AttributeDimension)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text AttributeDimension)
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SetDimension
eventType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text MetricDimension)
metrics

instance Prelude.NFData EventDimensions where
  rnf :: EventDimensions -> ()
rnf EventDimensions' {Maybe (HashMap Text AttributeDimension)
Maybe (HashMap Text MetricDimension)
Maybe SetDimension
metrics :: Maybe (HashMap Text MetricDimension)
eventType :: Maybe SetDimension
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:metrics:EventDimensions' :: EventDimensions -> Maybe (HashMap Text MetricDimension)
$sel:eventType:EventDimensions' :: EventDimensions -> Maybe SetDimension
$sel:attributes:EventDimensions' :: EventDimensions -> Maybe (HashMap Text AttributeDimension)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text AttributeDimension)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SetDimension
eventType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text MetricDimension)
metrics

instance Data.ToJSON EventDimensions where
  toJSON :: EventDimensions -> Value
toJSON EventDimensions' {Maybe (HashMap Text AttributeDimension)
Maybe (HashMap Text MetricDimension)
Maybe SetDimension
metrics :: Maybe (HashMap Text MetricDimension)
eventType :: Maybe SetDimension
attributes :: Maybe (HashMap Text AttributeDimension)
$sel:metrics:EventDimensions' :: EventDimensions -> Maybe (HashMap Text MetricDimension)
$sel:eventType:EventDimensions' :: EventDimensions -> Maybe SetDimension
$sel:attributes:EventDimensions' :: EventDimensions -> Maybe (HashMap Text AttributeDimension)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Attributes" 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 (HashMap Text AttributeDimension)
attributes,
            (Key
"EventType" 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 SetDimension
eventType,
            (Key
"Metrics" 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 (HashMap Text MetricDimension)
metrics
          ]
      )