{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.GetJourneyDateRangeKpi
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves (queries) pre-aggregated data for a standard engagement metric
-- that applies to a journey.
module Amazonka.Pinpoint.GetJourneyDateRangeKpi
  ( -- * Creating a Request
    GetJourneyDateRangeKpi (..),
    newGetJourneyDateRangeKpi,

    -- * Request Lenses
    getJourneyDateRangeKpi_endTime,
    getJourneyDateRangeKpi_nextToken,
    getJourneyDateRangeKpi_pageSize,
    getJourneyDateRangeKpi_startTime,
    getJourneyDateRangeKpi_journeyId,
    getJourneyDateRangeKpi_applicationId,
    getJourneyDateRangeKpi_kpiName,

    -- * Destructuring the Response
    GetJourneyDateRangeKpiResponse (..),
    newGetJourneyDateRangeKpiResponse,

    -- * Response Lenses
    getJourneyDateRangeKpiResponse_httpStatus,
    getJourneyDateRangeKpiResponse_journeyDateRangeKpiResponse,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetJourneyDateRangeKpi' smart constructor.
data GetJourneyDateRangeKpi = GetJourneyDateRangeKpi'
  { -- | The last date and time to retrieve data for, as part of an inclusive
    -- date range that filters the query results. This value should be in
    -- extended ISO 8601 format and use Coordinated Universal Time (UTC), for
    -- example: 2019-07-26T20:00:00Z for 8:00 PM UTC July 26, 2019.
    GetJourneyDateRangeKpi -> Maybe ISO8601
endTime :: Prelude.Maybe Data.ISO8601,
    -- | The string that specifies which page of results to return in a paginated
    -- response. This parameter is not supported for application, campaign, and
    -- journey metrics.
    GetJourneyDateRangeKpi -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of items to include in each page of a paginated
    -- response. This parameter is not supported for application, campaign, and
    -- journey metrics.
    GetJourneyDateRangeKpi -> Maybe Text
pageSize :: Prelude.Maybe Prelude.Text,
    -- | The first date and time to retrieve data for, as part of an inclusive
    -- date range that filters the query results. This value should be in
    -- extended ISO 8601 format and use Coordinated Universal Time (UTC), for
    -- example: 2019-07-19T20:00:00Z for 8:00 PM UTC July 19, 2019. This value
    -- should also be fewer than 90 days from the current day.
    GetJourneyDateRangeKpi -> Maybe ISO8601
startTime :: Prelude.Maybe Data.ISO8601,
    -- | The unique identifier for the journey.
    GetJourneyDateRangeKpi -> Text
journeyId :: Prelude.Text,
    -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    GetJourneyDateRangeKpi -> Text
applicationId :: Prelude.Text,
    -- | The name of the metric, also referred to as a /key performance indicator
    -- (KPI)/, to retrieve data for. This value describes the associated metric
    -- and consists of two or more terms, which are comprised of lowercase
    -- alphanumeric characters, separated by a hyphen. Examples are
    -- email-open-rate and successful-delivery-rate. For a list of valid
    -- values, see the
    -- <https://docs.aws.amazon.com/pinpoint/latest/developerguide/analytics-standard-metrics.html Amazon Pinpoint Developer Guide>.
    GetJourneyDateRangeKpi -> Text
kpiName :: Prelude.Text
  }
  deriving (GetJourneyDateRangeKpi -> GetJourneyDateRangeKpi -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetJourneyDateRangeKpi -> GetJourneyDateRangeKpi -> Bool
$c/= :: GetJourneyDateRangeKpi -> GetJourneyDateRangeKpi -> Bool
== :: GetJourneyDateRangeKpi -> GetJourneyDateRangeKpi -> Bool
$c== :: GetJourneyDateRangeKpi -> GetJourneyDateRangeKpi -> Bool
Prelude.Eq, ReadPrec [GetJourneyDateRangeKpi]
ReadPrec GetJourneyDateRangeKpi
Int -> ReadS GetJourneyDateRangeKpi
ReadS [GetJourneyDateRangeKpi]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetJourneyDateRangeKpi]
$creadListPrec :: ReadPrec [GetJourneyDateRangeKpi]
readPrec :: ReadPrec GetJourneyDateRangeKpi
$creadPrec :: ReadPrec GetJourneyDateRangeKpi
readList :: ReadS [GetJourneyDateRangeKpi]
$creadList :: ReadS [GetJourneyDateRangeKpi]
readsPrec :: Int -> ReadS GetJourneyDateRangeKpi
$creadsPrec :: Int -> ReadS GetJourneyDateRangeKpi
Prelude.Read, Int -> GetJourneyDateRangeKpi -> ShowS
[GetJourneyDateRangeKpi] -> ShowS
GetJourneyDateRangeKpi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetJourneyDateRangeKpi] -> ShowS
$cshowList :: [GetJourneyDateRangeKpi] -> ShowS
show :: GetJourneyDateRangeKpi -> String
$cshow :: GetJourneyDateRangeKpi -> String
showsPrec :: Int -> GetJourneyDateRangeKpi -> ShowS
$cshowsPrec :: Int -> GetJourneyDateRangeKpi -> ShowS
Prelude.Show, forall x. Rep GetJourneyDateRangeKpi x -> GetJourneyDateRangeKpi
forall x. GetJourneyDateRangeKpi -> Rep GetJourneyDateRangeKpi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetJourneyDateRangeKpi x -> GetJourneyDateRangeKpi
$cfrom :: forall x. GetJourneyDateRangeKpi -> Rep GetJourneyDateRangeKpi x
Prelude.Generic)

-- |
-- Create a value of 'GetJourneyDateRangeKpi' 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', 'getJourneyDateRangeKpi_endTime' - The last date and time to retrieve data for, as part of an inclusive
-- date range that filters the query results. This value should be in
-- extended ISO 8601 format and use Coordinated Universal Time (UTC), for
-- example: 2019-07-26T20:00:00Z for 8:00 PM UTC July 26, 2019.
--
-- 'nextToken', 'getJourneyDateRangeKpi_nextToken' - The string that specifies which page of results to return in a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
--
-- 'pageSize', 'getJourneyDateRangeKpi_pageSize' - The maximum number of items to include in each page of a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
--
-- 'startTime', 'getJourneyDateRangeKpi_startTime' - The first date and time to retrieve data for, as part of an inclusive
-- date range that filters the query results. This value should be in
-- extended ISO 8601 format and use Coordinated Universal Time (UTC), for
-- example: 2019-07-19T20:00:00Z for 8:00 PM UTC July 19, 2019. This value
-- should also be fewer than 90 days from the current day.
--
-- 'journeyId', 'getJourneyDateRangeKpi_journeyId' - The unique identifier for the journey.
--
-- 'applicationId', 'getJourneyDateRangeKpi_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
--
-- 'kpiName', 'getJourneyDateRangeKpi_kpiName' - The name of the metric, also referred to as a /key performance indicator
-- (KPI)/, to retrieve data for. This value describes the associated metric
-- and consists of two or more terms, which are comprised of lowercase
-- alphanumeric characters, separated by a hyphen. Examples are
-- email-open-rate and successful-delivery-rate. For a list of valid
-- values, see the
-- <https://docs.aws.amazon.com/pinpoint/latest/developerguide/analytics-standard-metrics.html Amazon Pinpoint Developer Guide>.
newGetJourneyDateRangeKpi ::
  -- | 'journeyId'
  Prelude.Text ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'kpiName'
  Prelude.Text ->
  GetJourneyDateRangeKpi
newGetJourneyDateRangeKpi :: Text -> Text -> Text -> GetJourneyDateRangeKpi
newGetJourneyDateRangeKpi
  Text
pJourneyId_
  Text
pApplicationId_
  Text
