{-# 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.CreateBatchPrediction
-- 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 predictions for a group of observations. The observations to
-- process exist in one or more data files referenced by a @DataSource@.
-- This operation creates a new @BatchPrediction@, and uses an @MLModel@
-- and the data files referenced by the @DataSource@ as information
-- sources.
--
-- @CreateBatchPrediction@ is an asynchronous operation. In response to
-- @CreateBatchPrediction@, Amazon Machine Learning (Amazon ML) immediately
-- returns and sets the @BatchPrediction@ status to @PENDING@. After the
-- @BatchPrediction@ completes, Amazon ML sets the status to @COMPLETED@.
--
-- You can poll for status updates by using the GetBatchPrediction
-- operation and checking the @Status@ parameter of the result. After the
-- @COMPLETED@ status appears, the results are available in the location
-- specified by the @OutputUri@ parameter.
module Amazonka.MachineLearning.CreateBatchPrediction
  ( -- * Creating a Request
    CreateBatchPrediction (..),
    newCreateBatchPrediction,

    -- * Request Lenses
    createBatchPrediction_batchPredictionName,
    createBatchPrediction_batchPredictionId,
    createBatchPrediction_mLModelId,
    createBatchPrediction_batchPredictionDataSourceId,
    createBatchPrediction_outputUri,

    -- * Destructuring the Response
    CreateBatchPredictionResponse (..),
    newCreateBatchPredictionResponse,

    -- * Response Lenses
    createBatchPredictionResponse_batchPredictionId,
    createBatchPredictionResponse_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:/ 'newCreateBatchPrediction' smart constructor.
data CreateBatchPrediction = CreateBatchPrediction'
  { -- | A user-supplied name or description of the @BatchPrediction@.
    -- @BatchPredictionName@ can only use the UTF-8 character set.
    CreateBatchPrediction -> Maybe Text
batchPredictionName :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied ID that uniquely identifies the @BatchPrediction@.
    CreateBatchPrediction -> Text
batchPredictionId :: Prelude.Text,
    -- | The ID of the @MLModel@ that will generate predictions for the group of
    -- observations.
    CreateBatchPrediction -> Text
mLModelId :: Prelude.Text,
    -- | The ID of the @DataSource@ that points to the group of observations to
    -- predict.
    CreateBatchPrediction -> Text
batchPredictionDataSourceId :: Prelude.Text,
    -- | The location of an Amazon Simple Storage Service (Amazon S3) bucket or
    -- directory to store the batch prediction results. The following
    -- substrings are not allowed in the @s3 key@ portion of the @outputURI@
    -- field: \':\', \'\/\/\', \'\/.\/\', \'\/..\/\'.
    --
    -- Amazon ML needs permissions to store and retrieve the logs on your
    -- behalf. For information about how to set permissions, see the
    -- <https://docs.aws.amazon.com/machine-learning/latest/dg Amazon Machine Learning Developer Guide>.
    CreateBatchPrediction -> Text
outputUri :: Prelude.Text
  }
  deriving (CreateBatchPrediction -> CreateBatchPrediction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBatchPrediction -> CreateBatchPrediction -> Bool
$c/= :: CreateBatchPrediction -> CreateBatchPrediction -> Bool
== :: CreateBatchPrediction -> CreateBatchPrediction -> Bool
$c== :: CreateBatchPrediction -> CreateBatchPrediction -> Bool
Prelude.Eq, ReadPrec [CreateBatchPrediction]
ReadPrec CreateBatchPrediction
Int -> ReadS CreateBatchPrediction
ReadS [CreateBatchPrediction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBatchPrediction]
$creadListPrec :: ReadPrec [CreateBatchPrediction]
readPrec :: ReadPrec CreateBatchPrediction
$creadPrec :: ReadPrec CreateBatchPrediction
readList :: ReadS [CreateBatchPrediction]
$creadList :: ReadS [CreateBatchPrediction]
readsPrec :: Int -> ReadS CreateBatchPrediction
$creadsPrec :: Int -> ReadS CreateBatchPrediction
Prelude.Read, Int -> CreateBatchPrediction -> ShowS
[CreateBatchPrediction] -> ShowS
CreateBatchPrediction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBatchPrediction] -> ShowS
$cshowList :: [CreateBatchPrediction] -> ShowS
show :: CreateBatchPrediction -> String
$cshow :: CreateBatchPrediction -> String
showsPrec :: Int -> CreateBatchPrediction -> ShowS
$cshowsPrec :: Int -> CreateBatchPrediction -> ShowS
Prelude.Show, forall x. Rep CreateBatchPrediction x -> CreateBatchPrediction
forall x. CreateBatchPrediction -> Rep CreateBatchPrediction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBatchPrediction x -> CreateBatchPrediction
$cfrom :: forall x. CreateBatchPrediction -> Rep CreateBatchPrediction x
Prelude.Generic)

-- |
-- Create a value of 'CreateBatchPrediction' 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:
--
-- 'batchPredictionName', 'createBatchPrediction_batchPredictionName' - A user-supplied name or description of the @BatchPrediction@.
-- @BatchPredictionName@ can only use the UTF-8 character set.
--
-- 'batchPredictionId', 'createBatchPrediction_batchPredictionId' - A user-supplied ID that uniquely identifies the @BatchPrediction@.
--
-- 'mLModelId', 'createBatchPrediction_mLModelId' - The ID of the @MLModel@ that will generate predictions for the group of
-- observations.
--
-- 'batchPredictionDataSourceId', 'createBatchPrediction_batchPredictionDataSourceId' - The ID of the @DataSource@ that points to the group of observations to
-- predict.
--
-- 'outputUri', 'createBatchPrediction_outputUri' - The location of an Amazon Simple Storage Service (Amazon S3) bucket or
-- directory to store the batch prediction results. The following
-- substrings are not allowed in the @s3 key@ portion of the @outputURI@
-- field: \':\', \'\/\/\', \'\/.\/\', \'\/..\/\'.
--
-- Amazon ML needs permissions to store and retrieve the logs on your
-- behalf. For information about how to set permissions, see the
-- <https://docs.aws.amazon.com/machine-learning/latest/dg Amazon Machine Learning Developer Guide>.
newCreateBatchPrediction ::
  -- | 'batchPredictionId'
  Prelude.Text ->
  -- | 'mLModelId'
  Prelude.Text ->
  -- | 'batchPredictionDataSourceId'
  Prelude.Text ->
  -- | 'outputUri'
  Prelude.Text ->
  CreateBatchPrediction
newCreateBatchPrediction :: Text -> Text -> Text -> Text -> CreateBatchPrediction
newCreateBatchPrediction
  Text
pBatchPredictionId_
  Text
pMLModelId_
  Text
pBatchPredictionDataSourceId_
  Text
pOutputUri_ =
    CreateBatchPrediction'
      { $sel:batchPredictionName:CreateBatchPrediction' :: Maybe Text
batchPredictionName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:batchPredictionId:CreateBatchPrediction' :: Text
batchPredictionId = Text
pBatchPredictionId_,
        $sel:mLModelId:CreateBatchPrediction' :: Text
mLModelId = Text
pMLModelId_,
        $sel:batchPredictionDataSourceId:CreateBatchPrediction' :: Text
batchPredictionDataSourceId =
          Text
pBatchPredictionDataSourceId_,
        $sel:outputUri:CreateBatchPrediction' :: Text
outputUri = Text
pOutputUri_
      }

-- | A user-supplied name or description of the @BatchPrediction@.
-- @BatchPredictionName@ can only use the UTF-8 character set.
createBatchPrediction_batchPredictionName :: Lens.Lens' CreateBatchPrediction (Prelude.Maybe Prelude.Text)
createBatchPrediction_batchPredictionName :: Lens' CreateBatchPrediction (Maybe Text)
createBatchPrediction_batchPredictionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBatchPrediction' {Maybe Text
batchPredictionName :: Maybe Text
$sel:batchPredictionName:CreateBatchPrediction' :: CreateBatchPrediction -> Maybe Text
batchPredictionName} -> Maybe Text
batchPredictionName) (\s :: CreateBatchPrediction
s@CreateBatchPrediction' {} Maybe Text
a -> CreateBatchPrediction
s {$sel:batchPredictionName:CreateBatchPrediction' :: Maybe Text
batchPredictionName = Maybe Text
a} :: CreateBatchPrediction)

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

