Skip to content
This repository

0.9 #138

Merged
merged 4 commits into from almost 2 years ago

3 participants

Leonid Onokhov Gregory Collins Andrew Cowie
Leonid Onokhov
sopvop commented June 05, 2012

Adding PATCH method, and ExtMethod constructor to Methods.

I didn't find if anything else needs to be changed in snap-core.

src/Snap/Internal/Http/Types.hs
@@ -132,6 +132,7 @@ deleteHeader k = updateHeaders $ H.delete k
132 132
 -- | Enumerates the HTTP method values (see
133 133
 -- <http://tools.ietf.org/html/rfc2068.html#section-5.1.1>).
134 134
 data Method  = GET | HEAD | POST | PUT | DELETE | TRACE | OPTIONS | CONNECT
  135
+             | PATCH | ExtMethod ByteString
135 136
                deriving(Show,Read,Ord,Eq)
2
Gregory Collins Owner

Formatting: please put the pipe at the end of the first line here. Also, would ExtMethod be better as a "CI ByteString"? I don't have any strong feelings one way or the other, just something to think about.

Leonid Onokhov
sopvop added a note June 05, 2012

According to this note method names are case sensitive.
edit: That's the old note, spec 5.1.1 also mentions what methods are case sensitive.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Gregory Collins
Owner

Could you also please update the test suite to match? There should be tests for ExtMethod at least.

Leonid Onokhov
sopvop commented June 05, 2012

In test I follow formatting as it is there (no spaces in list etc.)

Andrew Cowie

You might want to have a read through snoyberg/http-conduit#24 I'm not pleased with Michael's position there, but it does raise a useful question about whether HEAD is equal to ExtMethod "HEAD". Personally, I see that objection as a bit ridiculous; if you're stupid enough to define one that already exists that's your problem, I should think, but it did come up in other libraries.

Also, why call it ExtMethod? Why not just call the constructor Method Bytestring in the ADT?

AfC

Leonid Onokhov
sopvop commented June 05, 2012

I don't have an opinion about constructor name or equality of HEAD and ExtMethod "HEAD", can make it either way.

Gregory Collins gregorycollins merged commit 340f01a into from June 06, 2012
Gregory Collins gregorycollins closed this June 06, 2012
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
3  src/Snap/Internal/Http/Types.hs
@@ -131,7 +131,8 @@ deleteHeader k = updateHeaders $ H.delete k
131 131
 ------------------------------------------------------------------------------
132 132
 -- | Enumerates the HTTP method values (see
133 133
 -- <http://tools.ietf.org/html/rfc2068.html#section-5.1.1>).
134  
-data Method  = GET | HEAD | POST | PUT | DELETE | TRACE | OPTIONS | CONNECT
  134
+data Method  = GET | HEAD | POST | PUT | DELETE | TRACE | OPTIONS | CONNECT |
  135
+               PATCH | ExtMethod ByteString
135 136
                deriving(Show,Read,Ord,Eq)
136 137
 
137 138
 
65  test/suite/Snap/Core/Tests.hs
@@ -30,6 +30,7 @@ import           Test.Framework
30 30
 import           Test.Framework.Providers.HUnit
31 31
 import           Test.Framework.Providers.QuickCheck2
32 32
 import           Test.HUnit hiding (Test, path)
  33
+import           Test.QuickCheck(oneof, variant, elements, Gen, arbitrary)
33 34
 
34 35
 import           Snap.Internal.Exceptions
35 36
 import           Snap.Internal.Http.Types
@@ -54,6 +55,8 @@ tests = [ testFail
54 55
         , testTrivials
55 56
         , testMethod
56 57
         , testMethods
  58
+        , testMethodEq
  59
+        , testMethodNotEq
57 60
         , testDir
58 61
         , testCatchIO
59 62
         , testWrites
@@ -122,6 +125,13 @@ mkZomgRq = do
122 125
                      enum Nothing GET (1,1) [] "/" "/" "/" ""
123 126
                      Map.empty Map.empty Map.empty
124 127
 
  128
+mkMethodRq :: Method -> IO Request
  129
+mkMethodRq m = do
  130
+    enum <- newIORef $ SomeEnumerator returnI
  131
+
  132
+    return $ Request "foo" 80 "127.0.0.1" 999 "foo" 1000 "foo" False H.empty
  133
+                     enum Nothing m (1,1) [] "/" "/" "/" ""
  134
+                     Map.empty Map.empty Map.empty
125 135
 
126 136
 mkIpHeaderRq :: IO Request
127 137
 mkIpHeaderRq = do
@@ -167,6 +177,13 @@ go m = do
167 177
   where
168 178
     dummy !x = return $! (show x `using` rdeepseq) `seq` ()
169 179
 
  180
+goMeth :: Method -> Snap a -> IO (Request,Response)
  181
+goMeth m s = do
  182
+    methRq <- mkMethodRq m
  183
+    run_ $ runSnap s dummy (const (return ())) methRq
  184
+  where
  185
+    dummy !x = return $! (show x `using` rdeepseq) `seq` ()
  186
+
170 187
 goIP :: Snap a -> IO (Request,Response)
171 188
 goIP m = do
172 189
     rq <- mkIpHeaderRq
@@ -454,11 +471,57 @@ testMethod = testCase "types/method" $ do
454 471
 
455 472
 testMethods :: Test
456 473
 testMethods = testCase "types/methods" $ do
457  
-   expect404 $ go (methods [POST,PUT] $ return ())
  474
+   expect404 $ go (methods [POST,PUT,PATCH,Method "MOVE"] $ return ())
458 475
    expectNo404 $ go (methods [GET] $ return ())
459 476
    expectNo404 $ go (methods [POST,GET] $ return ())
460 477
    expectNo404 $ go (methods [PUT,GET] $ return ())
461 478
    expectNo404 $ go (methods [GET,PUT,DELETE] $ return ())
  479
+   expectNo404 $ go (methods [GET,PUT,DELETE,PATCH] $ return ())
  480
+   expectNo404 $ go (methods [GET,Method "COPY"] $ return ())
  481
+   expect404 $ goMeth PATCH (methods [POST,PUT,GET,Method "FOO"] $ return ())
  482
+   expect404 $ goMeth (Method "Baz")
  483
+     (methods [GET,POST,Method "Foo"] $ return ())
  484
+   expectNo404 $ goMeth (Method "Baz")
  485
+     (method (Method "Baz") $ return ())
  486
+   expectNo404 $ goMeth (Method "Foo")
  487
+     (methods [Method "Baz",PATCH,GET,Method "Foo"] $ return ())
  488
+
  489
+   expectNo404 $ goMeth GET (method (Method "GET") $ return ())
  490
+   expectNo404 $ goMeth (Method "GET") (method GET $ return ())
  491
+
  492
+
  493
+methodGen :: Int -> Gen Method
  494
+methodGen n = variant n $ oneof
  495
+              [ elements [ GET, HEAD, POST, PUT, DELETE
  496
+                         , TRACE, OPTIONS, CONNECT, PATCH ]
  497
+              , Method <$> arbitrary
  498
+              ]
  499
+
  500
+testMethodEq :: Test
  501
+testMethodEq = testProperty "types/Method/eq" $ prop
  502
+  where
  503
+    prop n = do
  504
+      m <- methodGen n
  505
+      return $ m == m && toMeth m == m
  506
+    toMeth GET     = Method "GET"
  507
+    toMeth HEAD    = Method "HEAD"
  508
+    toMeth POST    = Method "POST"
  509
+    toMeth PUT     = Method "PUT"
  510
+    toMeth DELETE  = Method "DELETE"
  511
+    toMeth TRACE   = Method "TRACE"
  512
+    toMeth OPTIONS = Method "OPTIONS"
  513
+    toMeth CONNECT = Method "CONNECT"
  514
+    toMeth PATCH   = Method "PATCH"
  515
+    toMeth (Method a) = Method a
  516
+
  517
+
  518
+testMethodNotEq :: Test
  519
+testMethodNotEq = testProperty "types/Method/noteq" $ prop
  520
+  where
  521
+    prop n = do
  522
+      m <- methodGen n
  523
+      m' <- methodGen (n + 1)
  524
+      return $ (m /= m') == not (m == m')
462 525
 
463 526
 
464 527
 testDir :: Test
7  test/suite/Snap/Test/Tests.hs
@@ -62,6 +62,13 @@ testSetRequestType = testCase "test/requestBuilder/setRequestType" $ do
62 62
                 UrlEncodedPostRequest $ Map.fromList [("foo", ["foo"])]
63 63
     assertEqual "setRequestType/5/Method" POST (rqMethod request5)
64 64
 
  65
+    request6 <- buildRequest $ setRequestType $
  66
+                RequestWithRawBody (Method "MOVE") "foo"
  67
+    assertEqual "setRequestType/6/Method" (Method "MOVE") (rqMethod request6)
  68
+
  69
+    request7 <- buildRequest $ setRequestType $ RequestWithRawBody PATCH "bar"
  70
+    assertEqual "setRequestType/7/Method" PATCH (rqMethod request7)
  71
+
65 72
   where
66 73
     rt4 = MultipartPostRequest [ ("foo", FormData ["foo"])
67 74
                                , ("bar", Files [fd4])
Commit_comment_tip

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.