packages feed

hprox-0.7.0: test/Network/HProx/RouteSpec.hs

-- SPDX-License-Identifier: Apache-2.0
--
-- Copyright (C) 2026 Bin Jin. All Rights Reserved.

module Network.HProx.RouteSpec
  ( spec
  ) where

import Network.HProx.Route

import Test.Hspec

spec :: Spec
spec =
  describe "ReverseRoute" $ do
    it "converts and normalizes from the public Config reverse-route tuple shape" $ do
      fromReverseRouteTuple (Just "example.com", "/api/", "backend:80")
        `shouldBe` ReverseRoute
          { routeHost = Just "example.com"
          , routePrefix = "/api"
          , routeUpstream = "backend:80"
          }
      routePrefix (fromReverseRouteTuple (Nothing, "api", "backend:80")) `shouldBe` "/api"
      routePrefix (fromReverseRouteTuple (Nothing, "/", "backend:80")) `shouldBe` "/"

    it "sorts domain-specific routes before catch-all routes and longer prefixes first" $ do
      let catchAllLong = ReverseRoute Nothing "/longer/" "catch-long:80"
          catchAllShort = ReverseRoute Nothing "/" "catch-short:80"
          hostShort = ReverseRoute (Just "example.com") "/" "host-short:80"
          hostLong = ReverseRoute (Just "example.com") "/api/" "host-long:80"
      sortReverseRoutes [catchAllShort, hostShort, catchAllLong, hostLong]
        `shouldBe` [hostLong, hostShort, catchAllLong, catchAllShort]

    it "matches hostless routes against any request host" $ do
      let route = ReverseRoute Nothing "/" "backend:80"
      hostMatches route Nothing `shouldBe` True
      hostMatches route (Just "example.com") `shouldBe` True

    it "matches host-specific routes case-insensitively" $ do
      let route = ReverseRoute (Just "example.com") "/" "backend:80"
      hostMatches route Nothing `shouldBe` False
      hostMatches route (Just "example.com") `shouldBe` True
      hostMatches route (Just "EXAMPLE.com") `shouldBe` True
      hostMatches route (Just "other.example") `shouldBe` False

    it "matches prefixes on path boundaries" $ do
      let route = ReverseRoute Nothing "/api" "backend:80"
      prefixMatches route "/api" `shouldBe` True
      prefixMatches route "/api/v1" `shouldBe` True
      prefixMatches route "/apiary" `shouldBe` False
      prefixMatches route "/apix" `shouldBe` False
      prefixMatches route "/other" `shouldBe` False

    it "finds the first matching route after current route sorting" $ do
      let catchAll = ReverseRoute Nothing "/api/" "catch-all:80"
          shorterHost = ReverseRoute (Just "example.com") "/" "shorter-host:80"
          longerHost = ReverseRoute (Just "example.com") "/api/" "longer-host:80"
      findMatchingRoute [catchAll, shorterHost, longerHost] (Just "EXAMPLE.com:8080") "/api/users"
        `shouldBe` Just longerHost

    it "uses hostless routes for any request host when no host-specific route matches" $ do
      let catchAll = ReverseRoute Nothing "/api/" "catch-all:80"
          hostRoute = ReverseRoute (Just "example.com") "/api/" "host:80"
      findMatchingRoute [catchAll, hostRoute] (Just "other.example") "/api/users"
        `shouldBe` Just catchAll

    it "does not match host-specific routes without a request host" $ do
      let route = ReverseRoute (Just "example.com") "/api/" "host:80"
      findMatchingRoute [route] Nothing "/api/users" `shouldBe` Nothing

    it "rewrites raw paths using normalized prefix boundaries" $ do
      let route = fromReverseRouteTuple (Nothing, "/api", "backend:80")
          exactRewrite = rewriteReverseProxyRequest route [] "/api"
          nestedRewrite = rewriteReverseProxyRequest route [] "/api/users"
          unmatchedRewrite = rewriteReverseProxyRequest route [] "/other"
      rewriteRawPath exactRewrite `shouldBe` "/"
      rewriteRawPath nestedRewrite `shouldBe` "/users"
      rewriteRawPath unmatchedRewrite `shouldBe` "/other"

    it "selects secure upstream behavior only for port 443" $ do
      let secure = rewriteReverseProxyRequest (ReverseRoute Nothing "/" "secure.example:443") [] "/"
          defaultPort = rewriteReverseProxyRequest (ReverseRoute Nothing "/" "plain.example") [] "/"
      rewriteUpstream secure `shouldBe` "secure.example"
      rewritePort secure `shouldBe` 443
      rewriteSecure secure `shouldBe` True
      rewriteUpstream defaultPort `shouldBe` "plain.example"
      rewritePort defaultPort `shouldBe` 80
      rewriteSecure defaultPort `shouldBe` False

    it "strips current proxy, forwarded, CDN, X-Real-IP, and X-Scheme headers" $ do
      let route = ReverseRoute Nothing "/" "backend:80"
          headers =
            [ ("Proxy-Connection", "keep-alive")
            , ("X-Forwarded-For", "127.0.0.1")
            , ("cf-ray", "ray")
            , ("cdn-loop", "loop")
            , ("X-Real-IP", "127.0.0.1")
            , ("X-Scheme", "https")
            , ("Authorization", "keep")
            ]
          rewrite = rewriteReverseProxyRequest route headers "/"
      rewriteHeaders rewrite `shouldBe` [("Host", "backend"), ("Authorization", "keep")]

    it "rewrites the request Host to the upstream host" $ do
      let route = ReverseRoute Nothing "/" "backend.example:8080"
          rewrite = rewriteReverseProxyRequest route [("Host", "original.example")] "/"
      rewriteRequestHost rewrite `shouldBe` Just "backend.example"
      rewriteHeaders rewrite `shouldBe` [("Host", "backend.example")]