pKpiName_ =
    GetJourneyDateRangeKpi'
      { $sel:endTime:GetJourneyDateRangeKpi' :: Maybe ISO8601
endTime = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:GetJourneyDateRangeKpi' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:pageSize:GetJourneyDateRangeKpi' :: Maybe Text
pageSize = forall a. Maybe a
Prelude.Nothing,
        $sel:startTime:GetJourneyDateRangeKpi' :: Maybe ISO8601
startTime = forall a. Maybe a
Prelude.Nothing,
        $sel:journeyId:GetJourneyDateRangeKpi' :: Text
journeyId = Text
pJourneyId_,
        $sel:applicationId:GetJourneyDateRangeKpi' :: Text
applicationId = Text
pApplicationId_,
        $sel:kpiName:GetJourneyDateRangeKpi' :: Text
kpiName = Text
pKpiName_
      }

-- | The last date and time to retrieve data for, as part of an inclusive
-- date range that filters the query results. This value should be in
-- extended ISO 8601 format and use Coordinated Universal Time (UTC), for
-- example: 2019-07-26T20:00:00Z for 8:00 PM UTC July 26, 2019.
getJourneyDateRangeKpi_endTime :: Lens.Lens' GetJourneyDateRangeKpi (Prelude.Maybe Prelude.UTCTime)
getJourneyDateRangeKpi_endTime :: Lens' GetJourneyDateRangeKpi (Maybe UTCTime)
getJourneyDateRangeKpi_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpi' {Maybe ISO8601
endTime :: Maybe ISO8601
$sel:endTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
endTime} -> Maybe ISO8601
endTime) (\s :: GetJourneyDateRangeKpi
s@GetJourneyDateRangeKpi' {} Maybe ISO8601
a -> GetJourneyDateRangeKpi
s {$sel:endTime:GetJourneyDateRangeKpi' :: Maybe ISO8601
endTime = Maybe ISO8601
a} :: GetJourneyDateRangeKpi) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The string that specifies which page of results to return in a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
getJourneyDateRangeKpi_nextToken :: Lens.Lens' GetJourneyDateRangeKpi (Prelude.Maybe Prelude.Text)
getJourneyDateRangeKpi_nextToken :: Lens' GetJourneyDateRangeKpi (Maybe Text)
getJourneyDateRangeKpi_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpi' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetJourneyDateRangeKpi
s@GetJourneyDateRangeKpi' {} Maybe Text
a -> GetJourneyDateRangeKpi
s {$sel:nextToken:GetJourneyDateRangeKpi' :: Maybe Text
nextToken = Maybe Text
a} :: GetJourneyDateRangeKpi)

-- | The maximum number of items to include in each page of a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
getJourneyDateRangeKpi_pageSize :: Lens.Lens' GetJourneyDateRangeKpi (Prelude.Maybe Prelude.Text)
getJourneyDateRangeKpi_pageSize :: Lens' GetJourneyDateRangeKpi (Maybe Text)
getJourneyDateRangeKpi_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpi' {Maybe Text
pageSize :: Maybe Text
$sel:pageSize:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
pageSize} -> Maybe Text
pageSize) (\s :: GetJourneyDateRangeKpi
s@GetJourneyDateRangeKpi' {} Maybe Text
a -> GetJourneyDateRangeKpi
s {$sel:pageSize:GetJourneyDateRangeKpi' :: Maybe Text
pageSize = Maybe Text
a} :: GetJourneyDateRangeKpi)

-- | The first date and time to retrieve data for, as part of an inclusive
-- date range that filters the query results. This value should be in
-- extended ISO 8601 format and use Coordinated Universal Time (UTC), for
-- example: 2019-07-19T20:00:00Z for 8:00 PM UTC July 19, 2019. This value
-- should also be fewer than 90 days from the current day.
getJourneyDateRangeKpi_startTime :: Lens.Lens' GetJourneyDateRangeKpi (Prelude.Maybe Prelude.UTCTime)
getJourneyDateRangeKpi_startTime :: Lens' GetJourneyDateRangeKpi (Maybe UTCTime)
getJourneyDateRangeKpi_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpi' {Maybe ISO8601
startTime :: Maybe ISO8601
$sel:startTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
startTime} -> Maybe ISO8601
startTime) (\s :: GetJourneyDateRangeKpi
s@GetJourneyDateRangeKpi' {} Maybe ISO8601
a -> GetJourneyDateRangeKpi
s {$sel:startTime:GetJourneyDateRangeKpi' :: Maybe ISO8601
startTime = Maybe ISO8601
a} :: GetJourneyDateRangeKpi) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

-- | The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
getJourneyDateRangeKpi_applicationId :: Lens.Lens' GetJourneyDateRangeKpi Prelude.Text
getJourneyDateRangeKpi_applicationId :: Lens' GetJourneyDateRangeKpi Text
getJourneyDateRangeKpi_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpi' {Text
applicationId :: Text
$sel:applicationId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
applicationId} -> Text
applicationId) (\s :: GetJourneyDateRangeKpi
s@GetJourneyDateRangeKpi' {} Text
a -> GetJourneyDateRangeKpi
s {$sel:applicationId:GetJourneyDateRangeKpi' :: Text
applicationId = Text
a} :: GetJourneyDateRangeKpi)

-- | The name of the metric, also referred to as a /key performance indicator
-- (KPI)/, to retrieve data for. This value describes the associated metric
-- and consists of two or more terms, which are comprised of lowercase
-- alphanumeric characters, separated by a hyphen. Examples are
-- email-open-rate and successful-delivery-rate. For a list of valid
-- values, see the
-- <https://docs.aws.amazon.com/pinpoint/latest/developerguide/analytics-standard-metrics.html Amazon Pinpoint Developer Guide>.
getJourneyDateRangeKpi_kpiName :: Lens.Lens' GetJourneyDateRangeKpi Prelude.Text
getJourneyDateRangeKpi_kpiName :: Lens' GetJourneyDateRangeKpi Text
getJourneyDateRangeKpi_kpiName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpi' {Text
kpiName :: Text
$sel:kpiName:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
kpiName} -> Text
kpiName) (\s :: GetJourneyDateRangeKpi
s@GetJourneyDateRangeKpi' {} Text
a -> GetJourneyDateRangeKpi
s {$sel:kpiName:GetJourneyDateRangeKpi' :: Text
kpiName = Text
a} :: GetJourneyDateRangeKpi)

instance Core.AWSRequest GetJourneyDateRangeKpi where
  type
    AWSResponse GetJourneyDateRangeKpi =
      GetJourneyDateRangeKpiResponse
  request :: (Service -> Service)
-> GetJourneyDateRangeKpi -> Request GetJourneyDateRangeKpi
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetJourneyDateRangeKpi
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetJourneyDateRangeKpi)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int
-> JourneyDateRangeKpiResponse -> GetJourneyDateRangeKpiResponse
GetJourneyDateRangeKpiResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
      )

instance Prelude.Hashable GetJourneyDateRangeKpi where
  hashWithSalt :: Int -> GetJourneyDateRangeKpi -> Int
hashWithSalt Int
_salt GetJourneyDateRangeKpi' {Maybe Text
Maybe ISO8601
Text
kpiName :: Text
applicationId :: Text
journeyId :: Text
startTime :: Maybe ISO8601
pageSize :: Maybe Text
nextToken :: Maybe Text
endTime :: Maybe ISO8601
$sel:kpiName:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:applicationId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:journeyId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:startTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
$sel:pageSize:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:nextToken:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:endTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
journeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
kpiName

instance Prelude.NFData GetJourneyDateRangeKpi where
  rnf :: GetJourneyDateRangeKpi -> ()
rnf GetJourneyDateRangeKpi' {Maybe Text
Maybe ISO8601
Text
kpiName :: Text
applicationId :: Text
journeyId :: Text
startTime :: Maybe ISO8601
pageSize :: Maybe Text
nextToken :: Maybe Text
endTime :: Maybe ISO8601
$sel:kpiName:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:applicationId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:journeyId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:startTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
$sel:pageSize:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:nextToken:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:endTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
journeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
kpiName

instance Data.ToHeaders GetJourneyDateRangeKpi where
  toHeaders :: GetJourneyDateRangeKpi -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetJourneyDateRangeKpi where
  toPath :: GetJourneyDateRangeKpi -> ByteString