-- | The ID of the @MLModel@ that will generate predictions for the group of
-- observations.
createBatchPrediction_mLModelId :: Lens.Lens' CreateBatchPrediction Prelude.Text
createBatchPrediction_mLModelId :: Lens' CreateBatchPrediction Text
createBatchPrediction_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBatchPrediction' {Text
mLModelId :: Text
$sel:mLModelId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
mLModelId} -> Text
mLModelId) (\s :: CreateBatchPrediction
s@CreateBatchPrediction' {} Text
a -> CreateBatchPrediction
s {$sel:mLModelId:CreateBatchPrediction' :: Text
mLModelId = Text
a} :: CreateBatchPrediction)

-- | The ID of the @DataSource@ that points to the group of observations to
-- predict.
createBatchPrediction_batchPredictionDataSourceId :: Lens.Lens' CreateBatchPrediction Prelude.Text
createBatchPrediction_batchPredictionDataSourceId :: Lens' CreateBatchPrediction Text
createBatchPrediction_batchPredictionDataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBatchPrediction' {Text
batchPredictionDataSourceId :: Text
$sel:batchPredictionDataSourceId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
batchPredictionDataSourceId} -> Text
batchPredictionDataSourceId) (\s :: CreateBatchPrediction
s@CreateBatchPrediction' {} Text
a -> CreateBatchPrediction
s {$sel:batchPredictionDataSourceId:CreateBatchPrediction' :: Text
batchPredictionDataSourceId = Text
a} :: CreateBatchPrediction)

-- | The location of an Amazon Simple Storage Service (Amazon S3) bucket or
-- directory to store the batch prediction results. The following
-- substrings are not allowed in the @s3 key@ portion of the @outputURI@
-- field: \':\', \'\/\/\', \'\/.\/\', \'\/..\/\'.
--
-- Amazon ML needs permissions to store and retrieve the logs on your
-- behalf. For information about how to set permissions, see the
-- <https://docs.aws.amazon.com/machine-learning/latest/dg Amazon Machine Learning Developer Guide>.
createBatchPrediction_outputUri :: Lens.Lens' CreateBatchPrediction Prelude.Text
createBatchPrediction_outputUri :: Lens' CreateBatchPrediction Text
createBatchPrediction_outputUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBatchPrediction' {Text
outputUri :: Text
$sel:outputUri:CreateBatchPrediction' :: CreateBatchPrediction -> Text
outputUri} -> Text
outputUri) (\s :: CreateBatchPrediction
s@CreateBatchPrediction' {} Text
a -> CreateBatchPrediction
s {$sel:outputUri:CreateBatchPrediction' :: Text
outputUri = Text
a} :: CreateBatchPrediction)

instance Core.AWSRequest CreateBatchPrediction where
  type
    AWSResponse CreateBatchPrediction =
      CreateBatchPredictionResponse
  request :: (Service -> Service)
-> CreateBatchPrediction -> Request CreateBatchPrediction
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 CreateBatchPrediction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateBatchPrediction)))
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 -> CreateBatchPredictionResponse
CreateBatchPredictionResponse'
            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
"BatchPredictionId")
            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 CreateBatchPrediction where
  hashWithSalt :: Int -> CreateBatchPrediction -> Int
hashWithSalt Int
_salt CreateBatchPrediction' {Maybe Text
Text
outputUri :: Text
batchPredictionDataSourceId :: Text
mLModelId :: Text
batchPredictionId :: Text
batchPredictionName :: Maybe Text
$sel:outputUri:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionDataSourceId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:mLModelId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionName:CreateBatchPrediction' :: CreateBatchPrediction -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
batchPredictionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
batchPredictionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mLModelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
batchPredictionDataSourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
outputUri

instance Prelude.NFData CreateBatchPrediction where
  rnf :: CreateBatchPrediction -> ()
rnf CreateBatchPrediction' {Maybe Text
Text
outputUri :: Text
batchPredictionDataSourceId :: Text
mLModelId :: Text
batchPredictionId :: Text
batchPredictionName :: Maybe Text
$sel:outputUri:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionDataSourceId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:mLModelId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionName:CreateBatchPrediction' :: CreateBatchPrediction -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
batchPredictionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
batchPredictionId
      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
batchPredictionDataSourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
outputUri

instance Data.ToHeaders CreateBatchPrediction where
  toHeaders :: CreateBatchPrediction -> 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.CreateBatchPrediction" ::
                          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 CreateBatchPrediction where
  toJSON :: CreateBatchPrediction -> Value
toJSON CreateBatchPrediction' {Maybe Text
Text
outputUri :: Text
batchPredictionDataSourceId :: Text
mLModelId :: Text
batchPredictionId :: Text
batchPredictionName :: Maybe Text
$sel:outputUri:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionDataSourceId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:mLModelId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionId:CreateBatchPrediction' :: CreateBatchPrediction -> Text
$sel:batchPredictionName:CreateBatchPrediction' :: CreateBatchPrediction -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BatchPredictionName" 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
batchPredictionName,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"BatchPredictionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
batchPredictionId),
            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
"BatchPredictionDataSourceId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
batchPredictionDataSourceId
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"OutputUri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
outputUri)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateBatchPredictionResponse' 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:
--
-- 'batchPredictionId', 'createBatchPredictionResponse_batchPredictionId' - A user-supplied ID that uniquely identifies the @BatchPrediction@. This
-- value is identical to the value of the @BatchPredictionId@ in the
-- request.
--
-- 'httpStatus', 'createBatchPredictionResponse_httpStatus' - The response's http status code.
newCreateBatchPredictionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBatchPredictionResponse
newCreateBatchPredictionResponse :: Int -> CreateBatchPredictionResponse
newCreateBatchPredictionResponse Int
pHttpStatus_ =
  CreateBatchPredictionResponse'
    { $sel:batchPredictionId:CreateBatchPredictionResponse' :: Maybe Text
batchPredictionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBatchPredictionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A user-supplied ID that uniquely identifies the @BatchPrediction@. This
-- value is identical to the value of the @BatchPredictionId@ in the
-- request.
createBatchPredictionResponse_batchPredictionId :: Lens.Lens' CreateBatchPredictionResponse (Prelude.Maybe Prelude.Text)
createBatchPredictionResponse_batchPredictionId :: Lens' CreateBatchPredictionResponse (Maybe Text)
createBatchPredictionResponse_batchPredictionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBatchPredictionResponse' {Maybe Text
batchPredictionId :: Maybe Text
$sel:batchPredictionId:CreateBatchPredictionResponse' :: CreateBatchPredictionResponse -> Maybe Text
batchPredictionId} -> Maybe Text
batchPredictionId) (\s :: CreateBatchPredictionResponse
s@CreateBatchPredictionResponse' {} Maybe Text
a -> CreateBatchPredictionResponse
s {$sel:batchPredictionId:CreateBatchPredictionResponse' :: Maybe Text
batchPredictionId = Maybe Text
a} :: CreateBatchPredictionResponse)

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

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