{-# 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.AppSync.EvaluateCode
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Evaluates the given code and returns the response. The code definition
-- requirements depend on the specified runtime. For @APPSYNC_JS@ runtimes,
-- the code defines the request and response functions. The request
-- function takes the incoming request after a GraphQL operation is parsed
-- and converts it into a request configuration for the selected data
-- source operation. The response function interprets responses from the
-- data source and maps it to the shape of the GraphQL field output type.
module Amazonka.AppSync.EvaluateCode
  ( -- * Creating a Request
    EvaluateCode (..),
    newEvaluateCode,

    -- * Request Lenses
    evaluateCode_function,
    evaluateCode_runtime,
    evaluateCode_code,
    evaluateCode_context,

    -- * Destructuring the Response
    EvaluateCodeResponse (..),
    newEvaluateCodeResponse,

    -- * Response Lenses
    evaluateCodeResponse_error,
    evaluateCodeResponse_evaluationResult,
    evaluateCodeResponse_logs,
    evaluateCodeResponse_httpStatus,
  )
where

import Amazonka.AppSync.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:/ 'newEvaluateCode' smart constructor.
data EvaluateCode = EvaluateCode'
  { -- | The function within the code to be evaluated. If provided, the valid
    -- values are @request@ and @response@.
    EvaluateCode -> Maybe Text
function :: Prelude.Maybe Prelude.Text,
    -- | The runtime to be used when evaluating the code. Currently, only the
    -- @APPSYNC_JS@ runtime is supported.
    EvaluateCode -> AppSyncRuntime
runtime :: AppSyncRuntime,
    -- | The code definition to be evaluated. Note that @code@ and @runtime@ are
    -- both required for this action. The @runtime@ value must be @APPSYNC_JS@.
    EvaluateCode -> Text
code :: Prelude.Text,
    -- | The map that holds all of the contextual information for your resolver
    -- invocation. A @context@ is required for this action.
    EvaluateCode -> Text
context :: Prelude.Text
  }
  deriving (EvaluateCode -> EvaluateCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateCode -> EvaluateCode -> Bool
$c/= :: EvaluateCode -> EvaluateCode -> Bool
== :: EvaluateCode -> EvaluateCode -> Bool
$c== :: EvaluateCode -> EvaluateCode -> Bool
Prelude.Eq, ReadPrec [EvaluateCode]
ReadPrec EvaluateCode
Int -> ReadS EvaluateCode
ReadS [EvaluateCode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluateCode]
$creadListPrec :: ReadPrec [EvaluateCode]
readPrec :: ReadPrec EvaluateCode
$creadPrec :: ReadPrec EvaluateCode
readList :: ReadS [EvaluateCode]
$creadList :: ReadS [EvaluateCode]
readsPrec :: Int -> ReadS EvaluateCode
$creadsPrec :: Int -> ReadS EvaluateCode
Prelude.Read, Int -> EvaluateCode -> ShowS
[EvaluateCode] -> ShowS
EvaluateCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateCode] -> ShowS
$cshowList :: [EvaluateCode] -> ShowS
show :: EvaluateCode -> String
$cshow :: EvaluateCode -> String
showsPrec :: Int -> EvaluateCode -> ShowS
$cshowsPrec :: Int -> EvaluateCode -> ShowS
Prelude.Show, forall x. Rep EvaluateCode x -> EvaluateCode
forall x. EvaluateCode -> Rep EvaluateCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvaluateCode x -> EvaluateCode
$cfrom :: forall x. EvaluateCode -> Rep EvaluateCode x
Prelude.Generic)

-- |
-- Create a value of 'EvaluateCode' 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:
--
-- 'function', 'evaluateCode_function' - The function within the code to be evaluated. If provided, the valid
-- values are @request@ and @response@.
--
-- 'runtime', 'evaluateCode_runtime' - The runtime to be used when evaluating the code. Currently, only the
-- @APPSYNC_JS@ runtime is supported.
--
-- 'code', 'evaluateCode_code' - The code definition to be evaluated. Note that @code@ and @runtime@ are
-- both required for this action. The @runtime@ value must be @APPSYNC_JS@.
--
-- 'context', 'evaluateCode_context' - The map that holds all of the contextual information for your resolver
-- invocation. A @context@ is required for this action.
newEvaluateCode ::
  -- | 'runtime'
  AppSyncRuntime ->
  -- | 'code'
  Prelude.Text ->
  -- | 'context'
  Prelude.Text ->
  EvaluateCode
newEvaluateCode :: AppSyncRuntime -> Text -> Text -> EvaluateCode
newEvaluateCode AppSyncRuntime
pRuntime_ Text
pCode_ Text
pContext_ =
  EvaluateCode'
    { $sel:function:EvaluateCode' :: Maybe Text
function = forall a. Maybe a
Prelude.Nothing,
      $sel:runtime:EvaluateCode' :: AppSyncRuntime
runtime = AppSyncRuntime
pRuntime_,
      $sel:code:EvaluateCode' :: Text
code = Text
pCode_,
      $sel:context:EvaluateCode' :: Text
context = Text
pContext_
    }

-- | The function within the code to be evaluated. If provided, the valid
-- values are @request@ and @response@.
evaluateCode_function :: Lens.Lens' EvaluateCode (Prelude.Maybe Prelude.Text)
evaluateCode_function :: Lens' EvaluateCode (Maybe Text)
evaluateCode_function = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateCode' {Maybe Text
function :: Maybe Text
$sel:function:EvaluateCode' :: EvaluateCode -> Maybe Text
function} -> Maybe Text
function) (\s :: EvaluateCode
s@EvaluateCode' {} Maybe Text
a -> EvaluateCode
s {$sel:function:EvaluateCode' :: Maybe Text
function = Maybe Text
a} :: EvaluateCode)

-- | The runtime to be used when evaluating the code. Currently, only the
-- @APPSYNC_JS@ runtime is supported.
evaluateCode_runtime :: Lens.Lens' EvaluateCode AppSyncRuntime
evaluateCode_runtime :: Lens' EvaluateCode AppSyncRuntime
evaluateCode_runtime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateCode' {AppSyncRuntime
runtime :: AppSyncRuntime
$sel:runtime:EvaluateCode' :: EvaluateCode -> AppSyncRuntime
runtime} -> AppSyncRuntime
runtime) (\s :: EvaluateCode
s@EvaluateCode' {} AppSyncRuntime
a -> EvaluateCode
s {$sel:runtime:EvaluateCode' :: AppSyncRuntime
runtime = AppSyncRuntime
a} :: EvaluateCode)

-- | The code definition to be evaluated. Note that @code@ and @runtime@ are
-- both required for this action. The @runtime@ value must be @APPSYNC_JS@.
evaluateCode_code :: Lens.Lens' EvaluateCode Prelude.Text
evaluateCode_code :: Lens' EvaluateCode Text
evaluateCode_code = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateCode' {Text
code :: Text
$sel:code:EvaluateCode' :: EvaluateCode -> Text
code} -> Text
code) (\s :: EvaluateCode
s@EvaluateCode' {} Text
a -> EvaluateCode
s {$sel:code:EvaluateCode' :: Text
code = Text
a} :: EvaluateCode)

-- | The map that holds all of the contextual information for your resolver
-- invocation. A @context@ is required for this action.
evaluateCode_context :: Lens.Lens' EvaluateCode Prelude.Text
evaluateCode_context :: Lens' EvaluateCode Text
evaluateCode_context = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateCode' {Text
context :: Text
$sel:context:EvaluateCode' :: EvaluateCode -> Text
context} -> Text
context) (\s :: EvaluateCode
s@EvaluateCode' {} Text
a -> EvaluateCode
s {$sel:context:EvaluateCode' :: Text
context = Text
a} :: EvaluateCode)

instance Core.AWSRequest EvaluateCode where
  type AWSResponse EvaluateCode = EvaluateCodeResponse
  request :: (Service -> Service) -> EvaluateCode -> Request EvaluateCode
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 EvaluateCode
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse EvaluateCode)))
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 EvaluateCodeErrorDetail
-> Maybe Text -> Maybe [Text] -> Int -> EvaluateCodeResponse
EvaluateCodeResponse'
            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
"error")
            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
"evaluationResult")
            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
"logs" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 EvaluateCode where
  hashWithSalt :: Int -> EvaluateCode -> Int
hashWithSalt Int
_salt EvaluateCode' {Maybe Text
Text
AppSyncRuntime
context :: Text
code :: Text
runtime :: AppSyncRuntime
function :: Maybe Text
$sel:context:EvaluateCode' :: EvaluateCode -> Text
$sel:code:EvaluateCode' :: EvaluateCode -> Text
$sel:runtime:EvaluateCode' :: EvaluateCode -> AppSyncRuntime
$sel:function:EvaluateCode' :: EvaluateCode -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
function
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AppSyncRuntime
runtime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
code
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
context

instance Prelude.NFData EvaluateCode where
  rnf :: EvaluateCode -> ()
rnf EvaluateCode' {Maybe Text
Text
AppSyncRuntime
context :: Text
code :: Text
runtime :: AppSyncRuntime
function :: Maybe Text
$sel:context:EvaluateCode' :: EvaluateCode -> Text
$sel:code:EvaluateCode' :: EvaluateCode -> Text
$sel:runtime:EvaluateCode' :: EvaluateCode -> AppSyncRuntime
$sel:function:EvaluateCode' :: EvaluateCode -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
function
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AppSyncRuntime
runtime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
code
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
context

instance Data.ToHeaders EvaluateCode where
  toHeaders :: EvaluateCode -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON EvaluateCode where
  toJSON :: EvaluateCode -> Value
toJSON EvaluateCode' {Maybe Text
Text
AppSyncRuntime
context :: Text
code :: Text
runtime :: AppSyncRuntime
function :: Maybe Text
$sel:context:EvaluateCode' :: EvaluateCode -> Text
$sel:code:EvaluateCode' :: EvaluateCode -> Text
$sel:runtime:EvaluateCode' :: EvaluateCode -> AppSyncRuntime
$sel:function:EvaluateCode' :: EvaluateCode -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"function" 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
function,
            forall a. a -> Maybe a
Prelude.Just (Key
"runtime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AppSyncRuntime
runtime),
            forall a. a -> Maybe a
Prelude.Just (Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
code),
            forall a. a -> Maybe a
Prelude.Just (Key
"context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
context)
          ]
      )

instance Data.ToPath EvaluateCode where
  toPath :: EvaluateCode -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/dataplane-evaluatecode"

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

-- | /See:/ 'newEvaluateCodeResponse' smart constructor.
data EvaluateCodeResponse = EvaluateCodeResponse'
  { -- | Contains the payload of the response error.
    EvaluateCodeResponse -> Maybe EvaluateCodeErrorDetail
error :: Prelude.Maybe EvaluateCodeErrorDetail,
    -- | The result of the evaluation operation.
    EvaluateCodeResponse -> Maybe Text
evaluationResult :: Prelude.Maybe Prelude.Text,
    -- | A list of logs that were generated by calls to @util.log.info@ and
    -- @util.log.error@ in the evaluated code.
    EvaluateCodeResponse -> Maybe [Text]
logs :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    EvaluateCodeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (EvaluateCodeResponse -> EvaluateCodeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateCodeResponse -> EvaluateCodeResponse -> Bool
$c/= :: EvaluateCodeResponse -> EvaluateCodeResponse -> Bool
== :: EvaluateCodeResponse -> EvaluateCodeResponse -> Bool
$c== :: EvaluateCodeResponse -> EvaluateCodeResponse -> Bool
Prelude.Eq, ReadPrec [EvaluateCodeResponse]
ReadPrec EvaluateCodeResponse
Int -> ReadS EvaluateCodeResponse
ReadS [EvaluateCodeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluateCodeResponse]
$creadListPrec :: ReadPrec [EvaluateCodeResponse]
readPrec :: ReadPrec EvaluateCodeResponse
$creadPrec :: ReadPrec EvaluateCodeResponse
readList :: ReadS [EvaluateCodeResponse]
$creadList :: ReadS [EvaluateCodeResponse]
readsPrec :: Int -> ReadS EvaluateCodeResponse
$creadsPrec :: Int -> ReadS EvaluateCodeResponse
Prelude.Read, Int -> EvaluateCodeResponse -> ShowS
[EvaluateCodeResponse] -> ShowS
EvaluateCodeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateCodeResponse] -> ShowS
$cshowList :: [EvaluateCodeResponse] -> ShowS
show :: EvaluateCodeResponse -> String
$cshow :: EvaluateCodeResponse -> String
showsPrec :: Int -> EvaluateCodeResponse -> ShowS
$cshowsPrec :: Int -> EvaluateCodeResponse -> ShowS
Prelude.Show, forall x. Rep EvaluateCodeResponse x -> EvaluateCodeResponse
forall x. EvaluateCodeResponse -> Rep EvaluateCodeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvaluateCodeResponse x -> EvaluateCodeResponse
$cfrom :: forall x. EvaluateCodeResponse -> Rep EvaluateCodeResponse x
Prelude.Generic)

-- |
-- Create a value of 'EvaluateCodeResponse' 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:
--
-- 'error', 'evaluateCodeResponse_error' - Contains the payload of the response error.
--
-- 'evaluationResult', 'evaluateCodeResponse_evaluationResult' - The result of the evaluation operation.
--
-- 'logs', 'evaluateCodeResponse_logs' - A list of logs that were generated by calls to @util.log.info@ and
-- @util.log.error@ in the evaluated code.
--
-- 'httpStatus', 'evaluateCodeResponse_httpStatus' - The response's http status code.
newEvaluateCodeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  EvaluateCodeResponse
newEvaluateCodeResponse :: Int -> EvaluateCodeResponse
newEvaluateCodeResponse Int
pHttpStatus_ =
  EvaluateCodeResponse'
    { $sel:error:EvaluateCodeResponse' :: Maybe EvaluateCodeErrorDetail
error = forall a. Maybe a
Prelude.Nothing,
      $sel:evaluationResult:EvaluateCodeResponse' :: Maybe Text
evaluationResult = forall a. Maybe a
Prelude.Nothing,
      $sel:logs:EvaluateCodeResponse' :: Maybe [Text]
logs = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:EvaluateCodeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains the payload of the response error.
evaluateCodeResponse_error :: Lens.Lens' EvaluateCodeResponse (Prelude.Maybe EvaluateCodeErrorDetail)
evaluateCodeResponse_error :: Lens' EvaluateCodeResponse (Maybe EvaluateCodeErrorDetail)
evaluateCodeResponse_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateCodeResponse' {Maybe EvaluateCodeErrorDetail
error :: Maybe EvaluateCodeErrorDetail
$sel:error:EvaluateCodeResponse' :: EvaluateCodeResponse -> Maybe EvaluateCodeErrorDetail
error} -> Maybe EvaluateCodeErrorDetail
error) (\s :: EvaluateCodeResponse
s@EvaluateCodeResponse' {} Maybe EvaluateCodeErrorDetail
a -> EvaluateCodeResponse
s {$sel:error:EvaluateCodeResponse' :: Maybe EvaluateCodeErrorDetail
error = Maybe EvaluateCodeErrorDetail
a} :: EvaluateCodeResponse)

-- | The result of the evaluation operation.
evaluateCodeResponse_evaluationResult :: Lens.Lens' EvaluateCodeResponse (Prelude.Maybe Prelude.Text)
evaluateCodeResponse_evaluationResult :: Lens' EvaluateCodeResponse (Maybe Text)
evaluateCodeResponse_evaluationResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateCodeResponse' {Maybe Text
evaluationResult :: Maybe Text
$sel:evaluationResult:EvaluateCodeResponse' :: EvaluateCodeResponse -> Maybe Text
evaluationResult} -> Maybe Text
evaluationResult) (\s :: EvaluateCodeResponse
s@EvaluateCodeResponse' {} Maybe Text
a -> EvaluateCodeResponse
s {$sel:evaluationResult:EvaluateCodeResponse' :: Maybe Text
evaluationResult = Maybe Text
a} :: EvaluateCodeResponse)

-- | A list of logs that were generated by calls to @util.log.info@ and
-- @util.log.error@ in the evaluated code.
evaluateCodeResponse_logs :: Lens.Lens' EvaluateCodeResponse (Prelude.Maybe [Prelude.Text])
evaluateCodeResponse_logs :: Lens' EvaluateCodeResponse (Maybe [Text])
evaluateCodeResponse_logs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateCodeResponse' {Maybe [Text]
logs :: Maybe [Text]
$sel:logs:EvaluateCodeResponse' :: EvaluateCodeResponse -> Maybe [Text]
logs} -> Maybe [Text]
logs) (\s :: EvaluateCodeResponse
s@EvaluateCodeResponse' {} Maybe [Text]
a -> EvaluateCodeResponse
s {$sel:logs:EvaluateCodeResponse' :: Maybe [Text]
logs = Maybe [Text]
a} :: EvaluateCodeResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData EvaluateCodeResponse where
  rnf :: EvaluateCodeResponse -> ()
rnf EvaluateCodeResponse' {Int
Maybe [Text]
Maybe Text
Maybe EvaluateCodeErrorDetail
httpStatus :: Int
logs :: Maybe [Text]
evaluationResult :: Maybe Text
error :: Maybe EvaluateCodeErrorDetail
$sel:httpStatus:EvaluateCodeResponse' :: EvaluateCodeResponse -> Int
$sel:logs:EvaluateCodeResponse' :: EvaluateCodeResponse -> Maybe [Text]
$sel:evaluationResult:EvaluateCodeResponse' :: EvaluateCodeResponse -> Maybe Text
$sel:error:EvaluateCodeResponse' :: EvaluateCodeResponse -> Maybe EvaluateCodeErrorDetail
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EvaluateCodeErrorDetail
error
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
evaluationResult
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
logs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus