{-# 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.GetBatchPrediction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a @BatchPrediction@ that includes detailed metadata, status, and
-- data file information for a @Batch Prediction@ request.
module Amazonka.MachineLearning.GetBatchPrediction
  ( -- * Creating a Request
    GetBatchPrediction (..),
    newGetBatchPrediction,

    -- * Request Lenses
    getBatchPrediction_batchPredictionId,

    -- * Destructuring the Response
    GetBatchPredictionResponse (..),
    newGetBatchPredictionResponse,

    -- * Response Lenses
    getBatchPredictionResponse_batchPredictionDataSourceId,
    getBatchPredictionResponse_batchPredictionId,
    getBatchPredictionResponse_computeTime,
    getBatchPredictionResponse_createdAt,
    getBatchPredictionResponse_createdByIamUser,
    getBatchPredictionResponse_finishedAt,
    getBatchPredictionResponse_inputDataLocationS3,
    getBatchPredictionResponse_invalidRecordCount,
    getBatchPredictionResponse_lastUpdatedAt,
    getBatchPredictionResponse_logUri,
    getBatchPredictionResponse_mLModelId,
    getBatchPredictionResponse_message,
    getBatchPredictionResponse_name,
    getBatchPredictionResponse_outputUri,
    getBatchPredictionResponse_startedAt,
    getBatchPredictionResponse_status,
    getBatchPredictionResponse_totalRecordCount,
    getBatchPredictionResponse_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:/ 'newGetBatchPrediction' smart constructor.
data GetBatchPrediction = GetBatchPrediction'
  { -- | An ID assigned to the @BatchPrediction@ at creation.
    GetBatchPrediction -> Text
batchPredictionId :: Prelude.Text
  }
  deriving (GetBatchPrediction -> GetBatchPrediction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBatchPrediction -> GetBatchPrediction -> Bool
$c/= :: GetBatchPrediction -> GetBatchPrediction -> Bool
== :: GetBatchPrediction -> GetBatchPrediction -> Bool
$c== :: GetBatchPrediction -> GetBatchPrediction -> Bool
Prelude.Eq, ReadPrec [GetBatchPrediction]
ReadPrec GetBatchPrediction
Int -> ReadS GetBatchPrediction
ReadS [GetBatchPrediction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBatchPrediction]
$creadListPrec :: ReadPrec [GetBatchPrediction]
readPrec :: ReadPrec GetBatchPrediction
$creadPrec :: ReadPrec GetBatchPrediction
readList :: ReadS [GetBatchPrediction]
$creadList :: ReadS [GetBatchPrediction]
readsPrec :: Int -> ReadS GetBatchPrediction
$creadsPrec :: Int -> ReadS GetBatchPrediction
Prelude.Read, Int -> GetBatchPrediction -> ShowS
[GetBatchPrediction] -> ShowS
GetBatchPrediction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBatchPrediction] -> ShowS
$cshowList :: [GetBatchPrediction] -> ShowS
show :: GetBatchPrediction -> String
$cshow :: GetBatchPrediction -> String
showsPrec :: Int -> GetBatchPrediction -> ShowS
$cshowsPrec :: Int -> GetBatchPrediction -> ShowS
Prelude.Show, forall x. Rep GetBatchPrediction x -> GetBatchPrediction
forall x. GetBatchPrediction -> Rep GetBatchPrediction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBatchPrediction x -> GetBatchPrediction
$cfrom :: forall x. GetBatchPrediction -> Rep GetBatchPrediction x
Prelude.Generic)

-- |
-- Create a value of 'GetBatchPrediction' 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', 'getBatchPrediction_batchPredictionId' - An ID assigned to the @BatchPrediction@ at creation.
newGetBatchPrediction ::
  -- | 'batchPredictionId'
  Prelude.Text ->
  GetBatchPrediction
newGetBatchPrediction :: Text -> GetBatchPrediction
newGetBatchPrediction Text
pBatchPredictionId_ =
  GetBatchPrediction'
    { $sel:batchPredictionId:GetBatchPrediction' :: Text
batchPredictionId =
        Text
pBatchPredictionId_
    }

-- | An ID assigned to the @BatchPrediction@ at creation.
getBatchPrediction_batchPredictionId :: Lens.Lens' GetBatchPrediction Prelude.Text
getBatchPrediction_batchPredictionId :: Lens' GetBatchPrediction Text
getBatchPrediction_batchPredictionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPrediction' {Text
batchPredictionId :: Text
$sel:batchPredictionId:GetBatchPrediction' :: GetBatchPrediction -> Text
batchPredictionId} -> Text
batchPredictionId) (\s :: GetBatchPrediction
s@GetBatchPrediction' {} Text
a -> GetBatchPrediction
s {$sel:batchPredictionId:GetBatchPrediction' :: Text
batchPredictionId = Text
a} :: GetBatchPrediction)

instance Core.AWSRequest GetBatchPrediction where
  type
    AWSResponse GetBatchPrediction =
      GetBatchPredictionResponse
  request :: (Service -> Service)
-> GetBatchPrediction -> Request GetBatchPrediction
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 GetBatchPrediction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBatchPrediction)))
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
-> Maybe Text
-> Maybe Integer
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Integer
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe EntityStatus
-> Maybe Integer
-> Int
-> GetBatchPredictionResponse
GetBatchPredictionResponse'
            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
"BatchPredictionDataSourceId")
            forall (f :: * -> *) a b. Applicative f => 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ComputeTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreatedByIamUser")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FinishedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"InputDataLocationS3")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"InvalidRecordCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastUpdatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LogUri")
            forall (f :: * -> *) a b. Applicative f => 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Message")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"OutputUri")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StartedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TotalRecordCount")
            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 GetBatchPrediction where
  hashWithSalt :: Int -> GetBatchPrediction -> Int
hashWithSalt Int
_salt GetBatchPrediction' {Text
batchPredictionId :: Text
$sel:batchPredictionId:GetBatchPrediction' :: GetBatchPrediction -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
batchPredictionId

instance Prelude.NFData GetBatchPrediction where
  rnf :: GetBatchPrediction -> ()
rnf GetBatchPrediction' {Text
batchPredictionId :: Text
$sel:batchPredictionId:GetBatchPrediction' :: GetBatchPrediction -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
batchPredictionId

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

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

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

