aws-lambda-haskell-runtime 2.0.4 → 2.0.6

raw patch · 13 files changed

+330/−60 lines, 13 filesdep +case-insensitivedep +unordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: case-insensitive, unordered-containers

API changes (from Hackage documentation)

Files

• aws-lambda-haskell-runtime.cabal +7/−4
• src/Aws/Lambda.hs +1/−0
• src/Aws/Lambda/Configuration.hs +3/−3
• src/Aws/Lambda/Meta/Dispatch.hs +71/−21
• src/Aws/Lambda/Meta/Main.hs +5/−1
• src/Aws/Lambda/Meta/Run.hs +4/−3
• src/Aws/Lambda/Runtime.hs +20/−7
• src/Aws/Lambda/Runtime/ApiGatewayInfo.hs +153/−0
• src/Aws/Lambda/Runtime/ApiInfo.hs +3/−3
• src/Aws/Lambda/Runtime/Common.hs +42/−5
• src/Aws/Lambda/Runtime/Environment.hs +1/−1
• src/Aws/Lambda/Runtime/Error.hs +6/−5
• src/Aws/Lambda/Runtime/Publish.hs +14/−7

@@ -1,13 +1,13 @@-cabal-version: 1.12
+cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: bb9ab608e3081e6e7eb875e81698026b23343c4e3c64e5ab89e4df76aeb280f3+-- hash: eab5b338b49db7854613ecd43b17245f105c8c936c40230ecf9d08c5dfad9d6d  name:           aws-lambda-haskell-runtime-version:        2.0.4+version:        2.0.6 synopsis:       Haskell runtime for AWS Lambda description:    Please see the README on GitHub at <https://github.com/theam/aws-lambda-haskell-runtime#readme> category:       AWS@@ -39,6 +39,7 @@       Aws.Lambda.Meta.Run       Aws.Lambda.Runtime.API.Endpoints       Aws.Lambda.Runtime.API.Version+      Aws.Lambda.Runtime.ApiGatewayInfo       Aws.Lambda.Runtime.ApiInfo       Aws.Lambda.Runtime.Common       Aws.Lambda.Runtime.Context@@ -54,6 +55,7 @@       aeson     , base >=4.7 && <5     , bytestring+    , case-insensitive     , http-client     , http-types     , path >0.7@@ -61,6 +63,7 @@     , safe-exceptions-checked     , template-haskell     , text+    , unordered-containers   default-language: Haskell2010  test-suite aws-lambda-haskell-runtime-test

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

@@ -15,8 +15,8 @@  {-| Generates a @main@ function that acts as a dispatcher -}-generateLambdaDispatcher :: Meta.DecsQ-generateLambdaDispatcher = do+generateLambdaDispatcher :: Main.DispatcherStrategy -> Main.DispatcherOptions -> Meta.DecsQ+generateLambdaDispatcher strategy options = do   main <- Main.generate-  run <- Run.generate+  run <- Run.generate options strategy   return (main <> [run])

