MiddlewareSpec.hs

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

module Network.HProx.MiddlewareSpec
  ( spec
  ) where

import Data.ByteString.Char8      qualified as BS8
import Data.ByteString.Lazy.Char8 qualified as LBS8
import Network.HTTP.Types         qualified as HT
import Network.Wai
import Network.Wai.Test

import Network.HProx.Impl

import Test.Hspec

spec :: Spec
spec = do
  describe "healthCheckProvider" $ do
    it "returns 200 okay for the health endpoint" $ do
      response <- runApp healthCheckProvider (requestPath "/.hprox/health")
      simpleStatus response `shouldBe` HT.status200
      simpleBody response `shouldBe` "okay"

    it "falls through outside the health endpoint" $ do
      response <- runApp healthCheckProvider (requestPath "/not-health")
      simpleStatus response `shouldBe` fallbackStatus
      simpleBody response `shouldBe` fallbackBody

  describe "acmeProvider" $ do
    it "serves an insecure challenge when a thumbprint is configured" $ do
      response <- runApp (acmeProvider testSettings) (requestPath "/.well-known/acme-challenge/token")
      simpleStatus response `shouldBe` HT.status200
      simpleBody response `shouldBe` "token.thumbprint"
      lookup "Content-Type" (simpleHeaders response) `shouldBe` Just "text/plain"

    it "falls through for secure ACME requests" $ do
      response <- runApp (acmeProvider testSettings) $ (requestPath "/.well-known/acme-challenge/token")
        { isSecure = True
        }
      simpleStatus response `shouldBe` fallbackStatus

    it "falls through without a configured thumbprint" $ do
      response <- runApp (acmeProvider testSettings { acmeThumbprint = Nothing }) (requestPath "/.well-known/acme-challenge/token")
      simpleStatus response `shouldBe` fallbackStatus

  describe "pacProvider" $ do
    it "uses forwarded host and lowercase https proto for the PAC response" $ do
      response <- runApp pacProvider $ (requestPath "/.hprox/config.pac")
        { requestHeaders = [("x-forwarded-host", "proxy.example"), ("x-forwarded-proto", "https")]
        }
      simpleStatus response `shouldBe` HT.status200
      simpleBody response `shouldBe` LBS8.unlines
        [ "function FindProxyForURL(url, host) {"
        , "  return \"HTTPS proxy.example:443\";"
        , "}"
        ]
      lookup "Content-Type" (simpleHeaders response) `shouldBe` Just "application/x-ns-proxy-autoconfig"

    it "uses Host and preserves an explicit host port for insecure PAC responses" $ do
      response <- runApp pacProvider $ (requestPath "/.hprox/config.pac")
        { requestHeaderHost = Just "proxy.example:8080"
        }
      simpleStatus response `shouldBe` HT.status200
      simpleBody response `shouldBe` LBS8.unlines
        [ "function FindProxyForURL(url, host) {"
        , "  return \"PROXY proxy.example:8080\";"
        , "}"
        ]

    it "treats forwarded proto values case-insensitively" $ do
      response <- runApp pacProvider $ (requestPath "/.hprox/config.pac")
        { requestHeaders = [("x-forwarded-host", "proxy.example"), ("x-forwarded-proto", "HTTPS")]
        }
      simpleStatus response `shouldBe` HT.status200
      simpleBody response `shouldBe` LBS8.unlines
        [ "function FindProxyForURL(url, host) {"
        , "  return \"HTTPS proxy.example:443\";"
        , "}"
        ]

    it "falls through without a host" $ do
      response <- runApp pacProvider (requestPath "/.hprox/config.pac")
      simpleStatus response `shouldBe` fallbackStatus

  describe "forceSSL" $ do
    it "redirects insecure origin-form requests with path and query to HTTPS" $ do
      response <- runApp (forceSSL testSettings) $ (requestPath "/docs")
        { requestHeaderHost = Just "example.com"
        , rawQueryString = "?q=1"
        }
      simpleStatus response `shouldBe` HT.status301
      lookup "Location" (simpleHeaders response) `shouldBe` Just "https://example.com/docs?q=1"

    it "redirects root origin-form requests to the HTTPS root" $ do
      response <- runApp (forceSSL testSettings) $ defaultRequest
        { requestHeaderHost = Just "example.com"
        , rawPathInfo = "/"
        }
      simpleStatus response `shouldBe` HT.status301
      lookup "Location" (simpleHeaders response) `shouldBe` Just "https://example.com/"

    it "redirects insecure absolute-form proxy requests to the parsed HTTPS target" $ do
      response <- runApp (forceSSL testSettings) $ defaultRequest
        { requestHeaderHost = Just "proxy.local"
        , rawPathInfo = "http://target.example:8080/docs"
        , rawQueryString = "?q=1"
        }
      simpleStatus response `shouldBe` HT.status301
      lookup "Location" (simpleHeaders response) `shouldBe` Just "https://target.example:8080/docs?q=1"

    it "omits default ports from absolute-form HTTPS redirect authorities" $ do
      response <- runApp (forceSSL testSettings) $ defaultRequest
        { requestHeaderHost = Just "proxy.local"
        , rawPathInfo = "http://target.example/docs"
        }
      simpleStatus response `shouldBe` HT.status301
      lookup "Location" (simpleHeaders response) `shouldBe` Just "https://target.example/docs"

    it "returns upgrade-required for insecure requests without Host" $ do
      response <- runApp (forceSSL testSettings) defaultRequest
      simpleStatus response `shouldBe` HT.mkStatus 426 "Upgrade Required"
      lookup "Upgrade" (simpleHeaders response) `shouldBe` Just "TLS/1.0, HTTP/1.1"

    it "falls through for secure requests" $ do
      response <- runApp (forceSSL testSettings) defaultRequest { isSecure = True }
      simpleStatus response `shouldBe` fallbackStatus

runApp :: Middleware -> Request -> IO SResponse
runApp middleware req = runSession (srequest $ SRequest req "") (middleware fallback)

requestPath :: String -> Request
requestPath path = setPath defaultRequest (BS8.pack path)

fallback :: Application
fallback _req respond = respond $ responseLBS fallbackStatus [("Content-Type", "text/plain")] fallbackBody

fallbackStatus :: HT.Status
fallbackStatus = HT.mkStatus 418 "fallback"

fallbackBody :: LBS8.ByteString
fallbackBody = "fallback"

testSettings :: ProxySettings
testSettings = ProxySettings
  { proxyAuth      = Nothing
  , passPrompt     = Just "hprox"
  , wsRemote       = Nothing
  , revRemoteMap   = []
  , hideProxyAuth  = False
  , naivePadding   = False
  , acmeThumbprint = Just "thumbprint"
  , logger         = \_ _ -> return ()
  }