{-# 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.BatchEvaluateFeature
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation assigns feature variation to user sessions. For each user
-- session, you pass in an @entityID@ that represents the user. Evidently
-- then checks the evaluation rules and assigns the variation.
--
-- The first rules that are evaluated are the override rules. If the
-- user\'s @entityID@ matches an override rule, the user is served the
-- variation specified by that rule.
--
-- Next, if there is a launch of the feature, the user might be assigned to
-- a variation in the launch. The chance of this depends on the percentage
-- of users that are allocated to that launch. If the user is enrolled in
-- the launch, the variation they are served depends on the allocation of
-- the various feature variations used for the launch.
--
-- If the user is not assigned to a launch, and there is an ongoing
-- experiment for this feature, the user might be assigned to a variation
-- in the experiment. The chance of this depends on the percentage of users
-- that are allocated to that experiment. If the user is enrolled in the
-- experiment, the variation they are served depends on the allocation of
-- the various feature variations used for the experiment.
--
-- If the user is not assigned to a launch or experiment, they are served
-- the default variation.
module Amazonka.Evidently.BatchEvaluateFeature
  ( -- * Creating a Request
    BatchEvaluateFeature (..),
    newBatchEvaluateFeature,

    -- * Request Lenses
    batchEvaluateFeature_project,
    batchEvaluateFeature_requests,

    -- * Destructuring the Response
    BatchEvaluateFeatureResponse (..),
    newBatchEvaluateFeatureResponse,

    -- * Response Lenses
    batchEvaluateFeatureResponse_results,
    batchEvaluateFeatureResponse_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:/ 'newBatchEvaluateFeature' smart constructor.
data BatchEvaluateFeature = BatchEvaluateFeature'
  { -- | The name or ARN of the project that contains the feature being
    -- evaluated.
    BatchEvaluateFeature -> Text
project :: Prelude.Text,
    -- | An array of structures, where each structure assigns a feature variation
    -- to one user session.
    BatchEvaluateFeature -> NonEmpty EvaluationRequest
requests :: Prelude.NonEmpty EvaluationRequest
  }
  deriving (BatchEvaluateFeature -> BatchEvaluateFeature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchEvaluateFeature -> BatchEvaluateFeature -> Bool
$c/= :: BatchEvaluateFeature -> BatchEvaluateFeature -> Bool
== :: BatchEvaluateFeature -> BatchEvaluateFeature -> Bool
$c== :: BatchEvaluateFeature -> BatchEvaluateFeature -> Bool
Prelude.Eq, ReadPrec [BatchEvaluateFeature]
ReadPrec BatchEvaluateFeature
Int -> ReadS BatchEvaluateFeature
ReadS [BatchEvaluateFeature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchEvaluateFeature]
$creadListPrec :: ReadPrec [BatchEvaluateFeature]
readPrec :: ReadPrec BatchEvaluateFeature
$creadPrec :: ReadPrec BatchEvaluateFeature
readList :: ReadS [BatchEvaluateFeature]
$creadList :: ReadS [BatchEvaluateFeature]
readsPrec :: Int -> ReadS BatchEvaluateFeature
$creadsPrec :: Int -> ReadS BatchEvaluateFeature
Prelude.Read, Int -> BatchEvaluateFeature -> ShowS
[BatchEvaluateFeature] -> ShowS
BatchEvaluateFeature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchEvaluateFeature] -> ShowS
$cshowList :: [BatchEvaluateFeature] -> ShowS
show :: BatchEvaluateFeature -> String
$cshow :: BatchEvaluateFeature -> String
showsPrec :: Int -> BatchEvaluateFeature -> ShowS
$cshowsPrec :: Int -> BatchEvaluateFeature -> ShowS
Prelude.Show, forall x. Rep BatchEvaluateFeature x -> BatchEvaluateFeature
forall x. BatchEvaluateFeature -> Rep BatchEvaluateFeature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchEvaluateFeature x -> BatchEvaluateFeature
$cfrom :: forall x. BatchEvaluateFeature -> Rep BatchEvaluateFeature x
Prelude.Generic)

-- |
-- Create a value of 'BatchEvaluateFeature' 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:
--
-- 'project', 'batchEvaluateFeature_project' - The name or ARN of the project that contains the feature being
-- evaluated.
--
-- 'requests', 'batchEvaluateFeature_requests' - An array of structures, where each structure assigns a feature variation
-- to one user session.
newBatchEvaluateFeature ::
  -- | 'project'
  Prelude.Text ->
  -- | 'requests'
  Prelude.NonEmpty EvaluationRequest ->
  BatchEvaluateFeature
newBatchEvaluateFeature :: Text -> NonEmpty EvaluationRequest -> BatchEvaluateFeature
newBatchEvaluateFeature Text
pProject_ NonEmpty EvaluationRequest
pRequests_ =
  BatchEvaluateFeature'
    { $sel:project:BatchEvaluateFeature' :: Text
project = Text
pProject_,
      $sel:requests:BatchEvaluateFeature' :: NonEmpty EvaluationRequest
requests = 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 EvaluationRequest
pRequests_
    }

-- | The name or ARN of the project that contains the feature being
-- evaluated.
batchEvaluateFeature_project :: Lens.Lens' BatchEvaluateFeature Prelude.Text
batchEvaluateFeature_project :: Lens' BatchEvaluateFeature Text
batchEvaluateFeature_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchEvaluateFeature' {Text
project :: Text
$sel:project:BatchEvaluateFeature' :: BatchEvaluateFeature -> Text
project} -> Text
project) (\s :: BatchEvaluateFeature
s@BatchEvaluateFeature' {} Text
a -> BatchEvaluateFeature
s {$sel:project:BatchEvaluateFeature' :: Text
project = Text
a} :: BatchEvaluateFeature)

