hal 0.4.5 → 0.4.6

raw patch · 5 files changed

+500/−97 lines, 5 filesdep +base64-bytestringdep +case-insensitivedep +unordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base64-bytestring, case-insensitive, unordered-containers

API changes (from Hackage documentation)

Files

• hal.cabal +8/−3
• src/AWS/Lambda/Events/ApiGateway/ProxyRequest.hs +174/−0
• src/AWS/Lambda/Events/ApiGateway/ProxyResponse.hs +210/−0
• src/AWS/Lambda/Runtime/Value.hs +6/−82
• src/AWS/Lambda/RuntimeClient.hs +102/−12

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2175dc8b8db69d64e82ae49c3130cc5d820d63bc28a956f8d4aa3af961c4ddb5+-- hash: d43ec18e49bb7ce77fd444cdf150662cb6ff0f3c8ba1349dbd4318e6b5bc7e29  name:           hal-version:        0.4.5+version:        0.4.6 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@@ -32,6 +32,8 @@   exposed-modules:       AWS.Lambda.Combinators       AWS.Lambda.Context+      AWS.Lambda.Events.ApiGateway.ProxyRequest+      AWS.Lambda.Events.ApiGateway.ProxyResponse       AWS.Lambda.Events.S3       AWS.Lambda.Events.SQS       AWS.Lambda.Internal@@ -42,12 +44,14 @@       Paths_hal   hs-source-dirs:       src-  default-extensions: OverloadedStrings BangPatterns DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable EmptyCase GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf OverloadedStrings PatternSynonyms ScopedTypeVariables+  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   build-depends:       aeson     , base >=4.7 && <5+    , base64-bytestring     , bytestring+    , case-insensitive     , conduit     , conduit-extra     , containers@@ -59,4 +63,5 @@     , mtl     , text     , time+    , unordered-containers   default-language: Haskell2010

@@ -0,0 +1,174 @@+{-|+Module      : AWS.Lambda.Events.ApiGateway.ProxyRequest+Description : Data types that represent typical lambda responses+Copyright   : (c) Nike, Inc., 2019+License     : BSD3+Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com+Stability   : stable++This module exposes types used to model incoming __proxy__ requests from AWS+API Gateway.  These types are a light pass over the incoming JSON+representation.+-}+module AWS.Lambda.Events.ApiGateway.ProxyRequest+    ( ProxyRequest(..)+    , RequestContext(..)+    , Identity(..)+    , NoAuthorizer+    , StrictlyNoAuthorizer+    ) where++import           Data.Aeson                  (FromJSON, Value, parseJSON,+                                              withObject, (.:), (.:?))+import           Data.ByteString.Base64.Lazy (decodeLenient)+import           Data.ByteString.Lazy        (ByteString)+import           Data.CaseInsensitive        (CI, mk)+import           Data.Foldable               (fold)+import           Data.HashMap.Strict         (HashMap, foldrWithKey, insert)+import           Data.Text                   (Text)+import qualified Data.Text.Lazy              as TL+import qualified Data.Text.Lazy.Encoding     as TLE+import           Data.Void                   (Void)+import           GHC.Generics                (Generic (..))++-- This function is available in Data.Functor as of base 4.11, but we define it+-- here for compatibility.+(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) x f = f <$> x++infixl 1 <&>++data Identity = Identity+    { cognitoIdentityPoolId         :: Maybe Text+    , accountId                     :: Maybe Text+    , cognitoIdentityId             :: Maybe Text+    , caller                        :: Maybe Text+    , apiKey                        :: Maybe Text+    , sourceIp                      :: Text+    , accessKey                     :: Maybe Text+    , cognitoAuthenticationType     :: Maybe Text+    , cognitoAuthenticationProvider :: Maybe Text+    , userArn                       :: Maybe Text+    , apiKeyId                      :: Maybe Text+    , userAgent                     :: Maybe Text+    , user                          :: Maybe Text+    } deriving (Generic)++instance FromJSON Identity++data RequestContext a = RequestContext+    { path              :: Text+    , accountId         :: Text+    , authorizer        :: Maybe a+    , resourceId        :: Text+    , stage             :: Text+    , domainPrefix      :: Maybe Text+    , requestId         :: Text+    , identity          :: Identity+    , domainName        :: Maybe Text+    , resourcePath      :: Text+    , httpMethod        :: Text+    , extendedRequestId :: Maybe Text+    , apiId             :: Text+    }++instance FromJSON a => FromJSON (RequestContext a) where+    parseJSON = withObject "ProxyRequest" $ \v ->+        RequestContext <$> v .: "path" <*> v .: "accountId" <*>+        v .:? "authorizer" <*>+        v .: "resourceId" <*>+        v .: "stage" <*>+        v .:? "domainPrefix" <*>+        v .: "requestId" <*>+        v .: "identity" <*>+        v .:? "domainName" <*>+        v .: "resourcePath" <*>+        v .: "httpMethod" <*>+        v .:? "extendedRequestId" <*>+        v .: "apiId"++-- TODO: Should also include websocket fields+-- | This type is for representing events that come from API Gateway via the+-- Lambda Proxy integration (forwarding HTTP data directly, rather than a+-- custom integration).  It will automatically decode the event that comes in.+--+-- The 'ProxyRequest' notably has one parameter for the type of information+-- returned by the API Gateway's custom authorizer (if applicable).  This type+-- must also implement FromJSON so that it can be decoded.  If you do not+-- expect this data to be populated we recommended using the 'NoAuthorizer'+-- type exported from this module (which is just an alias for 'Value').  If+-- there _must not_ be authorizer populated (this is unlikely) then use the+-- 'StrictlyNoAuthorizer' type.+--+-- @+--     {-\# LANGUAGE NamedFieldPuns \#-}+--     {-\# LANGUAGE DuplicateRecordFields \#-}+--+--     module Main where+--+--     import AWS.Lambda.Runtime (pureRuntime)+--     import AWS.Lambda.Events.ApiGateway.ProxyRequest (ProxyRequest(..), NoAuthorizer)+--     import AWS.Lambda.Events.ApiGateway.ProxyResponse (ProxyResponse(..), textPlain, forbidden403, ok200)+--+--     myHandler :: ProxyRequest NoAuthorizer -> ProxyResponse+--     myHandler ProxyRequest { httpMethod = \"GET\", path = "/say_hello" } =+--         ProxyResponse+--         {   status = ok200+--         ,   body = textPlain \"Hello\"+--         ,   headers = mempty+--         ,   multiValueHeaders = mempty+--         }+--     myHandler _ =+--         ProxyResponse+--         {   status = forbidden403+--         ,   body = textPlain \"Forbidden\"+--         ,   headers = mempty+--         ,   multiValueHeaders = mempty+--         }+--+--     main :: IO ()+--     main = pureRuntime myHandler+-- @+data ProxyRequest a = ProxyRequest+    { path                            :: Text+    , headers                         :: HashMap (CI Text) Text+    , multiValueHeaders               :: HashMap (CI Text) [Text]+    , pathParameters                  :: HashMap Text Text+    , stageVariables                  :: HashMap Text Text+    , requestContext                  :: RequestContext a+    , resource                        :: Text+    , httpMethod                      :: Text+    , queryStringParameters           :: HashMap Text Text+    , multiValueQueryStringParameters :: HashMap Text [Text]+    , body                            :: ByteString+    } deriving (Generic)++toCIHashMap :: HashMap Text a -> HashMap (CI Text) a+toCIHashMap = foldrWithKey (insert . mk) mempty++toByteString :: Bool -> TL.Text -> ByteString+toByteString isBase64Encoded =+    if isBase64Encoded+        then decodeLenient . TLE.encodeUtf8+        else TLE.encodeUtf8++-- | For ignoring API Gateway custom authorizer values+type NoAuthorizer = Value++-- | For ensuring that there were no API Gateway custom authorizer values (this+-- is not likely to be useful, you probably want 'NoAuthorizer')+type StrictlyNoAuthorizer = Void++instance FromJSON a => FromJSON (ProxyRequest a) where+    parseJSON = withObject "ProxyRequest" $ \v ->+        ProxyRequest <$> v .: "path" <*>+        (v .:? "headers" <&> toCIHashMap . fold) <*>+        (v .:? "multiValueHeaders" <&> toCIHashMap . fold) <*>+        (v .:? "pathParameters" <&> fold) <*>+        (v .:? "stageVariables" <&> fold) <*>+        v .: "requestContext" <*>+        v .: "resource" <*>+        v .: "httpMethod" <*>+        (v .:? "queryStringParameters" <&> fold) <*>+        (v .:? "multiValueQueryStringParameters" <&> fold) <*>+        (toByteString <$> v .: "isBase64Encoded" <*> (v .:? "body" <&> fold))

@@ -0,0 +1,210 @@+{-|+Module      : AWS.Lambda.Events.ApiGateway.ProxyResponse+Description : Data types that represent typical lambda responses+Copyright   : (c) Nike, Inc., 2019+License     : BSD3+Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com+Stability   : stable++This module enable exposes the required types for responding to API Gateway+Proxy Events.  Responses must return a status, body, and optionaly headers.+Multiple smart contructors and helpers are provided to help encapsulated+details like header case-insensitivity, multiple header copies, correct base64+encoding, and default content type.+-}+module AWS.Lambda.Events.ApiGateway.ProxyResponse+    ( ProxyResponse(..)+    , response+    , addHeader+    , setHeader+    , ProxyBody(..)+    , textPlain+    , applicationJson+    , genericBinary+    , module Network.HTTP.Types.Status+    ) where++import           Data.Aeson                (ToJSON, encode, object, toJSON,+                                            (.=))+import           Data.ByteString           (ByteString)+import qualified Data.ByteString.Base64    as B64+import           Data.CaseInsensitive      (CI, mk, original)+import           Data.HashMap.Strict       (HashMap, foldrWithKey, insert,+                                            insertWith)+import           Data.Semigroup            ((<>))+import qualified Data.Text                 as T+import qualified Data.Text.Encoding        as TE+import qualified Data.Text.Lazy            as TL+import qualified Data.Text.Lazy.Encoding   as TLE+import           Network.HTTP.Types.Status (Status (..), accepted202,+                                            badGateway502, badRequest400,+                                            conflict409, continue100,+                                            created201, expectationFailed417,+                                            forbidden403, found302,+                                            gatewayTimeout504, gone410,+                                            httpVersionNotSupported505,+                                            imATeapot418,+                                            internalServerError500,+                                            lengthRequired411,+                                            methodNotAllowed405,+                                            movedPermanently301,+                                            multipleChoices300,+                                            networkAuthenticationRequired511,+                                            noContent204, nonAuthoritative203,+                                            notAcceptable406, notFound404,+                                            notImplemented501, notModified304,+                                            ok200, partialContent206,+                                            paymentRequired402,+                                            permanentRedirect308,+                                            preconditionFailed412,+                                            preconditionRequired428,+                                            proxyAuthenticationRequired407,+                                            requestEntityTooLarge413,+                                            requestHeaderFieldsTooLarge431,+                                            requestTimeout408,+                                            requestURITooLong414,+                                            requestedRangeNotSatisfiable416,+                                            resetContent205, seeOther303,+                                            serviceUnavailable503, status100,+                                            status101, status200, status201,+                                            status202, status203, status204,+                                            status205, status206, status300,+                                            status301, status302, status303,+                                            status304, status305, status307,+                                            status308, status400, status401,+                                            status402, status403, status404,+                                            status405, status406, status407,+                                            status408, status409, status410,+                                            status411, status412, status413,+                                            status414, status415, status416,+                                            status417, status418, status422,+                                            status426, status428, status429,+                                            status431, status500, status501,+                                            status502, status503, status504,+                                            status505, status511,+                                            switchingProtocols101,+                                            temporaryRedirect307,+                                            tooManyRequests429, unauthorized401,+                                            unprocessableEntity422,+                                            unsupportedMediaType415,+                                            upgradeRequired426, useProxy305)++-- | Type that represents the body returned to an API Gateway when using HTTP+-- Lambda Proxy integration.  It is highly recommended that you do not use this+-- type directly, and instead use the smart constructors exposed such as+-- 'textPlain', 'applicationJson', and 'genericBinary'.  These make sure that+-- the base64 encodings work transparently.+data ProxyBody = ProxyBody+    { contentType     :: T.Text+    , serialized      :: T.Text+    , isBase64Encoded :: Bool+    } deriving (Show)++-- | A response returned to an API Gateway when using the HTTP Lambda Proxy+-- integration.  ContentType will be set based on the ProxyBody (recommended)+-- if a value is not present in the headers field.+--+-- This type can be constructed explicity or via the smart constructor+-- `response`.  Headers can then be added incrementally with `addHeader` or+-- `setHeader`.  The smart constructor pattern is recommended because it avoids+-- some of the awkwardness of dealing with the multiValueHeaders field's type.+--+-- @+-- {-\# LANGUAGE NamedFieldPuns \#-}+-- {-\# LANGUAGE DuplicateRecordFields \#-}+-- {-\# LANGUAGE OverloadedStrings \#-}+--+-- module Main where+--+-- import AWS.Lambda.Runtime (pureRuntime)+-- import AWS.Lambda.Events.ApiGateway.ProxyRequest (ProxyRequest(..), NoAuthorizer)+-- import AWS.Lambda.Events.ApiGateway.ProxyResponse (ProxyResponse(..), textPlain, forbidden403, ok200, response)+--+-- myHandler :: ProxyRequest NoAuthorizer -> ProxyResponse+-- myHandler ProxyRequest { httpMethod = \"GET\", path = "/say_hello" } =+--     -- Smart Constructor and added header (recommended)+--     addHeader "My-Custom-Header" "Value" $+--       response ok200 $ textPlain \"Hello\"+-- myHandler _ =+--     -- Explicit Construction (not recommended)+--     ProxyResponse+--     {   status = forbidden403+--     ,   body = textPlain \"Forbidden\"+--     ,   multiValueHeaders =+--           fromList [(mk "My-Custom-Header", ["Other Value])]+--     }+--+-- main :: IO ()+-- main = pureRuntime myHandler+-- @+data ProxyResponse = ProxyResponse+    { status            :: Status+    , multiValueHeaders :: HashMap (CI T.Text) [T.Text]+    , body              :: ProxyBody+    } deriving (Show)++-- | Smart constructor for creating a ProxyResponse from a status and a body+response :: Status -> ProxyBody -> ProxyResponse+response =+  flip ProxyResponse mempty++-- | Add a header to the ProxyResponse.  If there was already a value for this+-- header, this one is __added__, meaning the response will include multiple+-- copies of this header (valid by the HTTP spec).  This does NOT replace any+-- previous headers or their values.+addHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse+addHeader header value (ProxyResponse s mvh b) =+  ProxyResponse s (insertWith (<>) (mk header) [value] mvh) b++-- | Set a header to the ProxyResponse.  If there were any previous values for+-- this header they are __all replaced__ by this new value.+setHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse+setHeader header value (ProxyResponse s mvh b) =+  ProxyResponse s (insert (mk header) [value] mvh) b++-- | Smart constructor for creating a ProxyBody with an arbitrary ByteString of+-- the chosen content type.  Use this smart constructor to avoid invalid JSON+-- representations of binary data.+--+-- From here it is easy to make more specific body constructors:+--+-- @+-- imageGif :: ByteString -> ProxyBody+-- imageGif = genericBinary "image/gif"+--+-- imageJpeg :: ByteString -> ProxyBody+-- imageJpeg = genericBinary "image/jpeg"+-- @+genericBinary :: T.Text -> ByteString -> ProxyBody+genericBinary contentType x =+    ProxyBody contentType (TE.decodeUtf8 $ B64.encode x) True++-- | Smart constructor for creating a simple body of text.+textPlain :: T.Text -> ProxyBody+textPlain x = ProxyBody "text/plain; charset=utf-8" x False++-- | Smart constructor for creating a simple body of JSON.+applicationJson :: ToJSON a => a -> ProxyBody+applicationJson x =+    ProxyBody+        "application/json; charset=utf-8"+        (TL.toStrict $ TLE.decodeUtf8 $ encode x)+        False++-- | Smart constructor for creating a simple body of a GIF (that has already+-- been converted to a ByteString).++instance ToJSON ProxyResponse where+    toJSON (ProxyResponse status mvh (ProxyBody contentType body isBase64Encoded)) =+        let unCI = foldrWithKey (insert . original) mempty+        in object+               [ "statusCode" .= statusCode status+               , "multiValueHeaders" .=+                     insertWith+                         (\_ old -> old)+                         ("Content-Type" :: T.Text)+                         [contentType]+                         (unCI mvh)+               , "body" .= body+               , "isBase64Encoded" .= isBase64Encoded+               ]

@@ -39,98 +39,27 @@ ) where  import           AWS.Lambda.RuntimeClient (RuntimeClientConfig, getRuntimeClientConfig,-                                           getNextEvent, sendEventError, sendEventSuccess,-                                           sendInitError)+                                           getNextData, sendEventError, sendEventSuccess) 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.Aeson               (ToJSON, 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      (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) => RuntimeClientConfig -> StaticContext ->+runtimeLoop :: (HasLambdaContext r, MonadReader r m, MonadCatch m, MonadIO m, ToJSON result) => RuntimeClientConfig ->   (Value -> m result) -> m ()-runtimeLoop runtimeClientConfig staticContext fn = do+runtimeLoop runtimeClientConfig 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 event = getResponseBody nextRes+  (reqIdBS, event, eCtx) <- liftIO $ getNextData runtimeClientConfig    result <- case eCtx of     Left e -> return $ Left e@@ -198,15 +127,10 @@ 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 StaticContext within-  -- RuntimeClientConfig that encapsulates more details   runtimeClientConfig <- liftIO getRuntimeClientConfig -  possibleStaticCtx <- liftIO $ (decodeEnv :: IO (Either String StaticContext))+  forever $ runtimeLoop runtimeClientConfig fn -  case possibleStaticCtx of-    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. --

@@ -10,23 +10,32 @@ module AWS.Lambda.RuntimeClient (   RuntimeClientConfig,   getRuntimeClientConfig,+  getNextData,   getNextEvent,   sendEventSuccess,   sendEventError,-  sendInitError ) 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                (encode, Value)+import           Data.Aeson                (decode, encode, Value) import           Data.Aeson.Parser         (value')-import           Data.Aeson.Types          (ToJSON)+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,@@ -37,7 +46,9 @@                                             managerSetProxy, newManager,                                             noProxy, parseRequest, responseBody,                                             responseTimeoutNone, withResponse)-import           Network.HTTP.Simple       (getResponseStatus,+import           Network.HTTP.Simple       (getResponseBody,+                                            getResponseHeader,+                                            getResponseStatus,                                             setRequestBodyJSON,                                             setRequestBodyLBS,                                             setRequestCheckStatus,@@ -45,6 +56,7 @@                                             setRequestPath) import           Network.HTTP.Types.Status (status403, status413, statusIsSuccessful) import           System.Environment        (getEnv)+import           System.Envy               (decodeEnv)  -- | Lambda runtime error that we pass back to AWS data LambdaError = LambdaError@@ -55,7 +67,7 @@  instance ToJSON LambdaError -data RuntimeClientConfig = RuntimeClientConfig Request Manager+data RuntimeClientConfig = RuntimeClientConfig Request Manager StaticContext  -- Exposed Handlers @@ -80,12 +92,56 @@              , managerConnCount = 1              , managerIdleConnectionCount = 1              }-  return $ RuntimeClientConfig req man +  possibleStaticCtx <- liftIO $ (decodeEnv :: IO (Either String StaticContext))++  case possibleStaticCtx of+    Left err -> do+      liftIO $ sendInitError req man err+      error err+    Right staticCtx -> return $ RuntimeClientConfig req man staticCtx+++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)+ -- AWS lambda guarantees that we will get valid JSON, -- so parsing is guaranteed to succeed. getNextEvent :: RuntimeClientConfig -> IO (Response Value)-getNextEvent rcc@(RuntimeClientConfig baseRuntimeRequest manager) = do+getNextEvent (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."@@ -94,12 +150,12 @@   let resOrMsg = first (displayException :: HttpException -> String) resOrEx >>= checkStatus   case resOrMsg of     Left msg -> do-      _ <- sendInitError rcc msg+      _ <- sendInitError baseRuntimeRequest manager msg       error msg     Right y -> return y  sendEventSuccess :: ToJSON a => RuntimeClientConfig -> BS.ByteString -> a -> IO ()-sendEventSuccess rcc@(RuntimeClientConfig baseRuntimeRequest manager) reqId json = do+sendEventSuccess rcc@(RuntimeClientConfig baseRuntimeRequest manager _) reqId json = do   resOrEx <- runtimeClientRetryTry $ flip httpNoBody manager $ toEventSuccessRequest reqId json baseRuntimeRequest    let resOrTypedMsg = case resOrEx of@@ -126,12 +182,46 @@     Right () -> return ()  sendEventError :: RuntimeClientConfig -> BS.ByteString -> String -> IO ()-sendEventError (RuntimeClientConfig baseRuntimeRequest manager) reqId e =+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 =+sendInitError :: Request -> Manager -> String -> IO ()+sendInitError baseRuntimeRequest manager e =   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