hal 0.4.6 → 0.4.7
raw patch · 10 files changed
+1026/−509 lines, 10 filesdep +haldep +hspecdep −http-conduitdep ~aesondep ~envyPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: hal, hspec
Dependencies removed: http-conduit
Dependency ranges changed: aeson, envy
API changes (from Hackage documentation)
- AWS.Lambda.Internal: instance System.Envy.DefConfig AWS.Lambda.Internal.StaticContext
- AWS.Lambda.Internal: instance System.Envy.FromEnv AWS.Lambda.Internal.StaticContext
+ AWS.Lambda.Context: instance GHC.Classes.Eq AWS.Lambda.Context.ClientApplication
+ AWS.Lambda.Context: instance GHC.Classes.Eq AWS.Lambda.Context.ClientContext
+ AWS.Lambda.Context: instance GHC.Classes.Eq AWS.Lambda.Context.CognitoIdentity
+ AWS.Lambda.Context: instance GHC.Classes.Eq AWS.Lambda.Context.LambdaContext
+ AWS.Lambda.Internal: getStaticContext :: IO StaticContext
+ AWS.Lambda.Runtime: mRuntime :: (MonadCatch m, MonadIO m, FromJSON event, ToJSON result) => (event -> m result) -> m ()
+ AWS.Lambda.Runtime: mRuntimeWithContext' :: (MonadCatch m, MonadIO m, FromJSON event, ToJSON result) => (LambdaContext -> event -> m result) -> m ()
+ AWS.Lambda.Runtime.Value: mRuntime :: (MonadCatch m, MonadIO m, ToJSON result) => (Value -> m result) -> m ()
+ AWS.Lambda.Runtime.Value: mRuntimeWithContext' :: (MonadCatch m, MonadIO m, ToJSON result) => (LambdaContext -> Value -> m result) -> m ()
+ AWS.Lambda.RuntimeClient.Internal: eventResponseToNextData :: StaticContext -> Response Value -> (ByteString, Value, Either String LambdaContext)
Files
- README.md +26/−2
- hal.cabal +24/−4
- src/AWS/Lambda/Combinators.hs +3/−1
- src/AWS/Lambda/Context.hs +12/−5
- src/AWS/Lambda/Internal.hs +13/−11
- src/AWS/Lambda/Runtime.hs +245/−161
- src/AWS/Lambda/Runtime/Value.hs +314/−216
- src/AWS/Lambda/RuntimeClient.hs +73/−109
- src/AWS/Lambda/RuntimeClient/Internal.hs +102/−0
- test/Spec.hs +214/−0
README.md view
@@ -110,6 +110,20 @@ # ... ``` +You'll need to either build on a compatible linux host or inside a compatible docker container (or some other mechanism like nix).+Note that current Stack LTS images are _not_ compatible.+If you see an error message that contains "version 'GLIBC_X.XX' not found" when running (hosted or locally), then your build environment is not compatible.++Enable stack's docker integration and define an optional image within stack.yaml:++```yaml+# file: stack.yaml+docker:+ enabled: true+ # If omitted, this defaults to fpco/stack-build:lts-${YOUR_LTS_VERSION}+ image: ${BUILD_IMAGE}+```+ Don't forget to define your [CloudFormation] stack: ```yaml@@ -164,7 +178,6 @@ - [Stack][stack.yaml] - [Docker]- - [aws-sam-cli] (>v0.8.0) ### Build @@ -173,7 +186,18 @@ stack build --copy-bins ``` -### Execute+### Execute w/ Docker++```bash+echo '{ "accountId": "byebye" }' | docker run -i --rm \+ -e DOCKER_LAMBDA_USE_STDIN=1 \+ -v ${PWD}/.stack-work/docker/_home/.local/bin/:/var/task \+ lambci/lambda:provided+```++### Execute w/ SAM Local++Note that hal currently only supports [aws-sam-cli] on versions <1.0. ```bash echo '{ "accountId": "byebye" }' | sam local invoke --region us-east-1
hal.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d43ec18e49bb7ce77fd444cdf150662cb6ff0f3c8ba1349dbd4318e6b5bc7e29+-- hash: ac72c27a2329613830cbbdeaf5c590a17af49cb9f6987d444b538ded08a8d451 name: hal-version: 0.4.6+version: 0.4.7 synopsis: A runtime environment for Haskell applications running on AWS Lambda. description: This library uniquely supports different types of AWS Lambda Handlers for your needs/comfort with advanced Haskell. Instead of exposing a single function@@ -40,6 +40,7 @@ AWS.Lambda.Runtime AWS.Lambda.Runtime.Value AWS.Lambda.RuntimeClient+ AWS.Lambda.RuntimeClient.Internal other-modules: Paths_hal hs-source-dirs:@@ -55,13 +56,32 @@ , conduit , conduit-extra , containers- , envy <2+ , envy , exceptions , http-client- , http-conduit , http-types , mtl , text , time , unordered-containers+ default-language: Haskell2010++test-suite hal-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_hal+ hs-source-dirs:+ test+ default-extensions: OverloadedStrings BangPatterns DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DuplicateRecordFields EmptyCase GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf OverloadedStrings PatternSynonyms ScopedTypeVariables+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-partial-type-signatures -fno-warn-name-shadowing -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson+ , base >=4.7 && <5+ , containers+ , hal+ , hspec+ , http-client+ , http-types+ , time default-language: Haskell2010
src/AWS/Lambda/Combinators.hs view
@@ -31,7 +31,6 @@ Left e -> error e Right x -> return x - -- | Upgrades a handler that uses the `IO` monad with an `Either` inside into a -- base runtime handler. --@@ -71,6 +70,7 @@ -- main :: IO () -- main = (readerTRuntime . withIOInterface) myHandler -- @+{-# DEPRECATED withIOInterface "This combinator is useful when combined with the current mRuntimeWithContext, which is deprecated." #-} withIOInterface :: (MonadReader c m, MonadIO m) => (c -> b -> IO (Either String a)) -> (b -> m a) withIOInterface fn event = do config <- ask@@ -114,6 +114,7 @@ -- main :: IO () -- main = (readerTRuntime . withFallibleInterface) myHandler -- @+{-# DEPRECATED withFallibleInterface "This combinator is useful when combined with the current mRuntimeWithContext, which is deprecated." #-} withFallibleInterface :: MonadReader c m => (c -> b -> Either String a) -> b -> m a withFallibleInterface fn event = do config <- ask@@ -155,6 +156,7 @@ -- main :: IO () -- main = (readerTRuntime . withPureInterface) myHandler -- @+{-# DEPRECATED withPureInterface "This combinator is useful when combined with the current mRuntimeWithContext, which is deprecated." #-} withPureInterface :: MonadReader c m => (c -> b -> a) -> b -> m a withPureInterface fn event = do config <- ask
src/AWS/Lambda/Context.hs view
@@ -14,9 +14,9 @@ ClientContext(..), CognitoIdentity(..), LambdaContext(..),+ getRemainingTime, HasLambdaContext(..), defConfig,- getRemainingTime, runReaderTLambdaContext ) where @@ -36,7 +36,7 @@ appVersionName :: Text, appVersionCode :: Text, appPackageName :: Text- } deriving (Show, Generic)+ } deriving (Show, Generic, Eq) instance ToJSON ClientApplication instance FromJSON ClientApplication@@ -45,7 +45,7 @@ { client :: ClientApplication, custom :: Map Text Text, environment :: Map Text Text- } deriving (Show, Generic)+ } deriving (Show, Generic, Eq) instance ToJSON ClientContext instance FromJSON ClientContext@@ -53,7 +53,7 @@ data CognitoIdentity = CognitoIdentity { identityId :: Text , identityPoolId :: Text- } deriving (Show, Generic)+ } deriving (Show, Generic, Eq) instance ToJSON CognitoIdentity instance FromJSON CognitoIdentity@@ -75,17 +75,24 @@ deadline :: UTCTime, clientContext :: Maybe ClientContext, identity :: Maybe CognitoIdentity- } deriving (Show, Generic)+ } deriving (Show, Generic, Eq) +{-# DEPRECATED HasLambdaContext "HasLambdaContext will be removed along with the original mRuntimeWithContext. This utility is no longer necessary without it." #-} class HasLambdaContext r where withContext :: (LambdaContext -> r -> r) instance HasLambdaContext LambdaContext where withContext = const +-- TODO: This sticks around for backwards compatibility, and as a conevient-ish+-- way to runReaderTLambdaContext. In the long term, all runtimes where the+-- LambdaContext is (incorrectly) available outside of the request/response+-- cycle will be removed. This instance (and its dependent package, envy) can+-- be dropped on that breaking change. instance DefConfig LambdaContext where defConfig = LambdaContext "" "" 0 "" "" "" "" "" (posixSecondsToUTCTime 0) Nothing Nothing -- | Helper for using arbitrary monads with only the LambdaContext in its Reader+{-# DEPRECATED runReaderTLambdaContext "runReaderTLambdaContext will be removed along with the original mRuntimeWithContext. This particular approach was problematic, in that it required a default LambdaContext, when in reality, there is no valid instance." #-} runReaderTLambdaContext :: ReaderT LambdaContext m a -> m a runReaderTLambdaContext = flip runReaderT defConfig
src/AWS/Lambda/Internal.hs view
@@ -12,16 +12,18 @@ module AWS.Lambda.Internal ( StaticContext(..), DynamicContext(..),+ getStaticContext, mkContext ) where import AWS.Lambda.Context (ClientContext, CognitoIdentity, LambdaContext (LambdaContext))-import Data.Text (Text)+import Data.Maybe (fromMaybe)+import Data.Text (Text, pack) import Data.Time.Clock (UTCTime) import GHC.Generics (Generic)-import System.Envy (DefConfig (..), FromEnv, Option (..),- fromEnv, gFromEnvCustom)+import System.Environment (getEnv)+import Text.Read (readMaybe) data StaticContext = StaticContext { functionName :: Text,@@ -31,14 +33,14 @@ logStreamName :: Text } deriving (Show, Generic) -instance DefConfig StaticContext where- defConfig = StaticContext "" "" 0 "" ""--instance FromEnv StaticContext where- fromEnv = gFromEnvCustom Option {- dropPrefixCount = 0,- customPrefix = "AWS_LAMBDA"- }+getStaticContext :: IO StaticContext+getStaticContext =+ StaticContext <$> (pack <$> getEnv "AWS_LAMBDA_FUNCTION_NAME") <*>+ (pack <$> getEnv "AWS_LAMBDA_FUNCTION_VERSION") <*>+ ((fromMaybe (error "AWS_LAMBDA_FUNCTION_MEMORY_SIZE was not an Int") . readMaybe) <$>+ getEnv "AWS_LAMBDA_FUNCTION_MEMORY_SIZE") <*>+ (pack <$> getEnv "AWS_LAMBDA_LOG_GROUP_NAME") <*>+ (pack <$> getEnv "AWS_LAMBDA_LOG_STREAM_NAME") data DynamicContext = DynamicContext { awsRequestId :: Text,
src/AWS/Lambda/Runtime.hs view
@@ -25,61 +25,145 @@ ioRuntime, ioRuntimeWithContext, readerTRuntime,+ mRuntimeWithContext',+ mRuntime, mRuntimeWithContext ) where -import AWS.Lambda.Combinators (withIOInterface,- withFallibleInterface,- withPureInterface,- withoutContext,- withInfallibleParse)-import AWS.Lambda.Context (LambdaContext(..), HasLambdaContext(..), runReaderTLambdaContext)+import AWS.Lambda.Combinators (withInfallibleParse)+import AWS.Lambda.Context (LambdaContext(..), HasLambdaContext(..)) import qualified AWS.Lambda.Runtime.Value as ValueRuntime import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (MonadReader, ReaderT) import Data.Aeson (FromJSON, ToJSON) +-- | For any monad that supports 'IO' and 'catch'. Useful if you need+-- caching behaviours or are comfortable manipulating monad+-- transformers, and want full control over your monadic interface.+--+-- In a future version, this function will be renamed to+-- @mRuntimeWithContext@ (after the deprecated function is removed).+--+-- @+-- {-\# LANGUAGE DeriveGeneric, NamedFieldPuns \#-}+--+-- module Main where+--+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (mRuntimeWithContext')+-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic)+--+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: LambdaContext -> Named -> StateT Int IO String+-- myHandler LambdaContext { functionName } Named { name } = do+-- greeting <- liftIO $ getEnv \"GREETING\"+--+-- greetingCount <- get+-- put $ greetingCount + 1+--+-- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!"+--+-- main :: IO ()+-- main = evalStateT (mRuntimeWithContext' myHandler) 0+-- @+mRuntimeWithContext' :: (MonadCatch m, MonadIO m, FromJSON event, ToJSON result) => (LambdaContext -> event -> m result) -> m ()+mRuntimeWithContext' = ValueRuntime.mRuntimeWithContext' . fmap withInfallibleParse+++-- | For any monad that supports 'IO' and 'catch'. Useful if you need+-- caching behaviours or are comfortable manipulating monad+-- transformers, want full control over your monadic interface, but+-- don't need to inspect the 'LambdaContext'.+--+-- @+-- {-\# LANGUAGE DeriveGeneric, NamedFieldPuns \#-}+--+-- module Main where+--+-- import AWS.Lambda.Runtime (mRuntime)+-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (FromJSON)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic)+--+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: Named -> StateT Int IO String+-- myHandler Named { name } = do+-- greeting <- liftIO $ getEnv \"GREETING\"+--+-- greetingCount <- get+-- put $ greetingCount + 1+--+-- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ")!"+--+-- main :: IO ()+-- main = evalStateT (mRuntime myHandler) 0+-- @+mRuntime :: (MonadCatch m, MonadIO m, FromJSON event, ToJSON result) => (event -> m result) -> m ()+mRuntime = ValueRuntime.mRuntime . withInfallibleParse++ --TODO: Revisit all names before we put them under contract--- | For any monad that supports IO/catch/Reader LambdaContext.+-- | For any monad that supports IO\/catch\/Reader LambdaContext. ----- Use this if you need caching behavours or are comfortable--- manipulating monad transformers and want full control over--- your monadic interface.+-- This function is problematic, and has been deprecated. The+-- 'HasLambdaContext' constraint requires that a 'LambdaContext' is+-- settable in the @m@ monad, but that is not the case - we only have+-- a 'LambdaContext' during the request/response cycle. --+-- If you need caching behavours or are comfortable manipulating monad+-- transformers and want full control over your monadic interface,+-- consider 'mRuntimeWithContext''.+-- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..), runReaderTLambdaContext)--- import AWS.Lambda.Runtime (mRuntimeWithContext)--- import Control.Monad.Reader (ReaderT, ask)--- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)--- import Control.Monad.Trans (liftIO)--- import Data.Aeson (FromJSON)--- import Data.Text (unpack)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..), runReaderTLambdaContext)+-- import AWS.Lambda.Runtime (mRuntimeWithContext)+-- import Control.Monad.Reader (ReaderT, ask)+-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Named -> StateT Int (ReaderT LambdaContext IO) String--- myHandler Named { name } = do--- LambdaContext { functionName } <- ask--- greeting <- liftIO $ getEnv \"GREETING\"+-- myHandler :: Named -> StateT Int (ReaderT LambdaContext IO) String+-- myHandler Named { name } = do+-- LambdaContext { functionName } <- ask+-- greeting <- liftIO $ getEnv \"GREETING\" ----- greetingCount <- get--- put $ greetingCount + 1+-- greetingCount <- get+-- put $ greetingCount + 1 ----- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!"+-- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = runReaderTLambdaContext (evalStateT (mRuntimeWithContext myHandler) 0)+-- main :: IO ()+-- main = runReaderTLambdaContext (evalStateT (mRuntimeWithContext myHandler) 0) -- @+{-# DEPRECATED mRuntimeWithContext "mRuntimeWithContext will be replaced by mRuntimeWithContext' in a future version. This type signature makes impossible promises - see the haddock for details." #-} mRuntimeWithContext :: (HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m, FromJSON event, ToJSON result) => (event -> m result) -> m () mRuntimeWithContext = ValueRuntime.mRuntimeWithContext . withInfallibleParse@@ -92,36 +176,36 @@ -- However, do not use this runtime if you need stateful (caching) behaviors. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (readerTRuntime)--- import Control.Monad.Reader (ReaderT, ask)--- import Control.Monad.Trans (liftIO)--- import Data.Aeson (FromJSON)--- import Data.Text (unpack)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (readerTRuntime)+-- import Control.Monad.Reader (ReaderT, ask)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Named -> ReaderT LambdaContext IO String--- myHandler Named { name } = do--- LambdaContext { functionName } <- ask--- greeting <- liftIO $ getEnv \"GREETING\"--- return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"+-- myHandler :: Named -> ReaderT LambdaContext IO String+-- myHandler Named { name } = do+-- LambdaContext { functionName } <- ask+-- greeting <- liftIO $ getEnv \"GREETING\"+-- return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = readerTRuntime myHandler+-- main :: IO ()+-- main = readerTRuntime myHandler -- @ readerTRuntime :: (FromJSON event, ToJSON result) => (event -> ReaderT LambdaContext IO result) -> IO ()-readerTRuntime = runReaderTLambdaContext . mRuntimeWithContext+readerTRuntime = ValueRuntime.readerTRuntime . withInfallibleParse -- | For functions with IO that can fail in a pure way (or via throw). --@@ -131,33 +215,33 @@ -- However, do not use this runtime if you need stateful (caching) behaviors. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (ioRuntimeWithContext)--- import Data.Aeson (FromJSON)--- import Data.Text (unpack)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (ioRuntimeWithContext)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: LambdaContext -> Named -> IO (Either String String)--- myHandler (LambdaContext { functionName }) (Named { name }) = do--- greeting <- getEnv \"GREETING\"--- return $ pure $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"+-- myHandler :: LambdaContext -> Named -> IO (Either String String)+-- myHandler (LambdaContext { functionName }) (Named { name }) = do+-- greeting <- getEnv \"GREETING\"+-- return $ pure $ greeting ++ name ++ " from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = ioRuntimeWithContext myHandler+-- main :: IO ()+-- main = ioRuntimeWithContext myHandler -- @ ioRuntimeWithContext :: (FromJSON event, ToJSON result) => (LambdaContext -> event -> IO (Either String result)) -> IO ()-ioRuntimeWithContext = readerTRuntime . withIOInterface+ioRuntimeWithContext = ValueRuntime.ioRuntimeWithContext . fmap withInfallibleParse -- | For functions with IO that can fail in a pure way (or via throw). --@@ -166,31 +250,31 @@ -- However, do not use this runtime if you need stateful (caching) behaviors. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Runtime (ioRuntime)--- import Data.Aeson (FromJSON)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Runtime (ioRuntime)+-- import Data.Aeson (FromJSON)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Named -> IO (Either String String)--- myHandler (Named { name }) = do--- greeting <- getEnv \"GREETING\"--- return $ pure $ greeting ++ name+-- myHandler :: Named -> IO (Either String String)+-- myHandler (Named { name }) = do+-- greeting <- getEnv \"GREETING\"+-- return $ pure $ greeting ++ name ----- main :: IO ()--- main = ioRuntime myHandler+-- main :: IO ()+-- main = ioRuntime myHandler -- @ ioRuntime :: (FromJSON event, ToJSON result) => (event -> IO (Either String result)) -> IO ()-ioRuntime = readerTRuntime . withIOInterface . withoutContext+ioRuntime = ValueRuntime.ioRuntime . withInfallibleParse -- | For pure functions that can still fail. --@@ -198,34 +282,34 @@ -- but can fail and need the AWS Lambda Context as input. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (fallibleRuntimeWithContext)--- import Data.Aeson (FromJSON)--- import Data.Text (unpack)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (fallibleRuntimeWithContext)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: LambdaContext -> Named -> Either String String--- myHandler (LambdaContext { functionName }) (Named { name }) =--- if name == \"World\" then--- Right $ "Hello, World from " ++ unpack functionName ++ "!"--- else--- Left "Can only greet the world."+-- myHandler :: LambdaContext -> Named -> Either String String+-- myHandler (LambdaContext { functionName }) (Named { name }) =+-- if name == \"World\" then+-- Right $ "Hello, World from " ++ unpack functionName ++ "!"+-- else+-- Left "Can only greet the world." ----- main :: IO ()--- main = fallibleRuntimeWithContext myHandler+-- main :: IO ()+-- main = fallibleRuntimeWithContext myHandler -- @ fallibleRuntimeWithContext :: (FromJSON event, ToJSON result) => (LambdaContext -> event -> Either String result) -> IO ()-fallibleRuntimeWithContext = readerTRuntime . withFallibleInterface+fallibleRuntimeWithContext = ValueRuntime.fallibleRuntimeWithContext . fmap withInfallibleParse -- | For pure functions that can still fail. --@@ -233,32 +317,32 @@ -- but can fail. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Runtime (fallibleRuntime)--- import Data.Aeson (FromJSON)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Runtime (fallibleRuntime)+-- import Data.Aeson (FromJSON)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Named -> Either String String--- myHandler (Named { name }) =--- if name == \"World\" then--- Right "Hello, World!"--- else--- Left "Can only greet the world."+-- myHandler :: Named -> Either String String+-- myHandler (Named { name }) =+-- if name == \"World\" then+-- Right "Hello, World!"+-- else+-- Left "Can only greet the world." ----- main :: IO ()--- main = fallibleRuntime myHandler+-- main :: IO ()+-- main = fallibleRuntime myHandler -- @ fallibleRuntime :: (FromJSON event, ToJSON result) => (event -> Either String result) -> IO ()-fallibleRuntime = readerTRuntime . withFallibleInterface . withoutContext+fallibleRuntime = ValueRuntime.fallibleRuntime . withInfallibleParse -- | For pure functions that can never fail that also need access to the context. --@@ -266,55 +350,55 @@ -- but that need the AWS Lambda Context as input. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (pureRuntimeWithContext)--- import Data.Aeson (FromJSON)--- import Data.Text (unpack)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (pureRuntimeWithContext)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: LambdaContext -> Named -> String--- myHandler (LambdaContext { functionName }) (Named { name }) =--- "Hello, " ++ name ++ " from " ++ unpack functionName ++ "!"+-- myHandler :: LambdaContext -> Named -> String+-- myHandler (LambdaContext { functionName }) (Named { name }) =+-- "Hello, " ++ name ++ " from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = pureRuntimeWithContext myHandler+-- main :: IO ()+-- main = pureRuntimeWithContext myHandler -- @ pureRuntimeWithContext :: (FromJSON event, ToJSON result) => (LambdaContext -> event -> result) -> IO ()-pureRuntimeWithContext = readerTRuntime . withPureInterface+pureRuntimeWithContext = ValueRuntime.pureRuntimeWithContext . fmap withInfallibleParse -- | For pure functions that can never fail. -- -- Use this for simple handlers that just translate input to output without side-effects. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Runtime (pureRuntime)--- import Data.Aeson (FromJSON)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Runtime (pureRuntime)+-- import Data.Aeson (FromJSON)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Named -> String--- myHandler Named { name } = "Hello, " ++ name ++ "!"+-- myHandler :: Named -> String+-- myHandler Named { name } = "Hello, " ++ name ++ "!" ----- main :: IO ()--- main = pureRuntime myHandler+-- main :: IO ()+-- main = pureRuntime myHandler -- @ pureRuntime :: (FromJSON event, ToJSON result) => (event -> result) -> IO ()-pureRuntime = readerTRuntime . withPureInterface . withoutContext+pureRuntime = ValueRuntime.pureRuntime . withInfallibleParse
src/AWS/Lambda/Runtime/Value.hs view
@@ -35,103 +35,201 @@ ioRuntime, ioRuntimeWithContext, readerTRuntime,+ mRuntimeWithContext',+ mRuntime, mRuntimeWithContext ) where import AWS.Lambda.RuntimeClient (RuntimeClientConfig, getRuntimeClientConfig, getNextData, sendEventError, sendEventSuccess)-import AWS.Lambda.Combinators (withIOInterface,- withFallibleInterface,- withPureInterface,- withoutContext)-import AWS.Lambda.Context (LambdaContext(..), HasLambdaContext(..), runReaderTLambdaContext)+import AWS.Lambda.Combinators (withoutContext)+import AWS.Lambda.Context (LambdaContext(..), HasLambdaContext(..)) import Control.Exception (SomeException, displayException)-import Control.Monad (forever)+import Control.Monad ((<=<), forever) import Control.Monad.Catch (MonadCatch, try) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader (MonadReader, ReaderT, local)+import Control.Monad.Reader (MonadReader, ReaderT, local, runReaderT) import Data.Aeson (ToJSON, Value) import Data.Bifunctor (first) import Data.Text (unpack) import System.Environment (setEnv) -runtimeLoop :: (HasLambdaContext r, MonadReader r m, MonadCatch m, MonadIO m, ToJSON result) => RuntimeClientConfig ->- (Value -> m result) -> m ()+runtimeLoop :: (MonadCatch m, MonadIO m, ToJSON result) => RuntimeClientConfig -> (LambdaContext -> Value -> m result) -> m () runtimeLoop runtimeClientConfig fn = do -- Get an event (reqIdBS, event, eCtx) <- liftIO $ getNextData runtimeClientConfig - result <- case eCtx of- Left e -> return $ Left e- Right ctx ->- local (withContext ctx) $ do- -- Propagate the tracing header (Exception safe for this env var name)- liftIO $ setEnv "_X_AMZN_TRACE_ID" $ unpack $ xRayTraceId ctx+ -- Propagate the tracing header (Exception safe for this env var name)+ liftIO $ either (const (pure ())) (setEnv "_X_AMZN_TRACE_ID" . unpack . xRayTraceId) eCtx - {- Catching like this is _usually_ considered bad practice, but this is a true- case where we want to both catch all errors and propogate information about them.- See: http://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Exception.html#g:4- -}- -- Put any exceptions in an Either- caughtResult <- try (fn event)- -- Map the Either (via first) so it is an `Either String a`- return $ first (displayException :: SomeException -> String) caughtResult+ {- Catching like this is _usually_ considered bad practice, but this is a true+ case where we want to both catch all errors and propogate information about them.+ See: http://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Exception.html#g:4+ -}+ -- Put any exceptions in an Either+ caughtResult <- try (fn (either error id eCtx) event)+ -- Map the Either (via first) so it is an `Either String result`+ let result = first (displayException :: SomeException -> String) caughtResult liftIO $ case result of Right r -> sendEventSuccess runtimeClientConfig reqIdBS r Left e -> sendEventError runtimeClientConfig reqIdBS e ---- | For any monad that supports IO/catch/Reader LambdaContext.+-- | For any monad that supports 'IO' and 'catch'. Useful if you need+-- caching behaviours or are comfortable manipulating monad+-- transformers, and want full control over your monadic interface. ----- Use this if you need caching behavours or are comfortable manipulating monad--- transformers and want full control over your monadic interface.+-- In a future version, this function will be renamed to+-- @mRuntimeWithContext@ (after the deprecated function is removed). --+-- A contrived example, that parses the 'Value' argument directly+-- instead of using the higher-level features in+-- @AWS.Lambda.Runtime.Value@:+-- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE DeriveAnyClass, DeriveGeneric, NamedFieldPuns \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..), runReaderTLambdaContext)--- import AWS.Lambda.Runtime (mRuntimeWithContext)--- import Control.Monad.Reader (ReaderT, ask)--- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)--- import Control.Monad.Trans (liftIO)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import Data.Text (unpack)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (mRuntimeWithContext')+-- import Control.Monad.Catch (Exception, throwM)+-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (FromJSON, Result(..), Value, fromJSON)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data AesonParseException = AesonParseException String+-- deriving (Show, Exception) ----- myHandler :: Value -> StateT Int (ReaderT LambdaContext IO) String--- myHandler jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> return $ "My name is HAL, what's yours?"--- Just Named { name } -> do--- LambdaContext { functionName } <- ask--- greeting <- liftIO $ getEnv \"GREETING\"+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- greetingCount <- get--- put $ greetingCount + 1+-- myHandler :: LambdaContext -> Value -> StateT Int IO String+-- myHandler LambdaContext { functionName } value = do+-- greeting <- liftIO $ getEnv \"GREETING\"+-- Named { name } <- case fromJSON value of+-- Error err -> throwM $ AesonParseException err+-- Success named -> pure named+-- greetingCount <- get+-- put $ greetingCount + 1 ----- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!"+-- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = runReaderTLambdaContext (evalStateT (mRuntimeWithContext myHandler) 0)+-- main :: IO ()+-- main = evalStateT (mRuntimeWithContext' myHandler) 0 -- @-mRuntimeWithContext :: (HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m, ToJSON result) =>- (Value -> m result) -> m ()-mRuntimeWithContext fn = do+mRuntimeWithContext' :: (MonadCatch m, MonadIO m, ToJSON result) => (LambdaContext -> Value -> m result) -> m ()+mRuntimeWithContext' fn = do runtimeClientConfig <- liftIO getRuntimeClientConfig forever $ runtimeLoop runtimeClientConfig fn +-- | For any monad that supports 'IO' and 'catch'. Useful if you need+-- caching behaviours or are comfortable manipulating monad+-- transformers, want full control over your monadic interface, but+-- don't need to inspect the 'LambdaContext'.+--+-- A contrived example, that parses the 'Value' argument directly+-- instead of using the higher-level features in+-- @AWS.Lambda.Runtime.Value@:+--+-- @+-- {-\# LANGUAGE DeriveAnyClass, DeriveGeneric, NamedFieldPuns \#-}+--+-- module Main where+--+-- import AWS.Lambda.Runtime (mRuntime)+-- import Control.Monad.Catch (Exception, throwM)+-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (FromJSON, Result(..), Value, fromJSON)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic)+--+-- data AesonParseException = AesonParseException String+-- deriving (Show, Exception)+--+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: Value -> StateT Int IO String+-- myHandler value = do+-- greeting <- liftIO $ getEnv \"GREETING\"+-- Named { name } <- case fromJSON value of+-- Error err -> throwM $ AesonParseException err+-- Success named -> pure named+-- greetingCount <- get+-- put $ greetingCount + 1+--+-- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ")!"+--+-- main :: IO ()+-- main = evalStateT (mRuntime myHandler) 0+-- @+mRuntime :: (MonadCatch m, MonadIO m, ToJSON result) => (Value -> m result) -> m ()+mRuntime = mRuntimeWithContext' . withoutContext +-- | For any monad that supports IO\/catch\/Reader LambdaContext.+--+-- This function is problematic, and has been deprecated. The+-- 'HasLambdaContext' constraint requires that a 'LambdaContext' is+-- settable in the @m@ monad, but that is not the case - we only have+-- a 'LambdaContext' during the request/response cycle.+--+-- If you need caching behavours or are comfortable manipulating monad+-- transformers and want full control over your monadic interface,+-- consider 'mRuntimeWithContext''.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Context (LambdaContext(..), runReaderTLambdaContext)+-- import AWS.Lambda.Runtime (mRuntimeWithContext)+-- import Control.Monad.Reader (ReaderT, ask)+-- import Control.Monad.State.Lazy (StateT, evalStateT, get, put)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic)+--+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: Value -> StateT Int (ReaderT LambdaContext IO) String+-- myHandler jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> return $ "My name is HAL, what's yours?"+-- Just Named { name } -> do+-- LambdaContext { functionName } <- ask+-- greeting <- liftIO $ getEnv \"GREETING\"+--+-- greetingCount <- get+-- put $ greetingCount + 1+--+-- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!"+--+-- main :: IO ()+-- main = runReaderTLambdaContext (evalStateT (mRuntimeWithContext myHandler) 0)+-- @+{-# DEPRECATED mRuntimeWithContext "mRuntimeWithContext will be replaced by mRuntimeWithContext' in a future version. This type signature makes impossible promises - see the haddock for details." #-}+mRuntimeWithContext :: (HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m, ToJSON result) =>+ (Value -> m result) -> m ()+mRuntimeWithContext fn = mRuntimeWithContext' (\lc -> local (withContext lc) . fn)++ -- | For functions that can read the lambda context and use IO within the same monad. -- -- Use this for handlers that need any form of side-effect such as reading@@ -140,40 +238,40 @@ -- However, do not use this runtime if you need stateful (caching) behaviors. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (readerTRuntime)--- import Control.Monad.Reader (ReaderT, ask)--- import Control.Monad.Trans (liftIO)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import Data.Text (unpack)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (readerTRuntime)+-- import Control.Monad.Reader (ReaderT, ask)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Value -> ReaderT LambdaContext IO String--- myHandler jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> return $ "My name is HAL, what's yours?"--- Just Named { name } -> do--- LambdaContext { functionName } <- ask--- greeting <- liftIO $ getEnv \"GREETING\"--- return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"+-- myHandler :: Value -> ReaderT LambdaContext IO String+-- myHandler jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> return $ "My name is HAL, what's yours?"+-- Just Named { name } -> do+-- LambdaContext { functionName } <- ask+-- greeting <- liftIO $ getEnv \"GREETING\"+-- return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = readerTRuntime myHandler+-- main :: IO ()+-- main = readerTRuntime myHandler -- @ readerTRuntime :: ToJSON result => (Value -> ReaderT LambdaContext IO result) -> IO ()-readerTRuntime = runReaderTLambdaContext . mRuntimeWithContext+readerTRuntime fn = mRuntimeWithContext' $ flip (runReaderT . fn) -- | For functions with IO that can fail in a pure way (or via throw). --@@ -183,38 +281,38 @@ -- However, do not use this runtime if you need stateful (caching) behaviors. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (ioRuntimeWithContext)--- import Control.Monad.Trans (liftIO)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import Data.Text (unpack)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (ioRuntimeWithContext)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: LambdaContext -> Value -> IO (Either String String)--- myHandler (LambdaContext { functionName }) jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> return $ pure "My name is HAL, what's yours?"--- Just Named { name } -> do--- greeting <- liftIO $ getEnv \"GREETING\"--- return $ pure $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"+-- myHandler :: LambdaContext -> Value -> IO (Either String String)+-- myHandler (LambdaContext { functionName }) jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> return $ pure "My name is HAL, what's yours?"+-- Just Named { name } -> do+-- greeting <- liftIO $ getEnv \"GREETING\"+-- return $ pure $ greeting ++ name ++ " from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = ioRuntimeWithContext myHandler+-- main :: IO ()+-- main = ioRuntimeWithContext myHandler -- @ ioRuntimeWithContext :: ToJSON result => (LambdaContext -> Value -> IO (Either String result)) -> IO ()-ioRuntimeWithContext = readerTRuntime . withIOInterface+ioRuntimeWithContext fn = mRuntimeWithContext' (\lc -> either error pure <=< liftIO . fn lc) -- | For functions with IO that can fail in a pure way (or via throw). --@@ -223,36 +321,36 @@ -- However, do not use this runtime if you need stateful (caching) behaviors. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Runtime (ioRuntime)--- import Control.Monad.Trans (liftIO)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import System.Environment (getEnv)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Runtime (ioRuntime)+-- import Control.Monad.Trans (liftIO)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import System.Environment (getEnv)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Value -> IO (Either String String)--- myHandler jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> return $ pure "My name is HAL, what's yours?"--- Just Named { name } -> do--- greeting <- liftIO $ getEnv \"GREETING\"--- return $ pure $ greeting ++ name+-- myHandler :: Value -> IO (Either String String)+-- myHandler jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> return $ pure "My name is HAL, what's yours?"+-- Just Named { name } -> do+-- greeting <- liftIO $ getEnv \"GREETING\"+-- return $ pure $ greeting ++ name ----- main :: IO ()--- main = ioRuntime myHandler+-- main :: IO ()+-- main = ioRuntime myHandler -- @ ioRuntime :: ToJSON result => (Value -> IO (Either String result)) -> IO ()-ioRuntime = readerTRuntime . withIOInterface . withoutContext+ioRuntime = ioRuntimeWithContext . withoutContext -- | For pure functions that can still fail. --@@ -260,38 +358,38 @@ -- but can fail and need the AWS Lambda Context as input. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (fallibleRuntimeWithContext)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import Data.Text (unpack)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (fallibleRuntimeWithContext)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import Data.Text (unpack)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: LambdaContext -> Value -> Either String String--- myHandler (LambdaContext { functionName }) jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> Right "My name is HAL, what's yours?"--- Just Named { name } ->--- if name == \"World\" then--- Right $ "Hello, World from " ++ unpack functionName ++ "!"--- else--- Left "Can only greet the world."+-- myHandler :: LambdaContext -> Value -> Either String String+-- myHandler (LambdaContext { functionName }) jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> Right "My name is HAL, what's yours?"+-- Just Named { name } ->+-- if name == \"World\" then+-- Right $ "Hello, World from " ++ unpack functionName ++ "!"+-- else+-- Left "Can only greet the world." ----- main :: IO ()--- main = fallibleRuntimeWithContext myHandler+-- main :: IO ()+-- main = fallibleRuntimeWithContext myHandler -- @ fallibleRuntimeWithContext :: ToJSON result => (LambdaContext -> Value -> Either String result) -> IO ()-fallibleRuntimeWithContext = readerTRuntime . withFallibleInterface+fallibleRuntimeWithContext = mRuntimeWithContext' . fmap (fmap pure) -- | For pure functions that can still fail. --@@ -299,36 +397,36 @@ -- but can fail. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Runtime (fallibleRuntime)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Runtime (fallibleRuntime)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Value -> Either String String--- myHandler jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> Right "My name is HAL, what's yours?"--- Just Named { name } ->--- if name == \"World\" then--- Right "Hello, World!"--- else--- Left "Can only greet the world."+-- myHandler :: Value -> Either String String+-- myHandler jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> Right "My name is HAL, what's yours?"+-- Just Named { name } ->+-- if name == \"World\" then+-- Right "Hello, World!"+-- else+-- Left "Can only greet the world." ----- main :: IO ()--- main = fallibleRuntime myHandler+-- main :: IO ()+-- main = fallibleRuntime myHandler -- @ fallibleRuntime :: ToJSON result => (Value -> Either String result) -> IO ()-fallibleRuntime = readerTRuntime . withFallibleInterface . withoutContext+fallibleRuntime = fallibleRuntimeWithContext . withoutContext -- | For pure functions that can never fail that also need access to the context. --@@ -336,64 +434,64 @@ -- but that need the AWS Lambda Context as input. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Context (LambdaContext(..))--- import AWS.Lambda.Runtime (pureRuntimeWithContext)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import Data.Text (unpack)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (pureRuntimeWithContext)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import Data.Text (unpack)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: LambdaContext -> Value -> Either String String--- myHandler (LambdaContext { functionName }) jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> Right "My name is HAL, what's yours?"--- Just Named { name } ->--- Right $ "Hello, " ++ name ++ " from " ++ unpack functionName ++ "!"+-- myHandler :: LambdaContext -> Value -> Either String String+-- myHandler (LambdaContext { functionName }) jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> Right "My name is HAL, what's yours?"+-- Just Named { name } ->+-- Right $ "Hello, " ++ name ++ " from " ++ unpack functionName ++ "!" ----- main :: IO ()--- main = pureRuntimeWithContext myHandler+-- main :: IO ()+-- main = pureRuntimeWithContext myHandler -- @ pureRuntimeWithContext :: ToJSON result => (LambdaContext -> Value -> result) -> IO ()-pureRuntimeWithContext = readerTRuntime . withPureInterface+pureRuntimeWithContext = mRuntimeWithContext' . fmap (fmap pure) -- | For pure functions that can never fail. -- -- Use this for simple handlers that just translate input to output without side-effects. -- -- @--- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-} ----- module Main where+-- module Main where ----- import AWS.Lambda.Runtime (pureRuntime)--- import Data.Aeson (Value, FromJSON, parseJSON)--- import Data.Aeson.Types (parseMaybe)--- import GHC.Generics (Generic)+-- import AWS.Lambda.Runtime (pureRuntime)+-- import Data.Aeson (Value, FromJSON, parseJSON)+-- import Data.Aeson.Types (parseMaybe)+-- import GHC.Generics (Generic) ----- data Named = Named {--- name :: String--- } deriving Generic--- instance FromJSON Named+-- data Named = Named {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named ----- myHandler :: Value -> String--- myHandler jsonAst =--- case parseMaybe parseJSON jsonAst of--- Nothing -> "My name is HAL, what's yours?"--- Just Named { name } ->--- "Hello, " ++ name ++ "!"+-- myHandler :: Value -> String+-- myHandler jsonAst =+-- case parseMaybe parseJSON jsonAst of+-- Nothing -> "My name is HAL, what's yours?"+-- Just Named { name } ->+-- "Hello, " ++ name ++ "!" ----- main :: IO ()--- main = pureRuntime myHandler+-- main :: IO ()+-- main = pureRuntime myHandler -- @ pureRuntime :: ToJSON result => (Value -> result) -> IO ()-pureRuntime = readerTRuntime . withPureInterface . withoutContext+pureRuntime = pureRuntimeWithContext . withoutContext
src/AWS/Lambda/RuntimeClient.hs view
@@ -16,47 +16,49 @@ sendEventError, ) where -import AWS.Lambda.Context (LambdaContext(..))-import AWS.Lambda.Internal (DynamicContext(..), StaticContext,- mkContext)-import Control.Applicative ((<*>))-import Control.Concurrent (threadDelay)-import Control.Exception (displayException, try, throw)-import Control.Monad (unless)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Aeson (decode, encode, Value)-import Data.Aeson.Parser (value')-import Data.Aeson.Types (FromJSON, ToJSON)-import Data.Bifunctor (first)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC-import qualified Data.ByteString.Lazy as BSW-import qualified Data.ByteString.Internal as BSI-import Data.Conduit (ConduitM, runConduit, yield, (.|))-import Data.Conduit.Attoparsec (sinkParser)-import Data.Text.Encoding (decodeUtf8)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import GHC.Generics (Generic (..))-import Network.HTTP.Client (BodyReader, HttpException, Manager,- Request, Response, brRead,- defaultManagerSettings, httpNoBody,- managerConnCount,- managerIdleConnectionCount,- managerResponseTimeout,- managerSetProxy, newManager,- noProxy, parseRequest, responseBody,- responseTimeoutNone, withResponse)-import Network.HTTP.Simple (getResponseBody,- getResponseHeader,- getResponseStatus,- setRequestBodyJSON,- setRequestBodyLBS,- setRequestCheckStatus,- setRequestHeader, setRequestMethod,- setRequestPath)-import Network.HTTP.Types.Status (status403, status413, statusIsSuccessful)-import System.Environment (getEnv)-import System.Envy (decodeEnv)+import AWS.Lambda.Context (LambdaContext)+import AWS.Lambda.Internal (StaticContext, getStaticContext)+import AWS.Lambda.RuntimeClient.Internal (eventResponseToNextData)+import Control.Applicative ((<*>))+import Control.Concurrent (threadDelay)+import Control.Exception (IOException, displayException,+ throw, try)+import Control.Monad (unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Aeson (Value, encode)+import Data.Aeson.Parser (value')+import Data.Aeson.Types (ToJSON)+import Data.Bifunctor (first)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSW+import Data.Conduit (ConduitM, runConduit, yield,+ (.|))+import Data.Conduit.Attoparsec (sinkParser)+import Data.Semigroup ((<>))+import GHC.Generics (Generic (..))+import Network.HTTP.Client (BodyReader, HttpException,+ Manager, Request,+ RequestBody (RequestBodyLBS),+ Response, brRead,+ defaultManagerSettings,+ httpNoBody,+ managerConnCount,+ managerIdleConnectionCount,+ managerResponseTimeout,+ managerSetProxy, method,+ newManager, noProxy,+ parseRequest, path,+ requestBody, requestHeaders,+ responseBody,+ responseStatus,+ responseTimeoutNone,+ setRequestCheckStatus,+ withResponse)+import Network.HTTP.Types (HeaderName)+import Network.HTTP.Types.Status (Status, status403,+ status413,+ statusIsSuccessful)+import System.Environment (getEnv) -- | Lambda runtime error that we pass back to AWS data LambdaError = LambdaError@@ -93,7 +95,8 @@ , managerIdleConnectionCount = 1 } - possibleStaticCtx <- liftIO $ (decodeEnv :: IO (Either String StaticContext))+ possibleStaticCtx <-+ first (displayException :: IOException -> String) <$> try getStaticContext case possibleStaticCtx of Left err -> do@@ -103,40 +106,8 @@ getNextData :: RuntimeClientConfig -> IO (BS.ByteString, Value, Either String LambdaContext)-getNextData runtimeClientConfig@(RuntimeClientConfig _ _ staticContext) = do- nextRes <- getNextEvent runtimeClientConfig-- -- If we got an event but our requestId is invalid/missing, there's no hope of meaningful recovery- let reqIdBS = head $ getResponseHeader "Lambda-Runtime-Aws-Request-Id" nextRes-- let mTraceId = fmap decodeUtf8 $ exactlyOneHeader $ getResponseHeader "Lambda-Runtime-Trace-Id" nextRes- let mFunctionArn = fmap decodeUtf8 $ exactlyOneHeader $ getResponseHeader "Lambda-Runtime-Invoked-Function-Arn" nextRes- let mDeadline = do- header <- exactlyOneHeader (getResponseHeader "Lambda-Runtime-Deadline-Ms" nextRes)- milliseconds :: Double <- readMaybe $ BSC.unpack header- return $ posixSecondsToUTCTime $ realToFrac $ milliseconds / 1000-- let mClientContext = decodeOptionalHeader $ getResponseHeader "Lambda-Runtime-Client-Context" nextRes- let mIdentity = decodeOptionalHeader $ getResponseHeader "Lambda-Runtime-Cognito-Identity" nextRes-- -- Build out the Dynamic portion of the Lambda Context- let eDynCtx =- maybeToEither "Runtime Error: Unable to decode Context from event response."- -- Build the Dynamic Context, collapsing individual Maybes into a single Maybe- $ DynamicContext (decodeUtf8 reqIdBS)- <$> mFunctionArn- <*> mTraceId- <*> mDeadline- <*> mClientContext- <*> mIdentity-- -- combine our StaticContext and possible DynamicContext into a LambdaContext- let eCtx = fmap (mkContext staticContext) eDynCtx-- let event = getResponseBody nextRes-- -- Return the interesting components- return (reqIdBS, event, eCtx)+getNextData runtimeClientConfig@(RuntimeClientConfig _ _ staticContext) =+ eventResponseToNextData staticContext <$> getNextEvent runtimeClientConfig -- AWS lambda guarantees that we will get valid JSON, -- so parsing is guaranteed to succeed.@@ -190,39 +161,6 @@ fmap (const ()) $ runtimeClientRetry $ flip httpNoBody manager $ toInitErrorRequest e baseRuntimeRequest --- Helpers (mostly) for Headers--exactlyOneHeader :: [a] -> Maybe a-exactlyOneHeader [a] = Just a-exactlyOneHeader _ = Nothing--maybeToEither :: b -> Maybe a -> Either b a-maybeToEither b ma = case ma of- Nothing -> Left b- Just a -> Right a---- Note: Does not allow whitespace-readMaybe :: (Read a) => String -> Maybe a-readMaybe s = case reads s of- [(x,"")] -> Just x- _ -> Nothing---- TODO: There must be a better way to do this-decodeHeaderValue :: FromJSON a => BSC.ByteString -> Maybe a-decodeHeaderValue = decode . BSW.pack . fmap BSI.c2w . BSC.unpack---- An empty array means we successfully decoded, but nothing was there--- If we have exactly one element, our outer maybe signals successful decode,--- and our inner maybe signals that there was content sent--- If we had more than one header value, the event was invalid-decodeOptionalHeader :: FromJSON a => [BSC.ByteString] -> Maybe (Maybe a)-decodeOptionalHeader header =- case header of- [] -> Just Nothing- [x] -> fmap Just $ decodeHeaderValue x- _ -> Nothing-- -- Helpers for Requests with JSON Bodies httpValue :: Request -> Manager -> IO (Response Value)@@ -296,3 +234,29 @@ toInitErrorRequest :: String -> Request -> Request toInitErrorRequest e = setRequestPath "2018-06-01/runtime/init/error" . toBaseErrorRequest e+++-- HTTP Client Type Helpers++getResponseStatus :: Response a -> Status+getResponseStatus = responseStatus++setRequestBodyJSON :: ToJSON a => a -> Request -> Request+setRequestBodyJSON = setRequestBodyLBS . encode++setRequestBodyLBS :: BSW.ByteString -> Request -> Request+setRequestBodyLBS body req = req { requestBody = RequestBodyLBS body }++setRequestHeader :: HeaderName -> [BS.ByteString] -> Request -> Request+setRequestHeader headerName values req =+ let+ withoutPrevious = filter ((/=) headerName . fst) $ requestHeaders req+ withNew = fmap ((,) headerName) values <> withoutPrevious+ in+ req { requestHeaders = withNew }++setRequestMethod :: BS.ByteString -> Request -> Request+setRequestMethod m req = req { method = m }++setRequestPath :: BS.ByteString -> Request -> Request+setRequestPath p req = req { path = p }
+ src/AWS/Lambda/RuntimeClient/Internal.hs view
@@ -0,0 +1,102 @@+{-|+Module : AWS.Lambda.RuntimeClient.Internal+Description : Internal HTTP related machinery for talking to the AWS Lambda Custom Runtime interface.+Copyright : (c) Nike, Inc., 2018+License : BSD3+Maintainer : nathan.fairhurst@nike.com, fernando.freire@nike.com+Stability : stable+-}++module AWS.Lambda.RuntimeClient.Internal (+ eventResponseToNextData,+) where++import AWS.Lambda.Context (LambdaContext)+import AWS.Lambda.Internal (DynamicContext (..), StaticContext,+ mkContext)+import Data.Aeson (Value, eitherDecode)+import Data.Aeson.Types (FromJSON)+import Data.Bifunctor (first)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Internal as BSI+import qualified Data.ByteString.Lazy as BSW+import Data.CaseInsensitive (original)+import Data.Semigroup ((<>))+import Data.Text.Encoding (decodeUtf8)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Network.HTTP.Client (Response, responseBody,+ responseHeaders)+import Network.HTTP.Types (HeaderName)++eventResponseToNextData :: StaticContext -> Response Value -> (BS.ByteString, Value, Either String LambdaContext)+eventResponseToNextData staticContext nextRes =+ -- If we got an event but our requestId is invalid/missing, there's no hope of meaningful recovery+ let+ reqIdBS = head $ getResponseHeader "Lambda-Runtime-Aws-Request-Id" nextRes++ eCtx = first ("Runtime Error: Unable to decode Context from event response.\n" <>) $ do+ traceId <- fmap decodeUtf8 $ exactlyOneHeader "Lambda-Runtime-Trace-Id" nextRes+ functionArn <- fmap decodeUtf8 $ exactlyOneHeader "Lambda-Runtime-Invoked-Function-Arn" nextRes+ deadlineHeader <- exactlyOneHeader "Lambda-Runtime-Deadline-Ms" nextRes+ milliseconds :: Double <- maybeToEither "Could not parse deadline" $ readMaybe $ BSC.unpack deadlineHeader+ let deadline = posixSecondsToUTCTime $ realToFrac $ milliseconds / 1000++ clientContext <- decodeOptionalHeader "Lambda-Runtime-Client-Context" nextRes+ identity <- decodeOptionalHeader "Lambda-Runtime-Cognito-Identity" nextRes++ -- Build out the Dynamic portion of the Lambda Context+ let dynCtx = DynamicContext (decodeUtf8 reqIdBS) functionArn traceId deadline clientContext identity++ -- combine our StaticContext and possible DynamicContext into a LambdaContext+ return (mkContext staticContext dynCtx)++ -- Return the interesting components+ in (reqIdBS, getResponseBody nextRes, eCtx)+++-- Helpers (mostly) for Headers++getResponseBody :: Response a -> a+getResponseBody = responseBody++getResponseHeader :: HeaderName -> Response a -> [BS.ByteString]+getResponseHeader headerName = fmap snd . filter ((==) headerName . fst) . responseHeaders++headerNameToString :: HeaderName -> String+headerNameToString = fmap BSI.w2c . BS.unpack . original++exactlyOneHeader :: HeaderName -> Response Value -> Either String BS.ByteString+exactlyOneHeader name res =+ let nameStr = headerNameToString name+ in case getResponseHeader name res of+ [a] -> Right a+ [] -> Left ("Missing response header " <> nameStr)+ _ -> Left ("Too many values for header " <> nameStr)++maybeToEither :: b -> Maybe a -> Either b a+maybeToEither b ma = case ma of+ Nothing -> Left b+ Just a -> Right a++-- Note: Does not allow whitespace+readMaybe :: (Read a) => String -> Maybe a+readMaybe s = case reads s of+ [(x,"")] -> Just x+ _ -> Nothing++-- TODO: There must be a better way to do this+decodeHeaderValue :: FromJSON a => BSC.ByteString -> Either String a+decodeHeaderValue = eitherDecode . BSW.pack . fmap BSI.c2w . BSC.unpack++-- An empty array means we successfully decoded, but nothing was there+-- If we have exactly one element, our outer maybe signals successful decode,+-- and our inner maybe signals that there was content sent+-- If we had more than one header value, the event was invalid+decodeOptionalHeader :: FromJSON a => HeaderName -> Response Value -> Either String (Maybe a)+decodeOptionalHeader name res =+ let nameStr = headerNameToString name+ in case getResponseHeader name res of+ [] -> Right Nothing+ [x] -> first (\e -> "Could not JSON decode header " <> nameStr <> ": " <> e) $ fmap Just $ decodeHeaderValue x+ _ -> Left ("Too many values for header " <> nameStr)
+ test/Spec.hs view
@@ -0,0 +1,214 @@+import AWS.Lambda.Context (ClientApplication (..),+ ClientContext (..),+ CognitoIdentity (..),+ LambdaContext (..))+import AWS.Lambda.Internal (StaticContext (..))+import AWS.Lambda.RuntimeClient.Internal (eventResponseToNextData)+import Data.Aeson (Value (Null))+import Data.Map (singleton)+import Data.Semigroup ((<>))+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Network.HTTP.Client.Internal (Response (..))+import Network.HTTP.Types (Header)+import Test.Hspec (describe, it, shouldBe,+ shouldStartWith)+import Test.Hspec.Runner (hspec)++main :: IO ()+main =+ hspec $ do+ describe "Event Response Data" $ do+ let staticContext =+ StaticContext+ { functionName = "name"+ , functionVersion = "version"+ , functionMemorySize = 128+ , logGroupName = "logGroupName"+ , logStreamName = "logStreamName"+ }+ let basicValidHeaders =+ [ ("Lambda-Runtime-Aws-Request-Id", "abc")+ , ("Lambda-Runtime-Trace-Id", "123")+ , ("Lambda-Runtime-Invoked-Function-Arn", "arn")+ , ("Lambda-Runtime-Deadline-Ms", "12332000")+ ]+ it "Works given valid inputs" $ do+ let inputBody = Null+ let response = minResponse basicValidHeaders inputBody+ let (id, outputBody, context) =+ eventResponseToNextData staticContext response+ id `shouldBe` "abc"+ outputBody `shouldBe` inputBody+ context `shouldBe`+ (Right+ (LambdaContext+ { functionName = "name"+ , functionVersion = "version"+ , functionMemorySize = 128+ , logGroupName = "logGroupName"+ , logStreamName = "logStreamName"+ , awsRequestId = "abc"+ , invokedFunctionArn = "arn"+ , xRayTraceId = "123"+ , deadline = posixSecondsToUTCTime 12332+ , clientContext = Nothing+ , identity = Nothing+ }))+ it "has clientContext if it was provided" $ do+ let headers =+ ( "Lambda-Runtime-Client-Context"+ , "{ \"client\": { \"appTitle\": \"title\", \"appVersionName\": \"versionName\", \"appVersionCode\": \"versionCode\", \"appPackageName\": \"packageName\" }, \"custom\": { \"key1\": \"value1\" }, \"environment\": { \"key2\": \"value2\" } }") :+ basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ fmap clientContext context `shouldBe`+ (Right+ (Just+ (ClientContext+ { client =+ ClientApplication+ { appTitle = "title"+ , appVersionName = "versionName"+ , appVersionCode = "versionCode"+ , appPackageName = "packageName"+ }+ , custom = singleton "key1" "value1"+ , environment = singleton "key2" "value2"+ })))+ it "fails to construct the Context if the client context can't be parsed" $ do+ let headers =+ ("Lambda-Runtime-Client-Context", "{}") : basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ let msg = either id (const (error "Was able to parse a context that should have failed!")) context+ msg `shouldStartWith`+ "Runtime Error: Unable to decode Context from event response.\nCould not JSON decode header Lambda-Runtime-Client-Context: "+ it+ "fails to construct the Context if there are two client context headers" $ do+ let headers =+ [ ("Lambda-Runtime-Client-Context", "{}")+ , ("Lambda-Runtime-Client-Context", "{}")+ ] <>+ basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ fmap clientContext context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nToo many values for header Lambda-Runtime-Client-Context")+ it "has identity if it was provided" $ do+ let headers =+ ( "Lambda-Runtime-Cognito-Identity"+ , "{ \"identityId\": \"identityId\", \"identityPoolId\": \"identityPoolId\" }") :+ basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ fmap identity context `shouldBe`+ (Right+ (Just+ (CognitoIdentity+ { identityId = "identityId"+ , identityPoolId = "identityPoolId"+ })))+ it+ "fails to construct the Context if the cognito identity can't be parsed" $ do+ let headers =+ ("Lambda-Runtime-Cognito-Identity", "{}") : basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ let msg = either id (const (error "Was able to parse a context that should have failed!")) context+ msg `shouldStartWith`+ "Runtime Error: Unable to decode Context from event response.\nCould not JSON decode header Lambda-Runtime-Cognito-Identity: "+ it+ "fails to construct the Context if there are two cognito identity headers" $ do+ let headers =+ [ ("Lambda-Runtime-Cognito-Identity", "{}")+ , ("Lambda-Runtime-Cognito-Identity", "{}")+ ] <>+ basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ fmap clientContext context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nToo many values for header Lambda-Runtime-Cognito-Identity")+ it "fails to create the context if trace Id is not provided" $ do+ let headers =+ [ ("Lambda-Runtime-Aws-Request-Id", "abc")+ , ("Lambda-Runtime-Invoked-Function-Arn", "arn")+ , ("Lambda-Runtime-Deadline-Ms", "12332000")+ ]+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nMissing response header Lambda-Runtime-Trace-Id")+ it "fails to create the context if trace id has multiple values" $ do+ let headers = ("Lambda-Runtime-Trace-Id", "123") : basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nToo many values for header Lambda-Runtime-Trace-Id")+ it "fails to create the context if function ARN is not provided" $ do+ let headers =+ [ ("Lambda-Runtime-Aws-Request-Id", "abc")+ , ("Lambda-Runtime-Trace-Id", "123")+ , ("Lambda-Runtime-Deadline-Ms", "12332000")+ ]+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nMissing response header Lambda-Runtime-Invoked-Function-Arn")+ it "fails to create the context if function ARN has multiple values" $ do+ let headers =+ ("Lambda-Runtime-Invoked-Function-Arn", "arn") : basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nToo many values for header Lambda-Runtime-Invoked-Function-Arn")+ it "fails to create the context if a deadline is not provided" $ do+ let headers =+ [ ("Lambda-Runtime-Aws-Request-Id", "abc")+ , ("Lambda-Runtime-Trace-Id", "123")+ , ("Lambda-Runtime-Invoked-Function-Arn", "arn")+ ]+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nMissing response header Lambda-Runtime-Deadline-Ms")+ it "fails to create the context if the deadline has multiple values" $ do+ let headers =+ ("Lambda-Runtime-Deadline-Ms", "12332000") : basicValidHeaders+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nToo many values for header Lambda-Runtime-Deadline-Ms")+ it "fails to create the context if the deadline is not a valid timestamp" $ do+ let headers =+ [ ("Lambda-Runtime-Aws-Request-Id", "abc")+ , ("Lambda-Runtime-Trace-Id", "123")+ , ("Lambda-Runtime-Invoked-Function-Arn", "arn")+ , ("Lambda-Runtime-Deadline-Ms", "not a timestamp")+ ]+ let (_, _, context) =+ eventResponseToNextData staticContext (minJsonResponse headers)+ context `shouldBe`+ (Left+ "Runtime Error: Unable to decode Context from event response.\nCould not parse deadline")++minResponse :: [Header] -> a -> Response a+minResponse headers body =+ Response+ { responseStatus = undefined+ , responseVersion = undefined+ , responseHeaders = headers+ , responseBody = body+ , responseCookieJar = undefined+ , responseClose' = undefined+ }++minJsonResponse :: [Header] -> Response Value+minJsonResponse = flip minResponse Null