wai-handler-hal (empty) → 0.1.0.0

raw patch · 5 files changed

+390/−0 lines, 5 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed

Dependencies added: base, base64-bytestring, bytestring, case-insensitive, hal, http-types, network, text, unordered-containers, vault, wai

Files

• CHANGELOG.md +5/−0
• LICENSE +29/−0
• Setup.hs +2/−0
• src/Network/Wai/Handler/Hal.hs +295/−0
• wai-handler-hal.cabal +59/−0

@@ -0,0 +1,5 @@+# Revision history for wai-handler-hal++## 0.1.0.0 -- 2021-04-15++* First version. Released on an unsuspecting world.

@@ -0,0 +1,29 @@+Copyright (C) 2021 Bellroy Pty Ltd++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the+   distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived+   from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,295 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+--+-- Module      : Network.Wai.Handler.Hal+-- Copyright   : (C) 2021 Bellroy Pty Ltd+-- License     : BSD-3-Clause+-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>+-- Stability   : experimental+--+-- Lifts an 'Wai.Application' so that it can be run using+-- 'AWS.Lambda.Runtime.mRuntime' or+-- 'AWS.Lambda.Runtime.mRuntimeWithContext''. The glue code will look+-- something like this:+--+-- @+-- import AWS.Lambda.Runtime ('AWS.Lambda.Runtime.mRuntime')+-- import Network.Wai (Application)+-- import qualified Network.Wai.Handler.Hal as WaiHandler+--+-- app :: Application+-- app = undefined -- From Servant or wherever else+--+-- main :: IO ()+-- main = 'AWS.Lambda.Runtime.mRuntime' $ WaiHandler.'run' app+-- @+module Network.Wai.Handler.Hal+  ( run,+    runWithContext,+    toWaiRequest,+    fromWaiResponse,+  )+where++import AWS.Lambda.Context (LambdaContext)+import qualified AWS.Lambda.Events.ApiGateway.ProxyRequest as HalRequest+  ( RequestContext (identity),+  )+import qualified AWS.Lambda.Events.ApiGateway.ProxyRequest as HalRequest hiding+  ( RequestContext (..),+  )+import qualified AWS.Lambda.Events.ApiGateway.ProxyResponse as HalResponse+import Control.Monad.IO.Class (MonadIO (..))+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Builder.Extra as Builder+import qualified Data.ByteString.Lazy as BL+import qualified Data.CaseInsensitive as CI+import Data.Function ((&))+import Data.HashMap.Lazy (HashMap)+import qualified Data.HashMap.Lazy as H+import qualified Data.IORef as IORef+import Data.List (foldl')+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Vault.Lazy (Key, Vault)+import qualified Data.Vault.Lazy as Vault+import Network.HTTP.Types.Header+  ( HeaderName,+    ResponseHeaders,+    hContentType,+    hHost,+    hRange,+    hReferer,+    hUserAgent,+  )+import Network.HTTP.Types.URI+  ( Query,+    QueryItem,+    encodePath,+    queryTextToQuery,+    renderQuery,+  )+import Network.HTTP.Types.Version (HttpVersion (..))+import Network.Socket (PortNumber)+import qualified Network.Socket as NS+import qualified Network.Wai as Wai+import qualified Network.Wai.Internal as Wai+import System.IO (IOMode (..), SeekMode (..), hSeek, withFile)++-- | Convert a WAI 'Wai.Application' into a function that can+-- be run by hal's 'AWS.Lambda.Runtime.mRuntime'. This is the simplest+-- form, and probably all that you'll need. See 'runWithContext' if+-- you have more complex needs.+run ::+  MonadIO m =>+  Wai.Application ->+  HalRequest.ProxyRequest HalRequest.NoAuthorizer ->+  m HalResponse.ProxyResponse+run app req = liftIO $ do+  waiReq <- toWaiRequest Vault.empty 443 req+  responseRef <- IORef.newIORef Nothing+  Wai.ResponseReceived <- app waiReq $ \waiResp ->+    Wai.ResponseReceived <$ IORef.writeIORef responseRef (Just waiResp)+  Just waiResp <- IORef.readIORef responseRef+  fromWaiResponse waiResp++-- | Convert a WAI 'Wai.Application' into a function that can+-- be run by hal's 'AWS.Lambda.Runtime.mRuntimeWithContext''. This+-- function exposes all the configurable knobs.+runWithContext ::+  MonadIO m =>+  -- | Vault of values to share between the application and any+  -- middleware. You can pass in @Data.Vault.Lazy.'Vault.empty'@, or+  -- 'mempty' if you don't want to depend on @vault@ directly.+  Vault ->+  -- | API Gateway doesn't tell us the port it's listening on, so you+  -- have to tell it yourself. This is almost always going to be 443+  -- (HTTPS).+  PortNumber ->+  -- | We pass two 'Vault' keys to the callback that provides the+  -- 'Wai.Application'. This allows the application to look into the+  -- 'Vault' part of each request and read @hal@ data structures, if+  -- necessary:+  --+  -- * The @'Key' 'LambdaContext'@ provides+  --   information about the Lambda invocation, function, and+  --   execution environment; and+  --+  -- * The @'Key' ('HalRequest.ProxyRequest'+  -- 'HalRequest.NoAuthorizer')@ provides the unmodified API Gateway+  -- representation of the HTTP request.+  ( Key LambdaContext ->+    Key (HalRequest.ProxyRequest HalRequest.NoAuthorizer) ->+    Wai.Application+  ) ->+  LambdaContext ->+  -- | We force 'HalRequest.NoAuthorizer' because it's a type alias+  -- for 'Data.Aeson.Value' (i.e., should always parse), and it avoids+  -- an "ambiguous type variable" error at the use site.+  HalRequest.ProxyRequest HalRequest.NoAuthorizer ->+  m HalResponse.ProxyResponse+runWithContext vault port app ctx req = liftIO $ do+  contextKey <- Vault.newKey+  requestKey <- Vault.newKey+  let vault' =+        vault+          & Vault.insert contextKey ctx+          & Vault.insert requestKey req+  waiReq <- toWaiRequest vault' port req+  responseRef <- IORef.newIORef Nothing+  Wai.ResponseReceived <- app contextKey requestKey waiReq $ \waiResp ->+    Wai.ResponseReceived <$ IORef.writeIORef responseRef (Just waiResp)+  Just waiResp <- IORef.readIORef responseRef+  fromWaiResponse waiResp++-- | Convert the request sent to a Lambda serving an API Gateway proxy+-- integration into a WAI request.+--+-- __Note:__ We aren't told the HTTP version the client is using, so+-- we assume HTTP 1.1.+toWaiRequest ::+  Vault ->+  PortNumber ->+  HalRequest.ProxyRequest a ->+  IO Wai.Request+toWaiRequest vault port req = do+  let pathSegments = T.splitOn "/" . T.dropWhile (== '/') $ HalRequest.path req+      query = constructQuery $ HalRequest.multiValueQueryStringParameters req+      hints =+        NS.defaultHints+          { NS.addrFlags = [NS.AI_NUMERICHOST],+            NS.addrFamily = NS.AF_INET,+            NS.addrSocketType = NS.Stream+          }+      sourceIp =+        T.unpack+          . HalRequest.sourceIp+          . HalRequest.identity+          $ HalRequest.requestContext req+  print $ HalRequest.path req+  print pathSegments+  sourceAddr : _ <- NS.getAddrInfo (Just hints) (Just sourceIp) (Just $ show port)+  body <- returnChunks $ HalRequest.body req+  let waiReq =+        Wai.Request+          { Wai.requestMethod = T.encodeUtf8 $ HalRequest.httpMethod req,+            Wai.httpVersion = HttpVersion 1 1,+            Wai.rawPathInfo =+              BL.toStrict+                . Builder.toLazyByteString+                $ encodePath pathSegments query,+            Wai.rawQueryString = case query of+              [] -> ""+              _ -> renderQuery True query,+            Wai.requestHeaders =+              foldMap+                ( \(hName, hValues) ->+                    (CI.map T.encodeUtf8 hName,) . T.encodeUtf8 <$> hValues+                )+                . H.toList+                $ HalRequest.multiValueHeaders req,+            Wai.isSecure = True,+            Wai.remoteHost = NS.addrAddress sourceAddr,+            Wai.pathInfo = pathSegments,+            Wai.queryString = query,+            Wai.requestBody = body,+            Wai.vault = vault,+            Wai.requestBodyLength =+              Wai.KnownLength . fromIntegral . BL.length $ HalRequest.body req,+            Wai.requestHeaderHost = getHeader hHost req,+            Wai.requestHeaderRange = getHeader hRange req,+            Wai.requestHeaderReferer = getHeader hReferer req,+            Wai.requestHeaderUserAgent = getHeader hUserAgent req+          }+  print waiReq+  pure waiReq++-- | Unpack a lazy 'BL.ByteString' into its chunks, and return an IO+-- action which returns each chunk in sequence, and returns 'B.empty'+-- forever after the bytestring is exhausted.+returnChunks :: BL.ByteString -> IO (IO B.ByteString)+returnChunks bs = do+  chunkRef <- IORef.newIORef $ BL.toChunks bs+  pure . IORef.atomicModifyIORef' chunkRef $+    \case+      [] -> mempty+      (ch : chs) -> (chs, ch)++constructQuery :: HashMap Text [Text] -> Query+constructQuery = foldMap expandParamList . H.toList+  where+    expandParamList :: (Text, [Text]) -> [QueryItem]+    expandParamList (param, values) =+      queryTextToQuery $ case values of+        [] -> [(param, Nothing)]+        _ -> (param,) . Just <$> values++getHeader :: HeaderName -> HalRequest.ProxyRequest a -> Maybe ByteString+getHeader h =+  fmap T.encodeUtf8 . H.lookup (CI.map T.decodeUtf8 h) . HalRequest.headers++-- | Convert a WAI 'Wai.Response' into a hal+-- 'HalResponse.ProxyResponse'.+fromWaiResponse :: Wai.Response -> IO HalResponse.ProxyResponse+fromWaiResponse (Wai.ResponseFile status headers path mFilePart) = do+  fileData <- readFilePart path mFilePart+  pure+    . addHeaders headers+    . HalResponse.response status+    . createProxyBody (getContentType headers)+    $ fileData+fromWaiResponse (Wai.ResponseBuilder status headers builder) =+  pure+    . addHeaders headers+    . HalResponse.response status+    . createProxyBody (getContentType headers)+    . BL.toStrict+    $ Builder.toLazyByteString builder+fromWaiResponse (Wai.ResponseStream status headers stream) = do+  builderRef <- IORef.newIORef mempty+  let addChunk chunk = IORef.modifyIORef builderRef (<> chunk)+      flush = IORef.modifyIORef builderRef (<> Builder.flush)+  stream addChunk flush+  builder <- IORef.readIORef builderRef+  fromWaiResponse (Wai.ResponseBuilder status headers builder)+fromWaiResponse (Wai.ResponseRaw _ resp) = fromWaiResponse resp++readFilePart :: FilePath -> Maybe Wai.FilePart -> IO ByteString+readFilePart path mPart = withFile path ReadMode $ \h -> do+  case mPart of+    Nothing -> B.hGetContents h+    Just (Wai.FilePart offset count _) -> do+      hSeek h AbsoluteSeek offset+      B.hGet h $ fromIntegral count++createProxyBody :: Text -> ByteString -> HalResponse.ProxyBody+createProxyBody contentType body+  | any (`T.isPrefixOf` contentType) ["text/plain", "application/json"] =+    HalResponse.ProxyBody contentType (T.decodeUtf8 body) False+  | otherwise =+    HalResponse.ProxyBody contentType (T.decodeUtf8 $ B64.encode body) True++addHeaders ::+  ResponseHeaders -> HalResponse.ProxyResponse -> HalResponse.ProxyResponse+addHeaders headers response = foldl' addHeader response headers+  where+    addHeader r (hName, hValue) =+      HalResponse.addHeader+        (T.decodeUtf8 $ CI.original hName)+        (T.decodeUtf8 hValue)+        r++-- | Try to find the content-type of a response, given the response+-- headers. If we can't, return @"application/octet-stream"@.+getContentType :: ResponseHeaders -> Text+getContentType =+  maybe "application/octet-stream" T.decodeUtf8 . lookup hContentType

@@ -0,0 +1,59 @@+cabal-version:      2.2+name:               wai-handler-hal+version:            0.1.0.0+synopsis:           Wrap WAI applications to run on AWS Lambda+description:+  This library provides a function 'Network.Wai.Handler.Hal.run' to+  lift a @wai@ 'Network.Wai.Application' into a function that can be+  passed to @hal@'s 'AWS.Lambda.Runtime.mRuntime'. This allows you to+  run applications written in mature web frameworks (e.g., @servant@)+  on AWS Lambda, as proxy integrations of API Gateway Rest APIs.+  .+  More details, including deployment advice, are available in the+  repository's @README.md@.++homepage:           http://github.com/bellroy/wai-handler-hal+bug-reports:        http://github.com/bellroy/wai-handler-hal/issues+license:            BSD-3-Clause+license-file:       LICENSE+author:             Bellroy Tech Team <haskell@bellroy.com>+maintainer:         Bellroy Tech Team <haskell@bellroy.com>+copyright:          Copyright (C) 2021 Bellroy Pty Ltd+category:           AWS, Cloud+build-type:         Simple+extra-source-files:+  CHANGELOG.md++tested-with:        GHC ==8.6.5 || ==8.8.4 || ==8.10.4++common opts+  default-language: Haskell2010+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Werror=incomplete-patterns+    -Wredundant-constraints -Wpartial-fields -Wtabs+    -Wmissing-local-signatures -fhelpful-errors+    -fprint-expanded-synonyms -fwarn-unused-do-bind++common deps+  build-depends:+    , base                  >=4.12    && <4.15+    , base64-bytestring     ^>=1.1.0.0+    , bytestring            ^>=0.10.8+    , case-insensitive      ^>=1.2.1.0+    , hal                   ^>=0.4.7+    , http-types            ^>=0.12.3+    , network               ^>=3.1.1.1+    , text                  ^>=1.2.3+    , unordered-containers  ^>=0.2.13+    , vault                 ^>=0.3.1.5+    , wai                   ^>=3.2.3++library+  import:          opts, deps+  exposed-modules: Network.Wai.Handler.Hal+  hs-source-dirs:  src++source-repository head+  type:     git+  location: https://github.com/bellroy/wai-handler-hal.git