hal 0.4.3 → 0.4.4

raw patch · 3 files changed

+89/−40 lines, 3 filesdep +conduitdep +conduit-extradep +http-clientPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

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

API changes (from Hackage documentation)

Files

• hal.cabal +5/−2
• src/AWS/Lambda/Runtime/Value.hs +14/−16
• src/AWS/Lambda/RuntimeClient.hs +70/−22

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 076bfc1eca4e774099d305583e11d8f5253e39b53ace8f17b0a10c55836700c8+-- hash: fbfaaa4c29a274d91431ffc4f57974eb4e6b8428ddc2c200c9794e7b2eee4a76  name:           hal-version:        0.4.3+version:        0.4.4 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@@ -48,9 +48,12 @@       aeson     , base >=4.7 && <5     , bytestring+    , conduit+    , conduit-extra     , containers     , envy <2     , exceptions+    , http-client     , http-conduit     , http-types     , mtl

@@ -38,8 +38,9 @@   mRuntimeWithContext ) where -import           AWS.Lambda.RuntimeClient (getBaseRuntimeRequest, getNextEvent,-                                           sendEventError, sendEventSuccess, sendInitError)+import           AWS.Lambda.RuntimeClient (RuntimeClientConfig, getRuntimeClientConfig,+                                           getNextEvent, sendEventError, sendEventSuccess,+                                           sendInitError) import           AWS.Lambda.Combinators   (withIOInterface,                                            withFallibleInterface,                                            withPureInterface,@@ -61,8 +62,7 @@ import           Data.Text                (unpack) import           Data.Text.Encoding       (decodeUtf8) import           Data.Time.Clock.POSIX    (posixSecondsToUTCTime)-import           Network.HTTP.Simple      (Request, getResponseBody,-                                           getResponseHeader)+import           Network.HTTP.Simple      (getResponseBody, getResponseHeader) import           System.Environment       (setEnv) import           System.Envy              (decodeEnv) @@ -97,11 +97,11 @@     _ -> Nothing  -runtimeLoop :: (HasLambdaContext r, MonadReader r m, MonadCatch m, MonadIO m, ToJSON result) => Request -> StaticContext ->+runtimeLoop :: (HasLambdaContext r, MonadReader r m, MonadCatch m, MonadIO m, ToJSON result) => RuntimeClientConfig -> StaticContext ->   (Value -> m result) -> m ()-runtimeLoop baseRuntimeRequest staticContext fn = do+runtimeLoop runtimeClientConfig staticContext fn = do   -- Get an event-  nextRes <- liftIO $ getNextEvent baseRuntimeRequest+  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@@ -149,8 +149,8 @@         return $ first (displayException :: SomeException -> String) caughtResult    liftIO $ case result of-    Right r -> sendEventSuccess baseRuntimeRequest reqIdBS r-    Left e  -> sendEventError baseRuntimeRequest reqIdBS e+    Right r -> sendEventSuccess runtimeClientConfig reqIdBS r+    Left e  -> sendEventError runtimeClientConfig reqIdBS e   -- | For any monad that supports IO/catch/Reader LambdaContext.@@ -198,17 +198,15 @@ 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+  -- 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 baseRuntimeRequest err-    Right staticContext -> forever $ runtimeLoop baseRuntimeRequest staticContext fn+    Left err -> liftIO $ sendInitError runtimeClientConfig err+    Right staticContext -> forever $ runtimeLoop runtimeClientConfig staticContext fn  -- | For functions that can read the lambda context and use IO within the same monad. --

@@ -8,7 +8,8 @@ -}  module AWS.Lambda.RuntimeClient (-  getBaseRuntimeRequest,+  RuntimeClientConfig,+  getRuntimeClientConfig,   getNextEvent,   sendEventSuccess,   sendEventError,@@ -17,15 +18,26 @@  import           Control.Concurrent        (threadDelay) import           Control.Exception         (displayException, try, throw)+import           Control.Monad             (unless)+import           Control.Monad.IO.Class    (MonadIO, liftIO) import           Data.Aeson                (encode, Value)+import           Data.Aeson.Parser         (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.Simple       (HttpException,-                                            Request, Response,-                                            getResponseStatus, httpJSON,-                                            httpNoBody, parseRequest,+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,                                             setRequestBodyJSON,                                             setRequestBodyLBS,                                             setRequestCheckStatus,@@ -43,6 +55,8 @@  instance ToJSON LambdaError +data RuntimeClientConfig = RuntimeClientConfig Request Manager+ -- Exposed Handlers  -- TODO: It would be interesting if we could make the interface a sort of@@ -50,16 +64,29 @@ -- things off we get a 'getNextEvent' handler and then the 'getNextEvent' -- handler returns both the 'success' and 'error' handlers.  So things like -- baseRequest and reqId are pre-injected.-getBaseRuntimeRequest :: IO Request-getBaseRuntimeRequest = do+getRuntimeClientConfig :: IO RuntimeClientConfig+getRuntimeClientConfig = do   awsLambdaRuntimeApi <- getEnv "AWS_LAMBDA_RUNTIME_API"-  parseRequest $ "http://" ++ awsLambdaRuntimeApi+  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  -- 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+getNextEvent :: RuntimeClientConfig -> IO (Response Value)+getNextEvent rcc@(RuntimeClientConfig baseRuntimeRequest manager) = do+  resOrEx <- runtimeClientRetryTry $ flip httpValue manager $ toNextEventRequest baseRuntimeRequest   let checkStatus res = if not $ statusIsSuccessful $ getResponseStatus res then         Left "Unexpected Runtime Error:  Could not retrieve next event."       else@@ -67,13 +94,13 @@   let resOrMsg = first (displayException :: HttpException -> String) resOrEx >>= checkStatus   case resOrMsg of     Left msg -> do-      _ <- sendInitError baseRuntimeRequest msg+      _ <- sendInitError rcc msg       error msg     Right y -> return y -sendEventSuccess :: ToJSON a => Request -> BS.ByteString -> a -> IO ()-sendEventSuccess baseRuntimeRequest reqId json = do-  resOrEx <- runtimeClientRetryTry $ httpNoBody $ toEventSuccessRequest reqId json baseRuntimeRequest+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    let resOrTypedMsg = case resOrEx of         Left ex ->@@ -94,17 +121,38 @@   case resOrTypedMsg of     Left (Left msg) ->       -- If an exception occurs here, we want that to propogate-      sendEventError baseRuntimeRequest reqId msg+      sendEventError rcc reqId msg     Left (Right msg) -> error msg     Right () -> return () -sendEventError :: Request -> BS.ByteString -> String -> IO ()-sendEventError baseRuntimeRequest reqId e =-  fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toEventErrorRequest reqId e baseRuntimeRequest+sendEventError :: RuntimeClientConfig -> BS.ByteString -> String -> IO ()+sendEventError (RuntimeClientConfig baseRuntimeRequest manager) reqId e =+  fmap (const ()) $ runtimeClientRetry $ flip httpNoBody manager $ toEventErrorRequest reqId e baseRuntimeRequest -sendInitError :: Request -> String -> IO ()-sendInitError baseRuntimeRequest e =-  fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toInitErrorRequest 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++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+  )++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  -- Retry Helpers