{-# 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.Evidently.GetExperimentResults
-- 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 the results of a running or completed experiment. No results
-- are available until there have been 100 events for each variation and at
-- least 10 minutes have passed since the start of the experiment. To
-- increase the statistical power, Evidently performs an additional offline
-- p-value analysis at the end of the experiment. Offline p-value analysis
-- can detect statistical significance in some cases where the anytime
-- p-values used during the experiment do not find statistical
-- significance.
--
-- Experiment results are available up to 63 days after the start of the
-- experiment. They are not available after that because of CloudWatch data
-- retention policies.
module Amazonka.Evidently.GetExperimentResults
  ( -- * Creating a Request
    GetExperimentResults (..),
    newGetExperimentResults,

    -- * Request Lenses
    getExperimentResults_baseStat,
    getExperimentResults_endTime,
    getExperimentResults_period,
    getExperimentResults_reportNames,
    getExperimentResults_resultStats,
    getExperimentResults_startTime,
    getExperimentResults_experiment,
    getExperimentResults_metricNames,
    getExperimentResults_project,
    getExperimentResults_treatmentNames,

    -- * Destructuring the Response
    GetExperimentResultsResponse (..),
    newGetExperimentResultsResponse,

    -- * Response Lenses
    getExperimentResultsResponse_details,
    getExperimentResultsResponse_reports,
    getExperimentResultsResponse_resultsData,
    getExperimentResultsResponse_timestamps,
    getExperimentResultsResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetExperimentResults' smart constructor.
data GetExperimentResults = GetExperimentResults'
  { -- | The statistic used to calculate experiment results. Currently the only
    -- valid value is @mean@, which uses the mean of the collected values as
    -- the statistic.
    GetExperimentResults -> Maybe ExperimentBaseStat
baseStat :: Prelude.Maybe ExperimentBaseStat,
    -- | The date and time that the experiment ended, if it is completed. This
    -- must be no longer than 30 days after the experiment start time.
    GetExperimentResults -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | In seconds, the amount of time to aggregate results together.
    GetExperimentResults -> Maybe Natural
period :: Prelude.Maybe Prelude.Natural,
    -- | The names of the report types that you want to see. Currently,
    -- @BayesianInference@ is the only valid value.
    GetExperimentResults -> Maybe [ExperimentReportName]
reportNames :: Prelude.Maybe [ExperimentReportName],
    -- | The statistics that you want to see in the returned results.
    --
    -- -   @PValue@ specifies to use p-values for the results. A p-value is
    --     used in hypothesis testing to measure how often you are willing to
    --     make a mistake in rejecting the null hypothesis. A general practice
    --     is to reject the null hypothesis and declare that the results are
    --     statistically significant when the p-value is less than 0.05.
    --
    -- -   @ConfidenceInterval@ specifies a confidence interval for the
    --     results. The confidence interval represents the range of values for
    --     the chosen metric that is likely to contain the true difference
    --     between the @baseStat@ of a variation and the baseline. Evidently
    --     returns the 95% confidence interval.
    --
    -- -   @TreatmentEffect@ is the difference in the statistic specified by
    --     the @baseStat@ parameter between each variation and the default
    --     variation.
    --
    -- -   @BaseStat@ returns the statistical values collected for the metric
    --     for each variation. The statistic uses the same statistic specified
    --     in the @baseStat@ parameter. Therefore, if @baseStat@ is @mean@,
    --     this returns the mean of the values collected for each variation.
    GetExperimentResults -> Maybe [ExperimentResultRequestType]
resultStats :: Prelude.Maybe [ExperimentResultRequestType],
    -- | The date and time that the experiment started.
    GetExperimentResults -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the experiment to retrieve the results of.
    GetExperimentResults -> Text
experiment :: Prelude.Text,
    -- | The names of the experiment metrics that you want to see the results of.
    GetExperimentResults -> NonEmpty Text
metricNames :: Prelude.NonEmpty Prelude.Text,
    -- | The name or ARN of the project that contains the experiment that you
    -- want to see the results of.
    GetExperimentResults -> Text
project :: Prelude.Text,
    -- | The names of the experiment treatments that you want to see the results
    -- for.
    GetExperimentResults -> NonEmpty Text
treatmentNames :: Prelude.NonEmpty Prelude.Text
  }
  deriving (GetExperimentResults -> GetExperimentResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExperimentResults -> GetExperimentResults -> Bool
$c/= :: GetExperimentResults -> GetExperimentResults -> Bool
== :: GetExperimentResults -> GetExperimentResults -> Bool
$c== :: GetExperimentResults -> GetExperimentResults -> Bool
Prelude.Eq, ReadPrec [GetExperimentResults]
ReadPrec GetExperimentResults
Int -> ReadS GetExperimentResults
ReadS [GetExperimentResults]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetExperimentResults]
$creadListPrec :: ReadPrec [GetExperimentResults]
readPrec :: ReadPrec GetExperimentResults
$creadPrec :: ReadPrec GetExperimentResults
readList :: ReadS [GetExperimentResults]
$creadList :: ReadS [GetExperimentResults]
readsPrec :: Int -> ReadS GetExperimentResults
$creadsPrec :: Int -> ReadS GetExperimentResults
Prelude.Read, Int -> GetExperimentResults -> ShowS
[GetExperimentResults] -> ShowS
GetExperimentResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExperimentResults] -> ShowS
$cshowList :: [GetExperimentResults] -> ShowS
show :: GetExperimentResults -> String
$cshow :: GetExperimentResults -> String
showsPrec :: Int -> GetExperimentResults -> ShowS
$cshowsPrec :: Int -> GetExperimentResults -> ShowS
Prelude.Show, forall x. Rep GetExperimentResults x -> GetExperimentResults
forall x. GetExperimentResults -> Rep GetExperimentResults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetExperimentResults x -> GetExperimentResults
$cfrom :: forall x. GetExperimentResults -> Rep GetExperimentResults x
Prelude.Generic)

