{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Aws.Lambda.Runtime
  ( runLambda,
    Runtime.LambdaResult (..),
    Runtime.ApiGatewayDispatcherOptions (..),
    Error.Parsing (..),
  )
where

import qualified Aws.Lambda.Runtime.ApiInfo as ApiInfo
import qualified Aws.Lambda.Runtime.Common as Runtime
import qualified Aws.Lambda.Runtime.Context as Context
import qualified Aws.Lambda.Runtime.Environment as Environment
import qualified Aws.Lambda.Runtime.Error as Error
import qualified Aws.Lambda.Runtime.Publish as Publish
import Aws.Lambda.Runtime.StandaloneLambda.Types (StandaloneLambdaResponseBody (..))
import qualified Control.Exception as Unchecked
import Control.Exception.Safe.Checked (Throws, catch, throw)
import qualified Control.Exception.Safe.Checked as Checked
import Control.Monad (forever)
import Data.Aeson (encode)
import Data.IORef (newIORef)
import Data.Text (Text, unpack)
import qualified Network.HTTP.Client as Http
import System.IO (hFlush, stderr, stdout)

-- | Runs the user @haskell_lambda@ executable and posts back the
-- results. This is called from the layer's @main@ function.
runLambda :: forall context handlerType. IO context -> Runtime.RunCallback handlerType context -> IO ()
runLambda :: forall context (handlerType :: HandlerType).
IO context -> RunCallback handlerType context -> IO ()
runLambda IO context
initializeCustomContext RunCallback handlerType context
callback = do
  Manager
manager <- ManagerSettings -> IO Manager
Http.newManager ManagerSettings
httpManagerSettings
  context
customContext <- IO context
initializeCustomContext
  IORef context
customContextRef <- forall a. a -> IO (IORef a)
newIORef context
customContext
  Context context
context <- forall context.
(Throws Parsing, Throws EnvironmentVariableNotSet) =>
IORef context -> IO (Context context)
Context.initialize @context IORef context
customContextRef forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` forall a. Parsing -> IO a
errorParsing forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` forall a. EnvironmentVariableNotSet -> IO a
variableNotSet
  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
    Text
lambdaApi <- Throws EnvironmentVariableNotSet => IO Text
Environment.apiEndpoint forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` forall a. EnvironmentVariableNotSet -> IO a
variableNotSet
    Event
event <- Throws Parsing => Manager -> Text -> IO Event
ApiInfo.fetchEvent Manager
manager Text
lambdaApi forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` forall a. Parsing -> IO a
errorParsing

    -- Purposefully shadowing to prevent using the initial "empty" context
    Context context
context <- forall context. Context context -> Event -> IO (Context context)
Context.setEventData Context context
context Event
event

    ( ( ( forall (handlerType :: HandlerType) context.
(Throws Invocation, Throws EnvironmentVariableNotSet) =>
RunCallback handlerType context
-> Manager -> Text -> Event -> Context context -> IO ()
invokeAndRun RunCallback handlerType context
callback Manager
manager Text
lambdaApi Event
event Context context
context
            forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`Checked.catch` \Parsing
err -> forall context.
Parsing -> Text -> Context context -> Manager -> IO ()
Publish.parsingError Parsing
err Text
lambdaApi Context context
context Manager
manager
        )
          forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`Checked.catch` \Invocation
err -> forall context.
Invocation -> Text -> Context context -> Manager -> IO ()
Publish.invocationError Invocation
err Text
lambdaApi Context context
context Manager
manager
      )
        forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`Checked.catch` \(EnvironmentVariableNotSet
err :: Error.EnvironmentVariableNotSet) -> forall err context.
ToJSON err =>
err -> Text -> Context context -> Manager -> IO ()
Publish.runtimeInitError EnvironmentVariableNotSet
err Text
lambdaApi Context context
context Manager
manager
      )
      forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Unchecked.catch` \Invocation
err -> forall context.
Invocation -> Text -> Context context -> Manager -> IO ()
Publish.invocationError Invocation
err Text
lambdaApi Context context
context Manager
manager

httpManagerSettings :: Http.ManagerSettings
httpManagerSettings :: ManagerSettings
httpManagerSettings =
  -- We set the timeout to none, as AWS Lambda freezes the containers.
  ManagerSettings
Http.defaultManagerSettings
    { managerResponseTimeout :: ResponseTimeout
Http.managerResponseTimeout = ResponseTimeout
Http.responseTimeoutNone
    }

invokeAndRun ::
  Throws Error.Invocation =>
  Throws Error.EnvironmentVariableNotSet =>
  Runtime.RunCallback handlerType context ->
  Http.Manager ->
  Text ->
  ApiInfo.Event ->
  Context.Context context ->
  IO ()
invokeAndRun :: forall (handlerType :: HandlerType) context.
(Throws Invocation, Throws EnvironmentVariableNotSet) =>
RunCallback handlerType context
-> Manager -> Text -> Event -> Context context -> IO ()
invokeAndRun RunCallback handlerType context
callback Manager
manager Text
lambdaApi Event
event Context context
context = do
  LambdaResult handlerType
result <- forall (handlerType :: HandlerType) context.
(Throws Invocation, Throws EnvironmentVariableNotSet) =>
RunCallback handlerType context
-> Event -> Context context -> IO (LambdaResult handlerType)
invokeWithCallback RunCallback handlerType context
callback Event
event Context context
context

  forall (handlerType :: HandlerType) context.
LambdaResult handlerType
-> Text -> Context context -> Manager -> IO ()
Publish.result LambdaResult handlerType
result Text
lambdaApi Context context
context Manager
manager
    forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` \Invocation
err -> forall context.
Invocation -> Text -> Context context -> Manager -> IO ()
Publish.invocationError Invocation
err Text
lambdaApi Context context
context Manager
manager

invokeWithCallback ::
  Throws Error.Invocation =>
  Throws Error.EnvironmentVariableNotSet =>
  Runtime.RunCallback handlerType context ->
  ApiInfo.Event ->
  Context.Context context ->
  IO (Runtime.LambdaResult handlerType)
invokeWithCallback :: forall (handlerType :: HandlerType) context.
(Throws Invocation, Throws EnvironmentVariableNotSet) =>
RunCallback handlerType context
-> Event -> Context context -> IO (LambdaResult handlerType)
invokeWithCallback RunCallback handlerType context
callback Event
event Context context
context = do
  HandlerName
handlerName <- Text -> HandlerName
Runtime.HandlerName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Throws EnvironmentVariableNotSet => IO Text
Environment.handlerName
  let lambdaOptions :: LambdaOptions context
lambdaOptions =
        Runtime.LambdaOptions
          { eventObject :: RawEventObject
eventObject = Event -> RawEventObject
ApiInfo.event Event
event,
            functionHandler :: HandlerName
functionHandler = HandlerName
handlerName,
            executionUuid :: Text
executionUuid = Text
"", -- DirectCall doesnt use UUID
            contextObject :: Context context
contextObject = Context context
context
          }
  Either (LambdaError handlerType) (LambdaResult handlerType)
result <- RunCallback handlerType context
callback LambdaOptions context
lambdaOptions
  -- Flush output to insure output goes into CloudWatch logs
  IO ()
flushOutput
  case Either (LambdaError handlerType) (LambdaResult handlerType)
result of
    Left LambdaError handlerType
lambdaError -> case LambdaError handlerType
lambdaError of
      Runtime.StandaloneLambdaError (StandaloneLambdaResponseBodyPlain Text
err) ->
        forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> RawEventObject
encode Text
err
      Runtime.StandaloneLambdaError (StandaloneLambdaResponseBodyJson RawEventObject
err) ->
        forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation RawEventObject
err
      Runtime.APIGatewayLambdaError ApiGatewayResponse ApiGatewayResponseBody
err ->
        forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> RawEventObject
encode ApiGatewayResponse ApiGatewayResponseBody
err
      Runtime.ALBLambdaError ALBResponse ALBResponseBody
err ->
        forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> RawEventObject
encode ALBResponse ALBResponseBody
err
    Right LambdaResult handlerType
value ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure LambdaResult handlerType
value

variableNotSet :: Error.EnvironmentVariableNotSet -> IO a
variableNotSet :: forall a. EnvironmentVariableNotSet -> IO a
variableNotSet (Error.EnvironmentVariableNotSet Text
env) =
  forall a. HasCallStack => [Char] -> a
error ([Char]
"Error initializing, variable not set: " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
env)

errorParsing :: Error.Parsing -> IO a
errorParsing :: forall a. Parsing -> IO a
errorParsing Error.Parsing {Text
valueName :: Parsing -> Text
actualValue :: Parsing -> Text
errorMessage :: Parsing -> Text
valueName :: Text
actualValue :: Text
errorMessage :: Text
..} =
  forall a. HasCallStack => [Char] -> a
error ([Char]
"Failed parsing " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
errorMessage forall a. Semigroup a => a -> a -> a
<> [Char]
", got" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
actualValue)

-- | Flush standard output ('stdout') and standard error output ('stderr') handlers
flushOutput :: IO ()
flushOutput :: IO ()
flushOutput = do
  Handle -> IO ()
hFlush Handle
stdout
  Handle -> IO ()
hFlush Handle
stderr