{-# 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.UpdateEvaluation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the @EvaluationName@ of an @Evaluation@.
--
-- You can use the @GetEvaluation@ operation to view the contents of the
-- updated data element.
module Amazonka.MachineLearning.UpdateEvaluation
  ( -- * Creating a Request
    UpdateEvaluation (..),
    newUpdateEvaluation,

    -- * Request Lenses
    updateEvaluation_evaluationId,
    updateEvaluation_evaluationName,

    -- * Destructuring the Response
    UpdateEvaluationResponse (..),
    newUpdateEvaluationResponse,

    -- * Response Lenses
    updateEvaluationResponse_evaluationId,
    updateEvaluationResponse_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:/ 'newUpdateEvaluation' smart constructor.
data UpdateEvaluation = UpdateEvaluation'
  { -- | The ID assigned to the @Evaluation@ during creation.
    UpdateEvaluation -> Text
evaluationId :: Prelude.Text,
    -- | A new user-supplied name or description of the @Evaluation@ that will
    -- replace the current content.
    UpdateEvaluation -> Text
evaluationName :: Prelude.Text
  }
  deriving (UpdateEvaluation -> UpdateEvaluation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEvaluation -> UpdateEvaluation -> Bool
$c/= :: UpdateEvaluation -> UpdateEvaluation -> Bool
== :: UpdateEvaluation -> UpdateEvaluation -> Bool
$c== :: UpdateEvaluation -> UpdateEvaluation -> Bool
Prelude.Eq, ReadPrec [UpdateEvaluation]
ReadPrec UpdateEvaluation
Int -> ReadS UpdateEvaluation
ReadS [UpdateEvaluation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEvaluation]
$creadListPrec :: ReadPrec [UpdateEvaluation]
readPrec :: ReadPrec UpdateEvaluation
$creadPrec :: ReadPrec UpdateEvaluation
readList :: ReadS [UpdateEvaluation]
$creadList :: ReadS [UpdateEvaluation]
readsPrec :: Int -> ReadS UpdateEvaluation
$creadsPrec :: Int -> ReadS UpdateEvaluation
Prelude.Read, Int -> UpdateEvaluation -> ShowS
[UpdateEvaluation] -> ShowS
UpdateEvaluation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEvaluation] -> ShowS
$cshowList :: [UpdateEvaluation] -> ShowS
show :: UpdateEvaluation -> String
$cshow :: UpdateEvaluation -> String
showsPrec :: Int -> UpdateEvaluation -> ShowS
$cshowsPrec :: Int -> UpdateEvaluation -> ShowS
Prelude.Show, forall x. Rep UpdateEvaluation x -> UpdateEvaluation
forall x. UpdateEvaluation -> Rep UpdateEvaluation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateEvaluation x -> UpdateEvaluation
$cfrom :: forall x. UpdateEvaluation -> Rep UpdateEvaluation x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEvaluation' 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', 'updateEvaluation_evaluationId' - The ID assigned to the @Evaluation@ during creation.
--
-- 'evaluationName', 'updateEvaluation_evaluationName' - A new user-supplied name or description of the @Evaluation@ that will
-- replace the current content.
newUpdateEvaluation ::
  -- | 'evaluationId'
  Prelude.Text ->
  -- | 'evaluationName'
  Prelude.Text ->
  UpdateEvaluation
newUpdateEvaluation :: Text -> Text -> UpdateEvaluation
newUpdateEvaluation Text
pEvaluationId_ Text
pEvaluationName_ =
  UpdateEvaluation'
    { $sel:evaluationId:UpdateEvaluation' :: Text
evaluationId = Text
pEvaluationId_,
      $sel:evaluationName:UpdateEvaluation' :: Text
evaluationName = Text
pEvaluationName_
    }

-- | The ID assigned to the @Evaluation@ during creation.
updateEvaluation_evaluationId :: Lens.Lens' UpdateEvaluation Prelude.Text
updateEvaluation_evaluationId :: Lens' UpdateEvaluation Text
updateEvaluation_evaluationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEvaluation' {Text
evaluationId :: Text
$sel:evaluationId:UpdateEvaluation' :: UpdateEvaluation -> Text
evaluationId} -> Text
evaluationId) (\s :: UpdateEvaluation
s@UpdateEvaluation' {} Text
a -> UpdateEvaluation
s {$sel:evaluationId:UpdateEvaluation' :: Text
evaluationId = Text
a} :: UpdateEvaluation)

-- | A new user-supplied name or description of the @Evaluation@ that will
-- replace the current content.
updateEvaluation_evaluationName :: Lens.Lens' UpdateEvaluation Prelude.Text
updateEvaluation_evaluationName :: Lens' UpdateEvaluation Text
updateEvaluation_evaluationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEvaluation' {Text
evaluationName :: Text
$sel:evaluationName:UpdateEvaluation' :: UpdateEvaluation -> Text
evaluationName} -> Text
evaluationName) (\s :: UpdateEvaluation
s@UpdateEvaluation' {} Text
a -> UpdateEvaluation
s {$sel:evaluationName:UpdateEvaluation' :: Text
evaluationName = Text
a} :: UpdateEvaluation)

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

instance Prelude.NFData UpdateEvaluation where
  rnf :: UpdateEvaluation -> ()
rnf UpdateEvaluation' {Text
evaluationName :: Text
evaluationId :: Text
$sel:evaluationName:UpdateEvaluation' :: UpdateEvaluation -> Text
$sel:evaluationId:UpdateEvaluation' :: UpdateEvaluation -> Text
..} =
    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
evaluationName

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

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

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

-- | Represents the output of an @UpdateEvaluation@ operation.
--
-- You can see the updated content by using the @GetEvaluation@ operation.
--
-- /See:/ 'newUpdateEvaluationResponse' smart constructor.
data UpdateEvaluationResponse = UpdateEvaluationResponse'
  { -- | The ID assigned to the @Evaluation@ during creation. This value should
    -- be identical to the value of the @Evaluation@ in the request.
    UpdateEvaluationResponse -> Maybe Text
evaluationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateEvaluationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateEvaluationResponse -> UpdateEvaluationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEvaluationResponse -> UpdateEvaluationResponse -> Bool
$c/= :: UpdateEvaluationResponse -> UpdateEvaluationResponse -> Bool
== :: UpdateEvaluationResponse -> UpdateEvaluationResponse -> Bool
$c== :: UpdateEvaluationResponse -> UpdateEvaluationResponse -> Bool
Prelude.Eq, ReadPrec [UpdateEvaluationResponse]
ReadPrec UpdateEvaluationResponse
Int -> ReadS UpdateEvaluationResponse
ReadS [UpdateEvaluationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEvaluationResponse]
$creadListPrec :: ReadPrec [UpdateEvaluationResponse]
readPrec :: ReadPrec UpdateEvaluationResponse
$creadPrec :: ReadPrec UpdateEvaluationResponse
readList :: ReadS [UpdateEvaluationResponse]
$creadList :: ReadS [UpdateEvaluationResponse]
readsPrec :: Int -> ReadS UpdateEvaluationResponse
$creadsPrec :: Int -> ReadS UpdateEvaluationResponse
Prelude.Read, Int -> UpdateEvaluationResponse -> ShowS
[UpdateEvaluationResponse] -> ShowS
UpdateEvaluationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEvaluationResponse] -> ShowS
$cshowList :: [UpdateEvaluationResponse] -> ShowS
show :: UpdateEvaluationResponse -> String
$cshow :: UpdateEvaluationResponse -> String
showsPrec :: Int -> UpdateEvaluationResponse -> ShowS
$cshowsPrec :: Int -> UpdateEvaluationResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateEvaluationResponse x -> UpdateEvaluationResponse
forall x.
UpdateEvaluationResponse -> Rep UpdateEvaluationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateEvaluationResponse x -> UpdateEvaluationResponse
$cfrom :: forall x.
UpdateEvaluationResponse -> Rep UpdateEvaluationResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEvaluationResponse' 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', 'updateEvaluationResponse_evaluationId' - The ID assigned to the @Evaluation@ during creation. This value should
-- be identical to the value of the @Evaluation@ in the request.
--
-- 'httpStatus', 'updateEvaluationResponse_httpStatus' - The response's http status code.
newUpdateEvaluationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateEvaluationResponse
newUpdateEvaluationResponse :: Int -> UpdateEvaluationResponse
newUpdateEvaluationResponse Int
pHttpStatus_ =
  UpdateEvaluationResponse'
    { $sel:evaluationId:UpdateEvaluationResponse' :: Maybe Text
evaluationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateEvaluationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID assigned to the @Evaluation@ during creation. This value should
-- be identical to the value of the @Evaluation@ in the request.
updateEvaluationResponse_evaluationId :: Lens.Lens' UpdateEvaluationResponse (Prelude.Maybe Prelude.Text)
updateEvaluationResponse_evaluationId :: Lens' UpdateEvaluationResponse (Maybe Text)
updateEvaluationResponse_evaluationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEvaluationResponse' {Maybe Text
evaluationId :: Maybe Text
$sel:evaluationId:UpdateEvaluationResponse' :: UpdateEvaluationResponse -> Maybe Text
evaluationId} -> Maybe Text
evaluationId) (\s :: UpdateEvaluationResponse
s@UpdateEvaluationResponse' {} Maybe Text
a -> UpdateEvaluationResponse
s {$sel:evaluationId:UpdateEvaluationResponse' :: Maybe Text
evaluationId = Maybe Text
a} :: UpdateEvaluationResponse)

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

instance Prelude.NFData UpdateEvaluationResponse where
  rnf :: UpdateEvaluationResponse -> ()
rnf UpdateEvaluationResponse' {Int
Maybe Text
httpStatus :: Int
evaluationId :: Maybe Text
$sel:httpStatus:UpdateEvaluationResponse' :: UpdateEvaluationResponse -> Int
$sel:evaluationId:UpdateEvaluationResponse' :: UpdateEvaluationResponse -> 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