-- |
-- Create a value of 'GetExperimentResults' 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:
--
-- 'baseStat', 'getExperimentResults_baseStat' - The statistic used to calculate experiment results. Currently the only
-- valid value is @mean@, which uses the mean of the collected values as
-- the statistic.
--
-- 'endTime', 'getExperimentResults_endTime' - The date and time that the experiment ended, if it is completed. This
-- must be no longer than 30 days after the experiment start time.
--
-- 'period', 'getExperimentResults_period' - In seconds, the amount of time to aggregate results together.
--
-- 'reportNames', 'getExperimentResults_reportNames' - The names of the report types that you want to see. Currently,
-- @BayesianInference@ is the only valid value.
--
-- 'resultStats', 'getExperimentResults_resultStats' - The statistics that you want to see in the returned results.
--
-- -   @PValue@ specifies to use p-values for the results. A p-value is
--     used in hypothesis testing to measure how often you are willing to
--     make a mistake in rejecting the null hypothesis. A general practice
--     is to reject the null hypothesis and declare that the results are
--     statistically significant when the p-value is less than 0.05.
--
-- -   @ConfidenceInterval@ specifies a confidence interval for the
--     results. The confidence interval represents the range of values for
--     the chosen metric that is likely to contain the true difference
--     between the @baseStat@ of a variation and the baseline. Evidently
--     returns the 95% confidence interval.
--
-- -   @TreatmentEffect@ is the difference in the statistic specified by
--     the @baseStat@ parameter between each variation and the default
--     variation.
--
-- -   @BaseStat@ returns the statistical values collected for the metric
--     for each variation. The statistic uses the same statistic specified
--     in the @baseStat@ parameter. Therefore, if @baseStat@ is @mean@,
--     this returns the mean of the values collected for each variation.
--
-- 'startTime', 'getExperimentResults_startTime' - The date and time that the experiment started.
--
-- 'experiment', 'getExperimentResults_experiment' - The name of the experiment to retrieve the results of.
--
-- 'metricNames', 'getExperimentResults_metricNames' - The names of the experiment metrics that you want to see the results of.
--
-- 'project', 'getExperimentResults_project' - The name or ARN of the project that contains the experiment that you
-- want to see the results of.
--
-- 'treatmentNames', 'getExperimentResults_treatmentNames' - The names of the experiment treatments that you want to see the results
-- for.
newGetExperimentResults ::
  -- | 'experiment'
  Prelude.Text ->
  -- | 'metricNames'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  -- | 'treatmentNames'
  Prelude.NonEmpty Prelude.Text ->
  GetExperimentResults
newGetExperimentResults :: Text
-> NonEmpty Text -> Text -> NonEmpty Text -> GetExperimentResults
newGetExperimentResults
  Text
pExperiment_
  NonEmpty Text
pMetricNames_
  Text
pProject_
  NonEmpty Text
pTreatmentNames_ =
    GetExperimentResults'
      { $sel:baseStat:GetExperimentResults' :: Maybe ExperimentBaseStat
baseStat = forall a. Maybe a
Prelude.Nothing,
        $sel:endTime:GetExperimentResults' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
        $sel:period:GetExperimentResults' :: Maybe Natural
period = forall a. Maybe a
Prelude.Nothing,
        $sel:reportNames:GetExperimentResults' :: Maybe [ExperimentReportName]
reportNames = forall a. Maybe a
Prelude.Nothing,
        $sel:resultStats:GetExperimentResults' :: Maybe [ExperimentResultRequestType]
resultStats = forall a. Maybe a
Prelude.Nothing,
        $sel:startTime:GetExperimentResults' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing,
        $sel:experiment:GetExperimentResults' :: Text
experiment = Text
pExperiment_,
        $sel:metricNames:GetExperimentResults' :: NonEmpty Text
metricNames = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pMetricNames_,
        $sel:project:GetExperimentResults' :: Text
project = Text
pProject_,
        $sel:treatmentNames:GetExperimentResults' :: NonEmpty Text
treatmentNames =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pTreatmentNames_
      }

-- | The statistic used to calculate experiment results. Currently the only
-- valid value is @mean@, which uses the mean of the collected values as
-- the statistic.
getExperimentResults_baseStat :: Lens.Lens' GetExperimentResults (Prelude.Maybe ExperimentBaseStat)
getExperimentResults_baseStat :: Lens' GetExperimentResults (Maybe ExperimentBaseStat)
getExperimentResults_baseStat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Maybe ExperimentBaseStat
baseStat :: Maybe ExperimentBaseStat
$sel:baseStat:GetExperimentResults' :: GetExperimentResults -> Maybe ExperimentBaseStat
baseStat} -> Maybe ExperimentBaseStat
baseStat) (\s :: GetExperimentResults
s@GetExperimentResults' {} Maybe ExperimentBaseStat
a -> GetExperimentResults
s {$sel:baseStat:GetExperimentResults' :: Maybe ExperimentBaseStat
baseStat = Maybe ExperimentBaseStat
a} :: GetExperimentResults)

-- | The date and time that the experiment ended, if it is completed. This
-- must be no longer than 30 days after the experiment start time.
getExperimentResults_endTime :: Lens.Lens' GetExperimentResults (Prelude.Maybe Prelude.UTCTime)
getExperimentResults_endTime :: Lens' GetExperimentResults (Maybe UTCTime)
getExperimentResults_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: GetExperimentResults
s@GetExperimentResults' {} Maybe POSIX
a -> GetExperimentResults
s {$sel:endTime:GetExperimentResults' :: Maybe POSIX
endTime = Maybe POSIX
a} :: GetExperimentResults) 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

-- | In seconds, the amount of time to aggregate results together.
getExperimentResults_period :: Lens.Lens' GetExperimentResults (Prelude.Maybe Prelude.Natural)
getExperimentResults_period :: Lens' GetExperimentResults (Maybe Natural)
getExperimentResults_period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Maybe Natural
period :: Maybe Natural
$sel:period:GetExperimentResults' :: GetExperimentResults -> Maybe Natural
period} -> Maybe Natural
period) (\s :: GetExperimentResults
s@GetExperimentResults' {} Maybe Natural
a -> GetExperimentResults
s {$sel:period:GetExperimentResults' :: Maybe Natural
period = Maybe Natural
a} :: GetExperimentResults)

-- | The names of the report types that you want to see. Currently,
-- @BayesianInference@ is the only valid value.
getExperimentResults_reportNames :: Lens.Lens' GetExperimentResults (Prelude.Maybe [ExperimentReportName])
getExperimentResults_reportNames :: Lens' GetExperimentResults (Maybe [ExperimentReportName])
getExperimentResults_reportNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Maybe [ExperimentReportName]
reportNames :: Maybe [ExperimentReportName]
$sel:reportNames:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentReportName]
reportNames} -> Maybe [ExperimentReportName]
reportNames) (\s :: GetExperimentResults
s@GetExperimentResults' {} Maybe [ExperimentReportName]
a -> GetExperimentResults
s {$sel:reportNames:GetExperimentResults' :: Maybe [ExperimentReportName]
reportNames = Maybe [ExperimentReportName]
a} :: GetExperimentResults) 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 statistics that you want to see in the returned results.
--
-- -   @PValue@ specifies to use p-values for the results. A p-value is
--     used in hypothesis testing to measure how often you are willing to
--     make a mistake in rejecting the null hypothesis. A general practice
--     is to reject the null hypothesis and declare that the results are
--     statistically significant when the p-value is less than 0.05.
--
-- -   @ConfidenceInterval@ specifies a confidence interval for the
--     results. The confidence interval represents the range of values for
--     the chosen metric that is likely to contain the true difference
--     between the @baseStat@ of a variation and the baseline. Evidently
--     returns the 95% confidence interval.
--
-- -   @TreatmentEffect@ is the difference in the statistic specified by
--     the @baseStat@ parameter between each variation and the default
--     variation.
--
-- -   @BaseStat@ returns the statistical values collected for the metric
--     for each variation. The statistic uses the same statistic specified
--     in the @baseStat@ parameter. Therefore, if @baseStat@ is @mean@,
--     this returns the mean of the values collected for each variation.
getExperimentResults_resultStats :: Lens.Lens' GetExperimentResults (Prelude.Maybe [ExperimentResultRequestType])
getExperimentResults_resultStats :: Lens' GetExperimentResults (Maybe [ExperimentResultRequestType])
getExperimentResults_resultStats = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Maybe [ExperimentResultRequestType]
resultStats :: Maybe [ExperimentResultRequestType]
$sel:resultStats:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentResultRequestType]
resultStats} -> Maybe [ExperimentResultRequestType]
resultStats) (\s :: GetExperimentResults
s@GetExperimentResults' {} Maybe [ExperimentResultRequestType]
a -> GetExperimentResults
s {$sel:resultStats:GetExperimentResults' :: Maybe [ExperimentResultRequestType]
resultStats = Maybe [ExperimentResultRequestType]
a} :: GetExperimentResults) 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 date and time that the experiment started.
getExperimentResults_startTime :: Lens.Lens' GetExperimentResults (Prelude.Maybe Prelude.UTCTime)
getExperimentResults_startTime :: Lens' GetExperimentResults (Maybe UTCTime)
getExperimentResults_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: GetExperimentResults
s@GetExperimentResults' {} Maybe POSIX
a -> GetExperimentResults
s {$sel:startTime:GetExperimentResults' :: Maybe POSIX
startTime = Maybe POSIX
a} :: GetExperimentResults) 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 name of the experiment to retrieve the results of.
getExperimentResults_experiment :: Lens.Lens' GetExperimentResults Prelude.Text
getExperimentResults_experiment :: Lens' GetExperimentResults Text
getExperimentResults_experiment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Text
experiment :: Text
$sel:experiment:GetExperimentResults' :: GetExperimentResults -> Text
experiment} -> Text
experiment) (\s :: GetExperimentResults
s@GetExperimentResults' {} Text
a -> GetExperimentResults
s {$sel:experiment:GetExperimentResults' :: Text
experiment = Text
a} :: GetExperimentResults)

-- | The names of the experiment metrics that you want to see the results of.
getExperimentResults_metricNames :: Lens.Lens' GetExperimentResults (Prelude.NonEmpty Prelude.Text)
getExperimentResults_metricNames :: Lens' GetExperimentResults (NonEmpty Text)
getExperimentResults_metricNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {NonEmpty Text
metricNames :: NonEmpty Text
$sel:metricNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
metricNames} -> NonEmpty Text
metricNames) (\s :: GetExperimentResults
s@GetExperimentResults' {} NonEmpty Text
a -> GetExperimentResults
s {$sel:metricNames:GetExperimentResults' :: NonEmpty Text
metricNames = NonEmpty Text
a} :: GetExperimentResults) 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 name or ARN of the project that contains the experiment that you
-- want to see the results of.
getExperimentResults_project :: Lens.Lens' GetExperimentResults Prelude.Text
getExperimentResults_project :: Lens' GetExperimentResults Text
getExperimentResults_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {Text
project :: Text
$sel:project:GetExperimentResults' :: GetExperimentResults -> Text
project} -> Text
project) (\s :: GetExperimentResults
s@GetExperimentResults' {} Text
a -> GetExperimentResults
s {$sel:project:GetExperimentResults' :: Text
project = Text
a} :: GetExperimentResults)

-- | The names of the experiment treatments that you want to see the results
-- for.
getExperimentResults_treatmentNames :: Lens.Lens' GetExperimentResults (Prelude.NonEmpty Prelude.Text)
getExperimentResults_treatmentNames :: Lens' GetExperimentResults (NonEmpty Text)
getExperimentResults_treatmentNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResults' {NonEmpty Text
treatmentNames :: NonEmpty Text
$sel:treatmentNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
treatmentNames} -> NonEmpty Text
treatmentNames) (\s :: GetExperimentResults
s@GetExperimentResults' {} NonEmpty Text
a -> GetExperimentResults
s {$sel:treatmentNames:GetExperimentResults' :: NonEmpty Text
treatmentNames = NonEmpty Text
a} :: GetExperimentResults) 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

instance Core.AWSRequest GetExperimentResults where
  type
    AWSResponse GetExperimentResults =
      GetExperimentResultsResponse
  request :: (Service -> Service)
-> GetExperimentResults -> Request GetExperimentResults
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetExperimentResults
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetExperimentResults)))
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 ->
          Maybe Text
-> Maybe [ExperimentReport]
-> Maybe [ExperimentResultsData]
-> Maybe [POSIX]
-> Int
-> GetExperimentResultsResponse
GetExperimentResultsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"details")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"reports" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"resultsData" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"timestamps" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable GetExperimentResults where
  hashWithSalt :: Int -> GetExperimentResults -> Int
hashWithSalt Int
_salt GetExperimentResults' {Maybe Natural
Maybe [ExperimentReportName]
Maybe [ExperimentResultRequestType]
Maybe POSIX
Maybe ExperimentBaseStat
NonEmpty Text
Text
treatmentNames :: NonEmpty Text
project :: Text
metricNames :: NonEmpty Text
experiment :: Text
startTime :: Maybe POSIX
resultStats :: Maybe [ExperimentResultRequestType]
reportNames :: Maybe [ExperimentReportName]
period :: Maybe Natural
endTime :: Maybe POSIX
baseStat :: Maybe ExperimentBaseStat
$sel:treatmentNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:project:GetExperimentResults' :: GetExperimentResults -> Text
$sel:metricNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:experiment:GetExperimentResults' :: GetExperimentResults -> Text
$sel:startTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:resultStats:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentResultRequestType]
$sel:reportNames:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentReportName]
$sel:period:GetExperimentResults' :: GetExperimentResults -> Maybe Natural
$sel:endTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:baseStat:GetExperimentResults' :: GetExperimentResults -> Maybe ExperimentBaseStat
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExperimentBaseStat
baseStat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
period
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ExperimentReportName]
reportNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ExperimentResultRequestType]
resultStats
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
experiment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
metricNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
treatmentNames

instance Prelude.NFData GetExperimentResults where
  rnf :: GetExperimentResults -> ()
rnf GetExperimentResults' {Maybe Natural
Maybe [ExperimentReportName]
Maybe [ExperimentResultRequestType]
Maybe POSIX
Maybe ExperimentBaseStat
NonEmpty Text
Text
treatmentNames :: NonEmpty Text
project :: Text
metricNames :: NonEmpty Text
experiment :: Text
startTime :: Maybe POSIX
resultStats :: Maybe [ExperimentResultRequestType]
reportNames :: Maybe [ExperimentReportName]
period :: Maybe Natural
endTime :: Maybe POSIX
baseStat :: Maybe ExperimentBaseStat
$sel:treatmentNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:project:GetExperimentResults' :: GetExperimentResults -> Text
$sel:metricNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:experiment:GetExperimentResults' :: GetExperimentResults -> Text
$sel:startTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:resultStats:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentResultRequestType]
$sel:reportNames:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentReportName]
$sel:period:GetExperimentResults' :: GetExperimentResults -> Maybe Natural
$sel:endTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:baseStat:GetExperimentResults' :: GetExperimentResults -> Maybe ExperimentBaseStat
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ExperimentBaseStat
baseStat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
period
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ExperimentReportName]
reportNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ExperimentResultRequestType]
resultStats
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
experiment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
metricNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
treatmentNames

instance Data.ToHeaders GetExperimentResults where
  toHeaders :: GetExperimentResults -> 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.ToJSON GetExperimentResults where
  toJSON :: GetExperimentResults -> Value
toJSON GetExperimentResults' {Maybe Natural
Maybe [ExperimentReportName]
Maybe [ExperimentResultRequestType]
Maybe POSIX
Maybe ExperimentBaseStat
NonEmpty Text
Text
treatmentNames :: NonEmpty Text
project :: Text
metricNames :: NonEmpty Text
experiment :: Text
startTime :: Maybe POSIX
resultStats :: Maybe [ExperimentResultRequestType]
reportNames :: Maybe [ExperimentReportName]
period :: Maybe Natural
endTime :: Maybe POSIX
baseStat :: Maybe ExperimentBaseStat
$sel:treatmentNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:project:GetExperimentResults' :: GetExperimentResults -> Text
$sel:metricNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:experiment:GetExperimentResults' :: GetExperimentResults -> Text
$sel:startTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:resultStats:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentResultRequestType]
$sel:reportNames:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentReportName]
$sel:period:GetExperimentResults' :: GetExperimentResults -> Maybe Natural
$sel:endTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:baseStat:GetExperimentResults' :: GetExperimentResults -> Maybe ExperimentBaseStat
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"baseStat" 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 ExperimentBaseStat
baseStat,
            (Key
"endTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe POSIX
endTime,
            (Key
"period" 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 Natural
period,
            (Key
"reportNames" 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 [ExperimentReportName]
reportNames,
            (Key
"resultStats" 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 [ExperimentResultRequestType]
resultStats,
            (Key
"startTime" 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 POSIX
startTime,
            forall a. a -> Maybe a
Prelude.Just (Key
"metricNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
metricNames),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"treatmentNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
treatmentNames)
          ]
      )

instance Data.ToPath GetExperimentResults where
  toPath :: GetExperimentResults -> ByteString
toPath GetExperimentResults' {Maybe Natural
Maybe [ExperimentReportName]
Maybe [ExperimentResultRequestType]
Maybe POSIX
Maybe ExperimentBaseStat
NonEmpty Text
Text
treatmentNames :: NonEmpty Text
project :: Text
metricNames :: NonEmpty Text
experiment :: Text
startTime :: Maybe POSIX
resultStats :: Maybe [ExperimentResultRequestType]
reportNames :: Maybe [ExperimentReportName]
period :: Maybe Natural
endTime :: Maybe POSIX
baseStat :: Maybe ExperimentBaseStat
$sel:treatmentNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:project:GetExperimentResults' :: GetExperimentResults -> Text
$sel:metricNames:GetExperimentResults' :: GetExperimentResults -> NonEmpty Text
$sel:experiment:GetExperimentResults' :: GetExperimentResults -> Text
$sel:startTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:resultStats:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentResultRequestType]
$sel:reportNames:GetExperimentResults' :: GetExperimentResults -> Maybe [ExperimentReportName]
$sel:period:GetExperimentResults' :: GetExperimentResults -> Maybe Natural
$sel:endTime:GetExperimentResults' :: GetExperimentResults -> Maybe POSIX
$sel:baseStat:GetExperimentResults' :: GetExperimentResults -> Maybe ExperimentBaseStat
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
project,
        ByteString
"/experiments/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
experiment,
        ByteString
"/results"
      ]

instance Data.ToQuery GetExperimentResults where
  toQuery :: GetExperimentResults -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetExperimentResultsResponse' smart constructor.
data GetExperimentResultsResponse = GetExperimentResultsResponse'
  { -- | If the experiment doesn\'t yet have enough events to provide valid
    -- results, this field is returned with the message
    -- @Not enough events to generate results@. If there are enough events to
    -- provide valid results, this field is not returned.
    GetExperimentResultsResponse -> Maybe Text
details :: Prelude.Maybe Prelude.Text,
    -- | An array of structures that include the reports that you requested.
    GetExperimentResultsResponse -> Maybe [ExperimentReport]
reports :: Prelude.Maybe [ExperimentReport],
    -- | An array of structures that include experiment results including metric
    -- names and values.
    GetExperimentResultsResponse -> Maybe [ExperimentResultsData]
resultsData :: Prelude.Maybe [ExperimentResultsData],
    -- | The timestamps of each result returned.
    GetExperimentResultsResponse -> Maybe [POSIX]
timestamps :: Prelude.Maybe [Data.POSIX],
    -- | The response's http status code.
    GetExperimentResultsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetExperimentResultsResponse
-> GetExperimentResultsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExperimentResultsResponse
-> GetExperimentResultsResponse -> Bool
$c/= :: GetExperimentResultsResponse
-> GetExperimentResultsResponse -> Bool
== :: GetExperimentResultsResponse
-> GetExperimentResultsResponse -> Bool
$c== :: GetExperimentResultsResponse
-> GetExperimentResultsResponse -> Bool
Prelude.Eq, ReadPrec [GetExperimentResultsResponse]
ReadPrec GetExperimentResultsResponse
Int -> ReadS GetExperimentResultsResponse
ReadS [GetExperimentResultsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetExperimentResultsResponse]
$creadListPrec :: ReadPrec [GetExperimentResultsResponse]
readPrec :: ReadPrec GetExperimentResultsResponse
$creadPrec :: ReadPrec GetExperimentResultsResponse
readList :: ReadS [GetExperimentResultsResponse]
$creadList :: ReadS [GetExperimentResultsResponse]
readsPrec :: Int -> ReadS GetExperimentResultsResponse
$creadsPrec :: Int -> ReadS GetExperimentResultsResponse
Prelude.Read, Int -> GetExperimentResultsResponse -> ShowS
[GetExperimentResultsResponse] -> ShowS
GetExperimentResultsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExperimentResultsResponse] -> ShowS
$cshowList :: [GetExperimentResultsResponse] -> ShowS
show :: GetExperimentResultsResponse -> String
$cshow :: GetExperimentResultsResponse -> String
showsPrec :: Int -> GetExperimentResultsResponse -> ShowS
$cshowsPrec :: Int -> GetExperimentResultsResponse -> ShowS
Prelude.Show, forall x.
Rep GetExperimentResultsResponse x -> GetExperimentResultsResponse
forall x.
GetExperimentResultsResponse -> Rep GetExperimentResultsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetExperimentResultsResponse x -> GetExperimentResultsResponse
$cfrom :: forall x.
GetExperimentResultsResponse -> Rep GetExperimentResultsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetExperimentResultsResponse' 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:
--
-- 'details', 'getExperimentResultsResponse_details' - If the experiment doesn\'t yet have enough events to provide valid
-- results, this field is returned with the message
-- @Not enough events to generate results@. If there are enough events to
-- provide valid results, this field is not returned.
--
-- 'reports', 'getExperimentResultsResponse_reports' - An array of structures that include the reports that you requested.
--
-- 'resultsData', 'getExperimentResultsResponse_resultsData' - An array of structures that include experiment results including metric
-- names and values.
--
-- 'timestamps', 'getExperimentResultsResponse_timestamps' - The timestamps of each result returned.
--
-- 'httpStatus', 'getExperimentResultsResponse_httpStatus' - The response's http status code.
newGetExperimentResultsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetExperimentResultsResponse
newGetExperimentResultsResponse :: Int -> GetExperimentResultsResponse
newGetExperimentResultsResponse Int
pHttpStatus_ =
  GetExperimentResultsResponse'
    { $sel:details:GetExperimentResultsResponse' :: Maybe Text
details =
        forall a. Maybe a
Prelude.Nothing,
      $sel:reports:GetExperimentResultsResponse' :: Maybe [ExperimentReport]
reports = forall a. Maybe a
Prelude.Nothing,
      $sel:resultsData:GetExperimentResultsResponse' :: Maybe [ExperimentResultsData]
resultsData = forall a. Maybe a
Prelude.Nothing,
      $sel:timestamps:GetExperimentResultsResponse' :: Maybe [POSIX]
timestamps = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetExperimentResultsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the experiment doesn\'t yet have enough events to provide valid
-- results, this field is returned with the message
-- @Not enough events to generate results@. If there are enough events to
-- provide valid results, this field is not returned.
getExperimentResultsResponse_details :: Lens.Lens' GetExperimentResultsResponse (Prelude.Maybe Prelude.Text)
getExperimentResultsResponse_details :: Lens' GetExperimentResultsResponse (Maybe Text)
getExperimentResultsResponse_details = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResultsResponse' {Maybe Text
details :: Maybe Text
$sel:details:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe Text
details} -> Maybe Text
details) (\s :: GetExperimentResultsResponse
s@GetExperimentResultsResponse' {} Maybe Text
a -> GetExperimentResultsResponse
s {$sel:details:GetExperimentResultsResponse' :: Maybe Text
details = Maybe Text
a} :: GetExperimentResultsResponse)

