{-# 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.EndpointResponse
-- 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.EndpointResponse 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.ChannelType
import Amazonka.Pinpoint.Types.EndpointDemographic
import Amazonka.Pinpoint.Types.EndpointLocation
import Amazonka.Pinpoint.Types.EndpointUser
import qualified Amazonka.Prelude as Prelude

-- | Provides information about the channel type and other settings for an
-- endpoint.
--
-- /See:/ 'newEndpointResponse' smart constructor.
data EndpointResponse = EndpointResponse'
  { -- | The destination address for messages or push notifications that you send
    -- to the endpoint. The address varies by channel. For example, the address
    -- for a push-notification channel is typically the token provided by a
    -- push notification service, such as an Apple Push Notification service
    -- (APNs) device token or a Firebase Cloud Messaging (FCM) registration
    -- token. The address for the SMS channel is a phone number in E.164
    -- format, such as +12065550100. The address for the email channel is an
    -- email address.
    EndpointResponse -> Maybe Text
address :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the application that\'s associated with the
    -- endpoint.
    EndpointResponse -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    -- | One or more custom attributes that describe the endpoint by associating
    -- a name with an array of values. For example, the value of a custom
    -- attribute named Interests might be: [\"Science\", \"Music\",
    -- \"Travel\"]. You can use these attributes as filter criteria when you
    -- create segments.
    EndpointResponse -> Maybe (HashMap Text [Text])
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | The channel that\'s used when sending messages or push notifications to
    -- the endpoint.
    EndpointResponse -> Maybe ChannelType
channelType :: Prelude.Maybe ChannelType,
    -- | A number from 0-99 that represents the cohort that the endpoint is
    -- assigned to. Endpoints are grouped into cohorts randomly, and each
    -- cohort contains approximately 1 percent of the endpoints for an
    -- application. Amazon Pinpoint assigns cohorts to the holdout or treatment
    -- allocations for campaigns.
    EndpointResponse -> Maybe Text
cohortId :: Prelude.Maybe Prelude.Text,
    -- | The date and time, in ISO 8601 format, when the endpoint was created.
    EndpointResponse -> Maybe Text
creationDate :: Prelude.Maybe Prelude.Text,
    -- | The demographic information for the endpoint, such as the time zone and
    -- platform.
    EndpointResponse -> Maybe EndpointDemographic
demographic :: Prelude.Maybe EndpointDemographic,
    -- | The date and time, in ISO 8601 format, when the endpoint was last
    -- updated.
    EndpointResponse -> Maybe Text
effectiveDate :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether messages or push notifications are sent to the
    -- endpoint. Possible values are: ACTIVE, messages are sent to the
    -- endpoint; and, INACTIVE, messages aren’t sent to the endpoint.
    --
    -- Amazon Pinpoint automatically sets this value to ACTIVE when you create
    -- an endpoint or update an existing endpoint. Amazon Pinpoint
    -- automatically sets this value to INACTIVE if you update another endpoint
    -- that has the same address specified by the Address property.
    EndpointResponse -> Maybe Text
endpointStatus :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier that you assigned to the endpoint. The identifier
    -- should be a globally unique identifier (GUID) to ensure that it doesn\'t
    -- conflict with other endpoint identifiers that are associated with the
    -- application.
    EndpointResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The geographic information for the endpoint.
    EndpointResponse -> Maybe EndpointLocation
location :: Prelude.Maybe EndpointLocation,
    -- | One or more custom metrics that your app reports to Amazon Pinpoint for
    -- the endpoint.
    EndpointResponse -> Maybe (HashMap Text Double)
metrics :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Double),
    -- | Specifies whether the user who\'s associated with the endpoint has opted
    -- out of receiving messages and push notifications from you. Possible
    -- values are: ALL, the user has opted out and doesn\'t want to receive any
    -- messages or push notifications; and, NONE, the user hasn\'t opted out
    -- and wants to receive all messages and push notifications.
    EndpointResponse -> Maybe Text
optOut :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the most recent request to update the
    -- endpoint.
    EndpointResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | One or more custom user attributes that your app reports to Amazon
    -- Pinpoint for the user who\'s associated with the endpoint.
    EndpointResponse -> Maybe EndpointUser
user :: Prelude.Maybe EndpointUser
  }
  deriving (EndpointResponse -> EndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndpointResponse -> EndpointResponse -> Bool
$c/= :: EndpointResponse -> EndpointResponse -> Bool
== :: EndpointResponse -> EndpointResponse -> Bool
$c== :: EndpointResponse -> EndpointResponse -> Bool
Prelude.Eq, ReadPrec [EndpointResponse]
ReadPrec EndpointResponse
Int -> ReadS EndpointResponse
ReadS [EndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EndpointResponse]
$creadListPrec :: ReadPrec [EndpointResponse]
readPrec :: ReadPrec EndpointResponse
$creadPrec :: ReadPrec EndpointResponse
readList :: ReadS [EndpointResponse]
$creadList :: ReadS [EndpointResponse]
readsPrec :: Int -> ReadS EndpointResponse
$creadsPrec :: Int -> ReadS EndpointResponse
Prelude.Read, Int -> EndpointResponse -> ShowS
[EndpointResponse] -> ShowS
EndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndpointResponse] -> ShowS
$cshowList :: [EndpointResponse] -> ShowS
show :: EndpointResponse -> String
$cshow :: EndpointResponse -> String
showsPrec :: Int -> EndpointResponse -> ShowS
$cshowsPrec :: Int -> EndpointResponse -> ShowS
Prelude.Show, forall x. Rep EndpointResponse x -> EndpointResponse
forall x. EndpointResponse -> Rep EndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EndpointResponse x -> EndpointResponse
$cfrom :: forall x. EndpointResponse -> Rep EndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'EndpointResponse' 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:
--
-- 'address', 'endpointResponse_address' - The destination address for messages or push notifications that you send
-- to the endpoint. The address varies by channel. For example, the address
-- for a push-notification channel is typically the token provided by a
-- push notification service, such as an Apple Push Notification service
-- (APNs) device token or a Firebase Cloud Messaging (FCM) registration
-- token. The address for the SMS channel is a phone number in E.164
-- format, such as +12065550100. The address for the email channel is an
-- email address.
--
-- 'applicationId', 'endpointResponse_applicationId' - The unique identifier for the application that\'s associated with the
-- endpoint.
--
-- 'attributes', 'endpointResponse_attributes' - One or more custom attributes that describe the endpoint by associating
-- a name with an array of values. For example, the value of a custom
-- attribute named Interests might be: [\"Science\", \"Music\",
-- \"Travel\"]. You can use these attributes as filter criteria when you
-- create segments.
--
-- 'channelType', 'endpointResponse_channelType' - The channel that\'s used when sending messages or push notifications to
-- the endpoint.
--
-- 'cohortId', 'endpointResponse_cohortId' - A number from 0-99 that represents the cohort that the endpoint is
-- assigned to. Endpoints are grouped into cohorts randomly, and each
-- cohort contains approximately 1 percent of the endpoints for an
-- application. Amazon Pinpoint assigns cohorts to the holdout or treatment
-- allocations for campaigns.
--
-- 'creationDate', 'endpointResponse_creationDate' - The date and time, in ISO 8601 format, when the endpoint was created.
--
-- 'demographic', 'endpointResponse_demographic' - The demographic information for the endpoint, such as the time zone and
-- platform.
--
-- 'effectiveDate', 'endpointResponse_effectiveDate' - The date and time, in ISO 8601 format, when the endpoint was last
-- updated.
--
-- 'endpointStatus', 'endpointResponse_endpointStatus' - Specifies whether messages or push notifications are sent to the
-- endpoint. Possible values are: ACTIVE, messages are sent to the
-- endpoint; and, INACTIVE, messages aren’t sent to the endpoint.
--
-- Amazon Pinpoint automatically sets this value to ACTIVE when you create
-- an endpoint or update an existing endpoint. Amazon Pinpoint
-- automatically sets this value to INACTIVE if you update another endpoint
-- that has the same address specified by the Address property.
--
-- 'id', 'endpointResponse_id' - The unique identifier that you assigned to the endpoint. The identifier
-- should be a globally unique identifier (GUID) to ensure that it doesn\'t
-- conflict with other endpoint identifiers that are associated with the
-- application.
--
-- 'location', 'endpointResponse_location' - The geographic information for the endpoint.
--
-- 'metrics', 'endpointResponse_metrics' - One or more custom metrics that your app reports to Amazon Pinpoint for
-- the endpoint.
--
-- 'optOut', 'endpointResponse_optOut' - Specifies whether the user who\'s associated with the endpoint has opted
-- out of receiving messages and push notifications from you. Possible
-- values are: ALL, the user has opted out and doesn\'t want to receive any
-- messages or push notifications; and, NONE, the user hasn\'t opted out
-- and wants to receive all messages and push notifications.
--
-- 'requestId', 'endpointResponse_requestId' - The unique identifier for the most recent request to update the
-- endpoint.
--
-- 'user', 'endpointResponse_user' - One or more custom user attributes that your app reports to Amazon
-- Pinpoint for the user who\'s associated with the endpoint.
newEndpointResponse ::
  EndpointResponse
newEndpointResponse :: EndpointResponse
newEndpointResponse =
  EndpointResponse'
    { $sel:address:EndpointResponse' :: Maybe Text
address = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationId:EndpointResponse' :: Maybe Text
applicationId = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:EndpointResponse' :: Maybe (HashMap Text [Text])
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:channelType:EndpointResponse' :: Maybe ChannelType
channelType = forall a. Maybe a
Prelude.Nothing,
      $sel:cohortId:EndpointResponse' :: Maybe Text
cohortId = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:EndpointResponse' :: Maybe Text
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:demographic:EndpointResponse' :: Maybe EndpointDemographic
demographic = forall a. Maybe a
Prelude.Nothing,
      $sel:effectiveDate:EndpointResponse' :: Maybe Text
effectiveDate = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointStatus:EndpointResponse' :: Maybe Text
endpointStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:id:EndpointResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:location:EndpointResponse' :: Maybe EndpointLocation
location = forall a. Maybe a
Prelude.Nothing,
      $sel:metrics:EndpointResponse' :: Maybe (HashMap Text Double)
metrics = forall a. Maybe a
Prelude.Nothing,
      $sel:optOut:EndpointResponse' :: Maybe Text
optOut = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:EndpointResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:user:EndpointResponse' :: Maybe EndpointUser
user = forall a. Maybe a
Prelude.Nothing
    }

-- | The destination address for messages or push notifications that you send
-- to the endpoint. The address varies by channel. For example, the address
-- for a push-notification channel is typically the token provided by a
-- push notification service, such as an Apple Push Notification service
-- (APNs) device token or a Firebase Cloud Messaging (FCM) registration
-- token. The address for the SMS channel is a phone number in E.164
-- format, such as +12065550100. The address for the email channel is an
-- email address.
endpointResponse_address :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_address :: Lens' EndpointResponse (Maybe Text)
endpointResponse_address = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
address :: Maybe Text
$sel:address:EndpointResponse' :: EndpointResponse -> Maybe Text
address} -> Maybe Text
address) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:address:EndpointResponse' :: Maybe Text
address = Maybe Text
a} :: EndpointResponse)

-- | The unique identifier for the application that\'s associated with the
-- endpoint.
endpointResponse_applicationId :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_applicationId :: Lens' EndpointResponse (Maybe Text)
endpointResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:EndpointResponse' :: EndpointResponse -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:applicationId:EndpointResponse' :: Maybe Text
applicationId = Maybe Text
a} :: EndpointResponse)

-- | One or more custom attributes that describe the endpoint by associating
-- a name with an array of values. For example, the value of a custom
-- attribute named Interests might be: [\"Science\", \"Music\",
-- \"Travel\"]. You can use these attributes as filter criteria when you
-- create segments.
endpointResponse_attributes :: Lens.Lens' EndpointResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
endpointResponse_attributes :: Lens' EndpointResponse (Maybe (HashMap Text [Text]))
endpointResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe (HashMap Text [Text])
attributes :: Maybe (HashMap Text [Text])
$sel:attributes:EndpointResponse' :: EndpointResponse -> Maybe (HashMap Text [Text])
attributes} -> Maybe (HashMap Text [Text])
attributes) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe (HashMap Text [Text])
a -> EndpointResponse
s {$sel:attributes:EndpointResponse' :: Maybe (HashMap Text [Text])
attributes = Maybe (HashMap Text [Text])
a} :: EndpointResponse) 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 channel that\'s used when sending messages or push notifications to
-- the endpoint.
endpointResponse_channelType :: Lens.Lens' EndpointResponse (Prelude.Maybe ChannelType)
endpointResponse_channelType :: Lens' EndpointResponse (Maybe ChannelType)
endpointResponse_channelType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe ChannelType
channelType :: Maybe ChannelType
$sel:channelType:EndpointResponse' :: EndpointResponse -> Maybe ChannelType
channelType} -> Maybe ChannelType
channelType) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe ChannelType
a -> EndpointResponse
s {$sel:channelType:EndpointResponse' :: Maybe ChannelType
channelType = Maybe ChannelType
a} :: EndpointResponse)

