{-# 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.Predict
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates a prediction for the observation using the specified
-- @ML Model@.
--
-- __Note:__ Not all response parameters will be populated. Whether a
-- response parameter is populated depends on the type of model requested.
module Amazonka.MachineLearning.Predict
  ( -- * Creating a Request
    Predict (..),
    newPredict,

    -- * Request Lenses
    predict_mLModelId,
    predict_record,
    predict_predictEndpoint,

    -- * Destructuring the Response
    PredictResponse (..),
    newPredictResponse,

    -- * Response Lenses
    predictResponse_prediction,
    predictResponse_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:/ 'newPredict' smart constructor.
data Predict = Predict'
  { -- | A unique identifier of the @MLModel@.
    Predict -> Text
mLModelId :: Prelude.Text,
    Predict -> HashMap Text Text
record :: Prelude.HashMap Prelude.Text Prelude.Text,
    Predict -> Text
predictEndpoint :: Prelude.Text
  }
  deriving (Predict -> Predict -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Predict -> Predict -> Bool
$c/= :: Predict -> Predict -> Bool
== :: Predict -> Predict -> Bool
$c== :: Predict -> Predict -> Bool
Prelude.Eq, ReadPrec [Predict]
ReadPrec Predict
Int -> ReadS Predict
ReadS [Predict]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Predict]
$creadListPrec :: ReadPrec [Predict]
readPrec :: ReadPrec Predict
$creadPrec :: ReadPrec Predict
readList :: ReadS [Predict]
$creadList :: ReadS [Predict]
readsPrec :: Int -> ReadS Predict
$creadsPrec :: Int -> ReadS Predict
Prelude.Read, Int -> Predict -> ShowS
[Predict] -> ShowS
Predict -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Predict] -> ShowS
$cshowList :: [Predict] -> ShowS
show :: Predict -> String
$cshow :: Predict -> String
showsPrec :: Int -> Predict -> ShowS
$cshowsPrec :: Int -> Predict -> ShowS
Prelude.Show, forall x. Rep Predict x -> Predict
forall x. Predict -> Rep Predict x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Predict x -> Predict
$cfrom :: forall x. Predict -> Rep Predict x
Prelude.Generic)

-- |
-- Create a value of 'Predict' 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', 'predict_mLModelId' - A unique identifier of the @MLModel@.
--
-- 'record', 'predict_record' - Undocumented member.
--
-- 'predictEndpoint', 'predict_predictEndpoint' - Undocumented member.
newPredict ::
  -- | 'mLModelId'
  Prelude.Text ->
  -- | 'predictEndpoint'
  Prelude.Text ->
  Predict
newPredict :: Text -> Text -> Predict
newPredict Text
pMLModelId_ Text
pPredictEndpoint_ =
  Predict'
    { $sel:mLModelId:Predict' :: Text
mLModelId = Text
pMLModelId_,
      $sel:record:Predict' :: HashMap Text Text
record = forall a. Monoid a => a
Prelude.mempty,
      $sel:predictEndpoint:Predict' :: Text
predictEndpoint = Text
pPredictEndpoint_
    }

-- | A unique identifier of the @MLModel@.
predict_mLModelId :: Lens.Lens' Predict Prelude.Text
predict_mLModelId :: Lens' Predict Text
predict_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Predict' {Text
mLModelId :: Text
$sel:mLModelId:Predict' :: Predict -> Text
mLModelId} -> Text
mLModelId) (\s :: Predict
s@Predict' {} Text
a -> Predict
s {$sel:mLModelId:Predict' :: Text
mLModelId = Text
a} :: Predict)

-- | Undocumented member.
predict_record :: Lens.Lens' Predict (Prelude.HashMap Prelude.Text Prelude.Text)
predict_record :: Lens' Predict (HashMap Text Text)
predict_record = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Predict' {HashMap Text Text
record :: HashMap Text Text
$sel:record:Predict' :: Predict -> HashMap Text Text
record} -> HashMap Text Text
record) (\s :: Predict
s@Predict' {} HashMap Text Text
a -> Predict
s {$sel:record:Predict' :: HashMap Text Text
record = HashMap Text Text
a} :: Predict) 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

-- | Undocumented member.
predict_predictEndpoint :: Lens.Lens' Predict Prelude.Text
predict_predictEndpoint :: Lens' Predict Text
predict_predictEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Predict' {Text
predictEndpoint :: Text
$sel:predictEndpoint:Predict' :: Predict -> Text
predictEndpoint} -> Text
predictEndpoint) (\s :: Predict
s@Predict' {} Text
a -> Predict
s {$sel:predictEndpoint:Predict' :: Text
predictEndpoint = Text
a} :: Predict)

instance Core.AWSRequest Predict where
  type AWSResponse Predict = PredictResponse
  request :: (Service -> Service) -> Predict -> Request Predict
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 Predict
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Predict)))
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 Prediction -> Int -> PredictResponse
PredictResponse'
            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
"Prediction")
            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 Predict where
  hashWithSalt :: Int -> Predict -> Int
hashWithSalt Int
_salt Predict' {Text
HashMap Text Text
predictEndpoint :: Text
record :: HashMap Text Text
mLModelId :: Text
$sel:predictEndpoint:Predict' :: Predict -> Text
$sel:record:Predict' :: Predict -> HashMap Text Text
$sel:mLModelId:Predict' :: Predict -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mLModelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
record
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
predictEndpoint

instance Prelude.NFData Predict where
  rnf :: Predict -> ()
rnf Predict' {Text
HashMap Text Text
predictEndpoint :: Text
record :: HashMap Text Text
mLModelId :: Text
$sel:predictEndpoint:Predict' :: Predict -> Text
$sel:record:Predict' :: Predict -> HashMap Text Text
$sel:mLModelId:Predict' :: Predict -> Text
..} =
    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 HashMap Text Text
record
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
predictEndpoint

instance Data.ToHeaders Predict where
  toHeaders :: Predict -> 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.Predict" :: 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 Predict where
  toJSON :: Predict -> Value
toJSON Predict' {Text
HashMap Text Text
predictEndpoint :: Text
record :: HashMap Text Text
mLModelId :: Text
$sel:predictEndpoint:Predict' :: Predict -> Text
$sel:record:Predict' :: Predict -> HashMap Text Text
$sel:mLModelId:Predict' :: Predict -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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
"Record" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text Text
record),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PredictEndpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
predictEndpoint)
          ]
      )

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

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

-- | /See:/ 'newPredictResponse' smart constructor.
data PredictResponse = PredictResponse'
  { PredictResponse -> Maybe Prediction
prediction :: Prelude.Maybe Prediction,
    -- | The response's http status code.
    PredictResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PredictResponse -> PredictResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PredictResponse -> PredictResponse -> Bool
$c/= :: PredictResponse -> PredictResponse -> Bool
== :: PredictResponse -> PredictResponse -> Bool
$c== :: PredictResponse -> PredictResponse -> Bool
Prelude.Eq, ReadPrec [PredictResponse]
ReadPrec PredictResponse
Int -> ReadS PredictResponse
ReadS [PredictResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PredictResponse]
$creadListPrec :: ReadPrec [PredictResponse]
readPrec :: ReadPrec PredictResponse
$creadPrec :: ReadPrec PredictResponse
readList :: ReadS [PredictResponse]
$creadList :: ReadS [PredictResponse]
readsPrec :: Int -> ReadS PredictResponse
$creadsPrec :: Int -> ReadS PredictResponse
Prelude.Read, Int -> PredictResponse -> ShowS
[PredictResponse] -> ShowS
PredictResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PredictResponse] -> ShowS
$cshowList :: [PredictResponse] -> ShowS
show :: PredictResponse -> String
$cshow :: PredictResponse -> String
showsPrec :: Int -> PredictResponse -> ShowS
$cshowsPrec :: Int -> PredictResponse -> ShowS
Prelude.Show, forall x. Rep PredictResponse x -> PredictResponse
forall x. PredictResponse -> Rep PredictResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PredictResponse x -> PredictResponse
$cfrom :: forall x. PredictResponse -> Rep PredictResponse x
Prelude.Generic)

-- |
-- Create a value of 'PredictResponse' 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:
--
-- 'prediction', 'predictResponse_prediction' - Undocumented member.
--
-- 'httpStatus', 'predictResponse_httpStatus' - The response's http status code.
newPredictResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PredictResponse
newPredictResponse :: Int -> PredictResponse
newPredictResponse Int
pHttpStatus_ =
  PredictResponse'
    { $sel:prediction:PredictResponse' :: Maybe Prediction
prediction = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PredictResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
predictResponse_prediction :: Lens.Lens' PredictResponse (Prelude.Maybe Prediction)
predictResponse_prediction :: Lens' PredictResponse (Maybe Prediction)
predictResponse_prediction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PredictResponse' {Maybe Prediction
prediction :: Maybe Prediction
$sel:prediction:PredictResponse' :: PredictResponse -> Maybe Prediction
prediction} -> Maybe Prediction
prediction) (\s :: PredictResponse
s@PredictResponse' {} Maybe Prediction
a -> PredictResponse
s {$sel:prediction:PredictResponse' :: Maybe Prediction
prediction = Maybe Prediction
a} :: PredictResponse)

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

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