Merge pull request #29 from bellroy/binary-media-types-list

Binary media types list

.gitignore

@@ -1,4 +1,6 @@
 .dir-locals.el
+.direnv/
+.envrc
 dist-newstyle/
 dist/
 node_modules/

CHANGELOG.md

@@ -1,8 +1,30 @@
 # Revision history for wai-handler-hal
 
+## 0.4.0.0 -- 2024-01-17
+
+- New function: `Wai.Handler.Hal.runWithOptions :: Options ->
+  Application -> ProxyRequest NoAuthorizer -> ProxyResponse`. This
+  provides a convenient way to pass custom `Options` without all the
+  bells and whistles of `runWithContext`.
+
+- Instead of guessing whether a given response `Content-Type` should
+  be sent as text or base64-encoded binary, `Options` now contains a
+  `binaryMediaTypes :: [MediaType]`, which lists the media types that
+  should be base64-encoded. This should match the `binaryMediaTypes`
+  setting you have configured on the API Gateway that integrates with
+  your Lambda Function.
+
+  _See:_ [Content type conversion in API
+    Gateway](https://docs.aws.amazon.com/apigateway/latest/developerguide/api-gateway-payload-encodings-workflow.html)
+    in the [Amazon API Gateway Developer
+    Guide](https://docs.aws.amazon.com/apigateway/latest/developerguide/).
+
 ## 0.3.0.0 -- 2023-12-17
 
-- Breaking change: add `Options` record parameter to `runWithOptions`,
+- Accidental breaking change: more elaborate `Content-Type` headers
+  like `Content-Type: application/json; charset=utf-8` are now encoded
+  as if they were binary payloads. This release has been deprecated.
+- Breaking change: add `Options` record parameter to `runWithContext`,
   `toWaiRequest` and `fromWaiResponse`.
 - Provide a `defaultOptions`.
 - Make whether or not to run base64-encoding on the response body customizable

src/Network/Wai/Handler/Hal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TupleSections #-}
@@ -31,6 +32,7 @@
 -- @
 module Network.Wai.Handler.Hal
   ( run,
+    runWithOptions,
     runWithContext,
     Options (..),
     defaultOptions,
@@ -61,11 +63,13 @@ import Data.HashMap.Lazy (HashMap)
 import qualified Data.HashMap.Lazy as H
 import qualified Data.IORef as IORef
 import Data.List (foldl', sort)
+import Data.Maybe (fromMaybe)
 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.Media (MediaType, matches, parseAccept, renderHeader)
 import Network.HTTP.Types.Header
   ( HeaderName,
     ResponseHeaders,
@@ -105,13 +109,7 @@ run ::
   Wai.Application ->
   HalRequest.ProxyRequest HalRequest.NoAuthorizer ->
   m HalResponse.ProxyResponse
-run app req = liftIO $ do
-  waiReq <- toWaiRequest defaultOptions req
-  responseRef <- IORef.newIORef Nothing
-  Wai.ResponseReceived <- app waiReq $ \waiResp ->
-    Wai.ResponseReceived <$ IORef.writeIORef responseRef (Just waiResp)
-  Just waiResp <- IORef.readIORef responseRef
-  fromWaiResponse defaultOptions waiResp
+run = runWithOptions defaultOptions
 
 -- | Options that can be used to customize the behaviour of 'runWithContext'.
 -- 'defaultOptions' provides sensible defaults.
@@ -124,17 +122,20 @@ data Options = Options
     -- have to tell it yourself. This is almost always going to be 443
     -- (HTTPS).
     portNumber :: PortNumber,
-    -- | Binary responses need to be encoded as base64. This option lets you
-    -- customize which mime types are considered binary data.
+    -- | To return binary data, API Gateway requires you to configure
+    -- the @binaryMediaTypes@ setting on your API, and then
+    -- base64-encode your binary responses.
+    --
+    -- If the @Content-Type@ header in the @wai@ 'Wai.Response'
+    -- matches any of the media types in this field, @wai-handler-hal@
+    -- will base64-encode its response to the API Gateway.
     --
-    -- The following mime types are __not__ considered binary by default:
+    -- If you set @binaryMediaTypes@ in your API, you should override
+    -- the default (empty) list to match.
     --
-    -- * @application/json@
-    -- * @application/xml@
-    -- * anything starting with @text/@
-    -- * anything ending with @+json@
-    -- * anything ending with @+xml@
-    binaryMimeType :: Text -> Bool
+    -- /See:/ [Content type conversion in API Gateway](https://docs.aws.amazon.com/apigateway/latest/developerguide/api-gateway-payload-encodings-workflow.html)
+    -- in the [Amazon API Gateway Developer Guide](https://docs.aws.amazon.com/apigateway/latest/developerguide/).
+    binaryMediaTypes :: [MediaType]
   }
 
 -- | Default options for running 'Wai.Application's on Lambda.
@@ -143,15 +144,29 @@ defaultOptions =
   Options
     { vault = Vault.empty,
       portNumber = 443,
-      binaryMimeType = \mime -> case mime of
-        "application/json" -> False
-        "application/xml" -> False
-        _ | "text/" `T.isPrefixOf` mime -> False
-        _ | "+json" `T.isSuffixOf` mime -> False
-        _ | "+xml" `T.isSuffixOf` mime -> False
-        _ -> True
+      binaryMediaTypes = []
     }
 
+-- | 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.
+--
+-- @since 0.4.0.0
+runWithOptions ::
+  (MonadIO m) =>
+  -- | Configuration options. 'defaultOptions' provides sensible defaults.
+  Options ->
+  Wai.Application ->
+  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
+
 -- | 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.
@@ -330,12 +345,18 @@ readFilePart path mPart = withFile path ReadMode $ \h -> do
       hSeek h AbsoluteSeek offset
       B.hGet h $ fromIntegral count
 
-createProxyBody :: Options -> Text -> ByteString -> HalResponse.ProxyBody
-createProxyBody opts contentType body
-  | binaryMimeType opts contentType =
-      HalResponse.ProxyBody contentType (T.decodeUtf8 $ B64.encode body) True
-  | otherwise =
-      HalResponse.ProxyBody contentType (T.decodeUtf8 body) False
+createProxyBody :: Options -> MediaType -> ByteString -> HalResponse.ProxyBody
+createProxyBody opts contentType body =
+  HalResponse.ProxyBody
+    { HalResponse.contentType = T.decodeUtf8 $ renderHeader contentType,
+      HalResponse.serialized =
+        if isBase64Encoded
+          then T.decodeUtf8 $ B64.encode body
+          else T.decodeUtf8 body,
+      HalResponse.isBase64Encoded
+    }
+  where
+    isBase64Encoded = any (contentType `matches`) $ binaryMediaTypes opts
 
 addHeaders ::
   ResponseHeaders -> HalResponse.ProxyResponse -> HalResponse.ProxyResponse
@@ -349,6 +370,7 @@ addHeaders headers response = foldl' addHeader response headers
 
 -- | 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
+getContentType :: ResponseHeaders -> MediaType
+getContentType headers =
+  fromMaybe "application/octet-stream" $
+    lookup hContentType headers >>= parseAccept

test/Network/Wai/Handler/HalTest.hs

@@ -1,17 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Network.Wai.Handler.HalTest where
 
-import AWS.Lambda.Events.ApiGateway.ProxyRequest
+import AWS.Lambda.Events.ApiGateway.ProxyRequest (ProxyRequest)
+import AWS.Lambda.Events.ApiGateway.ProxyResponse
+  ( ProxyBody (..),
+    ProxyResponse (..),
+  )
 import Data.Aeson (eitherDecodeFileStrict')
-import qualified Data.Text as T
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy.Encoding as TL
 import Data.Void (Void)
+import Network.HTTP.Types (hContentType, ok200)
+import Network.Wai (Response, responseLBS)
 import Network.Wai.Handler.Hal
-import Test.Tasty
-import Test.Tasty.Golden
-import Test.Tasty.HUnit (assertEqual, testCase)
-import Text.Pretty.Simple
+import Test.Tasty (TestTree)
+import Test.Tasty.Golden (goldenVsString)
+import Test.Tasty.HUnit (Assertion, assertEqual)
+import Text.Pretty.Simple (pShowNoColor)
 
 test_ConvertProxyRequest :: TestTree
 test_ConvertProxyRequest =
@@ -22,22 +31,25 @@ test_ConvertProxyRequest =
     waiRequest <- toWaiRequest defaultOptions proxyRequest
     pure . TL.encodeUtf8 $ pShowNoColor waiRequest
 
-test_DefaultBinaryMimeTypes :: TestTree
-test_DefaultBinaryMimeTypes = testCase "default binary MIME types" $ do
-  assertBinary False "text/plain"
-  assertBinary False "text/html"
-  assertBinary False "application/json"
-  assertBinary False "application/xml"
-  assertBinary False "application/vnd.api+json"
-  assertBinary False "application/vnd.api+xml"
-  assertBinary False "image/svg+xml"
-
-  assertBinary True "application/octet-stream"
-  assertBinary True "audio/vorbis"
-  assertBinary True "image/png"
-  where
-    assertBinary expected mime =
-      assertEqual
-        mime
-        (binaryMimeType defaultOptions (T.pack mime))
-        expected
+unit_BinaryResponse :: Assertion
+unit_BinaryResponse = do
+  let options = defaultOptions {binaryMediaTypes = ["*/*"]}
+  ProxyResponse {body = ProxyBody {..}} <-
+    fromWaiResponse options helloWorld
+
+  assertEqual "response is binary" True isBase64Encoded
+  assertEqual
+    "response is base64-encoded"
+    (Right "Hello, World!")
+    (B64.decode (T.encodeUtf8 serialized))
+
+unit_TextResponse :: Assertion
+unit_TextResponse = do
+  ProxyResponse {body = ProxyBody {..}} <-
+    fromWaiResponse defaultOptions helloWorld
+
+  assertEqual "response is not binary" False isBase64Encoded
+  assertEqual "response is unmangled" "Hello, World!" serialized
+
+helloWorld :: Response
+helloWorld = responseLBS ok200 [(hContentType, "text/plain")] "Hello, World!"

wai-handler-hal.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               wai-handler-hal
-version:            0.3.0.0
+version:            0.4.0.0
 synopsis:           Wrap WAI applications to run on AWS Lambda
 description:
   This library provides a function 'Network.Wai.Handler.Hal.run' to
@@ -21,8 +21,9 @@ maintainer:         Bellroy Tech Team <[email protected]>
 copyright:          Copyright (C) 2021 Bellroy Pty Ltd
 category:           AWS, Cloud
 build-type:         Simple
-extra-source-files:
+extra-doc-files:
   CHANGELOG.md
+extra-source-files:
   README.md
   test/data/ProxyRequest.json
   test/golden/WaiRequest.txt
@@ -52,6 +53,7 @@ common deps
     , bytestring            >=0.10.8    && <0.12.1
     , 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