Browse Source

Merge pull request #1533 from TechEmpower/wai-plaintext

Added plaintext test to wai
Brittany Mazza 10 years ago
parent
commit
fcd51040a1
2 changed files with 12 additions and 5 deletions
  1. 11 5
      frameworks/Haskell/wai/bench/wai.hs
  2. 1 0
      frameworks/Haskell/wai/benchmark_config.json

+ 11 - 5
frameworks/Haskell/wai/bench/wai.hs

@@ -5,8 +5,8 @@ import Control.Concurrent (runInUnboundThread)
 import Data.Aeson ((.=), object, encode)
 import qualified Data.ByteString.Lazy as L
 import Data.Text (Text)
-import Network.HTTP.Types (status200)
-import Network.Wai (responseBuilder)
+import Network.HTTP.Types (status200, status404)
+import Network.Wai (responseBuilder, rawPathInfo)
 import qualified Network.Wai.Handler.Warp as W
 
 main :: IO ()
@@ -15,10 +15,16 @@ main =
   where
     settings = W.setPort 8000
              $ W.setOnException (\_ _ -> return ()) W.defaultSettings
-    app _ respond = respond response
-    !response = responseBuilder status200 ct json
-    ct = [("Content-Type", "application/json")]
+    app request respond = case rawPathInfo request of
+        "/json" -> respond responseJson
+        "/plaintext" -> respond responsePlaintext
+        _ -> respond $ responseBuilder status404 [] ""
+    !responseJson = responseBuilder status200 ctJson json
+    ctJson = [("Content-Type", "application/json")]
     !json = copyByteString
           $ L.toStrict
           $ encode
           $ object ["message" .= ("Hello, World!" :: Text)]
+    !responsePlaintext = responseBuilder status200 ctPlaintext plaintext
+    ctPlaintext = [("Content-type", "text/plain")]
+    plaintext = "Hello, World!"

+ 1 - 0
frameworks/Haskell/wai/benchmark_config.json

@@ -4,6 +4,7 @@
     "default": {
       "setup_file": "setup",
       "json_url": "/json",
+      "plaintext_url": "/plaintext",
       "port": 8000,
       "approach": "Realistic",
       "classification": "Platform",