-- | An array of structures that include the reports that you requested.
getExperimentResultsResponse_reports :: Lens.Lens' GetExperimentResultsResponse (Prelude.Maybe [ExperimentReport])
getExperimentResultsResponse_reports :: Lens' GetExperimentResultsResponse (Maybe [ExperimentReport])
getExperimentResultsResponse_reports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResultsResponse' {Maybe [ExperimentReport]
reports :: Maybe [ExperimentReport]
$sel:reports:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe [ExperimentReport]
reports} -> Maybe [ExperimentReport]
reports) (\s :: GetExperimentResultsResponse
s@GetExperimentResultsResponse' {} Maybe [ExperimentReport]
a -> GetExperimentResultsResponse
s {$sel:reports:GetExperimentResultsResponse' :: Maybe [ExperimentReport]
reports = Maybe [ExperimentReport]
a} :: GetExperimentResultsResponse) 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

-- | An array of structures that include experiment results including metric
-- names and values.
getExperimentResultsResponse_resultsData :: Lens.Lens' GetExperimentResultsResponse (Prelude.Maybe [ExperimentResultsData])
getExperimentResultsResponse_resultsData :: Lens' GetExperimentResultsResponse (Maybe [ExperimentResultsData])
getExperimentResultsResponse_resultsData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResultsResponse' {Maybe [ExperimentResultsData]
resultsData :: Maybe [ExperimentResultsData]
$sel:resultsData:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe [ExperimentResultsData]
resultsData} -> Maybe [ExperimentResultsData]
resultsData) (\s :: GetExperimentResultsResponse
s@GetExperimentResultsResponse' {} Maybe [ExperimentResultsData]
a -> GetExperimentResultsResponse
s {$sel:resultsData:GetExperimentResultsResponse' :: Maybe [ExperimentResultsData]
resultsData = Maybe [ExperimentResultsData]
a} :: GetExperimentResultsResponse) 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 timestamps of each result returned.
getExperimentResultsResponse_timestamps :: Lens.Lens' GetExperimentResultsResponse (Prelude.Maybe [Prelude.UTCTime])
getExperimentResultsResponse_timestamps :: Lens' GetExperimentResultsResponse (Maybe [UTCTime])
getExperimentResultsResponse_timestamps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResultsResponse' {Maybe [POSIX]
timestamps :: Maybe [POSIX]
$sel:timestamps:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe [POSIX]
timestamps} -> Maybe [POSIX]
timestamps) (\s :: GetExperimentResultsResponse
s@GetExperimentResultsResponse' {} Maybe [POSIX]
a -> GetExperimentResultsResponse
s {$sel:timestamps:GetExperimentResultsResponse' :: Maybe [POSIX]
timestamps = Maybe [POSIX]
a} :: GetExperimentResultsResponse) 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 response's http status code.
getExperimentResultsResponse_httpStatus :: Lens.Lens' GetExperimentResultsResponse Prelude.Int
getExperimentResultsResponse_httpStatus :: Lens' GetExperimentResultsResponse Int
getExperimentResultsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExperimentResultsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetExperimentResultsResponse
s@GetExperimentResultsResponse' {} Int
a -> GetExperimentResultsResponse
s {$sel:httpStatus:GetExperimentResultsResponse' :: Int
httpStatus = Int
a} :: GetExperimentResultsResponse)

instance Prelude.NFData GetExperimentResultsResponse where
  rnf :: GetExperimentResultsResponse -> ()
rnf GetExperimentResultsResponse' {Int
Maybe [POSIX]
Maybe [ExperimentReport]
Maybe [ExperimentResultsData]
Maybe Text
httpStatus :: Int
timestamps :: Maybe [POSIX]
resultsData :: Maybe [ExperimentResultsData]
reports :: Maybe [ExperimentReport]
details :: Maybe Text
$sel:httpStatus:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Int
$sel:timestamps:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe [POSIX]
$sel:resultsData:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe [ExperimentResultsData]
$sel:reports:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe [ExperimentReport]
$sel:details:GetExperimentResultsResponse' :: GetExperimentResultsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
details
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ExperimentReport]
reports
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ExperimentResultsData]
resultsData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [POSIX]
timestamps
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus