diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for wai-handler-hal +## 0.4.0.1 -- 2025-02-19 + +- Use a `NonEmpty` list when consuming the result of `getAddrInfo`. +- When resolving source IPs, do not require `AF_INET` (IPv4) + addresses. This allows IPv6 source addresses to be passed through to + the underlying `wai` `Application`. + ## 0.4.0.0 -- 2024-01-17 - New function: `Wai.Handler.Hal.runWithOptions :: Options -> diff --git a/src/Network/Wai/Handler/Hal.hs b/src/Network/Wai/Handler/Hal.hs --- a/src/Network/Wai/Handler/Hal.hs +++ b/src/Network/Wai/Handler/Hal.hs @@ -52,21 +52,23 @@ import Control.Exception (IOException, tryJust) 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 as ByteString +import qualified Data.ByteString.Base64 as Base64 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.ByteString.Lazy as LByteString import qualified Data.CaseInsensitive as CI import Data.Function ((&)) +import Data.Functor ((<&>)) import Data.HashMap.Lazy (HashMap) -import qualified Data.HashMap.Lazy as H +import qualified Data.HashMap.Lazy as HashMap import qualified Data.IORef as IORef import Data.List (foldl', sort) +import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text import Data.Vault.Lazy (Key, Vault) import qualified Data.Vault.Lazy as Vault import Network.HTTP.Media (MediaType, matches, parseAccept, renderHeader) @@ -149,7 +151,7 @@ -- | A variant of 'run' with configurable 'Options'. Useful if you -- just want to override the 'binaryMediaTypes' setting but don't need --- the rest of 'runWithContext''s features. +-- the rest of 'runWithContext'\'s features. -- -- @since 0.4.0.0 runWithOptions :: @@ -160,12 +162,12 @@ HalRequest.ProxyRequest HalRequest.NoAuthorizer -> m HalResponse.ProxyResponse runWithOptions opts app req = liftIO $ do - waiReq <- toWaiRequest opts req - responseRef <- IORef.newIORef Nothing - Wai.ResponseReceived <- app waiReq $ \waiResp -> - Wai.ResponseReceived <$ IORef.writeIORef responseRef (Just waiResp) - Just waiResp <- IORef.readIORef responseRef - fromWaiResponse opts waiResp + waiReq <- toWaiRequest opts req + responseRef <- IORef.newIORef Nothing + Wai.ResponseReceived <- app waiReq $ \waiResp -> + Wai.ResponseReceived <$ IORef.writeIORef responseRef (Just waiResp) + Just waiResp <- IORef.readIORef responseRef + fromWaiResponse opts waiResp -- | Convert a WAI 'Wai.Application' into a function that can -- be run by hal's 'AWS.Lambda.Runtime.mRuntimeWithContext'. This @@ -222,16 +224,17 @@ IO Wai.Request toWaiRequest opts req = do let port = portNumber opts - pathSegments = T.splitOn "/" . T.dropWhile (== '/') $ HalRequest.path req - query = sort . constructQuery $ HalRequest.multiValueQueryStringParameters req + pathSegments = + Text.splitOn "/" . Text.dropWhile (== '/') $ HalRequest.path req + query = + sort . constructQuery $ HalRequest.multiValueQueryStringParameters req hints = NS.defaultHints { NS.addrFlags = [NS.AI_NUMERICHOST], - NS.addrFamily = NS.AF_INET, NS.addrSocketType = NS.Stream } sourceIp = - T.unpack + Text.unpack . HalRequest.sourceIp . HalRequest.identity $ HalRequest.requestContext req @@ -243,7 +246,7 @@ (Just @IOException) (NS.getAddrInfo (Just hints) (Just sourceIp) (Just $ show port)) >>= \case - Right (s : _) -> pure $ NS.addrAddress s + Right (s :| _) -> pure $ NS.addrAddress s _ -> do hPutStrLn stderr $ mconcat @@ -253,53 +256,57 @@ ] pure . NS.SockAddrInet port $ NS.tupleToHostAddress (127, 0, 0, 1) 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 [], - Wai.rawQueryString = case query of - [] -> "" - _ -> renderQuery True query, - Wai.requestHeaders = - sort - . foldMap - ( \(hName, hValues) -> - (CI.map T.encodeUtf8 hName,) . T.encodeUtf8 <$> hValues - ) - . H.toList - $ HalRequest.multiValueHeaders req, - Wai.isSecure = True, - Wai.remoteHost = sourceHost, - Wai.pathInfo = pathSegments, - Wai.queryString = query, - Wai.requestBody = body, - Wai.vault = vault opts, - 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 - } - pure waiReq + pure + Wai.Request + { Wai.requestMethod = Text.encodeUtf8 $ HalRequest.httpMethod req, + Wai.httpVersion = HttpVersion 1 1, + Wai.rawPathInfo = + LByteString.toStrict + . Builder.toLazyByteString + $ encodePath pathSegments [], + Wai.rawQueryString = case query of + [] -> "" + _ -> renderQuery True query, + Wai.requestHeaders = + sort + . foldMap + ( \(hName, hValues) -> + hValues <&> \hValue -> + (CI.map Text.encodeUtf8 hName, Text.encodeUtf8 hValue) + ) + . HashMap.toList + $ HalRequest.multiValueHeaders req, + Wai.isSecure = True, + Wai.remoteHost = sourceHost, + Wai.pathInfo = pathSegments, + Wai.queryString = query, + Wai.requestBody = body, + Wai.vault = vault opts, + Wai.requestBodyLength = + Wai.KnownLength + . fromIntegral + . LByteString.length + $ HalRequest.body req, + Wai.requestHeaderHost = getHeader hHost req, + Wai.requestHeaderRange = getHeader hRange req, + Wai.requestHeaderReferer = getHeader hReferer req, + Wai.requestHeaderUserAgent = getHeader hUserAgent req + } --- | 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) +-- | Unpack a lazy 'LByteString.ByteString' into its chunks, and +-- return an IO action which returns each chunk in sequence, and +-- returns 'ByteString.empty' forever after the bytestring is +-- exhausted. +returnChunks :: LByteString.ByteString -> IO (IO ByteString.ByteString) returnChunks bs = do - chunkRef <- IORef.newIORef $ BL.toChunks bs + chunkRef <- IORef.newIORef $ LByteString.toChunks bs pure . IORef.atomicModifyIORef' chunkRef $ \case [] -> mempty (ch : chs) -> (chs, ch) constructQuery :: HashMap Text [Text] -> Query -constructQuery = foldMap expandParamList . H.toList +constructQuery = foldMap expandParamList . HashMap.toList where expandParamList :: (Text, [Text]) -> [QueryItem] expandParamList (param, values) = @@ -309,7 +316,9 @@ getHeader :: HeaderName -> HalRequest.ProxyRequest a -> Maybe ByteString getHeader h = - fmap T.encodeUtf8 . H.lookup (CI.map T.decodeUtf8 h) . HalRequest.headers + fmap Text.encodeUtf8 + . HashMap.lookup (CI.map Text.decodeUtf8 h) + . HalRequest.headers -- | Convert a WAI 'Wai.Response' into a hal -- 'HalResponse.ProxyResponse'. @@ -326,7 +335,7 @@ . addHeaders headers . HalResponse.response status . createProxyBody opts (getContentType headers) - . BL.toStrict + . LByteString.toStrict $ Builder.toLazyByteString builder fromWaiResponse opts (Wai.ResponseStream status headers stream) = do builderRef <- IORef.newIORef mempty @@ -340,19 +349,19 @@ readFilePart :: FilePath -> Maybe Wai.FilePart -> IO ByteString readFilePart path mPart = withFile path ReadMode $ \h -> do case mPart of - Nothing -> B.hGetContents h + Nothing -> ByteString.hGetContents h Just (Wai.FilePart offset count _) -> do hSeek h AbsoluteSeek offset - B.hGet h $ fromIntegral count + ByteString.hGet h $ fromIntegral count createProxyBody :: Options -> MediaType -> ByteString -> HalResponse.ProxyBody createProxyBody opts contentType body = HalResponse.ProxyBody - { HalResponse.contentType = T.decodeUtf8 $ renderHeader contentType, + { HalResponse.contentType = Text.decodeUtf8 $ renderHeader contentType, HalResponse.serialized = if isBase64Encoded - then T.decodeUtf8 $ B64.encode body - else T.decodeUtf8 body, + then Text.decodeUtf8 $ Base64.encode body + else Text.decodeUtf8 body, HalResponse.isBase64Encoded } where @@ -364,8 +373,8 @@ where addHeader r (hName, hValue) = HalResponse.addHeader - (T.decodeUtf8 $ CI.original hName) - (T.decodeUtf8 hValue) + (Text.decodeUtf8 $ CI.original hName) + (Text.decodeUtf8 hValue) r -- | Try to find the content-type of a response, given the response diff --git a/wai-handler-hal.cabal b/wai-handler-hal.cabal --- a/wai-handler-hal.cabal +++ b/wai-handler-hal.cabal @@ -1,13 +1,13 @@ cabal-version: 2.2 name: wai-handler-hal -version: 0.4.0.0 +version: 0.4.0.1 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. + on AWS Lambda, as proxy integrations of API Gateway REST APIs. . More details, including deployment advice, are available in the repository's @README.md@. @@ -21,8 +21,7 @@ copyright: Copyright (C) 2021, 2024 Bellroy Pty Ltd category: AWS, Cloud build-type: Simple -extra-doc-files: - CHANGELOG.md +extra-doc-files: CHANGELOG.md extra-source-files: README.md test/data/ProxyRequest.json @@ -35,7 +34,9 @@ || ==9.0.2 || ==9.2.4 || ==9.4.5 - || ==9.6.2 + || ==9.6.6 + || ==9.8.2 + || ==9.10.1 common opts default-language: Haskell2010 @@ -48,15 +49,15 @@ common deps build-depends: - , base >=4.12 && <4.19 + , base >=4.12 && <4.21 , base64-bytestring >=1.0.0.0 && <1.3 - , bytestring >=0.10.8 && <0.12.1 + , bytestring >=0.10.8 && <0.13 , case-insensitive ^>=1.2.0.0 , hal >=0.4.7 && <0.4.11 || >=1.0.0 && <1.2 , http-media ^>=0.8.1.1 , http-types ^>=0.12.3 - , network >=2.8.0.0 && <3.2 - , text ^>=1.2.3 || >=2.0 && <2.1.1 + , network >=3.2.3.0 && <3.3 + , text ^>=1.2.3 || ^>=2.0 || ^>=2.1 , unordered-containers ^>=0.2.10.0 , vault ^>=0.3.1.0 , wai ^>=3.2.2