infernal 0.2.0 → 0.3.0

raw patch · 4 files changed

+196/−9 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• infernal.cabal +5/−3
• src/Infernal.hs +25/−6
• src/Infernal/Events/APIGateway.hs +84/−0
• src/Infernal/Wai.hs +82/−0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4ab0e10451e82405d58538179329227b563bbfed77824227cd8020b2bc301df6+-- hash: a5e5af8e888606c56383340240a1e597cd6d9b3925850095b0ccd08074d9b07c  name:           infernal-version:        0.2.0+version:        0.3.0 synopsis:       The Infernal Machine - An AWS Lambda Custom Runtime for Haskell description:    Please see the README on GitHub at <https://github.com/ejconlon/infernal#readme> category:       AWS@@ -27,12 +27,14 @@ library   exposed-modules:       Infernal+      Infernal.Events.APIGateway+      Infernal.Wai   other-modules:       Paths_infernal   hs-source-dirs:       src   default-extensions: ConstraintKinds DeriveFunctor DeriveFoldable DeriveGeneric DeriveTraversable DerivingStrategies GeneralizedNewtypeDeriving NoImplicitPrelude OverloadedStrings TemplateHaskell-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -fno-warn-warnings-deprecations   build-depends:       aeson >=1.4     , base >=4.12 && <5

