Implement single process

Author: NickSeagull

app/Main.hs

@@ -4,18 +4,6 @@ module Main
   ) where
 
 import Aws.Lambda.Runtime
-import Control.Monad
-import qualified Network.HTTP.Client as Http
-
-
-httpManagerSettings :: Http.ManagerSettings
-httpManagerSettings =
-  -- We set the timeout to none, as AWS Lambda freezes the containers.
-  Http.defaultManagerSettings
-  { Http.managerResponseTimeout = Http.responseTimeoutNone
-  }
 
 main :: IO ()
-main = do
-  manager <- Http.newManager httpManagerSettings
-  forever (runLambda manager)
+main = runLambda IPC

package.yaml

@@ -37,7 +37,7 @@ library:
     - Aws.Lambda.Runtime
 
 executables:
-  bootstrap:
+  bootstrap-lol:
     source-dirs: app
     main: Main.hs
     dependencies:

src/Aws/Lambda.hs

@@ -3,4 +3,5 @@ module Aws.Lambda
   ) where
 
 import Aws.Lambda.Configuration as Reexported
+import Aws.Lambda.Runtime as Reexported
 import Aws.Lambda.Runtime.Context as Reexported

src/Aws/Lambda/Configuration.hs

@@ -1,18 +1,20 @@
 {-# OPTIONS_GHC -fno-warn-unused-pattern-binds #-}
 module Aws.Lambda.Configuration
   ( Main.LambdaOptions(..)
-  , Main.generate
   , Main.getRecord
   , configureLambda
+  , bootstrapLambda
   , IPC.returnAndFail
   , IPC.returnAndSucceed
   , Dispatch.decodeObj
+  , DispatchNoIPC.encodeObj
   )
 where
 
 import qualified Language.Haskell.TH as Meta
 
 import qualified Aws.Lambda.Meta.Dispatch as Dispatch
+import qualified Aws.Lambda.Meta.DispatchNoIPC as DispatchNoIPC
 import qualified Aws.Lambda.Meta.Main as Main
 import qualified Aws.Lambda.Meta.Run as Run
 import qualified Aws.Lambda.Runtime.IPC as IPC
@@ -22,6 +24,13 @@ AWS Lambda layer.
 -}
 configureLambda :: Meta.DecsQ
 configureLambda = do
-  main <- Main.generate
+  main <- Main.generateIPC
   run <- Run.generate
   return (main <> [run])
+
+{-| -}
+bootstrapLambda :: Meta.DecsQ
+bootstrapLambda = do
+  main <- Main.generateDirectCall
+  run <- Run.generateNoIPC
+  return (main <> [run])

src/Aws/Lambda/Meta/Common.hs

@@ -3,6 +3,7 @@ module Aws.Lambda.Meta.Common
   ( declarationName
   , expressionName
   , getFieldsFrom
+  , constructorName
   ) where
 
 import Data.Text (Text)
@@ -19,6 +20,10 @@ declarationName = pure . VarP . mkName . Text.unpack
 expressionName :: Text -> Q Exp
 expressionName = pure . VarE . mkName . Text.unpack
 
+-- | Helper for defining names for constructors
+-- think of @Foo@ in @quux = Foo 3@
+constructorName :: Text -> Q Exp
+constructorName = pure . ConE . mkName . Text.unpack
 
 -- | Helper for extracting fields of a specified record
 -- it expects the constructor name as the first parameter,

src/Aws/Lambda/Meta/DispatchNoIPC.hs

@@ -0,0 +1,73 @@
+{-| Dispatcher generation -}
+module Aws.Lambda.Meta.DispatchNoIPC
+  ( generate
+  , decodeObj
+  , encodeObj
+  , Runtime.LambdaResult(..)
+  ) where
+
+import Data.Function ((&))
+import Data.Text (Text)
+import qualified Data.Text as Text
+
+import Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as LazyByteString
+import qualified Language.Haskell.TH as Meta
+
+import Aws.Lambda.Meta.Common
+import qualified Aws.Lambda.Runtime.Common as Runtime
+
+{-| Helper function that the dispatcher will use to
+decode the JSON that comes as an AWS Lambda event into the
+appropriate type expected by the handler.
+-}
+decodeObj :: FromJSON a => String -> a
+decodeObj x =
+  case (eitherDecode $ LazyByteString.pack x) of
+    Left e  -> error e
+    Right v -> v
+
+{-| Helper function that the dispatcher will use to
+decode the JSON that comes as an AWS Lambda event into the
+appropriate type expected by the handler.
+-}
+encodeObj :: ToJSON a => a -> String
+encodeObj x = LazyByteString.unpack (encode x)
+
+
+{-| Generates the dispatcher out of a list of
+handler names in the form @src/Foo/Bar.handler@
+
+This dispatcher has a case for each of the handlers that calls
+the appropriate qualified function. In the case of the example above,
+the dispatcher will call @Foo.Bar.handler@.
+-}
+generate :: [Text] -> Meta.ExpQ
+generate handlerNames = do
+  caseExp <- expressionName "functionHandler"
+  matches <- traverse handlerCase handlerNames
+  unmatched <- unmatchedCase
+  pure $ Meta.CaseE caseExp (matches <> [unmatched])
+
+handlerCase :: Text -> Meta.MatchQ
+handlerCase lambdaHandler = do
+  let pat = Meta.LitP (Meta.StringL $ Text.unpack lambdaHandler)
+  body <- [e|do
+    result <- $(expressionName qualifiedName) (decodeObj $(expressionName "eventObject")) (decodeObj $(expressionName "contextObject"))
+-- ($(constructorName "LambdaResult") . encodeObj)
+    either (pure . Left . encodeObj) (pure . Right . $(constructorName "LambdaResult") . encodeObj) result |]
+  pure $ Meta.Match pat (Meta.NormalB body) []
+ where
+  qualifiedName =
+    lambdaHandler
+    & Text.dropWhile (/= '/')
+    & Text.drop 1
+    & Text.replace "/" "."
+
+unmatchedCase :: Meta.MatchQ
+unmatchedCase = do
+  let pattern = Meta.WildP
+  body <- [e|
+    pure $ Left ("Handler " <> $(expressionName "functionHandler") <> " does not exist on project")
+    |]
+  pure $ Meta.Match pattern (Meta.NormalB body) []

src/Aws/Lambda/Meta/Main.hs

@@ -1,27 +1,29 @@
 {-| main function generation for interoperation with the layer -}
 module Aws.Lambda.Meta.Main
-  ( LambdaOptions(..)
-  , generate
+  ( Runtime.LambdaOptions(..)
+  , generateIPC
+  , generateDirectCall
   , Options.getRecord
   ) where
 
-import GHC.Generics (Generic)
-
 import qualified Language.Haskell.TH as Meta
 import qualified Options.Generic as Options
 
 import Aws.Lambda.Meta.Common
-
--- | Options that the generated main expects
-data LambdaOptions = LambdaOptions
-  { eventObject     :: !String
-  , contextObject   :: !String
-  , functionHandler :: !String
-  , executionUuid   :: !String
-  } deriving (Generic, Options.ParseRecord)
+import qualified Aws.Lambda.Runtime.Common as Runtime
 
 -- | Generate the main function that the layer will call
-generate :: Meta.DecsQ
-generate = [d|
+generateIPC :: Meta.DecsQ
+generateIPC = [d|
   $(declarationName "main") = getRecord "" >>= run
   |]
+
+generateDirectCall :: Meta.DecsQ
+generateDirectCall = [d|
+  $(declarationName "main") = $(directCallBody)
+  |]
+ where
+  directCallBody =
+    [e|do
+    runLambda $ $(constructorName "DirectCall") run
+    |]

src/Aws/Lambda/Meta/Run.hs

@@ -1,12 +1,14 @@
 module Aws.Lambda.Meta.Run
   ( generate
+  , generateNoIPC
   ) where
 
 import qualified Language.Haskell.TH as Meta
 
 import Aws.Lambda.Meta.Common
 import qualified Aws.Lambda.Meta.Discover as Discover
 import qualified Aws.Lambda.Meta.Dispatch as Dispatch
+import qualified Aws.Lambda.Meta.DispatchNoIPC as DispatchNoIPC
 
 {-| Generate the run function
 
@@ -20,3 +22,10 @@ generate = do
   clause' <- getFieldsFrom "LambdaOptions" ["functionHandler", "contextObject", "eventObject", "executionUuid"]
   body <- Dispatch.generate handlers
   pure $ Meta.FunD (Meta.mkName "run") [Meta.Clause [clause'] (Meta.NormalB body) []]
+
+generateNoIPC :: Meta.DecQ
+generateNoIPC = do
+  handlers <- Meta.runIO Discover.handlers
+  clause' <- getFieldsFrom "LambdaOptions" ["functionHandler", "contextObject", "eventObject", "executionUuid"]
+  body <- DispatchNoIPC.generate handlers
+  pure $ Meta.FunD (Meta.mkName "run") [Meta.Clause [clause'] (Meta.NormalB body) []]

src/Aws/Lambda/Runtime.hs

@@ -1,45 +1,86 @@
 module Aws.Lambda.Runtime
   ( runLambda
+  , Runtime.Mode(..)
+  , Runtime.LambdaResult(..)
   ) where
 
 import Control.Exception.Safe.Checked
+import Control.Monad (forever)
 import qualified Network.HTTP.Client as Http
 
+import Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as LazyByteString
+
 import qualified Aws.Lambda.Runtime.ApiInfo as ApiInfo
 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.IPC as IPC
 import qualified Aws.Lambda.Runtime.Publish as Publish
+import qualified Aws.Lambda.Runtime.Common as Runtime
 
 -- | Runs the user @haskell_lambda@ executable and posts back the
--- results
-runLambda
-  :: Http.Manager
-  -> IO ()
-runLambda manager = do
-  lambdaApi <- Environment.apiEndpoint `catch` variableNotSet
-  event     <- ApiInfo.fetchEvent manager lambdaApi `catch` errorParsing
-  context   <- Context.initialize event `catch` errorParsing `catch` variableNotSet
-  ((invokeAndRun manager lambdaApi event context
-    `catch` \err -> Publish.parsingError err lambdaApi context manager)
-    `catch` \err -> Publish.invocationError err lambdaApi context manager)
-    `catch` \(err :: Error.EnvironmentVariableNotSet) -> Publish.runtimeInitError err lambdaApi context manager
+-- results. This is called from the layer's @main@ function.
+runLambda :: Runtime.Mode -> IO ()
+runLambda mode = do
+  manager <- Http.newManager httpManagerSettings
+  forever $ do
+    lambdaApi <- Environment.apiEndpoint `catch` variableNotSet
+    event     <- ApiInfo.fetchEvent manager lambdaApi `catch` errorParsing
+    context   <- Context.initialize event `catch` errorParsing `catch` variableNotSet
+    ((invokeAndRun mode manager lambdaApi event context
+      `catch` \err -> Publish.parsingError err lambdaApi context manager)
+      `catch` \err -> Publish.invocationError err lambdaApi context manager)
+      `catch` \(err :: Error.EnvironmentVariableNotSet) -> Publish.runtimeInitError err lambdaApi context manager
+
+httpManagerSettings :: Http.ManagerSettings
+httpManagerSettings =
+  -- We set the timeout to none, as AWS Lambda freezes the containers.
+  Http.defaultManagerSettings
+  { Http.managerResponseTimeout = Http.responseTimeoutNone
+  }
 
 invokeAndRun
   :: Throws Error.Parsing
   => Throws Error.Invocation
   => Throws Error.EnvironmentVariableNotSet
-  => Http.Manager
+  => Runtime.Mode
+  -> Http.Manager
   -> String
   -> ApiInfo.Event
   -> Context.Context
   -> IO ()
-invokeAndRun manager lambdaApi event context = do
-  result    <- IPC.invoke (ApiInfo.event event) context
+invokeAndRun mode manager lambdaApi event context = do
+  result    <- invokeWithMode mode event context
   Publish.result result lambdaApi context manager
     `catch` \err -> Publish.invocationError err lambdaApi context manager
 
+invokeWithMode
+  :: Throws Error.Invocation
+  => Throws Error.Parsing
+  => Throws Error.EnvironmentVariableNotSet
+  => Runtime.Mode
+  -> ApiInfo.Event
+  -> Context.Context
+  -> IO Runtime.LambdaResult
+invokeWithMode mode event context =
+  case mode of
+    Runtime.IPC -> IPC.invoke (ApiInfo.event event) context
+    (Runtime.DirectCall f) -> do
+      handlerName <- Environment.handlerName
+      let lambdaOptions = Runtime.LambdaOptions
+                          { eventObject = LazyByteString.unpack $ ApiInfo.event event
+                          , contextObject = LazyByteString.unpack . encode $ context
+                          , functionHandler = handlerName
+                          , executionUuid = ""  -- DirectCall doesnt use UUID
+                          }
+      result <- f lambdaOptions
+      case result of
+        Left err ->
+          throw $ Error.Invocation err
+        Right value ->
+          pure value
+
 variableNotSet :: Error.EnvironmentVariableNotSet -> IO a
 variableNotSet (Error.EnvironmentVariableNotSet env) =
   error ("Error initializing, variable not set: " <> env)

src/Aws/Lambda/Runtime/Common.hs

@@ -0,0 +1,35 @@
+module Aws.Lambda.Runtime.Common
+  ( Mode(..)
+  , LambdaResult(..)
+  , LambdaOptions(..)
+  ) where
+
+import GHC.Generics (Generic)
+import qualified Options.Generic as Options
+
+{-| Mode of calling the user functions.
+
+It can be 'IPC' (inter-process communication), where the
+dispatcher will spawn a process with the handlers of the
+user. (Used when using the layer)
+
+Or, it can be 'DirectCall', for when the handlers are in
+the same process. (The runtime is bootstrapped with the
+project).
+-}
+data Mode
+  = IPC
+  | DirectCall (LambdaOptions -> IO (Either String LambdaResult))
+  -- ^ This horrible signature implies the following
+
+-- | Options that the generated main expects
+data LambdaOptions = LambdaOptions
+  { eventObject     :: !String
+  , contextObject   :: !String
+  , functionHandler :: !String
+  , executionUuid   :: !String
+  } deriving (Generic, Options.ParseRecord)
+
+-- | Wrapper type to handle the result of the user
+newtype LambdaResult =
+  LambdaResult String