hal 0.3.4 → 0.4.0

raw patch · 6 files changed

+604/−233 lines, 6 filesdep −conduitdep −conduit-extradep −http-clientPVP ok

version bump matches the API change (PVP)

Dependencies removed: conduit, conduit-extra, http-client

API changes (from Hackage documentation)

Files

• hal.cabal +5/−6
• src/AWS/Lambda/Combinators.hs +23/−1
• src/AWS/Lambda/Events/SQS.hs +55/−0
• src/AWS/Lambda/Runtime.hs +8/−120
• src/AWS/Lambda/Runtime/Value.hs +477/−0
• src/AWS/Lambda/RuntimeClient.hs +36/−106

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 8d35e8a815b7bdb309aebceaefc610f970e0bd9fffe62b2356a9611ad61dbeb9+-- hash: f0a8761c52b07313708798791d5b65ef7ac4ab2fce5c2b8b26beea0bf4f6770e  name:           hal-version:        0.3.4+version:        0.4.0 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@@ -33,8 +33,10 @@       AWS.Lambda.Combinators       AWS.Lambda.Context       AWS.Lambda.Events.S3+      AWS.Lambda.Events.SQS       AWS.Lambda.Internal       AWS.Lambda.Runtime+      AWS.Lambda.Runtime.Value       AWS.Lambda.RuntimeClient   other-modules:       Paths_hal@@ -46,12 +48,9 @@       aeson     , base >=4.7 && <5     , bytestring-    , conduit-    , conduit-extra     , containers     , envy     , exceptions-    , http-client     , http-conduit     , http-types     , mtl

@@ -15,11 +15,14 @@     withIOInterface,     withFallibleInterface,     withPureInterface,-    withoutContext+    withoutContext,+    withInfallibleParse ) where  import           Control.Monad.IO.Class (MonadIO, liftIO) import           Control.Monad.Reader   (MonadReader, ask)+import           Data.Aeson             (FromJSON, parseJSON, Value)+import           Data.Aeson.Types       (parseEither)   -- Helper for converting an either result into a monad/exception@@ -183,3 +186,22 @@ -- @ withoutContext :: a -> b -> a withoutContext = const++-- | This modifies a function to accept a JSON AST (Value), instead of its JSON parsable+-- input.  It also assumes that the JSON AST passed in will ALWAYS be convertable into the+-- original input type.+--+-- This allows us to write handlers of the types we're interested in, but then map back+-- to the "native" handler that is only guaranteed JSON (but not necessarily in a useful+-- or restricted structure).+--+-- This is essentially the glue that converts the "AWS.Lambda.Runtime.Value" to+-- (the more standard) "AWS.Lambda.Runtime".  While both export a+-- 'AWS.Lambda.Runtime.mRuntimeWithContext', the difference is that the Value+-- Runtime makes no attempt to convert the JSON AST, the standard Runtime does.+--+-- Rarely would this function be used directly, and you wouldn't want to use it+-- at all, (directly or indirectly via Runtime runtimes), if you wanted to act+-- on a failure to convert the JSON AST sent to the Lambda.+withInfallibleParse :: FromJSON a => (a -> b) -> Value -> b+withInfallibleParse fn = either error fn . parseEither parseJSON

@@ -0,0 +1,55 @@+{-|+Module      : AWS.Lambda.Events.SQS+Description : Data types for working with SQS events.+Copyright   : (c) Nike, Inc., 2019+License     : BSD3+Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com+Stability   : stable+-}++module AWS.Lambda.Events.SQS (+  Records (..),+  Attributes (..),+  SQSEvent (..)+) where++import Data.Aeson   (FromJSON (..), withObject, (.:))+import Data.Map     (Map)+import Data.Text    (Text)+import GHC.Generics (Generic)++newtype Records = Records {+  records :: [SQSEvent]+} deriving (Show, Eq)++instance FromJSON Records where+  parseJSON = withObject "Records" $ \v -> Records <$> v .: "Records"++data Attributes = Attributes {+  approximateReceiveCount          :: Text,+  sentTimestamp                    :: Text,+  senderId                         :: Text,+  approximateFirstReceiveTimestamp :: Text+} deriving (Show, Eq)++instance FromJSON Attributes where+  parseJSON = withObject "Attributes" $ \v ->+    Attributes+      <$> v .: "ApproximateReceiveCount"+      <*> v .: "SentTimestamp"+      <*> v .: "SenderId"+      <*> v .: "ApproximateFirstReceiveTimestamp"++data SQSEvent = SQSEvent {+  messageId         :: Text,+  receiptHandle     :: Text,+  body              :: Text,+  attributes        :: Attributes,+  messageAttributes :: Map Text Text,+  md5OfBody         :: Text,+  eventSource       :: Text,+  eventSourceARN    :: Text,+  awsRegion         :: Text+} deriving (Show, Eq, Generic)++instance FromJSON SQSEvent

@@ -28,120 +28,17 @@   mRuntimeWithContext ) where -import           AWS.Lambda.RuntimeClient (RuntimeClientConfig, getNextEvent,-                                           getRuntimeClientConfig,-                                           sendEventError, sendEventSuccess,-                                           sendInitError) import           AWS.Lambda.Combinators   (withIOInterface,                                            withFallibleInterface,                                            withPureInterface,-                                           withoutContext)+                                           withoutContext,+                                           withInfallibleParse) import           AWS.Lambda.Context       (LambdaContext(..), HasLambdaContext(..), runReaderTLambdaContext)-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, local)-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      (getResponseBody, getResponseHeader)-import           System.Environment       (setEnv)-import           System.Envy              (decodeEnv)--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) => RuntimeClientConfig -> StaticContext ->-  (event -> m result) -> m ()-runtimeLoop runtimeClientConfig staticContext fn = do-  -- Get an event-  nextRes <- liftIO $ 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--  -- 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)-        <$> mFunctionArn-        <*> mTraceId-        <*> 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 runtimeClientConfig reqIdBS r-    Left e  -> sendEventError runtimeClientConfig reqIdBS e+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)  --TODO: Revisit all names before we put them under contract -- | For any monad that supports IO/catch/Reader LambdaContext.@@ -183,16 +80,7 @@ -- @ 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 StaticContext within-  -- RuntimeClientConfig that encapsulates more details-  runtimeClientConfig <- liftIO getRuntimeClientConfig--  possibleStaticCtx <- liftIO $ (decodeEnv :: IO (Either String StaticContext))--  case possibleStaticCtx of-    Left err -> liftIO $ sendInitError runtimeClientConfig err-    Right staticContext -> forever $ runtimeLoop runtimeClientConfig staticContext fn+mRuntimeWithContext = ValueRuntime.mRuntimeWithContext . withInfallibleParse  -- | For functions that can read the lambda context and use IO within the same monad. --

@@ -0,0 +1,477 @@+{-# LANGUAGE FlexibleContexts #-}++{-|+Module      : AWS.Lambda.Runtime.Value+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++These are runtimes designed for AWS Lambda, which accept a handler and return+an application that will retreive and execute events as long as a container+continues to exist.++These runtimes expect handlers that accept a parsed JSON AST+('Data.Aeson.Types.Value') as the input, instead some particular type with a FromJSON+instance.  Handlers using these runtimes must take care of the conversion and+handle errors explicitly.  Handlers that should throw an exception or never+expect to be invoked with an invalid payload, should simply use the runtimes in+the "AWS.Lambda.Runtime" module.++Each example shows the conversion from the Value type to the target FromJSON+type.++Many of these runtimes use "AWS.Lambda.Combinators" under the hood.+For those interested in peeking below the abstractions provided here,+please refer to that module.+-}++module AWS.Lambda.Runtime.Value (+  pureRuntime,+  pureRuntimeWithContext,+  fallibleRuntime,+  fallibleRuntimeWithContext,+  ioRuntime,+  ioRuntimeWithContext,+  readerTRuntime,+  mRuntimeWithContext+) where++import           AWS.Lambda.RuntimeClient (getBaseRuntimeRequest, getNextEvent,+                                           sendEventError, sendEventSuccess, sendInitError)+import           AWS.Lambda.Combinators   (withIOInterface,+                                           withFallibleInterface,+                                           withPureInterface,+                                           withoutContext)+import           AWS.Lambda.Context       (LambdaContext(..), HasLambdaContext(..), runReaderTLambdaContext)+import           AWS.Lambda.Internal      (StaticContext, DynamicContext(DynamicContext),+                                           mkContext)+import           Control.Applicative      ((<*>))+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, local)+import           Data.Aeson               (FromJSON, FromJSON, ToJSON, decode, Value)+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)++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, ToJSON result) => Request -> StaticContext ->+  (Value -> 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 event = getResponseBody nextRes++  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++        {- 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+++-- | 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(..), 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)+-- @+mRuntimeWithContext :: (HasLambdaContext r, MonadCatch m, MonadReader r m, MonadIO m, ToJSON result) =>+  (Value -> 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++-- | 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 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 -> 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+-- @+readerTRuntime :: ToJSON result =>+  (Value -> ReaderT LambdaContext IO result) -> IO ()+readerTRuntime = runReaderTLambdaContext .  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 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 :: 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+-- @+ioRuntimeWithContext :: ToJSON result =>+  (LambdaContext -> Value -> IO (Either String result)) -> IO ()+ioRuntimeWithContext = readerTRuntime . withIOInterface++-- | 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 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+--+--     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+-- @+ioRuntime :: ToJSON result =>+  (Value -> IO (Either String result)) -> IO ()+ioRuntime = readerTRuntime . withIOInterface . withoutContext++-- | 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 (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+--+--     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+-- @+fallibleRuntimeWithContext :: ToJSON result =>+  (LambdaContext -> Value -> Either String result) -> IO ()+fallibleRuntimeWithContext = readerTRuntime . withFallibleInterface++-- | 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 (Value, FromJSON, parseJSON)+--     import Data.Aeson.Types (parseMaybe)+--     import GHC.Generics (Generic)+--+--     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."+--+--     main :: IO ()+--     main = fallibleRuntime myHandler+-- @+fallibleRuntime :: ToJSON result =>+  (Value -> Either String result) -> IO ()+fallibleRuntime = readerTRuntime . withFallibleInterface . withoutContext++-- | 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 (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+--+--     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+-- @+pureRuntimeWithContext :: ToJSON result =>+  (LambdaContext -> Value -> result) -> IO ()+pureRuntimeWithContext = readerTRuntime . withPureInterface++-- | 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 (Value, FromJSON, parseJSON)+--     import Data.Aeson.Types (parseMaybe)+--     import GHC.Generics (Generic)+--+--     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 ++ "!"+--+--     main :: IO ()+--     main = pureRuntime myHandler+-- @+pureRuntime :: ToJSON result => (Value -> result) -> IO ()+pureRuntime = readerTRuntime . withPureInterface . withoutContext

@@ -8,8 +8,7 @@ -}  module AWS.Lambda.RuntimeClient (-  RuntimeClientConfig,-  getRuntimeClientConfig,+  getBaseRuntimeRequest,   getNextEvent,   sendEventSuccess,   sendEventError,@@ -17,35 +16,22 @@ ) where  import           Control.Concurrent        (threadDelay)-import           Control.Exception         (Exception, displayException, throw,-                                            try)-import           Control.Monad             (unless)-import           Control.Monad.IO.Class    (MonadIO, liftIO)-import           Data.Aeson                (Result (..), Value, encode,-                                            fromJSON)-import           Data.Aeson.Parser         (value')-import           Data.Aeson.Types          (FromJSON, ToJSON)+import           Control.Exception         (displayException, try, throw)+import           Data.Aeson                (encode, Value)+import           Data.Aeson.Types          (ToJSON) import           Data.Bifunctor            (first) import qualified Data.ByteString           as BS-import           Data.Conduit              (ConduitM, runConduit, yield, (.|))-import           Data.Conduit.Attoparsec   (sinkParser) 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       (getResponseStatus,+import           Network.HTTP.Simple       (HttpException,+                                            Request, Response,+                                            getResponseStatus, httpJSON,+                                            httpNoBody, parseRequest,                                             setRequestBodyJSON,                                             setRequestBodyLBS,                                             setRequestCheckStatus,                                             setRequestHeader, setRequestMethod,                                             setRequestPath)-import           Network.HTTP.Types.Status (status403, status413, statusIsSuccessful)+import           Network.HTTP.Types.Status (status413, statusIsSuccessful) import           System.Environment        (getEnv)  -- | Lambda runtime error that we pass back to AWS@@ -57,8 +43,6 @@  instance ToJSON LambdaError -data RuntimeClientConfig = RuntimeClientConfig Request Manager- -- Exposed Handlers  -- TODO: It would be interesting if we could make the interface a sort of@@ -66,28 +50,16 @@ -- 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.-getRuntimeClientConfig :: IO RuntimeClientConfig-getRuntimeClientConfig = do+getBaseRuntimeRequest :: IO Request+getBaseRuntimeRequest = do   awsLambdaRuntimeApi <- getEnv "AWS_LAMBDA_RUNTIME_API"-  req <- parseRequest $ "http://" ++ awsLambdaRuntimeApi-  man <- newManager-           -- In the off chance that they set a proxy value, we don't want to-           -- use it.  There's also no reason to spend time reading env vars.-           $ managerSetProxy noProxy-           $ defaultManagerSettings-             -- This is the most important setting, we must not timeout requests-             { managerResponseTimeout = responseTimeoutNone-             -- We only ever need a single connection, because we'll never make-             -- concurrent requests and never talk to more than one host.-             , managerConnCount = 1-             , managerIdleConnectionCount = 1-             }-  return $ RuntimeClientConfig req man-+  parseRequest $ "http://" ++ awsLambdaRuntimeApi -getNextEvent :: FromJSON a => RuntimeClientConfig -> IO (Response (Either JSONParseException a))-getNextEvent rcc@(RuntimeClientConfig baseRuntimeRequest manager) = do-  resOrEx <- runtimeClientRetryTry $ flip httpJSONEither manager $ toNextEventRequest baseRuntimeRequest+-- AWS lambda guarantees that we will get valid JSON,+-- so parsing is guaranteed to succeed.+getNextEvent :: Request -> IO (Response Value)+getNextEvent baseRuntimeRequest = do+  resOrEx <- runtimeClientRetryTry $ httpJSON $ toNextEventRequest baseRuntimeRequest   let checkStatus res = if not $ statusIsSuccessful $ getResponseStatus res then         Left "Unexpected Runtime Error:  Could not retrieve next event."       else@@ -95,13 +67,13 @@   let resOrMsg = first (displayException :: HttpException -> String) resOrEx >>= checkStatus   case resOrMsg of     Left msg -> do-      _ <- sendInitError rcc msg+      _ <- sendInitError baseRuntimeRequest msg       error msg     Right y -> return y -sendEventSuccess :: ToJSON a => RuntimeClientConfig -> BS.ByteString -> a -> IO ()-sendEventSuccess rcc@(RuntimeClientConfig baseRuntimeRequest manager) reqId json = do-  resOrEx <- runtimeClientRetryTry $ flip httpNoBody manager $ toEventSuccessRequest reqId json baseRuntimeRequest+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 ->@@ -122,72 +94,30 @@   case resOrTypedMsg of     Left (Left msg) ->       -- If an exception occurs here, we want that to propogate-      sendEventError rcc reqId msg+      sendEventError baseRuntimeRequest reqId msg     Left (Right msg) -> error msg     Right () -> return () -sendEventError :: RuntimeClientConfig -> BS.ByteString -> String -> IO ()-sendEventError (RuntimeClientConfig baseRuntimeRequest manager) reqId e =-  fmap (const ()) $ runtimeClientRetry $ flip httpNoBody manager $ toEventErrorRequest reqId e baseRuntimeRequest--sendInitError :: RuntimeClientConfig -> String -> IO ()-sendInitError (RuntimeClientConfig baseRuntimeRequest manager) e =-  fmap (const ()) $ runtimeClientRetry $ flip httpNoBody manager $ toInitErrorRequest e baseRuntimeRequest---- Helpers for Requests with JSON Bodies--newtype JSONParseException = JSONParseException { getException :: String } deriving (Show)-instance Exception JSONParseException--httpJSONEither :: FromJSON a => Request -> Manager -> IO (Response (Either JSONParseException a))-httpJSONEither request manager =-  let toEither v =-        case fromJSON v of-          Error e         -> Left (JSONParseException e)-          Success decoded -> Right decoded-  in fmap toEither <$> httpValue request manager--httpValue :: Request -> Manager -> IO (Response Value)-httpValue request manager =-  withResponse request manager (\bodyReaderRes -> do-    value <- runConduit $ bodyReaderSource (responseBody bodyReaderRes) .| sinkParser value'-    return $ fmap (const value) bodyReaderRes-  )+sendEventError :: Request -> BS.ByteString -> String -> IO ()+sendEventError baseRuntimeRequest reqId e =+  fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toEventErrorRequest reqId e baseRuntimeRequest -bodyReaderSource :: MonadIO m-                 => BodyReader-                 -> ConduitM i BS.ByteString m ()-bodyReaderSource br =-    loop-  where-    loop = do-        bs <- liftIO $ brRead br-        unless (BS.null bs) $ do-            yield bs-            loop+sendInitError :: Request -> String -> IO ()+sendInitError baseRuntimeRequest e =+  fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toInitErrorRequest e baseRuntimeRequest  -- Retry Helpers -runtimeClientRetryTry' :: Int -> Int -> IO (Response a) -> IO (Either HttpException (Response a))-runtimeClientRetryTry' retries maxRetries f-  | retries == maxRetries = try f-  | otherwise = do-    resOrEx <- try f-    let retry =-          threadDelay (500 * 2 ^ retries)-            >> runtimeClientRetryTry' (retries + 1) maxRetries f-    case resOrEx of-      Left (_ :: HttpException) -> retry-      Right res ->-        -- TODO: Explore this further.-        -- Before ~July 22nd 2020 it seemed that if a next event request reached-        -- the runtime before a new event was available that there would be a-        -- network error.  After it appears that a 403 is returned.-        if getResponseStatus res == status403 then retry-        else return $ Right res+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' 0 10+runtimeClientRetryTry = runtimeClientRetryTry' 3  runtimeClientRetry :: IO (Response a) -> IO (Response a) runtimeClientRetry = fmap (either throw id) . runtimeClientRetryTry