-- | A number from 0-99 that represents the cohort that the endpoint is
-- assigned to. Endpoints are grouped into cohorts randomly, and each
-- cohort contains approximately 1 percent of the endpoints for an
-- application. Amazon Pinpoint assigns cohorts to the holdout or treatment
-- allocations for campaigns.
endpointResponse_cohortId :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_cohortId :: Lens' EndpointResponse (Maybe Text)
endpointResponse_cohortId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
cohortId :: Maybe Text
$sel:cohortId:EndpointResponse' :: EndpointResponse -> Maybe Text
cohortId} -> Maybe Text
cohortId) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:cohortId:EndpointResponse' :: Maybe Text
cohortId = Maybe Text
a} :: EndpointResponse)

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

-- | The demographic information for the endpoint, such as the time zone and
-- platform.
endpointResponse_demographic :: Lens.Lens' EndpointResponse (Prelude.Maybe EndpointDemographic)
endpointResponse_demographic :: Lens' EndpointResponse (Maybe EndpointDemographic)
endpointResponse_demographic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe EndpointDemographic
demographic :: Maybe EndpointDemographic
$sel:demographic:EndpointResponse' :: EndpointResponse -> Maybe EndpointDemographic
demographic} -> Maybe EndpointDemographic
demographic) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe EndpointDemographic
a -> EndpointResponse
s {$sel:demographic:EndpointResponse' :: Maybe EndpointDemographic
demographic = Maybe EndpointDemographic
a} :: EndpointResponse)

-- | The date and time, in ISO 8601 format, when the endpoint was last
-- updated.
endpointResponse_effectiveDate :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_effectiveDate :: Lens' EndpointResponse (Maybe Text)
endpointResponse_effectiveDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
effectiveDate :: Maybe Text
$sel:effectiveDate:EndpointResponse' :: EndpointResponse -> Maybe Text
effectiveDate} -> Maybe Text
effectiveDate) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:effectiveDate:EndpointResponse' :: Maybe Text
effectiveDate = Maybe Text
a} :: EndpointResponse)

-- | Specifies whether messages or push notifications are sent to the
-- endpoint. Possible values are: ACTIVE, messages are sent to the
-- endpoint; and, INACTIVE, messages aren’t sent to the endpoint.
--
-- Amazon Pinpoint automatically sets this value to ACTIVE when you create
-- an endpoint or update an existing endpoint. Amazon Pinpoint
-- automatically sets this value to INACTIVE if you update another endpoint
-- that has the same address specified by the Address property.
endpointResponse_endpointStatus :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_endpointStatus :: Lens' EndpointResponse (Maybe Text)
endpointResponse_endpointStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
endpointStatus :: Maybe Text
$sel:endpointStatus:EndpointResponse' :: EndpointResponse -> Maybe Text
endpointStatus} -> Maybe Text
endpointStatus) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:endpointStatus:EndpointResponse' :: Maybe Text
endpointStatus = Maybe Text
a} :: EndpointResponse)

-- | The unique identifier that you assigned to the endpoint. The identifier
-- should be a globally unique identifier (GUID) to ensure that it doesn\'t
-- conflict with other endpoint identifiers that are associated with the
-- application.
endpointResponse_id :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_id :: Lens' EndpointResponse (Maybe Text)
endpointResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
id :: Maybe Text
$sel:id:EndpointResponse' :: EndpointResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:id:EndpointResponse' :: Maybe Text
id = Maybe Text
a} :: EndpointResponse)

-- | The geographic information for the endpoint.
endpointResponse_location :: Lens.Lens' EndpointResponse (Prelude.Maybe EndpointLocation)
endpointResponse_location :: Lens' EndpointResponse (Maybe EndpointLocation)
endpointResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe EndpointLocation
location :: Maybe EndpointLocation
$sel:location:EndpointResponse' :: EndpointResponse -> Maybe EndpointLocation
location} -> Maybe EndpointLocation
location) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe EndpointLocation
a -> EndpointResponse
s {$sel:location:EndpointResponse' :: Maybe EndpointLocation
location = Maybe EndpointLocation
a} :: EndpointResponse)

-- | One or more custom metrics that your app reports to Amazon Pinpoint for
-- the endpoint.
endpointResponse_metrics :: Lens.Lens' EndpointResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Double))
endpointResponse_metrics :: Lens' EndpointResponse (Maybe (HashMap Text Double))
endpointResponse_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe (HashMap Text Double)
metrics :: Maybe (HashMap Text Double)
$sel:metrics:EndpointResponse' :: EndpointResponse -> Maybe (HashMap Text Double)
metrics} -> Maybe (HashMap Text Double)
metrics) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe (HashMap Text Double)
a -> EndpointResponse
s {$sel:metrics:EndpointResponse' :: Maybe (HashMap Text Double)
metrics = Maybe (HashMap Text Double)
a} :: EndpointResponse) 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

-- | Specifies whether the user who\'s associated with the endpoint has opted
-- out of receiving messages and push notifications from you. Possible
-- values are: ALL, the user has opted out and doesn\'t want to receive any
-- messages or push notifications; and, NONE, the user hasn\'t opted out
-- and wants to receive all messages and push notifications.
endpointResponse_optOut :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_optOut :: Lens' EndpointResponse (Maybe Text)
endpointResponse_optOut = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
optOut :: Maybe Text
$sel:optOut:EndpointResponse' :: EndpointResponse -> Maybe Text
optOut} -> Maybe Text
optOut) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:optOut:EndpointResponse' :: Maybe Text
optOut = Maybe Text
a} :: EndpointResponse)

-- | The unique identifier for the most recent request to update the
-- endpoint.
endpointResponse_requestId :: Lens.Lens' EndpointResponse (Prelude.Maybe Prelude.Text)
endpointResponse_requestId :: Lens' EndpointResponse (Maybe Text)
endpointResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:EndpointResponse' :: EndpointResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe Text
a -> EndpointResponse
s {$sel:requestId:EndpointResponse' :: Maybe Text
requestId = Maybe Text
a} :: EndpointResponse)

-- | One or more custom user attributes that your app reports to Amazon
-- Pinpoint for the user who\'s associated with the endpoint.
endpointResponse_user :: Lens.Lens' EndpointResponse (Prelude.Maybe EndpointUser)
endpointResponse_user :: Lens' EndpointResponse (Maybe EndpointUser)
endpointResponse_user = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EndpointResponse' {Maybe EndpointUser
user :: Maybe EndpointUser
$sel:user:EndpointResponse' :: EndpointResponse -> Maybe EndpointUser
user} -> Maybe EndpointUser
user) (\s :: EndpointResponse
s@EndpointResponse' {} Maybe EndpointUser
a -> EndpointResponse
s {$sel:user:EndpointResponse' :: Maybe EndpointUser
user = Maybe EndpointUser
a} :: EndpointResponse)

instance Data.FromJSON EndpointResponse where
  parseJSON :: Value -> Parser EndpointResponse
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"EndpointResponse"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe (HashMap Text [Text])
-> Maybe ChannelType
-> Maybe Text
-> Maybe Text
-> Maybe EndpointDemographic
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe EndpointLocation
-> Maybe (HashMap Text Double)
-> Maybe Text
-> Maybe Text
-> Maybe EndpointUser
-> EndpointResponse
EndpointResponse'
            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
"Address")
            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
"ApplicationId")
            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
"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
"ChannelType")
            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
"CohortId")
            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
"Demographic")
            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
"EffectiveDate")
            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
"EndpointStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Location")
            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)
            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
"OptOut")
            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
"RequestId")
            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
"User")
      )

instance Prelude.Hashable EndpointResponse where
  hashWithSalt :: Int -> EndpointResponse -> Int
hashWithSalt Int
_salt EndpointResponse' {Maybe Text
Maybe (HashMap Text Double)
Maybe (HashMap Text [Text])
Maybe ChannelType
Maybe EndpointDemographic
Maybe EndpointLocation
Maybe EndpointUser
user :: Maybe EndpointUser
requestId :: Maybe Text
optOut :: Maybe Text
metrics :: Maybe (HashMap Text Double)
location :: Maybe EndpointLocation
id :: Maybe Text
endpointStatus :: Maybe Text
effectiveDate :: Maybe Text
demographic :: Maybe EndpointDemographic
creationDate :: Maybe Text
cohortId :: Maybe Text
channelType :: Maybe ChannelType
attributes :: Maybe (HashMap Text [Text])
applicationId :: Maybe Text
address :: Maybe Text
$sel:user:EndpointResponse' :: EndpointResponse -> Maybe EndpointUser
$sel:requestId:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:optOut:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:metrics:EndpointResponse' :: EndpointResponse -> Maybe (HashMap Text Double)
$sel:location:EndpointResponse' :: EndpointResponse -> Maybe EndpointLocation
$sel:id:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:endpointStatus:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:effectiveDate:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:demographic:EndpointResponse' :: EndpointResponse -> Maybe EndpointDemographic
$sel:creationDate:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:cohortId:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:channelType:EndpointResponse' :: EndpointResponse -> Maybe ChannelType
$sel:attributes:EndpointResponse' :: EndpointResponse -> Maybe (HashMap Text [Text])
$sel:applicationId:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:address:EndpointResponse' :: EndpointResponse -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
address
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelType
channelType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cohortId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
creationDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointDemographic
demographic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
effectiveDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpointStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointLocation
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Double)
metrics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optOut
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointUser
user

instance Prelude.NFData EndpointResponse where
  rnf :: EndpointResponse -> ()
rnf EndpointResponse' {Maybe Text
Maybe (HashMap Text Double)
Maybe (HashMap Text [Text])
Maybe ChannelType
Maybe EndpointDemographic
Maybe EndpointLocation
Maybe EndpointUser
user :: Maybe EndpointUser
requestId :: Maybe Text
optOut :: Maybe Text
metrics :: Maybe (HashMap Text Double)
location :: Maybe EndpointLocation
id :: Maybe Text
endpointStatus :: Maybe Text
effectiveDate :: Maybe Text
demographic :: Maybe EndpointDemographic
creationDate :: Maybe Text
cohortId :: Maybe Text
channelType :: Maybe ChannelType
attributes :: Maybe (HashMap Text [Text])
applicationId :: Maybe Text
address :: Maybe Text
$sel:user:EndpointResponse' :: EndpointResponse -> Maybe EndpointUser
$sel:requestId:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:optOut:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:metrics:EndpointResponse' :: EndpointResponse -> Maybe (HashMap Text Double)
$sel:location:EndpointResponse' :: EndpointResponse -> Maybe EndpointLocation
$sel:id:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:endpointStatus:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:effectiveDate:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:demographic:EndpointResponse' :: EndpointResponse -> Maybe EndpointDemographic
$sel:creationDate:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:cohortId:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:channelType:EndpointResponse' :: EndpointResponse -> Maybe ChannelType
$sel:attributes:EndpointResponse' :: EndpointResponse -> Maybe (HashMap Text [Text])
$sel:applicationId:EndpointResponse' :: EndpointResponse -> Maybe Text
$sel:address:EndpointResponse' :: EndpointResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
address
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelType
channelType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cohortId
      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 EndpointDemographic
demographic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
effectiveDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpointStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointLocation
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Double)
metrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optOut
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointUser
user