{-# 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.Athena.GetCalculationExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a previously submitted calculation execution.
module Amazonka.Athena.GetCalculationExecution
  ( -- * Creating a Request
    GetCalculationExecution (..),
    newGetCalculationExecution,

    -- * Request Lenses
    getCalculationExecution_calculationExecutionId,

    -- * Destructuring the Response
    GetCalculationExecutionResponse (..),
    newGetCalculationExecutionResponse,

    -- * Response Lenses
    getCalculationExecutionResponse_calculationExecutionId,
    getCalculationExecutionResponse_description,
    getCalculationExecutionResponse_result,
    getCalculationExecutionResponse_sessionId,
    getCalculationExecutionResponse_statistics,
    getCalculationExecutionResponse_status,
    getCalculationExecutionResponse_workingDirectory,
    getCalculationExecutionResponse_httpStatus,
  )
where

import Amazonka.Athena.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetCalculationExecution' smart constructor.
data GetCalculationExecution = GetCalculationExecution'
  { -- | The calculation execution UUID.
    GetCalculationExecution -> Text
calculationExecutionId :: Prelude.Text
  }
  deriving (GetCalculationExecution -> GetCalculationExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCalculationExecution -> GetCalculationExecution -> Bool
$c/= :: GetCalculationExecution -> GetCalculationExecution -> Bool
== :: GetCalculationExecution -> GetCalculationExecution -> Bool
$c== :: GetCalculationExecution -> GetCalculationExecution -> Bool
Prelude.Eq, ReadPrec [GetCalculationExecution]
ReadPrec GetCalculationExecution
Int -> ReadS GetCalculationExecution
ReadS [GetCalculationExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCalculationExecution]
$creadListPrec :: ReadPrec [GetCalculationExecution]
readPrec :: ReadPrec GetCalculationExecution
$creadPrec :: ReadPrec GetCalculationExecution
readList :: ReadS [GetCalculationExecution]
$creadList :: ReadS [GetCalculationExecution]
readsPrec :: Int -> ReadS GetCalculationExecution
$creadsPrec :: Int -> ReadS GetCalculationExecution
Prelude.Read, Int -> GetCalculationExecution -> ShowS
[GetCalculationExecution] -> ShowS
GetCalculationExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCalculationExecution] -> ShowS
$cshowList :: [GetCalculationExecution] -> ShowS
show :: GetCalculationExecution -> String
$cshow :: GetCalculationExecution -> String
showsPrec :: Int -> GetCalculationExecution -> ShowS
$cshowsPrec :: Int -> GetCalculationExecution -> ShowS
Prelude.Show, forall x. Rep GetCalculationExecution x -> GetCalculationExecution
forall x. GetCalculationExecution -> Rep GetCalculationExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCalculationExecution x -> GetCalculationExecution
$cfrom :: forall x. GetCalculationExecution -> Rep GetCalculationExecution x
Prelude.Generic)

-- |
-- Create a value of 'GetCalculationExecution' 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:
--
-- 'calculationExecutionId', 'getCalculationExecution_calculationExecutionId' - The calculation execution UUID.
newGetCalculationExecution ::
  -- | 'calculationExecutionId'
  Prelude.Text ->
  GetCalculationExecution
newGetCalculationExecution :: Text -> GetCalculationExecution
newGetCalculationExecution Text
pCalculationExecutionId_ =
  GetCalculationExecution'
    { $sel:calculationExecutionId:GetCalculationExecution' :: Text
calculationExecutionId =
        Text
pCalculationExecutionId_
    }

-- | The calculation execution UUID.
getCalculationExecution_calculationExecutionId :: Lens.Lens' GetCalculationExecution Prelude.Text
getCalculationExecution_calculationExecutionId :: Lens' GetCalculationExecution Text
getCalculationExecution_calculationExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecution' {Text
calculationExecutionId :: Text
$sel:calculationExecutionId:GetCalculationExecution' :: GetCalculationExecution -> Text
calculationExecutionId} -> Text
calculationExecutionId) (\s :: GetCalculationExecution
s@GetCalculationExecution' {} Text
a -> GetCalculationExecution
s {$sel:calculationExecutionId:GetCalculationExecution' :: Text
calculationExecutionId = Text
a} :: GetCalculationExecution)

instance Core.AWSRequest GetCalculationExecution where
  type
    AWSResponse GetCalculationExecution =
      GetCalculationExecutionResponse
  request :: (Service -> Service)
-> GetCalculationExecution -> Request GetCalculationExecution
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 GetCalculationExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCalculationExecution)))
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 CalculationResult
-> Maybe Text
-> Maybe CalculationStatistics
-> Maybe CalculationStatus
-> Maybe Text
-> Int
-> GetCalculationExecutionResponse
GetCalculationExecutionResponse'
            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
"CalculationExecutionId")
            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
"Description")
            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
"Result")
            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
"SessionId")
            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
"Statistics")
            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
"WorkingDirectory")
            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 GetCalculationExecution where
  hashWithSalt :: Int -> GetCalculationExecution -> Int
hashWithSalt Int
_salt GetCalculationExecution' {Text
calculationExecutionId :: Text
$sel:calculationExecutionId:GetCalculationExecution' :: GetCalculationExecution -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
calculationExecutionId

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

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

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

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

-- | /See:/ 'newGetCalculationExecutionResponse' smart constructor.
data GetCalculationExecutionResponse = GetCalculationExecutionResponse'
  { -- | The calculation execution UUID.
    GetCalculationExecutionResponse -> Maybe Text
calculationExecutionId :: Prelude.Maybe Prelude.Text,
    -- | The description of the calculation execution.
    GetCalculationExecutionResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Contains result information. This field is populated only if the
    -- calculation is completed.
    GetCalculationExecutionResponse -> Maybe CalculationResult
result :: Prelude.Maybe CalculationResult,
    -- | The session ID that the calculation ran in.
    GetCalculationExecutionResponse -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | Contains information about the data processing unit (DPU) execution time
    -- and progress. This field is populated only when statistics are
    -- available.
    GetCalculationExecutionResponse -> Maybe CalculationStatistics
statistics :: Prelude.Maybe CalculationStatistics,
    -- | Contains information about the status of the calculation.
    GetCalculationExecutionResponse -> Maybe CalculationStatus
status :: Prelude.Maybe CalculationStatus,
    -- | The Amazon S3 location in which calculation results are stored.
    GetCalculationExecutionResponse -> Maybe Text
workingDirectory :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetCalculationExecutionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCalculationExecutionResponse
-> GetCalculationExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCalculationExecutionResponse
-> GetCalculationExecutionResponse -> Bool
$c/= :: GetCalculationExecutionResponse
-> GetCalculationExecutionResponse -> Bool
== :: GetCalculationExecutionResponse
-> GetCalculationExecutionResponse -> Bool
$c== :: GetCalculationExecutionResponse
-> GetCalculationExecutionResponse -> Bool
Prelude.Eq, ReadPrec [GetCalculationExecutionResponse]
ReadPrec GetCalculationExecutionResponse
Int -> ReadS GetCalculationExecutionResponse
ReadS [GetCalculationExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCalculationExecutionResponse]
$creadListPrec :: ReadPrec [GetCalculationExecutionResponse]
readPrec :: ReadPrec GetCalculationExecutionResponse
$creadPrec :: ReadPrec GetCalculationExecutionResponse
readList :: ReadS [GetCalculationExecutionResponse]
$creadList :: ReadS [GetCalculationExecutionResponse]
readsPrec :: Int -> ReadS GetCalculationExecutionResponse
$creadsPrec :: Int -> ReadS GetCalculationExecutionResponse
Prelude.Read, Int -> GetCalculationExecutionResponse -> ShowS
[GetCalculationExecutionResponse] -> ShowS
GetCalculationExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCalculationExecutionResponse] -> ShowS
$cshowList :: [GetCalculationExecutionResponse] -> ShowS
show :: GetCalculationExecutionResponse -> String
$cshow :: GetCalculationExecutionResponse -> String
showsPrec :: Int -> GetCalculationExecutionResponse -> ShowS
$cshowsPrec :: Int -> GetCalculationExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep GetCalculationExecutionResponse x
-> GetCalculationExecutionResponse
forall x.
GetCalculationExecutionResponse
-> Rep GetCalculationExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCalculationExecutionResponse x
-> GetCalculationExecutionResponse
$cfrom :: forall x.
GetCalculationExecutionResponse
-> Rep GetCalculationExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCalculationExecutionResponse' 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:
--
-- 'calculationExecutionId', 'getCalculationExecutionResponse_calculationExecutionId' - The calculation execution UUID.
--
-- 'description', 'getCalculationExecutionResponse_description' - The description of the calculation execution.
--
-- 'result', 'getCalculationExecutionResponse_result' - Contains result information. This field is populated only if the
-- calculation is completed.
--
-- 'sessionId', 'getCalculationExecutionResponse_sessionId' - The session ID that the calculation ran in.
--
-- 'statistics', 'getCalculationExecutionResponse_statistics' - Contains information about the data processing unit (DPU) execution time
-- and progress. This field is populated only when statistics are
-- available.
--
-- 'status', 'getCalculationExecutionResponse_status' - Contains information about the status of the calculation.
--
-- 'workingDirectory', 'getCalculationExecutionResponse_workingDirectory' - The Amazon S3 location in which calculation results are stored.
--
-- 'httpStatus', 'getCalculationExecutionResponse_httpStatus' - The response's http status code.
newGetCalculationExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCalculationExecutionResponse
newGetCalculationExecutionResponse :: Int -> GetCalculationExecutionResponse
newGetCalculationExecutionResponse Int
pHttpStatus_ =
  GetCalculationExecutionResponse'
    { $sel:calculationExecutionId:GetCalculationExecutionResponse' :: Maybe Text
calculationExecutionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetCalculationExecutionResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:result:GetCalculationExecutionResponse' :: Maybe CalculationResult
result = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:GetCalculationExecutionResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:statistics:GetCalculationExecutionResponse' :: Maybe CalculationStatistics
statistics = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetCalculationExecutionResponse' :: Maybe CalculationStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:workingDirectory:GetCalculationExecutionResponse' :: Maybe Text
workingDirectory = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCalculationExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The calculation execution UUID.
getCalculationExecutionResponse_calculationExecutionId :: Lens.Lens' GetCalculationExecutionResponse (Prelude.Maybe Prelude.Text)
getCalculationExecutionResponse_calculationExecutionId :: Lens' GetCalculationExecutionResponse (Maybe Text)
getCalculationExecutionResponse_calculationExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecutionResponse' {Maybe Text
calculationExecutionId :: Maybe Text
$sel:calculationExecutionId:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
calculationExecutionId} -> Maybe Text
calculationExecutionId) (\s :: GetCalculationExecutionResponse
s@GetCalculationExecutionResponse' {} Maybe Text
a -> GetCalculationExecutionResponse
s {$sel:calculationExecutionId:GetCalculationExecutionResponse' :: Maybe Text
calculationExecutionId = Maybe Text
a} :: GetCalculationExecutionResponse)

-- | The description of the calculation execution.
getCalculationExecutionResponse_description :: Lens.Lens' GetCalculationExecutionResponse (Prelude.Maybe Prelude.Text)
getCalculationExecutionResponse_description :: Lens' GetCalculationExecutionResponse (Maybe Text)
getCalculationExecutionResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecutionResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetCalculationExecutionResponse
s@GetCalculationExecutionResponse' {} Maybe Text
a -> GetCalculationExecutionResponse
s {$sel:description:GetCalculationExecutionResponse' :: Maybe Text
description = Maybe Text
a} :: GetCalculationExecutionResponse)

-- | Contains result information. This field is populated only if the
-- calculation is completed.
getCalculationExecutionResponse_result :: Lens.Lens' GetCalculationExecutionResponse (Prelude.Maybe CalculationResult)
getCalculationExecutionResponse_result :: Lens' GetCalculationExecutionResponse (Maybe CalculationResult)
getCalculationExecutionResponse_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecutionResponse' {Maybe CalculationResult
result :: Maybe CalculationResult
$sel:result:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe CalculationResult
result} -> Maybe CalculationResult
result) (\s :: GetCalculationExecutionResponse
s@GetCalculationExecutionResponse' {} Maybe CalculationResult
a -> GetCalculationExecutionResponse
s {$sel:result:GetCalculationExecutionResponse' :: Maybe CalculationResult
result = Maybe CalculationResult
a} :: GetCalculationExecutionResponse)

-- | The session ID that the calculation ran in.
getCalculationExecutionResponse_sessionId :: Lens.Lens' GetCalculationExecutionResponse (Prelude.Maybe Prelude.Text)
getCalculationExecutionResponse_sessionId :: Lens' GetCalculationExecutionResponse (Maybe Text)
getCalculationExecutionResponse_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecutionResponse' {Maybe Text
sessionId :: Maybe Text
$sel:sessionId:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
sessionId} -> Maybe Text
sessionId) (\s :: GetCalculationExecutionResponse
s@GetCalculationExecutionResponse' {} Maybe Text
a -> GetCalculationExecutionResponse
s {$sel:sessionId:GetCalculationExecutionResponse' :: Maybe Text
sessionId = Maybe Text
a} :: GetCalculationExecutionResponse)

-- | Contains information about the data processing unit (DPU) execution time
-- and progress. This field is populated only when statistics are
-- available.
getCalculationExecutionResponse_statistics :: Lens.Lens' GetCalculationExecutionResponse (Prelude.Maybe CalculationStatistics)
getCalculationExecutionResponse_statistics :: Lens' GetCalculationExecutionResponse (Maybe CalculationStatistics)
getCalculationExecutionResponse_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecutionResponse' {Maybe CalculationStatistics
statistics :: Maybe CalculationStatistics
$sel:statistics:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe CalculationStatistics
statistics} -> Maybe CalculationStatistics
statistics) (\s :: GetCalculationExecutionResponse
s@GetCalculationExecutionResponse' {} Maybe CalculationStatistics
a -> GetCalculationExecutionResponse
s {$sel:statistics:GetCalculationExecutionResponse' :: Maybe CalculationStatistics
statistics = Maybe CalculationStatistics
a} :: GetCalculationExecutionResponse)

-- | Contains information about the status of the calculation.
getCalculationExecutionResponse_status :: Lens.Lens' GetCalculationExecutionResponse (Prelude.Maybe CalculationStatus)
getCalculationExecutionResponse_status :: Lens' GetCalculationExecutionResponse (Maybe CalculationStatus)
getCalculationExecutionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecutionResponse' {Maybe CalculationStatus
status :: Maybe CalculationStatus
$sel:status:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe CalculationStatus
status} -> Maybe CalculationStatus
status) (\s :: GetCalculationExecutionResponse
s@GetCalculationExecutionResponse' {} Maybe CalculationStatus
a -> GetCalculationExecutionResponse
s {$sel:status:GetCalculationExecutionResponse' :: Maybe CalculationStatus
status = Maybe CalculationStatus
a} :: GetCalculationExecutionResponse)

-- | The Amazon S3 location in which calculation results are stored.
getCalculationExecutionResponse_workingDirectory :: Lens.Lens' GetCalculationExecutionResponse (Prelude.Maybe Prelude.Text)
getCalculationExecutionResponse_workingDirectory :: Lens' GetCalculationExecutionResponse (Maybe Text)
getCalculationExecutionResponse_workingDirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCalculationExecutionResponse' {Maybe Text
workingDirectory :: Maybe Text
$sel:workingDirectory:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
workingDirectory} -> Maybe Text
workingDirectory) (\s :: GetCalculationExecutionResponse
s@GetCalculationExecutionResponse' {} Maybe Text
a -> GetCalculationExecutionResponse
s {$sel:workingDirectory:GetCalculationExecutionResponse' :: Maybe Text
workingDirectory = Maybe Text
a} :: GetCalculationExecutionResponse)

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

instance
  Prelude.NFData
    GetCalculationExecutionResponse
  where
  rnf :: GetCalculationExecutionResponse -> ()
rnf GetCalculationExecutionResponse' {Int
Maybe Text
Maybe CalculationResult
Maybe CalculationStatistics
Maybe CalculationStatus
httpStatus :: Int
workingDirectory :: Maybe Text
status :: Maybe CalculationStatus
statistics :: Maybe CalculationStatistics
sessionId :: Maybe Text
result :: Maybe CalculationResult
description :: Maybe Text
calculationExecutionId :: Maybe Text
$sel:httpStatus:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Int
$sel:workingDirectory:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
$sel:status:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe CalculationStatus
$sel:statistics:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe CalculationStatistics
$sel:sessionId:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
$sel:result:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe CalculationResult
$sel:description:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
$sel:calculationExecutionId:GetCalculationExecutionResponse' :: GetCalculationExecutionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
calculationExecutionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CalculationResult
result
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CalculationStatistics
statistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CalculationStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workingDirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus