{-# 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)
runLambda :: forall context handlerType. IO context -> Runtime.RunCallback handlerType context -> IO ()
runLambda :: 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 <- context -> IO (IORef context)
forall a. a -> IO (IORef a)
newIORef context
customContext
Context context
context <- IORef context -> IO (Context context)
forall context.
(Throws Parsing, Throws EnvironmentVariableNotSet) =>
IORef context -> IO (Context context)
Context.initialize @context IORef context
customContextRef (Throws Parsing => IO (Context context))
-> (Parsing -> IO (Context context)) -> IO (Context context)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` Parsing -> IO (Context context)
forall a. Parsing -> IO a
errorParsing (Throws EnvironmentVariableNotSet => IO (Context context))
-> (EnvironmentVariableNotSet -> IO (Context context))
-> IO (Context context)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` EnvironmentVariableNotSet -> IO (Context context)
forall a. EnvironmentVariableNotSet -> IO a
variableNotSet
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text
lambdaApi <- Throws EnvironmentVariableNotSet => IO Text
Environment.apiEndpoint (Throws EnvironmentVariableNotSet => IO Text)
-> (EnvironmentVariableNotSet -> IO Text) -> IO Text
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` EnvironmentVariableNotSet -> IO Text
forall a. EnvironmentVariableNotSet -> IO a
variableNotSet
Event
event <- Manager -> Text -> IO Event
Throws Parsing => Manager -> Text -> IO Event
ApiInfo.fetchEvent Manager
manager Text
lambdaApi (Throws Parsing => IO Event) -> (Parsing -> IO Event) -> IO Event
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` Parsing -> IO Event
forall a. Parsing -> IO a
errorParsing
Context context
context <- Context context -> Event -> IO (Context context)
forall context. Context context -> Event -> IO (Context context)
Context.setEventData Context context
context Event
event
( ( ( RunCallback handlerType context
-> Manager -> Text -> Event -> Context context -> IO ()
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
(Throws Parsing => IO ()) -> (Parsing -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`Checked.catch` \Parsing
err -> Parsing -> Text -> Context context -> Manager -> IO ()
forall context.
Parsing -> Text -> Context context -> Manager -> IO ()
Publish.parsingError Parsing
err Text
lambdaApi Context context
context Manager
manager
)
(Throws Invocation => IO ()) -> (Invocation -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`Checked.catch` \Invocation
err -> Invocation -> Text -> Context context -> Manager -> IO ()
forall context.
Invocation -> Text -> Context context -> Manager -> IO ()
Publish.invocationError Invocation
err Text
lambdaApi Context context
context Manager
manager
)
(Throws EnvironmentVariableNotSet => IO ())
-> (EnvironmentVariableNotSet -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`Checked.catch` \(EnvironmentVariableNotSet
err :: Error.EnvironmentVariableNotSet) -> EnvironmentVariableNotSet
-> Text -> Context context -> Manager -> IO ()
forall err context.
ToJSON err =>
err -> Text -> Context context -> Manager -> IO ()
Publish.runtimeInitError EnvironmentVariableNotSet
err Text
lambdaApi Context context
context Manager
manager
)
IO () -> (Invocation -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Unchecked.catch` \Invocation
err -> Invocation -> Text -> Context context -> Manager -> IO ()
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 =
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 :: 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 <- RunCallback handlerType context
-> Event -> Context context -> IO (LambdaResult handlerType)
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
LambdaResult handlerType
-> Text -> Context context -> Manager -> IO ()
forall (handlerType :: HandlerType) context.
LambdaResult handlerType
-> Text -> Context context -> Manager -> IO ()
Publish.result LambdaResult handlerType
result Text
lambdaApi Context context
context Manager
manager
(Throws Invocation => IO ()) -> (Invocation -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> (e -> m a) -> m a
`catch` \Invocation
err -> Invocation -> Text -> Context context -> Manager -> IO ()
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 :: 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 (Text -> HandlerName) -> IO Text -> IO HandlerName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
Throws EnvironmentVariableNotSet => IO Text
Environment.handlerName
let lambdaOptions :: LambdaOptions context
lambdaOptions =
LambdaOptions :: forall context.
RawEventObject
-> HandlerName -> Text -> Context context -> LambdaOptions context
Runtime.LambdaOptions
{ eventObject :: RawEventObject
eventObject = Event -> RawEventObject
ApiInfo.event Event
event,
functionHandler :: HandlerName
functionHandler = HandlerName
handlerName,
executionUuid :: Text
executionUuid = Text
"",
contextObject :: Context context
contextObject = Context context
context
}
Either (LambdaError handlerType) (LambdaResult handlerType)
result <- RunCallback handlerType context
callback LambdaOptions context
lambdaOptions
IO ()
flushOutput
case Either (LambdaError handlerType) (LambdaResult handlerType)
result of
Left LambdaError handlerType
lambdaError -> case LambdaError handlerType
lambdaError of
Runtime.StandaloneLambdaError (StandaloneLambdaResponseBodyPlain Text
err) ->
Invocation -> IO (LambdaResult handlerType)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw (Invocation -> IO (LambdaResult handlerType))
-> Invocation -> IO (LambdaResult handlerType)
forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation (RawEventObject -> Invocation) -> RawEventObject -> Invocation
forall a b. (a -> b) -> a -> b
$ Text -> RawEventObject
forall a. ToJSON a => a -> RawEventObject
encode Text
err
Runtime.StandaloneLambdaError (StandaloneLambdaResponseBodyJson RawEventObject
err) ->
Invocation -> IO (LambdaResult handlerType)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw (Invocation -> IO (LambdaResult handlerType))
-> Invocation -> IO (LambdaResult handlerType)
forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation RawEventObject
err
Runtime.APIGatewayLambdaError ApiGatewayResponse ApiGatewayResponseBody
err ->
Invocation -> IO (LambdaResult handlerType)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw (Invocation -> IO (LambdaResult handlerType))
-> Invocation -> IO (LambdaResult handlerType)
forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation (RawEventObject -> Invocation) -> RawEventObject -> Invocation
forall a b. (a -> b) -> a -> b
$ ApiGatewayResponse ApiGatewayResponseBody -> RawEventObject
forall a. ToJSON a => a -> RawEventObject
encode ApiGatewayResponse ApiGatewayResponseBody
err
Runtime.ALBLambdaError ALBResponse ALBResponseBody
err ->
Invocation -> IO (LambdaResult handlerType)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw (Invocation -> IO (LambdaResult handlerType))
-> Invocation -> IO (LambdaResult handlerType)
forall a b. (a -> b) -> a -> b
$ RawEventObject -> Invocation
Error.Invocation (RawEventObject -> Invocation) -> RawEventObject -> Invocation
forall a b. (a -> b) -> a -> b
$ ALBResponse ALBResponseBody -> RawEventObject
forall a. ToJSON a => a -> RawEventObject
encode ALBResponse ALBResponseBody
err
Right LambdaResult handlerType
value ->
LambdaResult handlerType -> IO (LambdaResult handlerType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LambdaResult handlerType
value
variableNotSet :: Error.EnvironmentVariableNotSet -> IO a
variableNotSet :: EnvironmentVariableNotSet -> IO a
variableNotSet (Error.EnvironmentVariableNotSet Text
env) =
[Char] -> IO a
forall a. HasCallStack => [Char] -> a
error ([Char]
"Error initializing, variable not set: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
env)
errorParsing :: Error.Parsing -> IO a
errorParsing :: Parsing -> IO a
errorParsing Error.Parsing {Text
valueName :: Parsing -> Text
actualValue :: Parsing -> Text
errorMessage :: Parsing -> Text
valueName :: Text
actualValue :: Text
errorMessage :: Text
..} =
[Char] -> IO a
forall a. HasCallStack => [Char] -> a
error ([Char]
"Failed parsing " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
errorMessage [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
", got" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
actualValue)
flushOutput :: IO ()
flushOutput :: IO ()
flushOutput = do
Handle -> IO ()
hFlush Handle
stdout
Handle -> IO ()
hFlush Handle
stderr