-- | Represents the output of a @GetBatchPrediction@ operation and describes
-- a @BatchPrediction@.
--
-- /See:/ 'newGetBatchPredictionResponse' smart constructor.
data GetBatchPredictionResponse = GetBatchPredictionResponse'
  { -- | The ID of the @DataSource@ that was used to create the
    -- @BatchPrediction@.
    GetBatchPredictionResponse -> Maybe Text
batchPredictionDataSourceId :: Prelude.Maybe Prelude.Text,
    -- | An ID assigned to the @BatchPrediction@ at creation. This value should
    -- be identical to the value of the @BatchPredictionID@ in the request.
    GetBatchPredictionResponse -> Maybe Text
batchPredictionId :: Prelude.Maybe Prelude.Text,
    -- | The approximate CPU time in milliseconds that Amazon Machine Learning
    -- spent processing the @BatchPrediction@, normalized and scaled on
    -- computation resources. @ComputeTime@ is only available if the
    -- @BatchPrediction@ is in the @COMPLETED@ state.
    GetBatchPredictionResponse -> Maybe Integer
computeTime :: Prelude.Maybe Prelude.Integer,
    -- | The time when the @BatchPrediction@ was created. The time is expressed
    -- in epoch time.
    GetBatchPredictionResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The AWS user account that invoked the @BatchPrediction@. The account
    -- type can be either an AWS root account or an AWS Identity and Access
    -- Management (IAM) user account.
    GetBatchPredictionResponse -> Maybe Text
createdByIamUser :: Prelude.Maybe Prelude.Text,
    -- | The epoch time when Amazon Machine Learning marked the @BatchPrediction@
    -- as @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
    -- @BatchPrediction@ is in the @COMPLETED@ or @FAILED@ state.
    GetBatchPredictionResponse -> Maybe POSIX
finishedAt :: Prelude.Maybe Data.POSIX,
    -- | The location of the data file or directory in Amazon Simple Storage
    -- Service (Amazon S3).
    GetBatchPredictionResponse -> Maybe Text
inputDataLocationS3 :: Prelude.Maybe Prelude.Text,
    -- | The number of invalid records that Amazon Machine Learning saw while
    -- processing the @BatchPrediction@.
    GetBatchPredictionResponse -> Maybe Integer
invalidRecordCount :: Prelude.Maybe Prelude.Integer,
    -- | The time of the most recent edit to @BatchPrediction@. The time is
    -- expressed in epoch time.
    GetBatchPredictionResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | A link to the file that contains logs of the @CreateBatchPrediction@
    -- operation.
    GetBatchPredictionResponse -> Maybe Text
logUri :: Prelude.Maybe Prelude.Text,
    -- | The ID of the @MLModel@ that generated predictions for the
    -- @BatchPrediction@ request.
    GetBatchPredictionResponse -> Maybe Text
mLModelId :: Prelude.Maybe Prelude.Text,
    -- | A description of the most recent details about processing the batch
    -- prediction request.
    GetBatchPredictionResponse -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied name or description of the @BatchPrediction@.
    GetBatchPredictionResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The location of an Amazon S3 bucket or directory to receive the
    -- operation results.
    GetBatchPredictionResponse -> Maybe Text
outputUri :: Prelude.Maybe Prelude.Text,
    -- | The epoch time when Amazon Machine Learning marked the @BatchPrediction@
    -- as @INPROGRESS@. @StartedAt@ isn\'t available if the @BatchPrediction@
    -- is in the @PENDING@ state.
    GetBatchPredictionResponse -> Maybe POSIX
startedAt :: Prelude.Maybe Data.POSIX,
    -- | The status of the @BatchPrediction@, which can be one of the following
    -- values:
    --
    -- -   @PENDING@ - Amazon Machine Learning (Amazon ML) submitted a request
    --     to generate batch predictions.
    --
    -- -   @INPROGRESS@ - The batch predictions are in progress.
    --
    -- -   @FAILED@ - The request to perform a batch prediction did not run to
    --     completion. It is not usable.
    --
    -- -   @COMPLETED@ - The batch prediction process completed successfully.
    --
    -- -   @DELETED@ - The @BatchPrediction@ is marked as deleted. It is not
    --     usable.
    GetBatchPredictionResponse -> Maybe EntityStatus
status :: Prelude.Maybe EntityStatus,
    -- | The number of total records that Amazon Machine Learning saw while
    -- processing the @BatchPrediction@.
    GetBatchPredictionResponse -> Maybe Integer
totalRecordCount :: Prelude.Maybe Prelude.Integer,
    -- | The response's http status code.
    GetBatchPredictionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBatchPredictionResponse -> GetBatchPredictionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBatchPredictionResponse -> GetBatchPredictionResponse -> Bool
$c/= :: GetBatchPredictionResponse -> GetBatchPredictionResponse -> Bool
== :: GetBatchPredictionResponse -> GetBatchPredictionResponse -> Bool
$c== :: GetBatchPredictionResponse -> GetBatchPredictionResponse -> Bool
Prelude.Eq, ReadPrec [GetBatchPredictionResponse]
ReadPrec GetBatchPredictionResponse
Int -> ReadS GetBatchPredictionResponse
ReadS [GetBatchPredictionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBatchPredictionResponse]
$creadListPrec :: ReadPrec [GetBatchPredictionResponse]
readPrec :: ReadPrec GetBatchPredictionResponse
$creadPrec :: ReadPrec GetBatchPredictionResponse
readList :: ReadS [GetBatchPredictionResponse]
$creadList :: ReadS [GetBatchPredictionResponse]
readsPrec :: Int -> ReadS GetBatchPredictionResponse
$creadsPrec :: Int -> ReadS GetBatchPredictionResponse
Prelude.Read, Int -> GetBatchPredictionResponse -> ShowS
[GetBatchPredictionResponse] -> ShowS
GetBatchPredictionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBatchPredictionResponse] -> ShowS
$cshowList :: [GetBatchPredictionResponse] -> ShowS
show :: GetBatchPredictionResponse -> String
$cshow :: GetBatchPredictionResponse -> String
showsPrec :: Int -> GetBatchPredictionResponse -> ShowS
$cshowsPrec :: Int -> GetBatchPredictionResponse -> ShowS
Prelude.Show, forall x.
Rep GetBatchPredictionResponse x -> GetBatchPredictionResponse
forall x.
GetBatchPredictionResponse -> Rep GetBatchPredictionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBatchPredictionResponse x -> GetBatchPredictionResponse
$cfrom :: forall x.
GetBatchPredictionResponse -> Rep GetBatchPredictionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBatchPredictionResponse' 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:
--
-- 'batchPredictionDataSourceId', 'getBatchPredictionResponse_batchPredictionDataSourceId' - The ID of the @DataSource@ that was used to create the
-- @BatchPrediction@.
--
-- 'batchPredictionId', 'getBatchPredictionResponse_batchPredictionId' - An ID assigned to the @BatchPrediction@ at creation. This value should
-- be identical to the value of the @BatchPredictionID@ in the request.
--
-- 'computeTime', 'getBatchPredictionResponse_computeTime' - The approximate CPU time in milliseconds that Amazon Machine Learning
-- spent processing the @BatchPrediction@, normalized and scaled on
-- computation resources. @ComputeTime@ is only available if the
-- @BatchPrediction@ is in the @COMPLETED@ state.
--
-- 'createdAt', 'getBatchPredictionResponse_createdAt' - The time when the @BatchPrediction@ was created. The time is expressed
-- in epoch time.
--
-- 'createdByIamUser', 'getBatchPredictionResponse_createdByIamUser' - The AWS user account that invoked the @BatchPrediction@. The account
-- type can be either an AWS root account or an AWS Identity and Access
-- Management (IAM) user account.
--
-- 'finishedAt', 'getBatchPredictionResponse_finishedAt' - The epoch time when Amazon Machine Learning marked the @BatchPrediction@
-- as @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
-- @BatchPrediction@ is in the @COMPLETED@ or @FAILED@ state.
--
-- 'inputDataLocationS3', 'getBatchPredictionResponse_inputDataLocationS3' - The location of the data file or directory in Amazon Simple Storage
-- Service (Amazon S3).
--
-- 'invalidRecordCount', 'getBatchPredictionResponse_invalidRecordCount' - The number of invalid records that Amazon Machine Learning saw while
-- processing the @BatchPrediction@.
--
-- 'lastUpdatedAt', 'getBatchPredictionResponse_lastUpdatedAt' - The time of the most recent edit to @BatchPrediction@. The time is
-- expressed in epoch time.
--
-- 'logUri', 'getBatchPredictionResponse_logUri' - A link to the file that contains logs of the @CreateBatchPrediction@
-- operation.
--
-- 'mLModelId', 'getBatchPredictionResponse_mLModelId' - The ID of the @MLModel@ that generated predictions for the
-- @BatchPrediction@ request.
--
-- 'message', 'getBatchPredictionResponse_message' - A description of the most recent details about processing the batch
-- prediction request.
--
-- 'name', 'getBatchPredictionResponse_name' - A user-supplied name or description of the @BatchPrediction@.
--
-- 'outputUri', 'getBatchPredictionResponse_outputUri' - The location of an Amazon S3 bucket or directory to receive the
-- operation results.
--
-- 'startedAt', 'getBatchPredictionResponse_startedAt' - The epoch time when Amazon Machine Learning marked the @BatchPrediction@
-- as @INPROGRESS@. @StartedAt@ isn\'t available if the @BatchPrediction@
-- is in the @PENDING@ state.
--
-- 'status', 'getBatchPredictionResponse_status' - The status of the @BatchPrediction@, which can be one of the following
-- values:
--
-- -   @PENDING@ - Amazon Machine Learning (Amazon ML) submitted a request
--     to generate batch predictions.
--
-- -   @INPROGRESS@ - The batch predictions are in progress.
--
-- -   @FAILED@ - The request to perform a batch prediction did not run to
--     completion. It is not usable.
--
-- -   @COMPLETED@ - The batch prediction process completed successfully.
--
-- -   @DELETED@ - The @BatchPrediction@ is marked as deleted. It is not
--     usable.
--
-- 'totalRecordCount', 'getBatchPredictionResponse_totalRecordCount' - The number of total records that Amazon Machine Learning saw while
-- processing the @BatchPrediction@.
--
-- 'httpStatus', 'getBatchPredictionResponse_httpStatus' - The response's http status code.
newGetBatchPredictionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBatchPredictionResponse
newGetBatchPredictionResponse :: Int -> GetBatchPredictionResponse
newGetBatchPredictionResponse Int
pHttpStatus_ =
  GetBatchPredictionResponse'
    { $sel:batchPredictionDataSourceId:GetBatchPredictionResponse' :: Maybe Text
batchPredictionDataSourceId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:batchPredictionId:GetBatchPredictionResponse' :: Maybe Text
batchPredictionId = forall a. Maybe a
Prelude.Nothing,
      $sel:computeTime:GetBatchPredictionResponse' :: Maybe Integer
computeTime = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:GetBatchPredictionResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:createdByIamUser:GetBatchPredictionResponse' :: Maybe Text
createdByIamUser = forall a. Maybe a
Prelude.Nothing,
      $sel:finishedAt:GetBatchPredictionResponse' :: Maybe POSIX
finishedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:inputDataLocationS3:GetBatchPredictionResponse' :: Maybe Text
inputDataLocationS3 = forall a. Maybe a
Prelude.Nothing,
      $sel:invalidRecordCount:GetBatchPredictionResponse' :: Maybe Integer
invalidRecordCount = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:GetBatchPredictionResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:logUri:GetBatchPredictionResponse' :: Maybe Text
logUri = forall a. Maybe a
Prelude.Nothing,
      $sel:mLModelId:GetBatchPredictionResponse' :: Maybe Text
mLModelId = forall a. Maybe a
Prelude.Nothing,
      $sel:message:GetBatchPredictionResponse' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetBatchPredictionResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:outputUri:GetBatchPredictionResponse' :: Maybe Text
outputUri = forall a. Maybe a
Prelude.Nothing,
      $sel:startedAt:GetBatchPredictionResponse' :: Maybe POSIX
startedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetBatchPredictionResponse' :: Maybe EntityStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:totalRecordCount:GetBatchPredictionResponse' :: Maybe Integer
totalRecordCount = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBatchPredictionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the @DataSource@ that was used to create the
-- @BatchPrediction@.
getBatchPredictionResponse_batchPredictionDataSourceId :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_batchPredictionDataSourceId :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_batchPredictionDataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
batchPredictionDataSourceId :: Maybe Text
$sel:batchPredictionDataSourceId:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
batchPredictionDataSourceId} -> Maybe Text
batchPredictionDataSourceId) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:batchPredictionDataSourceId:GetBatchPredictionResponse' :: Maybe Text
batchPredictionDataSourceId = Maybe Text
a} :: GetBatchPredictionResponse)

-- | An ID assigned to the @BatchPrediction@ at creation. This value should
-- be identical to the value of the @BatchPredictionID@ in the request.
getBatchPredictionResponse_batchPredictionId :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_batchPredictionId :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_batchPredictionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
batchPredictionId :: Maybe Text
$sel:batchPredictionId:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
batchPredictionId} -> Maybe Text
batchPredictionId) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:batchPredictionId:GetBatchPredictionResponse' :: Maybe Text
batchPredictionId = Maybe Text
a} :: GetBatchPredictionResponse)

-- | The approximate CPU time in milliseconds that Amazon Machine Learning
-- spent processing the @BatchPrediction@, normalized and scaled on
-- computation resources. @ComputeTime@ is only available if the
-- @BatchPrediction@ is in the @COMPLETED@ state.
getBatchPredictionResponse_computeTime :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Integer)
getBatchPredictionResponse_computeTime :: Lens' GetBatchPredictionResponse (Maybe Integer)
getBatchPredictionResponse_computeTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Integer
computeTime :: Maybe Integer
$sel:computeTime:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Integer
computeTime} -> Maybe Integer
computeTime) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Integer
a -> GetBatchPredictionResponse
s {$sel:computeTime:GetBatchPredictionResponse' :: Maybe Integer
computeTime = Maybe Integer
a} :: GetBatchPredictionResponse)

-- | The time when the @BatchPrediction@ was created. The time is expressed
-- in epoch time.
getBatchPredictionResponse_createdAt :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.UTCTime)
getBatchPredictionResponse_createdAt :: Lens' GetBatchPredictionResponse (Maybe UTCTime)
getBatchPredictionResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe POSIX
a -> GetBatchPredictionResponse
s {$sel:createdAt:GetBatchPredictionResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: GetBatchPredictionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The AWS user account that invoked the @BatchPrediction@. The account
-- type can be either an AWS root account or an AWS Identity and Access
-- Management (IAM) user account.
getBatchPredictionResponse_createdByIamUser :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_createdByIamUser :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_createdByIamUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
createdByIamUser :: Maybe Text
$sel:createdByIamUser:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
createdByIamUser} -> Maybe Text
createdByIamUser) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:createdByIamUser:GetBatchPredictionResponse' :: Maybe Text
createdByIamUser = Maybe Text
a} :: GetBatchPredictionResponse)

-- | The epoch time when Amazon Machine Learning marked the @BatchPrediction@
-- as @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
-- @BatchPrediction@ is in the @COMPLETED@ or @FAILED@ state.
getBatchPredictionResponse_finishedAt :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.UTCTime)
getBatchPredictionResponse_finishedAt :: Lens' GetBatchPredictionResponse (Maybe UTCTime)
getBatchPredictionResponse_finishedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe POSIX
finishedAt :: Maybe POSIX
$sel:finishedAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
finishedAt} -> Maybe POSIX
finishedAt) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe POSIX
a -> GetBatchPredictionResponse
s {$sel:finishedAt:GetBatchPredictionResponse' :: Maybe POSIX
finishedAt = Maybe POSIX
a} :: GetBatchPredictionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The location of the data file or directory in Amazon Simple Storage
-- Service (Amazon S3).
getBatchPredictionResponse_inputDataLocationS3 :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_inputDataLocationS3 :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_inputDataLocationS3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
inputDataLocationS3 :: Maybe Text
$sel:inputDataLocationS3:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
inputDataLocationS3} -> Maybe Text
inputDataLocationS3) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:inputDataLocationS3:GetBatchPredictionResponse' :: Maybe Text
inputDataLocationS3 = Maybe Text
a} :: GetBatchPredictionResponse)

-- | The number of invalid records that Amazon Machine Learning saw while
-- processing the @BatchPrediction@.
getBatchPredictionResponse_invalidRecordCount :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Integer)
getBatchPredictionResponse_invalidRecordCount :: Lens' GetBatchPredictionResponse (Maybe Integer)
getBatchPredictionResponse_invalidRecordCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Integer
invalidRecordCount :: Maybe Integer
$sel:invalidRecordCount:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Integer
invalidRecordCount} -> Maybe Integer
invalidRecordCount) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Integer
a -> GetBatchPredictionResponse
s {$sel:invalidRecordCount:GetBatchPredictionResponse' :: Maybe Integer
invalidRecordCount = Maybe Integer
a} :: GetBatchPredictionResponse)

-- | The time of the most recent edit to @BatchPrediction@. The time is
-- expressed in epoch time.
getBatchPredictionResponse_lastUpdatedAt :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.UTCTime)
getBatchPredictionResponse_lastUpdatedAt :: Lens' GetBatchPredictionResponse (Maybe UTCTime)
getBatchPredictionResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe POSIX
a -> GetBatchPredictionResponse
s {$sel:lastUpdatedAt:GetBatchPredictionResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: GetBatchPredictionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A link to the file that contains logs of the @CreateBatchPrediction@
-- operation.
getBatchPredictionResponse_logUri :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_logUri :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_logUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
logUri :: Maybe Text
$sel:logUri:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
logUri} -> Maybe Text
logUri) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:logUri:GetBatchPredictionResponse' :: Maybe Text
logUri = Maybe Text
a} :: GetBatchPredictionResponse)

-- | The ID of the @MLModel@ that generated predictions for the
-- @BatchPrediction@ request.
getBatchPredictionResponse_mLModelId :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_mLModelId :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
mLModelId :: Maybe Text
$sel:mLModelId:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
mLModelId} -> Maybe Text
mLModelId) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:mLModelId:GetBatchPredictionResponse' :: Maybe Text
mLModelId = Maybe Text
a} :: GetBatchPredictionResponse)

-- | A description of the most recent details about processing the batch
-- prediction request.
getBatchPredictionResponse_message :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_message :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
message :: Maybe Text
$sel:message:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
message} -> Maybe Text
message) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:message:GetBatchPredictionResponse' :: Maybe Text
message = Maybe Text
a} :: GetBatchPredictionResponse)

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

-- | The location of an Amazon S3 bucket or directory to receive the
-- operation results.
getBatchPredictionResponse_outputUri :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Text)
getBatchPredictionResponse_outputUri :: Lens' GetBatchPredictionResponse (Maybe Text)
getBatchPredictionResponse_outputUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Text
outputUri :: Maybe Text
$sel:outputUri:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
outputUri} -> Maybe Text
outputUri) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Text
a -> GetBatchPredictionResponse
s {$sel:outputUri:GetBatchPredictionResponse' :: Maybe Text
outputUri = Maybe Text
a} :: GetBatchPredictionResponse)

-- | The epoch time when Amazon Machine Learning marked the @BatchPrediction@
-- as @INPROGRESS@. @StartedAt@ isn\'t available if the @BatchPrediction@
-- is in the @PENDING@ state.
getBatchPredictionResponse_startedAt :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.UTCTime)
getBatchPredictionResponse_startedAt :: Lens' GetBatchPredictionResponse (Maybe UTCTime)
getBatchPredictionResponse_startedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe POSIX
startedAt :: Maybe POSIX
$sel:startedAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
startedAt} -> Maybe POSIX
startedAt) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe POSIX
a -> GetBatchPredictionResponse
s {$sel:startedAt:GetBatchPredictionResponse' :: Maybe POSIX
startedAt = Maybe POSIX
a} :: GetBatchPredictionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the @BatchPrediction@, which can be one of the following
-- values:
--
-- -   @PENDING@ - Amazon Machine Learning (Amazon ML) submitted a request
--     to generate batch predictions.
--
-- -   @INPROGRESS@ - The batch predictions are in progress.
--
-- -   @FAILED@ - The request to perform a batch prediction did not run to
--     completion. It is not usable.
--
-- -   @COMPLETED@ - The batch prediction process completed successfully.
--
-- -   @DELETED@ - The @BatchPrediction@ is marked as deleted. It is not
--     usable.
getBatchPredictionResponse_status :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe EntityStatus)
getBatchPredictionResponse_status :: Lens' GetBatchPredictionResponse (Maybe EntityStatus)
getBatchPredictionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe EntityStatus
status :: Maybe EntityStatus
$sel:status:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe EntityStatus
status} -> Maybe EntityStatus
status) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe EntityStatus
a -> GetBatchPredictionResponse
s {$sel:status:GetBatchPredictionResponse' :: Maybe EntityStatus
status = Maybe EntityStatus
a} :: GetBatchPredictionResponse)

-- | The number of total records that Amazon Machine Learning saw while
-- processing the @BatchPrediction@.
getBatchPredictionResponse_totalRecordCount :: Lens.Lens' GetBatchPredictionResponse (Prelude.Maybe Prelude.Integer)
getBatchPredictionResponse_totalRecordCount :: Lens' GetBatchPredictionResponse (Maybe Integer)
getBatchPredictionResponse_totalRecordCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchPredictionResponse' {Maybe Integer
totalRecordCount :: Maybe Integer
$sel:totalRecordCount:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Integer
totalRecordCount} -> Maybe Integer
totalRecordCount) (\s :: GetBatchPredictionResponse
s@GetBatchPredictionResponse' {} Maybe Integer
a -> GetBatchPredictionResponse
s {$sel:totalRecordCount:GetBatchPredictionResponse' :: Maybe Integer
totalRecordCount = Maybe Integer
a} :: GetBatchPredictionResponse)

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

instance Prelude.NFData GetBatchPredictionResponse where
  rnf :: GetBatchPredictionResponse -> ()
rnf GetBatchPredictionResponse' {Int
Maybe Integer
Maybe Text
Maybe POSIX
Maybe EntityStatus
httpStatus :: Int
totalRecordCount :: Maybe Integer
status :: Maybe EntityStatus
startedAt :: Maybe POSIX
outputUri :: Maybe Text
name :: Maybe Text
message :: Maybe Text
mLModelId :: Maybe Text
logUri :: Maybe Text
lastUpdatedAt :: Maybe POSIX
invalidRecordCount :: Maybe Integer
inputDataLocationS3 :: Maybe Text
finishedAt :: Maybe POSIX
createdByIamUser :: Maybe Text
createdAt :: Maybe POSIX
computeTime :: Maybe Integer
batchPredictionId :: Maybe Text
batchPredictionDataSourceId :: Maybe Text
$sel:httpStatus:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Int
$sel:totalRecordCount:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Integer
$sel:status:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe EntityStatus
$sel:startedAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
$sel:outputUri:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:name:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:message:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:mLModelId:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:logUri:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:lastUpdatedAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
$sel:invalidRecordCount:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Integer
$sel:inputDataLocationS3:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:finishedAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
$sel:createdByIamUser:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:createdAt:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe POSIX
$sel:computeTime:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Integer
$sel:batchPredictionId:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
$sel:batchPredictionDataSourceId:GetBatchPredictionResponse' :: GetBatchPredictionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
batchPredictionDataSourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Integer
computeTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
createdByIamUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
finishedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
inputDataLocationS3
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
invalidRecordCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EntityStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
totalRecordCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus