{-# 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.MachineLearning.CreateEvaluation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new @Evaluation@ of an @MLModel@. An @MLModel@ is evaluated on
-- a set of observations associated to a @DataSource@. Like a @DataSource@
-- for an @MLModel@, the @DataSource@ for an @Evaluation@ contains values
-- for the @Target Variable@. The @Evaluation@ compares the predicted
-- result for each observation to the actual outcome and provides a summary
-- so that you know how effective the @MLModel@ functions on the test data.
-- Evaluation generates a relevant performance metric, such as BinaryAUC,
-- RegressionRMSE or MulticlassAvgFScore based on the corresponding
-- @MLModelType@: @BINARY@, @REGRESSION@ or @MULTICLASS@.
--
-- @CreateEvaluation@ is an asynchronous operation. In response to
-- @CreateEvaluation@, Amazon Machine Learning (Amazon ML) immediately
-- returns and sets the evaluation status to @PENDING@. After the
-- @Evaluation@ is created and ready for use, Amazon ML sets the status to
-- @COMPLETED@.
--
-- You can use the @GetEvaluation@ operation to check progress of the
-- evaluation during the creation operation.
module Amazonka.MachineLearning.CreateEvaluation
  ( -- * Creating a Request
    CreateEvaluation (..),
    newCreateEvaluation,

    -- * Request Lenses
    createEvaluation_evaluationName,
    createEvaluation_evaluationId,
    createEvaluation_mLModelId,
    createEvaluation_evaluationDataSourceId,

    -- * Destructuring the Response
    CreateEvaluationResponse (..),
    newCreateEvaluationResponse,

    -- * Response Lenses
    createEvaluationResponse_evaluationId,
    createEvaluationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MachineLearning.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateEvaluation' smart constructor.
data CreateEvaluation = CreateEvaluation'
  { -- | A user-supplied name or description of the @Evaluation@.
    CreateEvaluation -> Maybe Text
evaluationName :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied ID that uniquely identifies the @Evaluation@.
    CreateEvaluation -> Text
evaluationId :: Prelude.Text,
    -- | The ID of the @MLModel@ to evaluate.
    --
    -- The schema used in creating the @MLModel@ must match the schema of the
    -- @DataSource@ used in the @Evaluation@.
    CreateEvaluation -> Text
mLModelId :: Prelude.Text,
    -- | The ID of the @DataSource@ for the evaluation. The schema of the
    -- @DataSource@ must match the schema used to create the @MLModel@.
    CreateEvaluation -> Text
evaluationDataSourceId :: Prelude.Text
  }
  deriving (CreateEvaluation -> CreateEvaluation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEvaluation -> CreateEvaluation -> Bool
$c/= :: CreateEvaluation -> CreateEvaluation -> Bool
== :: CreateEvaluation -> CreateEvaluation -> Bool
$c== :: CreateEvaluation -> CreateEvaluation -> Bool
Prelude.Eq, ReadPrec [CreateEvaluation]
ReadPrec CreateEvaluation
Int -> ReadS CreateEvaluation
ReadS [CreateEvaluation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEvaluation]
$creadListPrec :: ReadPrec [CreateEvaluation]
readPrec :: ReadPrec CreateEvaluation
$creadPrec :: ReadPrec CreateEvaluation
readList :: ReadS [CreateEvaluation]
$creadList :: ReadS [CreateEvaluation]
readsPrec :: Int -> ReadS CreateEvaluation
$creadsPrec :: Int -> ReadS CreateEvaluation
Prelude.Read, Int -> CreateEvaluation -> ShowS
[CreateEvaluation] -> ShowS
CreateEvaluation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEvaluation] -> ShowS
$cshowList :: [CreateEvaluation] -> ShowS
show :: CreateEvaluation -> String
$cshow :: CreateEvaluation -> String
showsPrec :: Int -> CreateEvaluation -> ShowS
$cshowsPrec :: Int -> CreateEvaluation -> ShowS
Prelude.Show, forall x. Rep CreateEvaluation x -> CreateEvaluation
forall x. CreateEvaluation -> Rep CreateEvaluation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEvaluation x -> CreateEvaluation
$cfrom :: forall x. CreateEvaluation -> Rep CreateEvaluation x
Prelude.Generic)

-- |
-- Create a value of 'CreateEvaluation' 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:
--
-- 'evaluationName', 'createEvaluation_evaluationName' - A user-supplied name or description of the @Evaluation@.
--
-- 'evaluationId', 'createEvaluation_evaluationId' - A user-supplied ID that uniquely identifies the @Evaluation@.
--
-- 'mLModelId', 'createEvaluation_mLModelId' - The ID of the @MLModel@ to evaluate.
--
-- The schema used in creating the @MLModel@ must match the schema of the
-- @DataSource@ used in the @Evaluation@.
--
-- 'evaluationDataSourceId', 'createEvaluation_evaluationDataSourceId' - The ID of the @DataSource@ for the evaluation. The schema of the
-- @DataSource@ must match the schema used to create the @MLModel@.
newCreateEvaluation ::
  -- | 'evaluationId'
  Prelude.Text ->
  -- | 'mLModelId'
  Prelude.Text ->
  -- | 'evaluationDataSourceId'
  Prelude.Text ->
  CreateEvaluation
newCreateEvaluation :: Text -> Text -> Text -> CreateEvaluation
newCreateEvaluation
  Text
pEvaluationId_
  Text
pMLModelId_
  Text
pEvaluationDataSourceId_ =
    CreateEvaluation'
      { $sel:evaluationName:CreateEvaluation' :: Maybe Text
evaluationName = forall a. Maybe a
Prelude.Nothing,
        $sel:evaluationId:CreateEvaluation' :: Text
evaluationId = Text
pEvaluationId_,
        $sel:mLModelId:CreateEvaluation' :: Text
mLModelId = Text
pMLModelId_,
        $sel:evaluationDataSourceId:CreateEvaluation' :: Text
evaluationDataSourceId = Text
pEvaluationDataSourceId_
      }

-- | A user-supplied name or description of the @Evaluation@.
createEvaluation_evaluationName :: Lens.Lens' CreateEvaluation (Prelude.Maybe Prelude.Text)
createEvaluation_evaluationName :: Lens' CreateEvaluation (Maybe Text)
createEvaluation_evaluationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEvaluation' {Maybe Text
evaluationName :: Maybe Text
$sel:evaluationName:CreateEvaluation' :: CreateEvaluation -> Maybe Text
evaluationName} -> Maybe Text
evaluationName) (\s :: CreateEvaluation
s@CreateEvaluation' {} Maybe Text
a -> CreateEvaluation
s {$sel:evaluationName:CreateEvaluation' :: Maybe Text
evaluationName = Maybe Text
a} :: CreateEvaluation)

-- | A user-supplied ID that uniquely identifies the @Evaluation@.
createEvaluation_evaluationId :: Lens.Lens' CreateEvaluation Prelude.Text
createEvaluation_evaluationId :: Lens' CreateEvaluation Text
createEvaluation_evaluationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEvaluation' {Text
evaluationId :: Text
$sel:evaluationId:CreateEvaluation' :: CreateEvaluation -> Text
evaluationId} -> Text
evaluationId) (\s :: CreateEvaluation
s@CreateEvaluation' {} Text
a -> CreateEvaluation
s {$sel:evaluationId:CreateEvaluation' :: Text
evaluationId = Text
a} :: CreateEvaluation)

-- | The ID of the @MLModel@ to evaluate.
--
-- The schema used in creating the @MLModel@ must match the schema of the
-- @DataSource@ used in the @Evaluation@.
createEvaluation_mLModelId :: Lens.Lens' CreateEvaluation Prelude.Text
createEvaluation_mLModelId :: Lens' CreateEvaluation Text
createEvaluation_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEvaluation' {Text
mLModelId :: Text
$sel:mLModelId:CreateEvaluation' :: CreateEvaluation -> Text
mLModelId} -> Text
mLModelId) (\s :: CreateEvaluation
s@CreateEvaluation' {} Text
a -> CreateEvaluation
s {$sel:mLModelId:CreateEvaluation' :: Text
mLModelId = Text
a} :: CreateEvaluation)

-- | The ID of the @DataSource@ for the evaluation. The schema of the
-- @DataSource@ must match the schema used to create the @MLModel@.
createEvaluation_evaluationDataSourceId :: Lens.Lens' CreateEvaluation Prelude.Text
createEvaluation_evaluationDataSourceId :: Lens' CreateEvaluation Text
createEvaluation_evaluationDataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEvaluation' {Text
evaluationDataSourceId :: Text
$sel:evaluationDataSourceId:CreateEvaluation' :: CreateEvaluation -> Text
evaluationDataSourceId} -> Text
evaluationDataSourceId) (\s :: CreateEvaluation
s@CreateEvaluation' {} Text
a -> CreateEvaluation
s {$sel:evaluationDataSourceId:CreateEvaluation' :: Text
evaluationDataSourceId = Text
a} :: CreateEvaluation)

instance Core.AWSRequest CreateEvaluation where
  type
    AWSResponse CreateEvaluation =
      CreateEvaluationResponse
  request :: (Service -> Service)
-> CreateEvaluation -> Request CreateEvaluation
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 CreateEvaluation
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateEvaluation)))
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 -> Int -> CreateEvaluationResponse
CreateEvaluationResponse'
            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
"EvaluationId")
            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 CreateEvaluation where
  hashWithSalt :: Int -> CreateEvaluation -> Int
hashWithSalt Int
_salt CreateEvaluation' {Maybe Text
Text
evaluationDataSourceId :: Text
mLModelId :: Text
evaluationId :: Text
evaluationName :: Maybe Text
$sel:evaluationDataSourceId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:mLModelId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:evaluationId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:evaluationName:CreateEvaluation' :: CreateEvaluation -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
evaluationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
evaluationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mLModelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
evaluationDataSourceId

instance Prelude.NFData CreateEvaluation where
  rnf :: CreateEvaluation -> ()
rnf CreateEvaluation' {Maybe Text
Text
evaluationDataSourceId :: Text
mLModelId :: Text
evaluationId :: Text
evaluationName :: Maybe Text
$sel:evaluationDataSourceId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:mLModelId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:evaluationId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:evaluationName:CreateEvaluation' :: CreateEvaluation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
evaluationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
evaluationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
mLModelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
evaluationDataSourceId

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

instance Data.ToJSON CreateEvaluation where
  toJSON :: CreateEvaluation -> Value
toJSON CreateEvaluation' {Maybe Text
Text
evaluationDataSourceId :: Text
mLModelId :: Text
evaluationId :: Text
evaluationName :: Maybe Text
$sel:evaluationDataSourceId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:mLModelId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:evaluationId:CreateEvaluation' :: CreateEvaluation -> Text
$sel:evaluationName:CreateEvaluation' :: CreateEvaluation -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EvaluationName" 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 Text
evaluationName,
            forall a. a -> Maybe a
Prelude.Just (Key
"EvaluationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
evaluationId),
            forall a. a -> Maybe a
Prelude.Just (Key
"MLModelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
mLModelId),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"EvaluationDataSourceId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
evaluationDataSourceId
              )
          ]
      )

instance Data.ToPath CreateEvaluation where
  toPath :: CreateEvaluation -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | Represents the output of a @CreateEvaluation@ operation, and is an
-- acknowledgement that Amazon ML received the request.
--
-- @CreateEvaluation@ operation is asynchronous. You can poll for status
-- updates by using the @GetEvcaluation@ operation and checking the
-- @Status@ parameter.
--
-- /See:/ 'newCreateEvaluationResponse' smart constructor.
data CreateEvaluationResponse = CreateEvaluationResponse'
  { -- | The user-supplied ID that uniquely identifies the @Evaluation@. This
    -- value should be identical to the value of the @EvaluationId@ in the
    -- request.
    CreateEvaluationResponse -> Maybe Text
evaluationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateEvaluationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateEvaluationResponse -> CreateEvaluationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEvaluationResponse -> CreateEvaluationResponse -> Bool
$c/= :: CreateEvaluationResponse -> CreateEvaluationResponse -> Bool
== :: CreateEvaluationResponse -> CreateEvaluationResponse -> Bool
$c== :: CreateEvaluationResponse -> CreateEvaluationResponse -> Bool
Prelude.Eq, ReadPrec [CreateEvaluationResponse]
ReadPrec CreateEvaluationResponse
Int -> ReadS CreateEvaluationResponse
ReadS [CreateEvaluationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEvaluationResponse]
$creadListPrec :: ReadPrec [CreateEvaluationResponse]
readPrec :: ReadPrec CreateEvaluationResponse
$creadPrec :: ReadPrec CreateEvaluationResponse
readList :: ReadS [CreateEvaluationResponse]
$creadList :: ReadS [CreateEvaluationResponse]
readsPrec :: Int -> ReadS CreateEvaluationResponse
$creadsPrec :: Int -> ReadS CreateEvaluationResponse
Prelude.Read, Int -> CreateEvaluationResponse -> ShowS
[CreateEvaluationResponse] -> ShowS
CreateEvaluationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEvaluationResponse] -> ShowS
$cshowList :: [CreateEvaluationResponse] -> ShowS
show :: CreateEvaluationResponse -> String
$cshow :: CreateEvaluationResponse -> String
showsPrec :: Int -> CreateEvaluationResponse -> ShowS
$cshowsPrec :: Int -> CreateEvaluationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateEvaluationResponse x -> CreateEvaluationResponse
forall x.
CreateEvaluationResponse -> Rep CreateEvaluationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateEvaluationResponse x -> CreateEvaluationResponse
$cfrom :: forall x.
CreateEvaluationResponse -> Rep CreateEvaluationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateEvaluationResponse' 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:
--
-- 'evaluationId', 'createEvaluationResponse_evaluationId' - The user-supplied ID that uniquely identifies the @Evaluation@. This
-- value should be identical to the value of the @EvaluationId@ in the
-- request.
--
-- 'httpStatus', 'createEvaluationResponse_httpStatus' - The response's http status code.
newCreateEvaluationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateEvaluationResponse
newCreateEvaluationResponse :: Int -> CreateEvaluationResponse
newCreateEvaluationResponse Int
pHttpStatus_ =
  CreateEvaluationResponse'
    { $sel:evaluationId:CreateEvaluationResponse' :: Maybe Text
evaluationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateEvaluationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The user-supplied ID that uniquely identifies the @Evaluation@. This
-- value should be identical to the value of the @EvaluationId@ in the
-- request.
createEvaluationResponse_evaluationId :: Lens.Lens' CreateEvaluationResponse (Prelude.Maybe Prelude.Text)
createEvaluationResponse_evaluationId :: Lens' CreateEvaluationResponse (Maybe Text)
createEvaluationResponse_evaluationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEvaluationResponse' {Maybe Text
evaluationId :: Maybe Text
$sel:evaluationId:CreateEvaluationResponse' :: CreateEvaluationResponse -> Maybe Text
evaluationId} -> Maybe Text
evaluationId) (\s :: CreateEvaluationResponse
s@CreateEvaluationResponse' {} Maybe Text
a -> CreateEvaluationResponse
s {$sel:evaluationId:CreateEvaluationResponse' :: Maybe Text
evaluationId = Maybe Text
a} :: CreateEvaluationResponse)

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

instance Prelude.NFData CreateEvaluationResponse where
  rnf :: CreateEvaluationResponse -> ()
rnf CreateEvaluationResponse' {Int
Maybe Text
httpStatus :: Int
evaluationId :: Maybe Text
$sel:httpStatus:CreateEvaluationResponse' :: CreateEvaluationResponse -> Int
$sel:evaluationId:CreateEvaluationResponse' :: CreateEvaluationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
evaluationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus