Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fix testsuite

  • Loading branch information...
commit 5c92e743bb012a1822847106947765cb5bfb7e5f 1 parent 7378b0a
Gregory Collins authored May 23, 2010
4  README.SNAP.md
Source Rendered
... ...
@@ -1,5 +1,5 @@
1  
-Snap Framework 0.1.1
2  
---------------------
  1
+Snap Framework
  2
+--------------
3 3
 
4 4
 This is the first developer prerelease of the Snap framework.  Snap is a simple
5 5
 and fast web development framework and server written in Haskell. For more
4  README.md
Source Rendered
... ...
@@ -1,5 +1,5 @@
1  
-Snap Framework HTTP Server Library 0.1.1
2  
-----------------------------------------
  1
+Snap Framework HTTP Server Library
  2
+----------------------------------
3 3
 
4 4
 This is the first developer prerelease of the Snap Framework HTTP Server
5 5
 library.  For more information about Snap, read the `README.SNAP.md` or visit
6  snap-server.cabal
... ...
@@ -1,5 +1,5 @@
1 1
 name:           snap-server
2  
-version:        0.1.5
  2
+version:        0.2.1
3 3
 synopsis:       A fast, iteratee-based, epoll-enabled web server for the Snap Framework
4 4
 description:
5 5
   This is the first developer prerelease of the Snap framework.  Snap is a
@@ -107,14 +107,14 @@ Library
107 107
     network == 2.2.1.*,
108 108
     old-locale,
109 109
     sendfile >= 0.6.1 && < 0.7,
110  
-    snap-core >= 0.1.2 && <0.2,
  110
+    snap-core >= 0.2.1 && <0.3,
111 111
     time,
112 112
     transformers,
113 113
     unix,
114 114
     vector >= 0.6 && <0.7
115 115
 
116 116
   if flag(libev)
117  
-    build-depends: hlibev >= 0.2.1
  117
+    build-depends: hlibev >= 0.2.2
118 118
     other-modules: Snap.Internal.Http.Server.LibevBackend
119 119
     cpp-options: -DLIBEV
120 120
   else
6  src/Snap/Internal/Http/Server.hs
@@ -52,8 +52,8 @@ import           Snap.Internal.Http.Server.Date
52 52
 --
53 53
 -- Note that we won't be bothering end users with this -- the details will be
54 54
 -- hidden inside the Snap monad
55  
-type ServerHandler = Request
56  
-                   -> (ByteString -> IO ())
  55
+type ServerHandler = (ByteString -> IO ())
  56
+                   -> Request
57 57
                    -> Iteratee IO (Request,Response)
58 58
 
59 59
 type ServerMonad = StateT ServerState (Iteratee IO)
@@ -288,7 +288,7 @@ httpSession writeEnd onSendFile handler = do
288 288
     case mreq of
289 289
       (Just req) -> do
290 290
           logerr <- gets _logError
291  
-          (req',rspOrig) <- lift $ handler req logerr
  291
+          (req',rspOrig) <- lift $ handler logerr req
292 292
           let rspTmp = rspOrig { rspHttpVersion = rqVersion req }
293 293
           checkConnectionClose (rspHttpVersion rspTmp) (rspHeaders rspTmp)
294 294
 
4  test/snap-server-testsuite.cabal
@@ -37,7 +37,7 @@ Executable testsuite
37 37
      old-locale,
38 38
      parallel > 2,
39 39
      iteratee >= 0.3.1 && < 0.4,
40  
-     snap-core == 0.1.1,
  40
+     snap-core >= 0.2.1 && <0.3,
41 41
      test-framework >= 0.3.1 && <0.4,
42 42
      test-framework-hunit >= 0.2.5 && < 0.3,
43 43
      test-framework-quickcheck2 >= 0.2.6 && < 0.3,
@@ -87,7 +87,7 @@ Executable pongserver
87 87
      network == 2.2.1.*,
88 88
      network-bytestring >= 0.1.2 && < 0.2,
89 89
      sendfile >= 0.6.1 && < 0.7,
90  
-     snap-core == 0.1.1,
  90
+     snap-core >= 0.2.1 && <0.3,
91 91
      time,
92 92
      transformers,
93 93
      unix,
39  test/suite/Snap/Internal/Http/Server/Tests.hs
@@ -323,8 +323,10 @@ testHttpResponse1 = testCase "HttpResponse1" $ do
323 323
 
324 324
 
325 325
 
326  
-echoServer :: Request -> Iteratee IO (Request,Response)
327  
-echoServer req = do
  326
+echoServer :: (ByteString -> IO ())
  327
+           -> Request
  328
+           -> Iteratee IO (Request,Response)
  329
+echoServer _ req = do
328 330
     se <- liftIO $ readIORef (rqBody req)
329 331
     let (SomeEnumerator enum) = se
330 332
     let i = joinIM $ enum stream2stream
@@ -337,9 +339,9 @@ echoServer req = do
337 339
                              , rspContentLength = Just $ fromIntegral cl }
338 340
 
339 341
 
340  
-echoServer2 :: Request -> Iteratee IO (Request,Response)
341  
-echoServer2 req = do
342  
-    (rq,rsp) <- echoServer req
  342
+echoServer2 :: ServerHandler
  343
+echoServer2 _ req = do
  344
+    (rq,rsp) <- echoServer (const $ return ()) req
343 345
     return (rq, addCookie cook rsp)
344 346
   where
345 347
     cook = Cookie "foo" "bar" (Just utc) (Just ".foo.com") (Just "/")
@@ -412,8 +414,8 @@ testChunkOn1_0 = testCase "transfer-encoding chunked" $ do
412 414
   where
413 415
     lower = S.map (c2w . toLower . w2c) . S.concat . L.toChunks
414 416
 
415  
-    f :: Request -> Iteratee IO (Request, Response)
416  
-    f req = do
  417
+    f :: ServerHandler
  418
+    f _ req = do
417 419
         let s = L.fromChunks $ Prelude.take 500 $ repeat "fldkjlfksdjlfd"
418 420
         let out = enumLBS s
419 421
         return (req, emptyResponse { rspBody = Enum out })
@@ -439,8 +441,17 @@ testHttp2 = testCase "connection: close" $ do
439 441
 
440 442
     let (iter,onSendFile) = mkIter ref
441 443
 
442  
-    runHTTP "localhost" "127.0.0.1" 80 "127.0.0.1" 58384
443  
-            Nothing Nothing enumBody iter onSendFile echoServer2
  444
+    runHTTP "localhost"
  445
+            "127.0.0.1"
  446
+            80
  447
+            "127.0.0.1"
  448
+            58384
  449
+            Nothing
  450
+            Nothing
  451
+            enumBody
  452
+            iter
  453
+            onSendFile
  454
+            echoServer2
444 455
 
445 456
     s <- readIORef ref
446 457
 
@@ -494,9 +505,13 @@ testSendFile = testCase "sendFile" $ do
494 505
 
495 506
 testServerStartupShutdown :: Test
496 507
 testServerStartupShutdown = testCase "startup/shutdown" $ do
497  
-    tid <- forkIO $ httpServe "*" port "localhost"
498  
-           (Just "test-access.log") (Just "test-error.log") $
499  
-           runSnap pongServer
  508
+    tid <- forkIO $
  509
+           httpServe "*"
  510
+                     port
  511
+                     "localhost"
  512
+                     (Just "test-access.log")
  513
+                     (Just "test-error.log")
  514
+                     (runSnap pongServer)
500 515
     waitabit
501 516
 
502 517
     rsp <- HTTP.simpleHTTP (HTTP.getRequest "http://localhost:8145/")

0 notes on commit 5c92e74

Please sign in to comment.
Something went wrong with that request. Please try again.