如何将小型外部React站点反向代理为Yesod子站点并实现响应URL重写？

Hey Stephen, nice work getting the foundational proxy setup running! Let's sort out that response URL rewriting part you're stuck on—this is a common gotcha when proxying apps under a subpath, but it's totally solvable with a bit of conduit-based stream processing and header manipulation.

Here's the complete implementation for your processResponse function and related adjustments: #

First, make sure you add these dependencies to your Cabal file (if you haven't already):

• conduit (for stream processing)
• regex-pcre-byteString (for reliable URL pattern matching)
• http-types (for working with response headers)

Now, update your code with these changes:

import qualified Data.Conduit as C
import qualified Data.Conduit.Combinators as CC
import qualified Data.ByteString as BS
import Network.HTTP.Types (ResponseHeaders)
import qualified Text.Regex.PCRE.ByteString as Regex
import Network.Wai (Response(..), pathInfo)
import Network.Wai.Proxy (WaiProxyResponse(..), defaultWaiProxySettings, waiProxyToSettings)

-- Helper to clean up prefix (remove trailing slash if present)
cleanPrefix :: BS.ByteString -> BS.ByteString
cleanPrefix prefix = if BS.isSuffixOf "/" prefix then BS.init prefix else prefix

-- Helper to update a specific response header
updateHeader :: BS.ByteString -> BS.ByteString -> ResponseHeaders -> ResponseHeaders
updateHeader name newValue headers = (name, newValue) : filter (\(n, _) -> n /= name) headers

-- Rewrite URLs in response headers (like Location for redirects)
modifyResponseHeaders :: BS.ByteString -> Response body -> Response body
modifyResponseHeaders prefix resp = case lookup "Location" (responseHeaders resp) of
  Just loc -> 
    let updatedLoc = if BS.isPrefixOf "/" loc then prefix <> loc else loc
    in resp { responseHeaders = updateHeader "Location" updatedLoc (responseHeaders resp) }
  _ -> resp

-- Rewrite URLs in response body (for HTML, JS, CSS, etc.)
replacePaths :: BS.ByteString -> BS.ByteString -> BS.ByteString
replacePaths prefix bs = case Regex.replaceAll regex replacement bs of
  Right result -> result
  Left _ -> bs -- Fall back to original if regex fails
  where
    -- Match root-relative URLs in HTML attributes and CSS url() calls
    -- Matches patterns like href="/", src="/", url(/), etc.
    regex = Regex.makeRegexOpts Regex.compUTF8 Regex.defaultExecOpts "(\\bhref=\"|src=\"|action=\"|url\\()/"
    -- Replace with the prefixed version (e.g., "/react/" instead of "/")
    replacement = Regex.makeRegexOpts Regex.compUTF8 Regex.defaultExecOpt ("\\1" <> prefix <> "/")

-- Your processResponse function now handles text-based responses
processResponse :: Network.Wai.Request -> Response () -> Maybe (C.ConduitT BS.ByteString (C.Flush BS.Builder) IO ())
processResponse req resp = do
  let prefix = cleanPrefix $ "/" <> BS.intercalate "/" (take 1 $ pathInfo req)
      -- Only process text-based content types to avoid breaking binary files (images, etc.)
      isTextType = case lookup "Content-Type" (responseHeaders resp) of
        Just ct -> any (`BS.isPrefixOf` ct) 
          ["text/html", "application/javascript", "text/css", "application/json", "text/plain"]
        Nothing -> False
  if isTextType
    then Just $ responseBody resp 
             C..| CC.map (replacePaths prefix) 
             C..| CC.map C.Flush
    else Nothing -- Skip binary responses

makeExternalServerProxy :: Manager -> ByteString -> Int -> Application
makeExternalServerProxy manager host port = simpleCors $ S.serveWithContext (S.Proxy :: S.Proxy S.Raw) S.EmptyContext forwardH
  where
    forwardH :: S.Tagged S.Handler Application
    forwardH = S.Tagged $ waiProxyToSettings forwardRequest proxySettings manager

    forwardRequest :: Network.Wai.Request -> IO WaiProxyResponse
    forwardRequest req = pure $ WPRModifiedRequest
      (rewriteRequestPure (\(pq,q) _ -> ( case pq of
          [] -> []
          (_:xs) -> xs , q)) req)
      (ProxyDest host port)

    handleException :: SomeException -> Application
    handleException exc _ sr = sr $ responseLBS HT.status402
      [("content-type", "text/plain")]
      ("We're sorry: Internal Error:\n\n" <> TLE.encodeUtf8 (pack $ show exc))

    proxySettings = defaultWaiProxySettings
      { wpsOnExc = handleException
      , wpsProcessBody = processResponse
      -- Add header rewriting to handle redirects
      , wpsProcessResponse = \req resp -> pure $ modifyResponseHeaders (cleanPrefix $ "/" <> BS.intercalate "/" (take 1 $ pathInfo req)) resp
      }

Let's break down what this does: #

• Dynamic Prefix Detection: Automatically grabs the first segment of the request path (e.g., /react from /react/dashboard) as your subpath prefix, so you don't hardcode it.
• Header Rewriting: Fixes redirect Location headers—if your React app sends a redirect to /login, this changes it to /react/login.
• Body Rewriting: Uses regex to safely replace root-relative URLs in text content:
  • Matches HTML attributes like href="/", src="/static/js/main.js"
  • Catches CSS url(/images/bg.jpg) patterns
  • Skips absolute URLs (like https://example.com/foo) so external links stay intact
• Binary Content Safety: Only processes text-based content types, so images, fonts, and other binary files aren't corrupted.

Quick Notes: #

• Test this with your React app—if you have other places where root-relative URLs appear (like in JSON responses), add "application/json" to the isTextType check list.
• If you run into regex edge cases, adjust the regex pattern to match any additional URL patterns your app uses.

That should cover all the URL rewriting you need to make your React app work seamlessly as a Yesod subpath!

内容的提问来源于stack exchange，提问作者esjmb