toPath GetJourneyDateRangeKpi' {Maybe Text
Maybe ISO8601
Text
kpiName :: Text
applicationId :: Text
journeyId :: Text
startTime :: Maybe ISO8601
pageSize :: Maybe Text
nextToken :: Maybe Text
endTime :: Maybe ISO8601
$sel:kpiName:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:applicationId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:journeyId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:startTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
$sel:pageSize:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:nextToken:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:endTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/journeys/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
journeyId,
        ByteString
"/kpis/daterange/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
kpiName
      ]

instance Data.ToQuery GetJourneyDateRangeKpi where
  toQuery :: GetJourneyDateRangeKpi -> QueryString
toQuery GetJourneyDateRangeKpi' {Maybe Text
Maybe ISO8601
Text
kpiName :: Text
applicationId :: Text
journeyId :: Text
startTime :: Maybe ISO8601
pageSize :: Maybe Text
nextToken :: Maybe Text
endTime :: Maybe ISO8601
$sel:kpiName:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:applicationId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:journeyId:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Text
$sel:startTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
$sel:pageSize:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:nextToken:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe Text
$sel:endTime:GetJourneyDateRangeKpi' :: GetJourneyDateRangeKpi -> Maybe ISO8601
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"end-time" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
endTime,
        ByteString
"next-token" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"page-size" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
pageSize,
        ByteString
"start-time" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
startTime
      ]

-- | /See:/ 'newGetJourneyDateRangeKpiResponse' smart constructor.
data GetJourneyDateRangeKpiResponse = GetJourneyDateRangeKpiResponse'
  { -- | The response's http status code.
    GetJourneyDateRangeKpiResponse -> Int
httpStatus :: Prelude.Int,
    GetJourneyDateRangeKpiResponse -> JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse :: JourneyDateRangeKpiResponse
  }
  deriving (GetJourneyDateRangeKpiResponse
-> GetJourneyDateRangeKpiResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetJourneyDateRangeKpiResponse
-> GetJourneyDateRangeKpiResponse -> Bool
$c/= :: GetJourneyDateRangeKpiResponse
-> GetJourneyDateRangeKpiResponse -> Bool
== :: GetJourneyDateRangeKpiResponse
-> GetJourneyDateRangeKpiResponse -> Bool
$c== :: GetJourneyDateRangeKpiResponse
-> GetJourneyDateRangeKpiResponse -> Bool
Prelude.Eq, ReadPrec [GetJourneyDateRangeKpiResponse]
ReadPrec GetJourneyDateRangeKpiResponse
Int -> ReadS GetJourneyDateRangeKpiResponse
ReadS [GetJourneyDateRangeKpiResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetJourneyDateRangeKpiResponse]
$creadListPrec :: ReadPrec [GetJourneyDateRangeKpiResponse]
readPrec :: ReadPrec GetJourneyDateRangeKpiResponse
$creadPrec :: ReadPrec GetJourneyDateRangeKpiResponse
readList :: ReadS [GetJourneyDateRangeKpiResponse]
$creadList :: ReadS [GetJourneyDateRangeKpiResponse]
readsPrec :: Int -> ReadS GetJourneyDateRangeKpiResponse
$creadsPrec :: Int -> ReadS GetJourneyDateRangeKpiResponse
Prelude.Read, Int -> GetJourneyDateRangeKpiResponse -> ShowS
[GetJourneyDateRangeKpiResponse] -> ShowS
GetJourneyDateRangeKpiResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetJourneyDateRangeKpiResponse] -> ShowS
$cshowList :: [GetJourneyDateRangeKpiResponse] -> ShowS
show :: GetJourneyDateRangeKpiResponse -> String
$cshow :: GetJourneyDateRangeKpiResponse -> String
showsPrec :: Int -> GetJourneyDateRangeKpiResponse -> ShowS
$cshowsPrec :: Int -> GetJourneyDateRangeKpiResponse -> ShowS
Prelude.Show, forall x.
Rep GetJourneyDateRangeKpiResponse x
-> GetJourneyDateRangeKpiResponse
forall x.
GetJourneyDateRangeKpiResponse
-> Rep GetJourneyDateRangeKpiResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetJourneyDateRangeKpiResponse x
-> GetJourneyDateRangeKpiResponse
$cfrom :: forall x.
GetJourneyDateRangeKpiResponse
-> Rep GetJourneyDateRangeKpiResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetJourneyDateRangeKpiResponse' 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:
--
-- 'httpStatus', 'getJourneyDateRangeKpiResponse_httpStatus' - The response's http status code.
--
-- 'journeyDateRangeKpiResponse', 'getJourneyDateRangeKpiResponse_journeyDateRangeKpiResponse' - Undocumented member.
newGetJourneyDateRangeKpiResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'journeyDateRangeKpiResponse'
  JourneyDateRangeKpiResponse ->
  GetJourneyDateRangeKpiResponse
newGetJourneyDateRangeKpiResponse :: Int
-> JourneyDateRangeKpiResponse -> GetJourneyDateRangeKpiResponse
newGetJourneyDateRangeKpiResponse
  Int
pHttpStatus_
  JourneyDateRangeKpiResponse
pJourneyDateRangeKpiResponse_ =
    GetJourneyDateRangeKpiResponse'
      { $sel:httpStatus:GetJourneyDateRangeKpiResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:journeyDateRangeKpiResponse:GetJourneyDateRangeKpiResponse' :: JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse =
          JourneyDateRangeKpiResponse
pJourneyDateRangeKpiResponse_
      }

-- | The response's http status code.
getJourneyDateRangeKpiResponse_httpStatus :: Lens.Lens' GetJourneyDateRangeKpiResponse Prelude.Int
getJourneyDateRangeKpiResponse_httpStatus :: Lens' GetJourneyDateRangeKpiResponse Int
getJourneyDateRangeKpiResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpiResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetJourneyDateRangeKpiResponse' :: GetJourneyDateRangeKpiResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetJourneyDateRangeKpiResponse
s@GetJourneyDateRangeKpiResponse' {} Int
a -> GetJourneyDateRangeKpiResponse
s {$sel:httpStatus:GetJourneyDateRangeKpiResponse' :: Int
httpStatus = Int
a} :: GetJourneyDateRangeKpiResponse)

-- | Undocumented member.
getJourneyDateRangeKpiResponse_journeyDateRangeKpiResponse :: Lens.Lens' GetJourneyDateRangeKpiResponse JourneyDateRangeKpiResponse
getJourneyDateRangeKpiResponse_journeyDateRangeKpiResponse :: Lens' GetJourneyDateRangeKpiResponse JourneyDateRangeKpiResponse
getJourneyDateRangeKpiResponse_journeyDateRangeKpiResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJourneyDateRangeKpiResponse' {JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse :: JourneyDateRangeKpiResponse
$sel:journeyDateRangeKpiResponse:GetJourneyDateRangeKpiResponse' :: GetJourneyDateRangeKpiResponse -> JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse} -> JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse) (\s :: GetJourneyDateRangeKpiResponse
s@GetJourneyDateRangeKpiResponse' {} JourneyDateRangeKpiResponse
a -> GetJourneyDateRangeKpiResponse
s {$sel:journeyDateRangeKpiResponse:GetJourneyDateRangeKpiResponse' :: JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse = JourneyDateRangeKpiResponse
a} :: GetJourneyDateRangeKpiResponse)

instance
  Prelude.NFData
    GetJourneyDateRangeKpiResponse
  where
  rnf :: GetJourneyDateRangeKpiResponse -> ()
rnf GetJourneyDateRangeKpiResponse' {Int
JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse :: JourneyDateRangeKpiResponse
httpStatus :: Int
$sel:journeyDateRangeKpiResponse:GetJourneyDateRangeKpiResponse' :: GetJourneyDateRangeKpiResponse -> JourneyDateRangeKpiResponse
$sel:httpStatus:GetJourneyDateRangeKpiResponse' :: GetJourneyDateRangeKpiResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JourneyDateRangeKpiResponse
journeyDateRangeKpiResponse