Răsfoiți Sursa

Using WAI 3.0 or later and GHC 7.8 or later.

Kazu Yamamoto 11 ani în urmă
părinte
comite
c45e2312fd
3 a modificat fișierele cu 22 adăugiri și 28 ștergeri
  1. 6 5
      wai/bench/bench.cabal
  2. 15 22
      wai/bench/wai.hs
  3. 1 1
      wai/setup.py

+ 6 - 5
wai/bench/bench.cabal

@@ -12,10 +12,11 @@ executable         bench
     extensions: OverloadedStrings
 
     build-depends: base                          >= 4          && < 5
-                 , warp                          >= 1.3        && < 1.4
-                 , wai                           >= 1.4
-                 , text                          >= 0.11       && < 0.12
                  , aeson                         >= 0.6.1.0
-                 , unix                          >= 2.5
-                 , network-conduit               >= 1.0
+                 , conduit-extra                 >= 1.1
                  , http-types
+                 , network                       >= 2.4
+                 , streaming-commons
+                 , text                          >= 1.0
+                 , wai                           >= 3.0
+                 , warp                          >= 3.0

+ 15 - 22
wai/bench/wai.hs

@@ -1,27 +1,20 @@
-{-# LANGUAGE OverloadedStrings #-}
-import Data.Aeson
-import Data.Text (Text)
+{-# LANGUAGE OverloadedStrings, BangPatterns #-}
 
-import Control.Monad (replicateM_)
+import Control.Concurrent (runInUnboundThread)
+import Data.Aeson ((.=), object, encode)
+import Data.Streaming.Network (bindPortTCP)
+import Data.Text (Text)
 import Network.HTTP.Types (status200)
-import qualified Network.Wai.Handler.Warp as Warp
-import System.Posix.Process (forkProcess)
-import Data.Conduit.Network (bindPort)
-import Network.Wai
-import System.Environment (getArgs)
+import Network.Wai (responseLBS)
+import qualified Network.Wai.Handler.Warp as W
 
 main :: IO ()
-main = do
-    socket <- bindPort 8000 "*"
-    [cores, _] <- getArgs
-    let run = Warp.runSettingsSocket Warp.defaultSettings
-                { Warp.settingsPort = 8000
-                , Warp.settingsHost = "*"
-                , Warp.settingsOnException = const $ return ()
-                } socket app
-    replicateM_ (read cores - 1) $ forkProcess run
-    run
+main = runInUnboundThread $ do
+    s <- bindPortTCP 8000 "*"
+    W.runSettingsSocket settings s app
   where
-    app _ = return $ responseLBS
-      status200 [("Content-Type", "application/json")] $
-      encode $ object ["message" .= ("Hello, World!" :: Text)]
+    settings = W.setOnException (\_ _ -> return ()) W.defaultSettings
+    app _ respond = respond response
+    !response = responseLBS status200 ct json
+    ct = [("Content-Type", "application/json")]
+    !json = encode $ object ["message" .= ("Hello, World!" :: Text)]

+ 1 - 1
wai/setup.py

@@ -12,7 +12,7 @@ def start(args, logfile, errfile):
 
   db_host = args.database_host
   threads = str(args.max_threads)
-  subprocess.Popen("dist/build/bench/bench " + threads + " " + db_host + " +RTS -A4M -N -qg2 -I0 -G2", shell=True, cwd="wai/bench", stderr=errfile, stdout=logfile)
+  subprocess.Popen("dist/build/bench/bench " + threads + " " + db_host + " +RTS -A32m -N", shell=True, cwd="wai/bench", stderr=errfile, stdout=logfile)
   return 0
 
 def stop(logfile, errfile):