packages feed

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 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