-- | An array of structures, where each structure assigns a feature variation
-- to one user session.
batchEvaluateFeature_requests :: Lens.Lens' BatchEvaluateFeature (Prelude.NonEmpty EvaluationRequest)
batchEvaluateFeature_requests :: Lens' BatchEvaluateFeature (NonEmpty EvaluationRequest)
batchEvaluateFeature_requests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchEvaluateFeature' {NonEmpty EvaluationRequest
requests :: NonEmpty EvaluationRequest
$sel:requests:BatchEvaluateFeature' :: BatchEvaluateFeature -> NonEmpty EvaluationRequest
requests} -> NonEmpty EvaluationRequest
requests) (\s :: BatchEvaluateFeature
s@BatchEvaluateFeature' {} NonEmpty EvaluationRequest
a -> BatchEvaluateFeature
s {$sel:requests:BatchEvaluateFeature' :: NonEmpty EvaluationRequest
requests = NonEmpty EvaluationRequest
a} :: BatchEvaluateFeature) 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 BatchEvaluateFeature where
  type
    AWSResponse BatchEvaluateFeature =
      BatchEvaluateFeatureResponse
  request :: (Service -> Service)
-> BatchEvaluateFeature -> Request BatchEvaluateFeature
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 BatchEvaluateFeature
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchEvaluateFeature)))
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 [EvaluationResult] -> Int -> BatchEvaluateFeatureResponse
BatchEvaluateFeatureResponse'
            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
"results" 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 BatchEvaluateFeature where
  hashWithSalt :: Int -> BatchEvaluateFeature -> Int
hashWithSalt Int
_salt BatchEvaluateFeature' {NonEmpty EvaluationRequest
Text
requests :: NonEmpty EvaluationRequest
project :: Text
$sel:requests:BatchEvaluateFeature' :: BatchEvaluateFeature -> NonEmpty EvaluationRequest
$sel:project:BatchEvaluateFeature' :: BatchEvaluateFeature -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty EvaluationRequest
requests

instance Prelude.NFData BatchEvaluateFeature where
  rnf :: BatchEvaluateFeature -> ()
rnf BatchEvaluateFeature' {NonEmpty EvaluationRequest
Text
requests :: NonEmpty EvaluationRequest
project :: Text
$sel:requests:BatchEvaluateFeature' :: BatchEvaluateFeature -> NonEmpty EvaluationRequest
$sel:project:BatchEvaluateFeature' :: BatchEvaluateFeature -> Text
..} =
    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 EvaluationRequest
requests

instance Data.ToHeaders BatchEvaluateFeature where
  toHeaders :: BatchEvaluateFeature -> 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 BatchEvaluateFeature where
  toJSON :: BatchEvaluateFeature -> Value
toJSON BatchEvaluateFeature' {NonEmpty EvaluationRequest
Text
requests :: NonEmpty EvaluationRequest
project :: Text
$sel:requests:BatchEvaluateFeature' :: BatchEvaluateFeature -> NonEmpty EvaluationRequest
$sel:project:BatchEvaluateFeature' :: BatchEvaluateFeature -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"requests" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty EvaluationRequest
requests)]
      )

instance Data.ToPath BatchEvaluateFeature where
  toPath :: BatchEvaluateFeature -> ByteString
toPath BatchEvaluateFeature' {NonEmpty EvaluationRequest
Text
requests :: NonEmpty EvaluationRequest
project :: Text
$sel:requests:BatchEvaluateFeature' :: BatchEvaluateFeature -> NonEmpty EvaluationRequest
$sel:project:BatchEvaluateFeature' :: BatchEvaluateFeature -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/projects/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
project, ByteString
"/evaluations"]

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

