{-# 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.UpdateMLModel
-- 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 @MLModelName@ and the @ScoreThreshold@ of an @MLModel@.
--
-- You can use the @GetMLModel@ operation to view the contents of the
-- updated data element.
module Amazonka.MachineLearning.UpdateMLModel
  ( -- * Creating a Request
    UpdateMLModel (..),
    newUpdateMLModel,

    -- * Request Lenses
    updateMLModel_mLModelName,
    updateMLModel_scoreThreshold,
    updateMLModel_mLModelId,

    -- * Destructuring the Response
    UpdateMLModelResponse (..),
    newUpdateMLModelResponse,

    -- * Response Lenses
    updateMLModelResponse_mLModelId,
    updateMLModelResponse_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:/ 'newUpdateMLModel' smart constructor.
data UpdateMLModel = UpdateMLModel'
  { -- | A user-supplied name or description of the @MLModel@.
    UpdateMLModel -> Maybe Text
mLModelName :: Prelude.Maybe Prelude.Text,
    -- | The @ScoreThreshold@ used in binary classification @MLModel@ that marks
    -- the boundary between a positive prediction and a negative prediction.
    --
    -- Output values greater than or equal to the @ScoreThreshold@ receive a
    -- positive result from the @MLModel@, such as @true@. Output values less
    -- than the @ScoreThreshold@ receive a negative response from the
    -- @MLModel@, such as @false@.
    UpdateMLModel -> Maybe Double
scoreThreshold :: Prelude.Maybe Prelude.Double,
    -- | The ID assigned to the @MLModel@ during creation.
    UpdateMLModel -> Text
mLModelId :: Prelude.Text
  }
  deriving (UpdateMLModel -> UpdateMLModel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMLModel -> UpdateMLModel -> Bool
$c/= :: UpdateMLModel -> UpdateMLModel -> Bool
== :: UpdateMLModel -> UpdateMLModel -> Bool
$c== :: UpdateMLModel -> UpdateMLModel -> Bool
Prelude.Eq, ReadPrec [UpdateMLModel]
ReadPrec UpdateMLModel
Int -> ReadS UpdateMLModel
ReadS [UpdateMLModel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMLModel]
$creadListPrec :: ReadPrec [UpdateMLModel]
readPrec :: ReadPrec UpdateMLModel
$creadPrec :: ReadPrec UpdateMLModel
readList :: ReadS [UpdateMLModel]
$creadList :: ReadS [UpdateMLModel]
readsPrec :: Int -> ReadS UpdateMLModel
$creadsPrec :: Int -> ReadS UpdateMLModel
Prelude.Read, Int -> UpdateMLModel -> ShowS
[UpdateMLModel] -> ShowS
UpdateMLModel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMLModel] -> ShowS
$cshowList :: [UpdateMLModel] -> ShowS
show :: UpdateMLModel -> String
$cshow :: UpdateMLModel -> String
showsPrec :: Int -> UpdateMLModel -> ShowS
$cshowsPrec :: Int -> UpdateMLModel -> ShowS
Prelude.Show, forall x. Rep UpdateMLModel x -> UpdateMLModel
forall x. UpdateMLModel -> Rep UpdateMLModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMLModel x -> UpdateMLModel
$cfrom :: forall x. UpdateMLModel -> Rep UpdateMLModel x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMLModel' 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:
--
-- 'mLModelName', 'updateMLModel_mLModelName' - A user-supplied name or description of the @MLModel@.
--
-- 'scoreThreshold', 'updateMLModel_scoreThreshold' - The @ScoreThreshold@ used in binary classification @MLModel@ that marks
-- the boundary between a positive prediction and a negative prediction.
--
-- Output values greater than or equal to the @ScoreThreshold@ receive a
-- positive result from the @MLModel@, such as @true@. Output values less
-- than the @ScoreThreshold@ receive a negative response from the
-- @MLModel@, such as @false@.
--
-- 'mLModelId', 'updateMLModel_mLModelId' - The ID assigned to the @MLModel@ during creation.
newUpdateMLModel ::
  -- | 'mLModelId'
  Prelude.Text ->
  UpdateMLModel
newUpdateMLModel :: Text -> UpdateMLModel
newUpdateMLModel Text
pMLModelId_ =
  UpdateMLModel'
    { $sel:mLModelName:UpdateMLModel' :: Maybe Text
mLModelName = forall a. Maybe a
Prelude.Nothing,
      $sel:scoreThreshold:UpdateMLModel' :: Maybe Double
scoreThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:mLModelId:UpdateMLModel' :: Text
mLModelId = Text
pMLModelId_
    }

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

-- | The @ScoreThreshold@ used in binary classification @MLModel@ that marks
-- the boundary between a positive prediction and a negative prediction.
--
-- Output values greater than or equal to the @ScoreThreshold@ receive a
-- positive result from the @MLModel@, such as @true@. Output values less
-- than the @ScoreThreshold@ receive a negative response from the
-- @MLModel@, such as @false@.
updateMLModel_scoreThreshold :: Lens.Lens' UpdateMLModel (Prelude.Maybe Prelude.Double)
updateMLModel_scoreThreshold :: Lens' UpdateMLModel (Maybe Double)
updateMLModel_scoreThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMLModel' {Maybe Double
scoreThreshold :: Maybe Double
$sel:scoreThreshold:UpdateMLModel' :: UpdateMLModel -> Maybe Double
scoreThreshold} -> Maybe Double
scoreThreshold) (\s :: UpdateMLModel
s@UpdateMLModel' {} Maybe Double
a -> UpdateMLModel
s {$sel:scoreThreshold:UpdateMLModel' :: Maybe Double
scoreThreshold = Maybe Double
a} :: UpdateMLModel)

-- | The ID assigned to the @MLModel@ during creation.
updateMLModel_mLModelId :: Lens.Lens' UpdateMLModel Prelude.Text
updateMLModel_mLModelId :: Lens' UpdateMLModel Text
updateMLModel_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMLModel' {Text
mLModelId :: Text
$sel:mLModelId:UpdateMLModel' :: UpdateMLModel -> Text
mLModelId} -> Text
mLModelId) (\s :: UpdateMLModel
s@UpdateMLModel' {} Text
a -> UpdateMLModel
s {$sel:mLModelId:UpdateMLModel' :: Text
mLModelId = Text
a} :: UpdateMLModel)

instance Core.AWSRequest UpdateMLModel where
  type
    AWSResponse UpdateMLModel =
      UpdateMLModelResponse
  request :: (Service -> Service) -> UpdateMLModel -> Request UpdateMLModel
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 UpdateMLModel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateMLModel)))
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 -> UpdateMLModelResponse
UpdateMLModelResponse'
            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
"MLModelId")
            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 UpdateMLModel where
  hashWithSalt :: Int -> UpdateMLModel -> Int
hashWithSalt Int
_salt UpdateMLModel' {Maybe Double
Maybe Text
Text
mLModelId :: Text
scoreThreshold :: Maybe Double
mLModelName :: Maybe Text
$sel:mLModelId:UpdateMLModel' :: UpdateMLModel -> Text
$sel:scoreThreshold:UpdateMLModel' :: UpdateMLModel -> Maybe Double
$sel:mLModelName:UpdateMLModel' :: UpdateMLModel -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mLModelName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
scoreThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mLModelId

instance Prelude.NFData UpdateMLModel where
  rnf :: UpdateMLModel -> ()
rnf UpdateMLModel' {Maybe Double
Maybe Text
Text
mLModelId :: Text
scoreThreshold :: Maybe Double
mLModelName :: Maybe Text
$sel:mLModelId:UpdateMLModel' :: UpdateMLModel -> Text
$sel:scoreThreshold:UpdateMLModel' :: UpdateMLModel -> Maybe Double
$sel:mLModelName:UpdateMLModel' :: UpdateMLModel -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mLModelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
scoreThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
mLModelId

instance Data.ToHeaders UpdateMLModel where
  toHeaders :: UpdateMLModel -> 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.UpdateMLModel" ::
                          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 UpdateMLModel where
  toJSON :: UpdateMLModel -> Value
toJSON UpdateMLModel' {Maybe Double
Maybe Text
Text
mLModelId :: Text
scoreThreshold :: Maybe Double
mLModelName :: Maybe Text
$sel:mLModelId:UpdateMLModel' :: UpdateMLModel -> Text
$sel:scoreThreshold:UpdateMLModel' :: UpdateMLModel -> Maybe Double
$sel:mLModelName:UpdateMLModel' :: UpdateMLModel -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MLModelName" 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
mLModelName,
            (Key
"ScoreThreshold" 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 Double
scoreThreshold,
            forall a. a -> Maybe a
Prelude.Just (Key
"MLModelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
mLModelId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateMLModelResponse' 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:
--
-- 'mLModelId', 'updateMLModelResponse_mLModelId' - The ID assigned to the @MLModel@ during creation. This value should be
-- identical to the value of the @MLModelID@ in the request.
--
-- 'httpStatus', 'updateMLModelResponse_httpStatus' - The response's http status code.
newUpdateMLModelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateMLModelResponse
newUpdateMLModelResponse :: Int -> UpdateMLModelResponse
newUpdateMLModelResponse Int
pHttpStatus_ =
  UpdateMLModelResponse'
    { $sel:mLModelId:UpdateMLModelResponse' :: Maybe Text
mLModelId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateMLModelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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