@@ -10,18 +10,21 @@   , LambdaError (..)   , LambdaRequestId (..)   , LambdaRequest (..)+  , LambdaResponse (..)   , LambdaVars (..)   , RunCallback   , UncaughtErrorCallback+  , decodeRequest   , defaultCallbackConfig   , defaultLambdaError   , defaultInitErrorCallback+  , encodeResponse   , runLambda   , runSimpleLambda   ) where  import Control.Monad (forever, void)-import Data.Aeson (encode, pairs, (.=))+import Data.Aeson (eitherDecode, encode, pairs, (.=)) import qualified Data.ByteString.Lazy as LBS import qualified Data.CaseInsensitive as CI import Data.Maybe (isJust)@@ -52,9 +55,14 @@   , _lreqBody :: !LBS.ByteString  -- ^ The unparsed request body. Typically you will 'Data.Aeson.decode' this.   } deriving stock (Eq, Show) +-- | A response to the 'LambdaRequest', typically as encoded JSON.+newtype LambdaResponse = LambdaResponse+  { _unLambdaResponse :: LBS.ByteString+  } deriving (Eq, Show, Ord, IsString, Hashable)+ -- | An error formatted to propagate to AWS (<https://docs.aws.amazon.com/lambda/latest/dg/runtimes-api.html#runtimes-api-invokeerror docs>).---   Note that this is an 'Exception' so you can throw it to short-circuit processing and report useful information. If you throw anything---   else a 'defaultLambdaError' will be reported with no useful information.+--   Note that this is an 'Exception' so you can throw it to short-circuit processing and report useful information. By default, if you throw+--   anything else a 'defaultLambdaError' will be reported with no useful information. data LambdaError = LambdaError   { _lerrErrorType :: !Text     -- ^ The type of error that occurred. In this library is is often @StartCase@-formated.   , _lerrErrorMessage :: !Text  -- ^ A useful error message@@ -102,7 +110,7 @@ type GetLambdaRequest m = m LambdaRequest type PostLambdaInitError m = LambdaError -> m () type PostLambdaInvokeError m = LambdaRequestId -> LambdaError -> m ()-type PostLambdaResponse m = LambdaRequestId -> LBS.ByteString -> m ()+type PostLambdaResponse m = LambdaRequestId -> LambdaResponse -> m ()  data LambdaClient m = LambdaClient   { _lcGetLambdaRequest :: !(GetLambdaRequest m)@@ -123,7 +131,7 @@ --   callbacks will process it. Most importantly, 'LambdaError' will propagate a formatted error to AWS, and 'System.Exit.ExitCode' will halt the program. Except for 'System.Exit.ExitCode', --   throwing exceptions here will not terminate the main loop (see 'runLambda'). Note that the AWS custom runtime loop implemented in this library is single-threaded (as required - we must finish an invocation --   before fetching the next) but you are free to spawn threads in your callback.-type RunCallback n = LambdaRequest -> n LBS.ByteString+type RunCallback n = LambdaRequest -> n LambdaResponse  -- | Error mapper for invocation errors. The result will be @POST@ed to the invocation error endpoint (<https://docs.aws.amazon.com/lambda/latest/dg/runtimes-api.html#runtimes-api-invokeerror docs>). --   Exceptions of type 'LambdaError' will not trigger this callback, and 'System.Exit.ExitCode' will be rethrown after it executes.@@ -321,7 +329,7 @@ postLambdaInvokeErrorImpl lamReqId = postRequest ["invocation", _unLambdaRequestId lamReqId, "error"] . encode  postLambdaResponseImpl :: MonadLambdaImpl env m => PostLambdaResponse m-postLambdaResponseImpl lamReqId = postRequest ["invocation", _unLambdaRequestId lamReqId, "response"]+postLambdaResponseImpl lamReqId = postRequest ["invocation", _unLambdaRequestId lamReqId, "response"] . _unLambdaResponse  lambdaClientImpl :: MonadLambdaImpl env m => LambdaClient m lambdaClientImpl = LambdaClient@@ -337,6 +345,17 @@ -- TODO This should go in heart-core, along with catch functions unliftRIO :: MonadIO m => env -> m (UnliftIO (RIO env)) unliftRIO env = liftIO (runRIO env askUnliftIO)++badRequestError :: Text -> LambdaError+badRequestError reason = LambdaError "BadRequestError" ("Bad request: " <> reason)++-- | Decodes a request with 'FromJSON' or throws a 'LambdaError' (@BadRequestError@).+decodeRequest :: (MonadThrow m, FromJSON a) => LambdaRequest -> m a+decodeRequest = either (throwM . badRequestError . Text.pack) pure . eitherDecode . _lreqBody++-- | Encodes a response with 'ToJSON'. (Mostly here to save you an Aeson import.)+encodeResponse :: ToJSON a => a -> LambdaResponse+encodeResponse = LambdaResponse . encode  -- | The full-powered entrypoint underlying 'runSimpleLambda' that allows you to use any 'UnliftIO'-capable monad for your callbacks. --   This runs the main loop of our AWS Lambda Custom Runtime to fetch invocations, process them, and report errors or results.

@@ -0,0 +1,84 @@+{-|+Definitions for API Gateway proxy objects. Where possible, information that maps directly+to 'Network.HTTP.Types' objects uses that representation. Otherwise a 'Text' representation+is used as 'Data.Aeson' natively provides.++See <https://docs.aws.amazon.com/apigateway/latest/developerguide/set-up-lambda-proxy-integrations.html AWS docs> for+information on these datatypes.++These definitions are taken in part from <https://hackage.haskell.org/package/serverless-haskell serverless-haskell>.+Attribution and license information are present in the README.+-}+module Infernal.Events.APIGateway+  ( APIGatewayProxyRequest (..)+  , APIGatewayProxyResponse (..)+  ) where++import Data.Aeson (object, withObject, (.!=), (.:), (.:?), (.=))+import Data.Bifunctor (bimap)+import Data.ByteString (ByteString)+import qualified Data.CaseInsensitive as CI+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Heart.Core.Prelude+import qualified Network.HTTP.Types as HT++fromAWSQuery :: HashMap Text Text -> HT.Query+fromAWSQuery = fmap toQueryItem . HashMap.toList where+  toQueryItem = bimap encodeUtf8 (\x -> if Text.null x then Nothing else Just (encodeUtf8 x))++toAWSHeaders :: HT.ResponseHeaders -> HashMap Text Text+toAWSHeaders = HashMap.fromList . fmap (bimap (decodeUtf8 . CI.original) decodeUtf8)++fromAWSHeaders :: HashMap Text Text -> HT.RequestHeaders+fromAWSHeaders = fmap toHeader . HashMap.toList where+  toHeader = bimap (CI.mk . encodeUtf8) encodeUtf8++-- | An API Gateway proxy request+data APIGatewayProxyRequest = APIGatewayProxyRequest+  { _agprqResource              :: !Text+  , _agprqPath                  :: !ByteString+  , _agprqHttpMethod            :: !HT.Method+  , _agprqHeaders               :: !HT.RequestHeaders+  , _agprqQueryStringParameters :: !HT.Query+  , _agprqPathParameters        :: !(HashMap Text Text)+  , _agprqStageVariables        :: !(HashMap Text Text)+  , _agprqBody                  :: !(Maybe ByteString)+  } deriving (Eq, Show, Generic)++instance FromJSON APIGatewayProxyRequest where+  parseJSON =+    withObject "APIGatewayProxyRequest" $ \o ->+      APIGatewayProxyRequest+      <$> o .: "resource"+      <*> (encodeUtf8 <$> o .: "path")+      <*> (encodeUtf8 <$> o .: "httpMethod")+      <*> (fmap fromAWSHeaders <$> o .:? "headers") .!= mempty+      <*> (fmap fromAWSQuery <$> o .:? "queryStringParameters") .!= mempty+      <*> o .:? "pathParameters" .!= HashMap.empty+      <*> o .:? "stageVariables" .!= HashMap.empty+      <*> (fmap encodeUtf8 <$> o .:? "body")++-- | An API Gateway proxy response+data APIGatewayProxyResponse = APIGatewayProxyResponse+  { _agprsStatusCode :: !Int+  , _agprsHeaders    :: !HT.ResponseHeaders+  , _agprsBody       :: !(Maybe ByteString)+  } deriving (Eq, Show)++instance ToJSON APIGatewayProxyResponse where+  toJSON rep =+    object+      [ "statusCode" .= _agprsStatusCode rep+      , "headers" .= toAWSHeaders (_agprsHeaders rep)+      , "body" .= fmap decodeUtf8 (_agprsBody rep)+      ]++instance FromJSON APIGatewayProxyResponse where+  parseJSON =+    withObject "APIGatewayProxyResponse" $ \o ->+      APIGatewayProxyResponse+        <$> o .: "statusCode"+        <*> (fromAWSHeaders <$> o .: "headers")+        <*> (fmap encodeUtf8 <$> o .:? "body")

@@ -0,0 +1,82 @@+{-|+Functions to let you wrap WAI Applications and use them to serve API Gateway requests.+See 'runSimpleWaiLambda' for a simple entrypoint.+-}+module Infernal.Wai+  ( adaptApplication+  , adaptRequest+  , adaptResponse+  , applicationCallback+  , runSimpleWaiLambda+  ) where++import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Data.Binary.Builder (Builder, toLazyByteString)+import qualified Data.ByteString as ByteString+import Data.ByteString.Lazy (toStrict)+import Data.IORef (modifyIORef', newIORef, readIORef)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8)+import Heart.App.Logging (WithSimpleLog, logDebug)+import Heart.Core.Prelude+import Infernal (RunCallback, decodeRequest, encodeResponse, runSimpleLambda)+import Infernal.Events.APIGateway (APIGatewayProxyRequest (..), APIGatewayProxyResponse (..))+import Network.Wai (Application, Response, StreamingBody, defaultRequest, responseToStream)+import Network.Wai.Internal (Request (..), ResponseReceived (..))++-- | Turn an 'APIGatewayProxyRequest' into a WAI 'Request'. (Not all fields will be present!)+adaptRequest :: APIGatewayProxyRequest -> Request+adaptRequest proxyReq =+  defaultRequest+  { requestMethod = _agprqHttpMethod proxyReq+  , rawPathInfo = _agprqPath proxyReq+  , pathInfo = dropWhile Text.null (Text.split (=='/') (decodeUtf8 (_agprqPath proxyReq)))+  , queryString = _agprqQueryStringParameters proxyReq+  , requestHeaders = _agprqHeaders proxyReq+  , requestBody = maybe empty pure (_agprqBody proxyReq)+  }++consumeStream :: StreamingBody -> IO Builder+consumeStream sb = do+  r <- newIORef mempty+  sb (modifyIORef' r . flip mappend) (pure ())+  readIORef r++-- | Turn a WAI 'Response' into an 'APIGatewayProxyResponse', materializing the whole response body.+adaptResponse :: MonadIO n => Response -> n APIGatewayProxyResponse+adaptResponse rep = do+  let (repStatus, repHeaders, repBodyAction) = responseToStream rep+  bodyBuilder <- liftIO (repBodyAction consumeStream)+  let body = toStrict (toLazyByteString bodyBuilder)+  pure APIGatewayProxyResponse+    { _agprsStatusCode = fromEnum repStatus+    , _agprsHeaders = repHeaders+    , _agprsBody = if ByteString.null body then Nothing else Just body+    }++-- | Adapt a WAI 'Application' into a function that handles API Gateway proxy requests.+adaptApplication :: MonadIO n => Application -> APIGatewayProxyRequest -> n APIGatewayProxyResponse+adaptApplication app proxyReq = do+  v <- liftIO newEmptyMVar+  let req = adaptRequest proxyReq+  _ <- liftIO $ app req $ \res -> do+    proxyRes <- adaptResponse res+    putMVar v proxyRes+    pure ResponseReceived+  liftIO (takeMVar v)++-- | Adapt a WAI 'Application' into a 'RunCallback' to handle API Gateway proxy requests encoded as Lambda requests.+applicationCallback :: (MonadThrow n, WithSimpleLog env n) => Application -> RunCallback n+applicationCallback app lamReq = do+  proxyReq <- decodeRequest lamReq+  logDebug ("Servicing proxy request " <> decodeUtf8 (_agprqHttpMethod proxyReq) <> " " <> decodeUtf8 (_agprqPath proxyReq))+  proxyRep <- adaptApplication app proxyReq+  logDebug ("Responding with status " <> Text.pack (show (_agprsStatusCode proxyRep)))+  let lamRep = encodeResponse proxyRep+  pure lamRep++-- | A simple entrypoint to run your WAI 'Application' in a Lambda function. (See 'runSimpleLambda' for more information on these entrypoints.)+--   You can configure API Gateway to send proxied HTTP requests as JSON to your Lambda (as 'APIGatewayProxyRequest') and have your WAI Application+--   service them with this entrypoint. (Correct API Gateway configuration is pretty tricky, so consult all the documentation available to figure it out.)+runSimpleWaiLambda :: Application -> IO ()+runSimpleWaiLambda = runSimpleLambda . applicationCallback