-- | /See:/ 'newBatchEvaluateFeatureResponse' smart constructor.
data BatchEvaluateFeatureResponse = BatchEvaluateFeatureResponse'
  { -- | An array of structures, where each structure displays the results of one
    -- feature evaluation assignment to one user session.
    BatchEvaluateFeatureResponse -> Maybe [EvaluationResult]
results :: Prelude.Maybe [EvaluationResult],
    -- | The response's http status code.
    BatchEvaluateFeatureResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchEvaluateFeatureResponse
-> BatchEvaluateFeatureResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchEvaluateFeatureResponse
-> BatchEvaluateFeatureResponse -> Bool
$c/= :: BatchEvaluateFeatureResponse
-> BatchEvaluateFeatureResponse -> Bool
== :: BatchEvaluateFeatureResponse
-> BatchEvaluateFeatureResponse -> Bool
$c== :: BatchEvaluateFeatureResponse
-> BatchEvaluateFeatureResponse -> Bool
Prelude.Eq, ReadPrec [BatchEvaluateFeatureResponse]
ReadPrec BatchEvaluateFeatureResponse
Int -> ReadS BatchEvaluateFeatureResponse
ReadS [BatchEvaluateFeatureResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchEvaluateFeatureResponse]
$creadListPrec :: ReadPrec [BatchEvaluateFeatureResponse]
readPrec :: ReadPrec BatchEvaluateFeatureResponse
$creadPrec :: ReadPrec BatchEvaluateFeatureResponse
readList :: ReadS [BatchEvaluateFeatureResponse]
$creadList :: ReadS [BatchEvaluateFeatureResponse]
readsPrec :: Int -> ReadS BatchEvaluateFeatureResponse
$creadsPrec :: Int -> ReadS BatchEvaluateFeatureResponse
Prelude.Read, Int -> BatchEvaluateFeatureResponse -> ShowS
[BatchEvaluateFeatureResponse] -> ShowS
BatchEvaluateFeatureResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchEvaluateFeatureResponse] -> ShowS
$cshowList :: [BatchEvaluateFeatureResponse] -> ShowS
show :: BatchEvaluateFeatureResponse -> String
$cshow :: BatchEvaluateFeatureResponse -> String
showsPrec :: Int -> BatchEvaluateFeatureResponse -> ShowS
$cshowsPrec :: Int -> BatchEvaluateFeatureResponse -> ShowS
Prelude.Show, forall x.
Rep BatchEvaluateFeatureResponse x -> BatchEvaluateFeatureResponse
forall x.
BatchEvaluateFeatureResponse -> Rep BatchEvaluateFeatureResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchEvaluateFeatureResponse x -> BatchEvaluateFeatureResponse
$cfrom :: forall x.
BatchEvaluateFeatureResponse -> Rep BatchEvaluateFeatureResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchEvaluateFeatureResponse' 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:
--
-- 'results', 'batchEvaluateFeatureResponse_results' - An array of structures, where each structure displays the results of one
-- feature evaluation assignment to one user session.
--
-- 'httpStatus', 'batchEvaluateFeatureResponse_httpStatus' - The response's http status code.
newBatchEvaluateFeatureResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchEvaluateFeatureResponse
newBatchEvaluateFeatureResponse :: Int -> BatchEvaluateFeatureResponse
newBatchEvaluateFeatureResponse Int
pHttpStatus_ =
  BatchEvaluateFeatureResponse'
    { $sel:results:BatchEvaluateFeatureResponse' :: Maybe [EvaluationResult]
results =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchEvaluateFeatureResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of structures, where each structure displays the results of one
-- feature evaluation assignment to one user session.
batchEvaluateFeatureResponse_results :: Lens.Lens' BatchEvaluateFeatureResponse (Prelude.Maybe [EvaluationResult])
batchEvaluateFeatureResponse_results :: Lens' BatchEvaluateFeatureResponse (Maybe [EvaluationResult])
batchEvaluateFeatureResponse_results = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchEvaluateFeatureResponse' {Maybe [EvaluationResult]
results :: Maybe [EvaluationResult]
$sel:results:BatchEvaluateFeatureResponse' :: BatchEvaluateFeatureResponse -> Maybe [EvaluationResult]
results} -> Maybe [EvaluationResult]
results) (\s :: BatchEvaluateFeatureResponse
s@BatchEvaluateFeatureResponse' {} Maybe [EvaluationResult]
a -> BatchEvaluateFeatureResponse
s {$sel:results:BatchEvaluateFeatureResponse' :: Maybe [EvaluationResult]
results = Maybe [EvaluationResult]
a} :: BatchEvaluateFeatureResponse) 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.
batchEvaluateFeatureResponse_httpStatus :: Lens.Lens' BatchEvaluateFeatureResponse Prelude.Int
batchEvaluateFeatureResponse_httpStatus :: Lens' BatchEvaluateFeatureResponse Int
batchEvaluateFeatureResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchEvaluateFeatureResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchEvaluateFeatureResponse' :: BatchEvaluateFeatureResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchEvaluateFeatureResponse
s@BatchEvaluateFeatureResponse' {} Int
a -> BatchEvaluateFeatureResponse
s {$sel:httpStatus:BatchEvaluateFeatureResponse' :: Int
httpStatus = Int
a} :: BatchEvaluateFeatureResponse)

instance Prelude.NFData BatchEvaluateFeatureResponse where
  rnf :: BatchEvaluateFeatureResponse -> ()
rnf BatchEvaluateFeatureResponse' {Int
Maybe [EvaluationResult]
httpStatus :: Int
results :: Maybe [EvaluationResult]
$sel:httpStatus:BatchEvaluateFeatureResponse' :: BatchEvaluateFeatureResponse -> Int
$sel:results:BatchEvaluateFeatureResponse' :: BatchEvaluateFeatureResponse -> Maybe [EvaluationResult]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EvaluationResult]
results
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus