hal (empty) → 0.1.0
raw patch · 8 files changed
+979/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, envy, exceptions, http-conduit, http-types, mtl, text, time
Files
- LICENSE +30/−0
- README.md +170/−0
- Setup.hs +2/−0
- hal.cabal +52/−0
- src/AWS/Lambda/Context.hs +85/−0
- src/AWS/Lambda/Internal.hs +65/−0
- src/AWS/Lambda/Runtime.hs +427/−0
- src/AWS/Lambda/RuntimeClient.hs +148/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Nike, Inc. (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,170 @@+# hal++A runtime environment for [Haskell] applications running on [AWS Lambda].++#### Flexible++This library uniquely supports different types of AWS Lambda Handlers for your needs/comfort with advanced Haskell.+Instead of exposing a single function that constructs a Lambda, this library exposes many.++For lambdas that are pure and safe, then `pureRuntime` is ideal.+It accepts a handler with the signature `(FromJSON a, ToJSON b) => a -> b`.+This runtime guarantees that side-effects cannot occur.++For advanced use cases `mRuntimeWithContext` unlocks the full power of Monad Transformers.+It accepts handlers with the signature `(HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m, FromJSON event, ToJSON result) => (event -> m result)`+This enables users to add caching logic or expose complex environments.++With numerous options in between these two, developers can choose the right balance of flexibility vs simplicity.++#### Performant++Measuring lambda performance is tricky, so investigation and optimization is ongoing.+Current indications show a _warm_ execution overhead of only ~20% more than the official [Rust Runtime] (a much lower level language).++#### Robust++While testing continues, we have executed over 30k test events without error caused by the runtime.+Naive approaches lead to error rates well over 10%.++## Table of Contents++ - [Quick Start](#quick-start)+ - [Usage](#usage)+ - [Local Testing](#local-testing)++## Quick Start++This quick start assumes you have the following tools installed:++ - [Stack][stack.yaml]+ - [Docker]+ - [aws-cli]++Add `hal` to your [stack.yaml]'s [`extra-deps`] and enable+[Docker] integration so that your binary is automatically compiled in a+compatible environment for AWS. Also add `hal` to your project's+dependency list (either `project-name.cabal` or `package.yaml`)++```yaml+#...+packages:+ - '.'+ - hal-0.1.0+# ...+docker:+ enable: true+# ...+```++Then, define your types and handler:++```haskell+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE DeriveGeneric #-}++module Main where++import AWS.Lambda.Runtime (simpleLambdaRuntime)+import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics (Generic)++data Request = Request {+ input :: String+} deriving (Generic)++instance FromJSON Request++data Response = Response {+ output :: String+} deriving (Generic)++instance ToJSON Response++idHandler :: Request -> Response+idHandler Request { input } = Response { output = input }++main :: IO ()+main = simpleLambdaRuntime idHandler+```++Don't forget to define your [CloudFormation] stack:++```yaml+# file: template.yaml+AWSTemplateFormatVersion: '2010-09-09'+Transform: 'AWS::Serverless-2016-10-31'+Description: Test for the Haskell Runtime.+Resources:+ HelloWorldApp:+ Type: 'AWS::Serverless::Function'+ Properties:+ Handler: NOT_USED+ Runtime: provided+ CodeUri: .stack-work/docker/_home/.local/bin/+ Description: My Haskell runtime.+ MemorySize: 128+ Timeout: 3+```++Finally, build, upload and test your lambda!++```bash+# Build the binary, make sure your executable is named `bootstrap`+stack build --copy-bins++# Create your function package+aws cloudformation package \+ --template-file template.yaml+ --s3-bucket your-existing-bucket > \+ deployment_stack.yaml++# Deploy your function+aws cloudformation deploy \+ --stack-name "hello-world-haskell" \+ --region us-west-2 \+ --capabilities CAPABILITY_IAM \+ --template-file deployment_stack.yaml++# Take it for a spin!+aws lambda invoke \+ --function-name your-function-name \+ --region us-west-2+ --payload '{"input": "foo"}'+ output.txt+```++## Usage++TODO++## Local Testing++### Dependencies++ - [Stack][stack.yaml]+ - [Docker]+ - [aws-sam-cli] (>v0.8.0)++### Build++```bash+docker pull fpco/stack-build:lts-12.21 #first build only+stack build --copy-bins+```++### Execute++```bash+echo '{ "accountId": "byebye" }' | sam local invoke --region us-east-1+```++[AWS Lambda]: https://docs.aws.amazon.com/lambda/latest/dg/welcome.html+[Haskell]: https://www.haskell.org/+[stack.yaml]: https://docs.haskellstack.org/+[`extra-deps`]: https://docs.haskellstack.org/en/stable/yaml_configuration/#yaml-configuration+[Docker]: https://www.docker.com/why-docker+[aws-cli]: https://aws.amazon.com/cli/+[CloudFormation]: https://aws.amazon.com/cloudformation/+[aws-sam-cli]: https://github.com/awslabs/aws-sam-cli+[Rust Runtime]: https://github.com/awslabs/aws-lambda-rust-runtime
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hal.cabal view
@@ -0,0 +1,52 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 9e95d1b7a42420d7a38abcd2683add3ad06324396c38400f285f6ef0dea5ec98++name: hal+version: 0.1.0+synopsis: Please see the README.md file for this project.+description: A runtime environment for Haskell applications running on AWS Lambda.+category: Web,AWS+homepage: https://github.com/Nike-inc/hal#readme+bug-reports: https://github.com/Nike-inc/hal/issues+author: Nike, Inc.+maintainer: nikeoss+copyright: 2018 Nike, Inc.+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/Nike-inc/hal++library+ exposed-modules:+ AWS.Lambda.Context+ AWS.Lambda.Internal+ AWS.Lambda.Runtime+ AWS.Lambda.RuntimeClient+ other-modules:+ Paths_hal+ hs-source-dirs:+ src+ default-extensions: OverloadedStrings BangPatterns DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies 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+ build-depends:+ aeson <2.0.0+ , base >=4.7 && <5+ , bytestring <1.0.0+ , containers <1.0.0+ , envy <2.0.0+ , exceptions <1.0.0+ , http-conduit <3.0.0+ , http-types <1.0.0+ , mtl <3.0.0+ , text <2.0.0+ , time <2.0.0+ default-language: Haskell2010
+ src/AWS/Lambda/Context.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}++{-|+Module : AWS.Lambda.Context+Description : AWS Lambda Context classes and related methods.+Copyright : (c) Nike, Inc., 2018+License : BSD3+Maintainer : nathan.fairhurst@nike.com, fernando.freire@nike.com+Stability : stable+-}++module AWS.Lambda.Context (+ ClientApplication(..),+ ClientContext(..),+ CognitoIdentity(..),+ LambdaContext(..),+ HasLambdaContext(..),+ defConfig,+ getRemainingTime+) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Aeson (FromJSON, ToJSON)+import Data.Map (Map)+import Data.Text (Text)+import Data.Time.Clock (DiffTime, UTCTime,+ diffUTCTime, getCurrentTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import GHC.Generics (Generic)+import System.Envy (DefConfig (..))++data ClientApplication = ClientApplication+ { appTitle :: Text,+ appVersionName :: Text,+ appVersionCode :: Text,+ appPackageName :: Text+ } deriving (Show, Generic)++instance ToJSON ClientApplication+instance FromJSON ClientApplication++data ClientContext = ClientContext+ { client :: ClientApplication,+ custom :: Map Text Text,+ environment :: Map Text Text+ } deriving (Show, Generic)++instance ToJSON ClientContext+instance FromJSON ClientContext++data CognitoIdentity = CognitoIdentity+ { identityId :: Text+ , identityPoolId :: Text+ } deriving (Show, Generic)++instance ToJSON CognitoIdentity+instance FromJSON CognitoIdentity++getRemainingTime :: MonadIO m => LambdaContext -> m DiffTime+getRemainingTime LambdaContext { deadline } =+ liftIO $ fmap (realToFrac . diffUTCTime deadline) getCurrentTime++data LambdaContext = LambdaContext+ { functionName :: Text,+ functionVersion :: Text,+ functionMemorySize :: Int,+ logGroupName :: Text,+ logStreamName :: Text,+ -- The following context values come from headers rather than env vars.+ awsRequestId :: Text,+ invokedFunctionArn :: Text,+ xRayTraceId :: Text,+ deadline :: UTCTime,+ clientContext :: Maybe ClientContext,+ identity :: Maybe CognitoIdentity+ } deriving (Show, Generic)++class HasLambdaContext r where+ withContext :: (LambdaContext -> r -> r)++instance HasLambdaContext LambdaContext where+ withContext = const++instance DefConfig LambdaContext where+ defConfig = LambdaContext "" "" 0 "" "" "" "" "" (posixSecondsToUTCTime 0) Nothing Nothing
+ src/AWS/Lambda/Internal.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module : AWS.Lambda.Internal+Description : Internal hal helper methods.+Copyright : (c) Nike, Inc., 2018+License : BSD3+Maintainer : nathan.fairhurst@nike.com, fernando.freire@nike.com+Stability : unstable+-}++module AWS.Lambda.Internal (+ StaticContext(..),+ DynamicContext(..),+ mkContext+) where++import AWS.Lambda.Context (ClientContext, CognitoIdentity,+ LambdaContext (LambdaContext))+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import GHC.Generics (Generic)+import System.Envy (DefConfig (..), FromEnv, Option (..),+ fromEnv, gFromEnvCustom)++data StaticContext = StaticContext+ { functionName :: Text,+ functionVersion :: Text,+ functionMemorySize :: Int,+ logGroupName :: Text,+ logStreamName :: Text+ } deriving (Show, Generic)++instance DefConfig StaticContext where+ defConfig = StaticContext "" "" 0 "" ""++instance FromEnv StaticContext where+ fromEnv = gFromEnvCustom Option {+ dropPrefixCount = 0,+ customPrefix = "AWS_LAMBDA"+ }++data DynamicContext = DynamicContext+ { awsRequestId :: Text,+ invokedFunctionArn :: Text,+ xRayTraceId :: Text,+ deadline :: UTCTime,+ clientContext :: Maybe ClientContext,+ identity :: Maybe CognitoIdentity+ } deriving (Show)++mkContext :: StaticContext -> DynamicContext -> LambdaContext+mkContext static dynamic =+ LambdaContext+ (functionName static)+ (functionVersion static)+ (functionMemorySize static)+ (logGroupName static)+ (logStreamName static)+ (awsRequestId dynamic)+ (invokedFunctionArn dynamic)+ (xRayTraceId dynamic)+ (deadline dynamic)+ (clientContext dynamic)+ (identity dynamic)
+ src/AWS/Lambda/Runtime.hs view
@@ -0,0 +1,427 @@+{-# LANGUAGE FlexibleContexts #-}++{-|+Module : AWS.Lambda.Runtime+Description : Runtime methods useful when constructing Haskell handlers for the AWS Lambda Custom Runtime.+Copyright : (c) Nike, Inc., 2018+License : BSD3+Maintainer : nathan.fairhurst@nike.com, fernando.freire@nike.com+Stability : stable+-}++module AWS.Lambda.Runtime (+ pureRuntime,+ pureRuntimeWithContext,+ fallibleRuntime,+ fallibleRuntimeWithContext,+ ioRuntime,+ ioRuntimeWithContext,+ readerTRuntime,+ mRuntimeWithContext+) where++import AWS.Lambda.RuntimeClient (getBaseRuntimeRequest, getNextEvent,+ sendEventError, sendEventSuccess, sendInitError)+import AWS.Lambda.Context (LambdaContext(..), HasLambdaContext(..))+import AWS.Lambda.Internal (StaticContext, DynamicContext(DynamicContext),+ mkContext)+import Control.Applicative ((<*>), liftA2)+import Control.Exception (SomeException, displayException)+import Control.Monad (forever)+import Control.Monad.Catch (MonadCatch, try)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (MonadReader, ReaderT, ask, local,+ runReaderT)+import Data.Aeson (FromJSON, ToJSON, decode)+import Data.Bifunctor (first)+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSW+import qualified Data.ByteString.Internal as BSI+import Data.Text (unpack)+import Data.Text.Encoding (decodeUtf8)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Network.HTTP.Simple (Request, getResponseBody,+ getResponseHeader)+import System.Environment (setEnv)+import System.Envy (decodeEnv, defConfig)++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+++runtimeLoop :: (HasLambdaContext r, MonadReader r m, MonadCatch m, MonadIO m, FromJSON event, ToJSON result) => Request -> StaticContext ->+ (event -> m result) -> m ()+runtimeLoop baseRuntimeRequest staticContext fn = do+ -- Get an event+ nextRes <- liftIO $ getNextEvent baseRuntimeRequest++ -- 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++ -- Populate the context with values from headers+ let eCtx =+ -- combine our StaticContext and possible DynamicContext into a LambdaContext+ fmap (mkContext staticContext)+ -- convert the Maybe DynamicContext into an Either String DynamicContext+ $ maybeToEither "Runtime Error: Unable to decode Context from event response."+ -- Build the Dynamic Context, collapsing individual Maybes into a single Maybe+ $ DynamicContext (decodeUtf8 reqIdBS)+ <$> mTraceId+ <*> mFunctionArn+ <*> mDeadline+ <*> mClientContext+ <*> mIdentity++ let eEvent = first displayException $ getResponseBody nextRes++ result <- case liftA2 (,) eCtx eEvent of+ Left e -> return $ Left e+ Right (ctx, event) ->+ local (withContext ctx) $ do+ -- Propagate the tracing header (Exception safe for this env var name)+ liftIO $ setEnv "_X_AMZN_TRACE_ID" $ unpack $ xRayTraceId ctx++ {- 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++ liftIO $ case result of+ Right r -> sendEventSuccess baseRuntimeRequest reqIdBS r+ Left e -> sendEventError baseRuntimeRequest reqIdBS e++--TODO: Revisit all names before we put them under contract+-- | 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.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (mRuntimeWithContext)+-- import Control.Monad.Reader (ReaderT, ask)+-- import Control.Monad.State.Lazy (StateT, runStateT, get, put)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+--+-- data Named = {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: Named -> StateT Int (ReaderT LambdaContext IO String)+-- myHandler Named { name } = do+-- LambdaContext { functionName } <- ask+-- greeting <- getEnv \"GREETING\"+--+-- greetingCount <- get+-- put $ greetingCount + 1+--+-- return $ greeting ++ name ++ " (" ++ show greetingCount ++ ") from " ++ unpack functionName ++ "!"+--+-- main :: IO ()+-- main = runStateT (mRuntimeWithContext myHandler) 0+-- @+mRuntimeWithContext :: (HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m, FromJSON event, ToJSON result) =>+ (event -> m result) -> m ()+mRuntimeWithContext fn = do+ -- TODO: Hide the implementation details of Request and StaticContext.+ -- If we instead have a method that returns an opaque RuntimeClientConfig+ -- that encapsulates these details, and then all clientMethods accept+ -- the RuntimeClientConfig instead of a baseRuntimeRequest.+ baseRuntimeRequest <- liftIO getBaseRuntimeRequest++ possibleStaticCtx <- liftIO $ (decodeEnv :: IO (Either String StaticContext))++ case possibleStaticCtx of+ Left err -> liftIO $ sendInitError baseRuntimeRequest err+ Right staticContext -> forever $ runtimeLoop baseRuntimeRequest staticContext fn++-- | Helper for using arbitrary monads with only the LambdaContext in its Reader+readerTRuntimeWithContext :: ReaderT LambdaContext m a -> m a+readerTRuntimeWithContext = flip runReaderT defConfig++-- | 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+-- environment variables or making network requests, and prefer to access the+-- AWS Lambda Context in the same monad.+-- However, do not use this runtime if you need stateful (caching) behaviors.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (readerTRuntime)+-- import Control.Monad.Reader (ReaderT, ask)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+-- import System.Environment (getEnv)+--+-- data Named = {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: Named -> ReaderT LambdaContext IO String+-- myHandler Named { name } = do+-- LambdaContext { functionName } <- ask+-- greeting <- getEnv \"GREETING\"+-- return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"+--+-- main :: IO ()+-- main = readerTRuntime myHandler+-- @+readerTRuntime :: (FromJSON event, ToJSON result) =>+ (event -> ReaderT LambdaContext IO result) -> IO ()+readerTRuntime = readerTRuntimeWithContext . mRuntimeWithContext++-- | For functions with IO that can fail in a pure way (or via throw).+--+-- Use this for handlers that need any form of side-effect such as reading+-- environment variables or making network requests, and also need the+-- AWS Lambda Context as input.+-- However, do not use this runtime if you need stateful (caching) behaviors.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- 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)+--+-- data Named = {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: LambdaContext -> Named -> IO String+-- myHandler (LambdaContext { functionName }) (Named { name }) = do+-- greeting <- getEnv \"GREETING\"+-- return $ greeting ++ name ++ " from " ++ unpack functionName ++ "!"+--+-- main :: IO ()+-- main = ioRuntimeWithContext myHandler+-- @+ioRuntimeWithContext :: (FromJSON event, ToJSON result) =>+ (LambdaContext -> event -> IO (Either String result)) -> IO ()+ioRuntimeWithContext fn = readerTRuntime (\event -> do+ config <- ask+ result <- liftIO $ fn config event+ case result of+ Left e -> error e+ Right x -> return x+ )++-- | For functions with IO that can fail in a pure way (or via throw).+--+-- Use this for handlers that need any form of side-effect such as reading+-- environment variables or making network requests.+-- However, do not use this runtime if you need stateful (caching) behaviors.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Runtime (ioRuntime)+-- import Data.Aeson (FromJSON)+-- import System.Environment (getEnv)+--+-- data Named = {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: Named -> IO String+-- myHandler (Named { name }) = do+-- greeting <- getEnv \"GREETING\"+-- return $ greeting ++ name+--+-- main :: IO ()+-- main = ioRuntime myHandler+-- @+ioRuntime :: (FromJSON event, ToJSON result) =>+ (event -> IO (Either String result)) -> IO ()+ioRuntime fn = ioRuntimeWithContext wrapped+ where wrapped _ e = fn e++-- | For pure functions that can still fail.+--+-- Use this for simple handlers that just translate input to output without side-effects,+-- but can fail and need the AWS Lambda Context as input.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (fallibleRuntimeWithContext)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+--+-- data 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."+--+-- main :: IO ()+-- main = fallibleRuntimeWithContext myHandler+-- @+fallibleRuntimeWithContext :: (FromJSON event, ToJSON result) =>+ (LambdaContext -> event -> Either String result) -> IO ()+fallibleRuntimeWithContext fn = ioRuntimeWithContext wrapped+ where wrapped c e = return $ fn c e++-- | For pure functions that can still fail.+--+-- Use this for simple handlers that just translate input to output without side-effects,+-- but can fail.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Runtime (fallibleRuntime)+-- import Data.Aeson (FromJSON)+--+-- data 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."+--+-- main :: IO ()+-- main = fallibleRuntime myHandler+-- @+fallibleRuntime :: (FromJSON event, ToJSON result) =>+ (event -> Either String result) -> IO ()+fallibleRuntime fn = fallibleRuntimeWithContext wrapped+ where+ wrapped _ e = fn e++-- | For pure functions that can never fail that also need access to the context.+--+-- Use this for simple handlers that just translate input to output without side-effects,+-- but that need the AWS Lambda Context as input.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Context (LambdaContext(..))+-- import AWS.Lambda.Runtime (pureRuntimeWithContext)+-- import Data.Aeson (FromJSON)+-- import Data.Text (unpack)+--+-- data Named = {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: LambdaContext -> Named -> String+-- myHandler (LambdaContext { functionName }) (Named { name }) =+-- "Hello, " ++ name ++ " from " ++ unpack functionName ++ "!"+--+-- main :: IO ()+-- main = pureRuntimeWithContext myHandler+-- @+pureRuntimeWithContext :: (FromJSON event, ToJSON result) =>+ (LambdaContext -> event -> result) -> IO ()+pureRuntimeWithContext fn = fallibleRuntimeWithContext wrapped+ where wrapped c e = Right $ fn c e++-- | For pure functions that can never fail.+--+-- Use this for simple handlers that just translate input to output without side-effects.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns, DeriveGeneric \#-}+--+-- module Main where+--+-- import AWS.Lambda.Runtime (pureRuntime)+-- import Data.Aeson (FromJSON)+--+-- data Named = {+-- name :: String+-- } deriving Generic+-- instance FromJSON Named+--+-- myHandler :: Named -> String+-- myHandler Named { name } = "Hello, " ++ name ++ "!"+--+-- main :: IO ()+-- main = pureRuntime myHandler+-- @+pureRuntime :: (FromJSON event, ToJSON result) => (event -> result) -> IO ()+pureRuntime fn = fallibleRuntime (Right . fn)
+ src/AWS/Lambda/RuntimeClient.hs view
@@ -0,0 +1,148 @@+{-|+Module : AWS.Lambda.RuntimeClient+Description : 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 (+ getBaseRuntimeRequest,+ getNextEvent,+ sendEventSuccess,+ sendEventError,+ sendInitError+) where++import Control.Concurrent (threadDelay)+import Control.Exception (displayException, try, throw)+import Data.Aeson (encode)+import Data.Aeson.Types (FromJSON, ToJSON)+import Data.Bifunctor (first)+import qualified Data.ByteString as BS+import GHC.Generics (Generic (..))+import Network.HTTP.Simple (HttpException, JSONException,+ Request, Response,+ getResponseStatus, httpJSONEither,+ httpNoBody, parseRequest,+ setRequestBodyJSON,+ setRequestBodyLBS,+ setRequestCheckStatus,+ setRequestHeader, setRequestMethod,+ setRequestPath)+import Network.HTTP.Types.Status (status413, statusIsSuccessful)+import System.Environment (getEnv)++-- | Lambda runtime error that we pass back to AWS+data LambdaError = LambdaError+ { errorMessage :: String,+ errorType :: String,+ stackTrace :: [String]+ } deriving (Show, Generic)++instance ToJSON LambdaError++-- Exposed Handlers++-- TODO: It would be interesting if we could make the interface a sort of+-- "chained" callback API. So instead of getting back a base request to kick+-- things off we get a 'getNextEvent' handler and then the 'getNextEvent'+-- handler returns both the 'success' and 'error' handlers. So things like+-- baseRequest and reqId are pre-injected.+getBaseRuntimeRequest :: IO Request+getBaseRuntimeRequest = do+ awsLambdaRuntimeApi <- getEnv "AWS_LAMBDA_RUNTIME_API"+ parseRequest $ "http://" ++ awsLambdaRuntimeApi++getNextEvent :: FromJSON a => Request -> IO (Response (Either JSONException a))+getNextEvent baseRuntimeRequest = do+ resOrEx <- runtimeClientRetryTry $ httpJSONEither $ toNextEventRequest baseRuntimeRequest+ let checkStatus res = if not $ statusIsSuccessful $ getResponseStatus res then+ Left "Unexpected Runtime Error: Could retrieve next event."+ else+ Right res+ let resOrMsg = first (displayException :: HttpException -> String) resOrEx >>= checkStatus+ case resOrMsg of+ Left msg -> do+ _ <- sendInitError baseRuntimeRequest msg+ error msg+ Right y -> return y++sendEventSuccess :: ToJSON a => Request -> BS.ByteString -> a -> IO ()+sendEventSuccess baseRuntimeRequest reqId json = do+ resOrEx <- runtimeClientRetryTry $ httpNoBody $ toEventSuccessRequest reqId json baseRuntimeRequest++ let resOrTypedMsg = case resOrEx of+ Left ex ->+ -- aka NonRecoverable+ Left $ Left $ displayException (ex :: HttpException)+ Right res ->+ if getResponseStatus res == status413 then+ -- TODO Get the real error info from the response+ -- aka Recoverable+ Left (Right "Payload Too Large")+ else if not $ statusIsSuccessful $ getResponseStatus res then+ --aka NonRecoverable+ Left (Left "Unexpected Runtime Error: Could not post handler result.")+ else+ --aka Success+ Right ()++ case resOrTypedMsg of+ Left (Left msg) ->+ -- If an exception occurs here, we want that to propogate+ sendEventError baseRuntimeRequest reqId msg+ Left (Right msg) -> error msg+ Right () -> return ()++sendEventError :: Request -> BS.ByteString -> String -> IO ()+sendEventError baseRuntimeRequest reqId e =+ fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toEventErrorRequest reqId e baseRuntimeRequest++sendInitError :: Request -> String -> IO ()+sendInitError baseRuntimeRequest e =+ fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toInitErrorRequest e baseRuntimeRequest++-- Retry Helpers++runtimeClientRetryTry' :: Int -> IO (Response a) -> IO (Either HttpException (Response a))+runtimeClientRetryTry' 1 f = try f+runtimeClientRetryTry' i f = do+ resOrEx <- try f+ case resOrEx of+ Left (_ :: HttpException) -> threadDelay 500 >> runtimeClientRetryTry' (i - 1) f+ Right res -> return $ Right res++runtimeClientRetryTry :: IO (Response a) -> IO (Either HttpException (Response a))+runtimeClientRetryTry = runtimeClientRetryTry' 3++runtimeClientRetry :: IO (Response a) -> IO (Response a)+runtimeClientRetry = fmap (either throw id) . runtimeClientRetryTry+++-- Request Transformers++toNextEventRequest :: Request -> Request+toNextEventRequest = setRequestPath "2018-06-01/runtime/invocation/next"++toEventSuccessRequest :: ToJSON a => BS.ByteString -> a -> Request -> Request+toEventSuccessRequest reqId json =+ setRequestBodyJSON json .+ setRequestMethod "POST" .+ setRequestPath (BS.concat ["2018-06-01/runtime/invocation/", reqId, "/response"])++toBaseErrorRequest :: String -> Request -> Request+toBaseErrorRequest e =+ setRequestBodyLBS (encode (LambdaError { errorMessage = e, stackTrace = [], errorType = "User"}))+ . setRequestHeader "Content-Type" ["application/vnd.aws.lambda.error+json"]+ . setRequestMethod "POST"+ . setRequestCheckStatus++toEventErrorRequest :: BS.ByteString -> String -> Request -> Request+toEventErrorRequest reqId e =+ setRequestPath (BS.concat ["2018-06-01/runtime/invocation/", reqId, "/error"]) . toBaseErrorRequest e++toInitErrorRequest :: String -> Request -> Request+toInitErrorRequest e =+ setRequestPath "2018-06-01/runtime/init/error" . toBaseErrorRequest e