@@ -1,3 +1,6 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+ {-| Dispatcher generation -} module Aws.Lambda.Meta.Dispatch   ( generate@@ -17,16 +20,22 @@  import Aws.Lambda.Meta.Common import qualified Aws.Lambda.Runtime.Common as Runtime+import qualified Aws.Lambda.Runtime.Error as Error+import qualified Aws.Lambda.Runtime.ApiGatewayInfo as ApiGatewayInfo+import qualified Control.Exception as Unchecked+import qualified Aws.Lambda.Meta.Main as Main+import Data.Typeable (Typeable, typeRep, Proxy (..))  {-| 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 :: forall a. (FromJSON a, Typeable a) => String -> Either Error.Parsing a decodeObj x =+  let objName = show (typeRep (Proxy :: Proxy a)) in   case (eitherDecode $ LazyByteString.pack x) of-    Left e  -> error e-    Right v -> v+    Left e  -> Left $ Error.Parsing e x objName+    Right v -> return v  {-| Helper function that the dispatcher will use to decode the JSON that comes as an AWS Lambda event into the@@ -43,31 +52,72 @@ 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+generate :: Main.DispatcherOptions -> Main.DispatcherStrategy -> [Text] -> Meta.ExpQ+generate options strategy handlerNames = do   caseExp <- expressionName "functionHandler"-  matches <- traverse handlerCase handlerNames-  unmatched <- unmatchedCase-  pure $ Meta.CaseE caseExp (matches <> [unmatched])+  case strategy of+    Main.StandaloneLambda -> do+      matches <- traverse standaloneLambdaHandlerCase handlerNames+      unmatched <- standaloneLambdaUnmatchedCase+      pure $ Meta.CaseE caseExp (matches <> [unmatched])+    Main.UseWithAPIGateway -> do+      matches <- traverse (apiGatewayHandlerCase options) handlerNames+      unmatched <- apiGatewayUnmatchedCase+      pure $ Meta.CaseE caseExp (matches <> [unmatched]) -handlerCase :: Text -> Meta.MatchQ-handlerCase lambdaHandler = do+standaloneLambdaHandlerCase :: Text -> Meta.MatchQ+standaloneLambdaHandlerCase lambdaHandler = do   let pat = Meta.LitP (Meta.StringL $ Text.unpack lambdaHandler)   body <- [e|do-    result <- $(expressionName qualifiedName) (decodeObj $(expressionName "eventObject")) (decodeObj $(expressionName "contextObject"))-    either (pure . Left . encodeObj) (pure . Right . $(constructorName "LambdaResult") . encodeObj) result |]+    case decodeObj $(expressionName "eventObject") of+      Right eventObject -> case decodeObj $(expressionName "contextObject") of+        Right context -> (do+          result <- $(expressionName (qualifiedHandlerName lambdaHandler)) eventObject context+          either (pure . Left . Runtime.StandaloneLambdaError . encodeObj) (pure . Right . Runtime.StandaloneLambdaResult . encodeObj) result)+          `Unchecked.catch` \(handlerError :: Unchecked.SomeException) -> pure . Left . Runtime.StandaloneLambdaError . encodeObj . show $ handlerError+        Left err -> pure . Left . Runtime.StandaloneLambdaError . encodeObj $ err+      Left err -> pure . Left . Runtime.StandaloneLambdaError . encodeObj $ err|]   pure $ Meta.Match pat (Meta.NormalB body) []- where-  qualifiedName =-    lambdaHandler-    & Text.splitOn "/"-    & filter (Char.isUpper . Text.head)-    & Text.intercalate "." -unmatchedCase :: Meta.MatchQ-unmatchedCase = do+standaloneLambdaUnmatchedCase :: Meta.MatchQ+standaloneLambdaUnmatchedCase = do   let pattern = Meta.WildP   body <- [e|-    pure $ Left ("Handler " <> $(expressionName "functionHandler") <> " does not exist on project")+    pure . Left . Runtime.StandaloneLambdaError . encodeObj $ ("Handler " <> $(expressionName "functionHandler") <> " does not exist on project")     |]   pure $ Meta.Match pattern (Meta.NormalB body) []++apiGatewayHandlerCase :: Main.DispatcherOptions -> Text -> Meta.MatchQ+apiGatewayHandlerCase options lambdaHandler = do+  let pat = Meta.LitP (Meta.StringL $ Text.unpack lambdaHandler)+  body <- [e|do+    let returnErr statusCode = pure . Left . Runtime.ApiGatewayLambdaError . ApiGatewayInfo.mkApiGatewayResponse statusCode+    case decodeObj $(expressionName "eventObject") of+      Right eventObject -> case decodeObj $(expressionName "contextObject") of+        Right context -> do+          resultE <- Unchecked.try $ $(expressionName (qualifiedHandlerName lambdaHandler)) eventObject context+          case resultE of+            Right result ->+              either (pure . Left . Runtime.ApiGatewayLambdaError . fmap toJSON) (pure . Right . Runtime.ApiGatewayResult . fmap toJSON) result+            Left (handlerError :: Unchecked.SomeException) ->+              if (Runtime.propagateImpureExceptions . Runtime.apiGatewayDispatcherOptions $ options)+              then returnErr 500 . toJSON . show $ handlerError+              else returnErr 500 . toJSON $ "Something went wrong."+        Left err -> returnErr 500 . toJSON $ err+      Left err -> returnErr 400 . toJSON $ err|]+  pure $ Meta.Match pat (Meta.NormalB body) []++apiGatewayUnmatchedCase :: Meta.MatchQ+apiGatewayUnmatchedCase = do+  let pattern = Meta.WildP+  body <- [e|+    pure . Left . Runtime.ApiGatewayLambdaError . ApiGatewayInfo.mkApiGatewayResponse 500 . toJSON $ ("Handler " <> $(expressionName "functionHandler") <> " does not exist on project")+    |]+  pure $ Meta.Match pattern (Meta.NormalB body) []++qualifiedHandlerName :: Text -> Text+qualifiedHandlerName lambdaHandler =+    lambdaHandler+    & Text.splitOn "/"+    & filter (Char.isUpper . Text.head)+    & Text.intercalate "."

@@ -1,6 +1,10 @@ {-| main function generation for interoperation with the layer -} module Aws.Lambda.Meta.Main   ( Runtime.LambdaOptions(..)+  , Runtime.DispatcherStrategy(..)+  , Runtime.DispatcherOptions(..)+  , Runtime.ApiGatewayDispatcherOptions(..)+  , Runtime.defaultDispatcherOptions   , generate   ) where @@ -16,6 +20,6 @@   |]  where   directCallBody =-    [e|do+    [e|     runLambda run     |]

@@ -7,10 +7,11 @@ 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.Main as Main -generate :: Meta.DecQ-generate = do+generate :: Main.DispatcherOptions -> Main.DispatcherStrategy -> Meta.DecQ+generate options strategy = do   handlers <- Meta.runIO Discover.handlers   clause' <- getFieldsFrom "LambdaOptions" ["functionHandler", "contextObject", "eventObject", "executionUuid"]-  body <- Dispatch.generate handlers+  body <- Dispatch.generate options strategy handlers   pure $ Meta.FunD (Meta.mkName "run") [Meta.Clause [clause'] (Meta.NormalB body) []]

@@ -1,9 +1,15 @@ module Aws.Lambda.Runtime   ( runLambda   , Runtime.LambdaResult(..)+  , Runtime.DispatcherStrategy(..)+  , Runtime.DispatcherOptions(..)+  , Runtime.ApiGatewayDispatcherOptions(..)+  , Runtime.defaultDispatcherOptions+  , Error.Parsing(..)   ) where  import Control.Exception.Safe.Checked+import qualified Control.Exception.Safe.Checked as Checked import Control.Monad (forever) import System.IO (hFlush, stdout, stderr) import qualified Network.HTTP.Client as Http@@ -17,6 +23,7 @@ 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 qualified Control.Exception as Unchecked  -- | Runs the user @haskell_lambda@ executable and posts back the -- results. This is called from the layer's @main@ function.@@ -27,11 +34,13 @@     lambdaApi <- Environment.apiEndpoint `catch` variableNotSet     event     <- ApiInfo.fetchEvent manager lambdaApi `catch` errorParsing     context   <- Context.initialize event `catch` errorParsing `catch` variableNotSet-    ((invokeAndRun callback 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 +    (((invokeAndRun callback manager lambdaApi event context+      `Checked.catch` \err -> Publish.parsingError err lambdaApi context manager)+      `Checked.catch` \err -> Publish.invocationError err lambdaApi context manager)+      `Checked.catch` \(err :: Error.EnvironmentVariableNotSet) -> Publish.runtimeInitError err lambdaApi context manager)+      `Unchecked.catch` \err -> Publish.invocationError err lambdaApi context manager+ httpManagerSettings :: Http.ManagerSettings httpManagerSettings =   -- We set the timeout to none, as AWS Lambda freezes the containers.@@ -49,7 +58,8 @@   -> Context.Context   -> IO () invokeAndRun callback manager lambdaApi event context = do-  result    <- invokeWithCallback callback event context+  result <- invokeWithCallback callback event context+   Publish.result result lambdaApi context manager     `catch` \err -> Publish.invocationError err lambdaApi context manager @@ -72,8 +82,11 @@   -- Flush output to insure output goes into CloudWatch logs   flushOutput   case result of-    Left err ->-      throw $ Error.Invocation err+    Left lambdaError -> case lambdaError of+      Runtime.StandaloneLambdaError err ->+        throw $ Error.Invocation $ toJSON err+      Runtime.ApiGatewayLambdaError err ->+        throw $ Error.Invocation $ toJSON err     Right value ->       pure value 

@@ -0,0 +1,153 @@+{-# LANGUAGE DuplicateRecordFields #-}++module Aws.Lambda.Runtime.ApiGatewayInfo+  ( ApiGatewayRequest(..)+  , ApiGatewayRequestContext(..)+  , ApiGatewayRequestContextIdentity(..)+  , ApiGatewayResponse(..)+  , mkApiGatewayResponse ) where++import Data.Aeson+import Data.HashMap.Strict (HashMap)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import GHC.Generics (Generic)+import Network.HTTP.Types+import qualified Data.CaseInsensitive as CI+import qualified Data.Aeson.Types as T+import qualified Data.ByteString.Lazy.Char8 as LazyByteString+import Data.Aeson.Types (Parser)++data ApiGatewayRequest body = ApiGatewayRequest+  { apiGatewayRequestResource              :: !Text+  , apiGatewayRequestPath                  :: !Text+  , apiGatewayRequestHttpMethod            :: !Text+  , apiGatewayRequestHeaders               :: !(HashMap Text Text)+  , apiGatewayRequestQueryStringParameters :: !(Maybe [(Text, Maybe Text)])+  , apiGatewayRequestPathParameters        :: !(Maybe (HashMap Text Text))+  , apiGatewayRequestStageVariables        :: !(Maybe (HashMap Text Text))+  , apiGatewayRequestIsBase64Encoded       :: !Bool+  , apiGatewayRequestRequestContext        :: !ApiGatewayRequestContext+  , apiGatewayRequestBody                  :: !(Maybe body)+  } deriving (Show)++instance FromJSON body => FromJSON (ApiGatewayRequest body) where+  parseJSON (Object v) = ApiGatewayRequest <$>+    v .: "resource" <*>+    v .: "path" <*>+    v .: "httpMethod" <*>+    v .: "headers" <*>+    v .: "queryStringParameters" <*>+    v .: "pathParameters" <*>+    v .: "stageVariables" <*>+    v .: "isBase64Encoded" <*>+    v .: "requestContext" <*>+    v `parseObjectFromStringField` "body"+  parseJSON _ = fail "Expected ApiGatewayRequest to be an object."++data ApiGatewayRequestContext = ApiGatewayRequestContext+  { apiGatewayRequestContextResourceId        :: !Text+  , apiGatewayRequestContextResourcePath      :: !Text+  , apiGatewayRequestContextHttpMethod        :: !Text+  , apiGatewayRequestContextExtendedRequestId :: !Text+  , apiGatewayRequestContextRequestTime       :: !Text+  , apiGatewayRequestContextPath              :: !Text+  , apiGatewayRequestContextAccountId         :: !Text+  , apiGatewayRequestContextProtocol          :: !Text+  , apiGatewayRequestContextStage             :: !Text+  , apiGatewayRequestContextDomainPrefix      :: !Text+  , apiGatewayRequestContextRequestId         :: !Text+  , apiGatewayRequestContextDomainName        :: !Text+  , apiGatewayRequestContextApiId             :: !Text+  , apiGatewayRequestContextIdentity          :: !ApiGatewayRequestContextIdentity+  } deriving (Show)++instance FromJSON ApiGatewayRequestContext where+  parseJSON (Object v) = ApiGatewayRequestContext <$>+    v .: "resourceId" <*>+    v .: "path" <*>+    v .: "httpMethod" <*>+    v .: "extendedRequestId" <*>+    v .: "requestTime" <*>+    v .: "path" <*>+    v .: "accountId" <*>+    v .: "protocol" <*>+    v .: "stage" <*>+    v .: "domainPrefix" <*>+    v .: "requestId" <*>+    v .: "domainName" <*>+    v .: "apiId" <*>+    v .: "identity"+  parseJSON _ = fail "Expected ApiGatewayRequestContext to be an object."++data ApiGatewayRequestContextIdentity = ApiGatewayRequestContextIdentity+  { apiGatewayRequestContextIdentityCognitoIdentityPoolId         :: !(Maybe Text)+  , apiGatewayRequestContextIdentityAccountId                     :: !(Maybe Text)+  , apiGatewayRequestContextIdentityCognitoIdentityId             :: !(Maybe Text)+  , apiGatewayRequestContextIdentityCaller                        :: !(Maybe Text)+  , apiGatewayRequestContextIdentitySourceIp                      :: !(Maybe Text)+  , apiGatewayRequestContextIdentityPrincipalOrgId                :: !(Maybe Text)+  , apiGatewayRequestContextIdentityAccesskey                     :: !(Maybe Text)+  , apiGatewayRequestContextIdentityCognitoAuthenticationType     :: !(Maybe Text)+  , apiGatewayRequestContextIdentityCognitoAuthenticationProvider :: !(Maybe Value)+  , apiGatewayRequestContextIdentityUserArn                       :: !(Maybe Text)+  , apiGatewayRequestContextIdentityUserAgent                     :: !(Maybe Text)+  , apiGatewayRequestContextIdentityUser                          :: !(Maybe Text)+  } deriving (Show)++instance FromJSON ApiGatewayRequestContextIdentity where+  parseJSON (Object v) = ApiGatewayRequestContextIdentity <$>+    v .: "cognitoIdentityPoolId" <*>+    v .: "accountId" <*>+    v .: "cognitoIdentityId" <*>+    v .: "caller" <*>+    v .: "sourceIp" <*>+    v .: "principalOrgId" <*>+    v .: "accessKey" <*>+    v .: "cognitoAuthenticationType" <*>+    v .: "cognitoAuthenticationProvider" <*>+    v .: "userArn" <*>+    v .: "userAgent" <*>+    v .: "user"+  parseJSON _ = fail "Expected ApiGatewayRequestContextIdentity to be an object."++-- We need this because API Gateway is going to send us the payload as a JSON string+parseObjectFromStringField :: FromJSON a => Object -> Text -> Parser (Maybe a)+parseObjectFromStringField obj fieldName = do+  fieldContents <- obj .: fieldName+  case fieldContents of+    String stringContents ->+      case eitherDecodeStrict (T.encodeUtf8 stringContents) of+        Right success -> pure success+        Left err -> fail err+    Null -> pure Nothing+    other -> T.typeMismatch "String or Null" other++data ApiGatewayResponse body = ApiGatewayResponse+  { apiGatewayResponseStatusCode      :: !Int+  , apiGatewayResponseHeaders         :: !ResponseHeaders+  , apiGatewayResponseBody            :: !body+  , apiGatewayResponseIsBase64Encoded :: !Bool+  } deriving (Generic, Show)++instance Functor ApiGatewayResponse where+  fmap f v = v { apiGatewayResponseBody = f (apiGatewayResponseBody v) }++instance ToJSON body => ToJSON (ApiGatewayResponse body)  where+  toJSON ApiGatewayResponse {..} = object+    [ "statusCode" .= apiGatewayResponseStatusCode+    , "body" .= (String . T.pack . LazyByteString.unpack . encode @body $ apiGatewayResponseBody)+    , "headers" .= object (map headerToPair apiGatewayResponseHeaders)+    , "isBase64Encoded" .= apiGatewayResponseIsBase64Encoded+    ]++mkApiGatewayResponse :: Int -> payload -> ApiGatewayResponse payload+mkApiGatewayResponse code payload =+  ApiGatewayResponse code [] payload False++headerToPair :: Header -> T.Pair+headerToPair (cibyte, bstr) = k .= v+ where+  k = (T.decodeUtf8 . CI.original) cibyte+  v = T.decodeUtf8 bstr

@@ -24,14 +24,14 @@   , awsRequestId       :: !String   , invokedFunctionArn :: !String   , event              :: !Lazy.ByteString-  }+  } deriving (Show)  -- | Performs a GET to the endpoint that provides the next event fetchEvent :: Throws Error.Parsing => Http.Manager -> String -> IO Event fetchEvent manager lambdaApi = do   response <- fetchApiData manager lambdaApi   let body = Http.responseBody response-  let headers = Http.responseHeaders response+      headers = Http.responseHeaders response   Monad.foldM reduceEvent (initialEvent body) headers  fetchApiData :: Http.Manager -> String -> IO (Http.Response Lazy.ByteString)@@ -46,7 +46,7 @@     ("Lambda-Runtime-Deadline-Ms", value) ->       case Read.readMaybe $ ByteString.unpack value of         Just ms -> pure event { deadlineMs = ms }-        Nothing -> throw (Error.Parsing "deadlineMs" $ ByteString.unpack value)+        Nothing -> throw (Error.Parsing "Could not parse deadlineMs." (ByteString.unpack value) "deadlineMs")      ("Lambda-Runtime-Trace-Id", value) ->       pure event { traceId = ByteString.unpack value }

@@ -1,15 +1,56 @@+{-# LANGUAGE DeriveLift #-}+ module Aws.Lambda.Runtime.Common   ( RunCallback   , LambdaResult(..)+  , LambdaError(..)   , LambdaOptions(..)+  , DispatcherOptions(..)+  , ApiGatewayDispatcherOptions(..)+  , DispatcherStrategy(..)+  , defaultDispatcherOptions   ) where +import Aws.Lambda.Runtime.ApiGatewayInfo+import Data.Aeson (Value) import GHC.Generics (Generic)+import Language.Haskell.TH.Syntax (Lift) +-- | API Gateway specific dispatcher options+newtype ApiGatewayDispatcherOptions = ApiGatewayDispatcherOptions+  { propagateImpureExceptions :: Bool+  -- ^ Should impure exceptions be propagated through the API Gateway interface+  } deriving (Lift)++-- | Options that the dispatcher generator expects+newtype DispatcherOptions = DispatcherOptions+  { apiGatewayDispatcherOptions :: ApiGatewayDispatcherOptions+  } deriving (Lift)++defaultDispatcherOptions :: DispatcherOptions+defaultDispatcherOptions =+  DispatcherOptions (ApiGatewayDispatcherOptions True)++-- | A strategy on how to generate the dispatcher functions+data DispatcherStrategy =+  UseWithAPIGateway |+  StandaloneLambda+  deriving (Lift)+ -- | Callback that we pass to the dispatcher function type RunCallback =-  LambdaOptions -> IO (Either String LambdaResult)+  LambdaOptions -> IO (Either LambdaError LambdaResult) +-- | Wrapper type for lambda execution results+data LambdaError =+  StandaloneLambdaError String |+  ApiGatewayLambdaError (ApiGatewayResponse Value)++-- | Wrapper type to handle the result of the user+data LambdaResult =+  StandaloneLambdaResult String |+  ApiGatewayResult (ApiGatewayResponse Value)+ -- | Options that the generated main expects data LambdaOptions = LambdaOptions   { eventObject     :: !String@@ -17,7 +58,3 @@   , functionHandler :: !String   , executionUuid   :: !String   } deriving (Generic)---- | Wrapper type to handle the result of the user-newtype LambdaResult =-  LambdaResult String

@@ -55,7 +55,7 @@   memoryValue <- readEnvironmentVariable envVar   case Read.readMaybe memoryValue of     Just value -> pure value-    Nothing    -> throw (Error.Parsing envVar memoryValue)+    Nothing    -> throw (Error.Parsing envVar memoryValue envVar)  readEnvironmentVariable :: Throws Error.EnvironmentVariableNotSet => String -> IO String readEnvironmentVariable envVar = do

@@ -7,7 +7,7 @@   ) where  import Control.Exception.Safe.Checked-import Data.Aeson (ToJSON (..), object, (.=))+import Data.Aeson (ToJSON (..), object, (.=), Value)  newtype EnvironmentVariableNotSet =   EnvironmentVariableNotSet String@@ -22,18 +22,19 @@ data Parsing = Parsing   { errorMessage :: String   , actualValue  :: String+  , valueName    :: String   } deriving (Show, Exception)  instance ToJSON Parsing where-  toJSON (Parsing objectBeingParsed value) = object+  toJSON (Parsing errorMessage _ valueName) = object     [ "errorType" .= ("Parsing" :: String)-    , "errorMessage" .= ("Parse error for " <> objectBeingParsed <> ", could not parse value '" <> value <> "'")+    , "errorMessage" .= ("Could not parse '" <> valueName <> "': " <> errorMessage)     ]  newtype Invocation =-  Invocation String+  Invocation Value   deriving (Show, Exception)  instance ToJSON Invocation where   -- We return the user error as it is-  toJSON (Invocation err) = toJSON err+  toJSON (Invocation err) = err

@@ -19,20 +19,24 @@  -- | Publishes the result back to AWS Lambda result :: LambdaResult -> String -> Context -> Http.Manager -> IO ()-result (LambdaResult res) lambdaApi context manager = do+result lambdaResult lambdaApi context manager = do   let Endpoints.Endpoint endpoint = Endpoints.response lambdaApi (awsRequestId context)   rawRequest <- Http.parseRequest endpoint-  let request = rawRequest++  let requestBody = case lambdaResult of+        (StandaloneLambdaResult res) -> Http.RequestBodyBS (ByteString.pack res)+        (ApiGatewayResult res) -> Http.RequestBodyLBS (encode res)+      request = rawRequest                 { Http.method = "POST"-                , Http.requestBody = Http.RequestBodyBS (ByteString.pack res)+                , Http.requestBody = requestBody                 }+   void $ Http.httpNoBody request manager  -- | Publishes an invocation error back to AWS Lambda invocationError :: Error.Invocation -> String -> Context -> Http.Manager -> IO () invocationError err lambdaApi context =-  publish err (Endpoints.invocationError lambdaApi $ awsRequestId context)-    context+  publish err (Endpoints.invocationError lambdaApi $ awsRequestId context) context  -- | Publishes a parsing error back to AWS Lambda parsingError :: Error.Parsing -> String -> Context -> Http.Manager -> IO ()@@ -48,8 +52,11 @@ publish :: ToJSON err => err -> Endpoints.Endpoint -> Context -> Http.Manager -> IO () publish err (Endpoints.Endpoint endpoint) Context{..} manager = do   rawRequest <- Http.parseRequest endpoint-  let request = rawRequest++  let requestBody = Http.RequestBodyLBS (encode err)+      request = rawRequest                 { Http.method = "POST"-                , Http.requestBody = Http.RequestBodyLBS (encode err)+                , Http.requestBody = requestBody                 }+   void $ Http.httpNoBody request manager