diff --git a/aws-lambda-haskell-runtime.cabal b/aws-lambda-haskell-runtime.cabal --- a/aws-lambda-haskell-runtime.cabal +++ b/aws-lambda-haskell-runtime.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.3. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack name: aws-lambda-haskell-runtime -version: 4.1.0 +version: 4.1.1 synopsis: Haskell runtime for AWS Lambda description: Please see the README on GitHub at category: AWS @@ -46,7 +46,16 @@ Paths_aws_lambda_haskell_runtime hs-source-dirs: src - default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables DeriveGeneric TypeApplications FlexibleContexts DeriveAnyClass QuasiQuotes + default-extensions: + TemplateHaskell + OverloadedStrings + RecordWildCards + ScopedTypeVariables + DeriveGeneric + TypeApplications + FlexibleContexts + DeriveAnyClass + QuasiQuotes ghc-options: -Wall -optP-Wno-nonportable-include-path -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Widentities -Wredundant-constraints -Wmissing-export-lists -Wpartial-fields -fhide-source-paths -freverse-errors build-depends: aeson @@ -73,7 +82,16 @@ Paths_aws_lambda_haskell_runtime hs-source-dirs: test - default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables DeriveGeneric TypeApplications FlexibleContexts DeriveAnyClass QuasiQuotes + default-extensions: + TemplateHaskell + OverloadedStrings + RecordWildCards + ScopedTypeVariables + DeriveGeneric + TypeApplications + FlexibleContexts + DeriveAnyClass + QuasiQuotes ghc-options: -Wall -optP-Wno-nonportable-include-path -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Widentities -Wredundant-constraints -Wmissing-export-lists -Wpartial-fields -fhide-source-paths -freverse-errors -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 diff --git a/src/Aws/Lambda/Runtime.hs b/src/Aws/Lambda/Runtime.hs --- a/src/Aws/Lambda/Runtime.hs +++ b/src/Aws/Lambda/Runtime.hs @@ -17,11 +17,12 @@ 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 (ToJSON (toJSON)) +import Data.Aeson (encode) import Data.IORef (newIORef) import Data.Text (Text, unpack) import qualified Network.HTTP.Client as Http @@ -94,12 +95,14 @@ flushOutput case result of Left lambdaError -> case lambdaError of - Runtime.StandaloneLambdaError err -> - throw $ Error.Invocation $ toJSON err + Runtime.StandaloneLambdaError (StandaloneLambdaResponseBodyPlain err) -> + throw $ Error.Invocation $ encode err + Runtime.StandaloneLambdaError (StandaloneLambdaResponseBodyJson err) -> + throw $ Error.Invocation err Runtime.APIGatewayLambdaError err -> - throw $ Error.Invocation $ toJSON err + throw $ Error.Invocation $ encode err Runtime.ALBLambdaError err -> - throw $ Error.Invocation $ toJSON err + throw $ Error.Invocation $ encode err Right value -> pure value diff --git a/src/Aws/Lambda/Runtime/Error.hs b/src/Aws/Lambda/Runtime/Error.hs --- a/src/Aws/Lambda/Runtime/Error.hs +++ b/src/Aws/Lambda/Runtime/Error.hs @@ -7,7 +7,8 @@ where import Control.Exception.Safe.Checked (Exception) -import Data.Aeson (ToJSON (..), Value, object, (.=)) +import Data.Aeson (ToJSON (..), object, (.=)) +import qualified Data.ByteString.Lazy as LBS import Data.Text (Text) newtype EnvironmentVariableNotSet @@ -36,9 +37,5 @@ ] newtype Invocation - = Invocation Value + = Invocation LBS.ByteString deriving (Show, Exception) - -instance ToJSON Invocation where - -- We return the user error as it is - toJSON (Invocation err) = err diff --git a/src/Aws/Lambda/Runtime/Publish.hs b/src/Aws/Lambda/Runtime/Publish.hs --- a/src/Aws/Lambda/Runtime/Publish.hs +++ b/src/Aws/Lambda/Runtime/Publish.hs @@ -17,6 +17,7 @@ import Aws.Lambda.Runtime.StandaloneLambda.Types import Control.Monad (void) import Data.Aeson +import qualified Data.ByteString.Lazy as LBS import Data.Text (Text, unpack) import qualified Data.Text.Encoding as T import qualified Network.HTTP.Client as Http @@ -28,7 +29,10 @@ rawRequest <- Http.parseRequest . unpack $ endpoint let requestBody = case lambdaResult of - (StandaloneLambdaResult res) -> Http.RequestBodyBS (T.encodeUtf8 . unStandaloneLambdaResponseBody $ res) + (StandaloneLambdaResult (StandaloneLambdaResponseBodyPlain res)) -> + Http.RequestBodyBS (T.encodeUtf8 res) + (StandaloneLambdaResult (StandaloneLambdaResponseBodyJson res)) -> + Http.RequestBodyLBS res (APIGatewayResult res) -> Http.RequestBodyLBS (encode res) (ALBResult res) -> Http.RequestBodyLBS (encode res) request = @@ -41,27 +45,27 @@ -- | Publishes an invocation error back to AWS Lambda invocationError :: Error.Invocation -> Text -> Context context -> Http.Manager -> IO () -invocationError err lambdaApi context = +invocationError (Error.Invocation err) lambdaApi context = publish err (Endpoints.invocationError lambdaApi $ awsRequestId context) context -- | Publishes a parsing error back to AWS Lambda parsingError :: Error.Parsing -> Text -> Context context -> Http.Manager -> IO () parsingError err lambdaApi context = publish - err + (encode err) (Endpoints.invocationError lambdaApi $ awsRequestId context) context -- | Publishes a runtime initialization error back to AWS Lambda runtimeInitError :: ToJSON err => err -> Text -> Context context -> Http.Manager -> IO () runtimeInitError err lambdaApi = - publish err (Endpoints.runtimeInitError lambdaApi) + publish (encode err) (Endpoints.runtimeInitError lambdaApi) -publish :: ToJSON err => err -> Endpoints.Endpoint -> Context context -> Http.Manager -> IO () +publish :: LBS.ByteString -> Endpoints.Endpoint -> Context context -> Http.Manager -> IO () publish err (Endpoints.Endpoint endpoint) _context manager = do rawRequest <- Http.parseRequest . unpack $ endpoint - let requestBody = Http.RequestBodyLBS (encode err) + let requestBody = Http.RequestBodyLBS err request = rawRequest { Http.method = "POST", diff --git a/src/Aws/Lambda/Runtime/StandaloneLambda/Types.hs b/src/Aws/Lambda/Runtime/StandaloneLambda/Types.hs --- a/src/Aws/Lambda/Runtime/StandaloneLambda/Types.hs +++ b/src/Aws/Lambda/Runtime/StandaloneLambda/Types.hs @@ -9,14 +9,15 @@ ) where -import Aws.Lambda.Utilities (toJSONText) -import Data.Aeson (FromJSON, ToJSON) +import Data.Aeson (ToJSON, encode) +import qualified Data.ByteString.Lazy as LBS import Data.Text (Text) import qualified Data.Text as Text -- | Wrapper type for lambda response body -newtype StandaloneLambdaResponseBody = StandaloneLambdaResponseBody {unStandaloneLambdaResponseBody :: Text} - deriving newtype (ToJSON, FromJSON) +data StandaloneLambdaResponseBody + = StandaloneLambdaResponseBodyPlain Text + | StandaloneLambdaResponseBodyJson LBS.ByteString class ToStandaloneLambdaResponseBody a where toStandaloneLambdaResponse :: a -> StandaloneLambdaResponseBody @@ -24,10 +25,10 @@ -- We need to special case String and Text to avoid unneeded encoding -- which results in extra quotes put around plain text responses instance {-# OVERLAPPING #-} ToStandaloneLambdaResponseBody String where - toStandaloneLambdaResponse = StandaloneLambdaResponseBody . Text.pack + toStandaloneLambdaResponse = StandaloneLambdaResponseBodyPlain . Text.pack instance {-# OVERLAPPING #-} ToStandaloneLambdaResponseBody Text where - toStandaloneLambdaResponse = StandaloneLambdaResponseBody + toStandaloneLambdaResponse = StandaloneLambdaResponseBodyPlain instance ToJSON a => ToStandaloneLambdaResponseBody a where - toStandaloneLambdaResponse = StandaloneLambdaResponseBody . toJSONText + toStandaloneLambdaResponse = StandaloneLambdaResponseBodyJson . encode