Add support for HEAD, CONNECT, OPTIONS, TRACE, and PATCH (#44)

This commit is contained in:
Connor Prussin 2017-07-18 22:21:36 -07:00 committed by GitHub
parent 3676a3b0f9
commit be26faa803
3 changed files with 157 additions and 25 deletions

View File

@ -20,6 +20,11 @@ data Request
| Post Headers.Headers Path.Path Body.Body
| Put Headers.Headers Path.Path Body.Body
| Delete Headers.Headers Path.Path
| Head Headers.Headers Path.Path
| Connect Headers.Headers Path.Path Body.Body
| Options Headers.Headers Path.Path
| Trace Headers.Headers Path.Path
| Patch Headers.Headers Path.Path Body.Body
-- | When using show on a Request, print the method and the path.
instance show :: Show.Show Request where
@ -27,6 +32,11 @@ instance show :: Show.Show Request where
show (Post _ path _) = "POST: " <> path
show (Put _ path _) = "PUT: " <> path
show (Delete _ path) = "DELETE: " <> path
show (Head _ path) = "HEAD: " <> path
show (Connect _ path _) = "CONNECT: " <> path
show (Options _ path) = "OPTIONS: " <> path
show (Trace _ path) = "TRACE: " <> path
show (Patch _ path _) = "PATCH: " <> path
-- | Given an HTTP Request object, this method will convert it to an HTTPure
-- | Request object.
@ -35,11 +45,16 @@ fromHTTPRequest :: forall e.
Aff.Aff (HTTPureM.HTTPureEffects e) Request
fromHTTPRequest request = do
body <- Body.read request
case method of
"POST" -> pure $ Post headers path body
"PUT" -> pure $ Put headers path body
"DELETE" -> pure $ Delete headers path
_ -> pure $ Get headers path
pure $ case method of
"POST" -> Post headers path body
"PUT" -> Put headers path body
"DELETE" -> Delete headers path
"HEAD" -> Head headers path
"CONNECT" -> Connect headers path body
"OPTIONS" -> Options headers path
"TRACE" -> Trace headers path
"PATCH" -> Patch headers path body
_ -> Get headers path
where
method = HTTP.requestMethod request
headers = HTTP.requestHeaders request

View File

@ -11,23 +11,37 @@ import HTTPure.Headers as Headers
import HTTPure.Request as Request
import HTTPure.SpecHelpers as SpecHelpers
import HTTPure.SpecHelpers ((?=))
showSpec :: SpecHelpers.Test
showSpec = Spec.describe "show" do
Spec.describe "with a POST" do
Spec.it "is the method and the path" do
show (Request.Post none "test" "") `Assertions.shouldEqual` "POST: test"
show (Request.Post StrMap.empty "test" "") ?= "POST: test"
Spec.describe "with a PUT" do
Spec.it "is the method and the path" do
show (Request.Put none "test" "") `Assertions.shouldEqual` "PUT: test"
show (Request.Put StrMap.empty "test" "") ?= "PUT: test"
Spec.describe "with a DELETE" do
Spec.it "is the method and the path" do
show (Request.Delete none "test") `Assertions.shouldEqual` "DELETE: test"
show (Request.Delete StrMap.empty "test") ?= "DELETE: test"
Spec.describe "with a HEAD" do
Spec.it "is the method and the path" do
show (Request.Head StrMap.empty "test") ?= "HEAD: test"
Spec.describe "with a CONNECT" do
Spec.it "is the method and the path" do
show (Request.Connect StrMap.empty "test" "") ?= "CONNECT: test"
Spec.describe "with a OPTIONS" do
Spec.it "is the method and the path" do
show (Request.Options StrMap.empty "test") ?= "OPTIONS: test"
Spec.describe "with a TRACE" do
Spec.it "is the method and the path" do
show (Request.Trace StrMap.empty "test") ?= "TRACE: test"
Spec.describe "with a PATH" do
Spec.it "is the method and the path" do
show (Request.Patch StrMap.empty "test" "") ?= "PATCH: test"
Spec.describe "with a GET" do
Spec.it "is the method and the path" do
show (Request.Get none "test") `Assertions.shouldEqual` "GET: test"
where
none = StrMap.empty
show (Request.Get StrMap.empty "test") ?= "GET: test"
fromHTTPRequestSpec :: SpecHelpers.Test
fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
@ -42,7 +56,7 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
response <- mock "POST" "" "" mockHeader
case response of
(Request.Post headers _ _) ->
Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Post, got " <> show a
Spec.it "has the correct path" do
response <- mock "POST" "test" "" StrMap.empty
@ -65,7 +79,7 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
response <- mock "PUT" "" "" mockHeader
case response of
(Request.Put headers _ _) ->
Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Put, got " <> show a
Spec.it "has the correct path" do
response <- mock "PUT" "test" "" StrMap.empty
@ -88,7 +102,7 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
response <- mock "DELETE" "" "" mockHeader
case response of
(Request.Delete headers _) ->
Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Delete, got " <> show a
Spec.it "has the correct path" do
response <- mock "DELETE" "test" "" StrMap.empty
@ -96,6 +110,106 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
(Request.Delete _ "test") -> pure unit
a -> Assertions.fail $ "expected the path 'test', got " <> show a
Spec.describe "with a HEAD" do
Spec.it "is a Head" do
response <- mock "HEAD" "" "" StrMap.empty
case response of
(Request.Head _ _) -> pure unit
a -> Assertions.fail $ "expected a Head, got " <> show a
Spec.it "has the correct headers" do
response <- mock "HEAD" "" "" mockHeader
case response of
(Request.Head headers _) ->
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Head, got " <> show a
Spec.it "has the correct path" do
response <- mock "HEAD" "test" "" StrMap.empty
case response of
(Request.Head _ "test") -> pure unit
a -> Assertions.fail $ "expected the path 'test', got " <> show a
Spec.describe "with a CONNECT" do
Spec.it "is a Connect" do
response <- mock "CONNECT" "" "" StrMap.empty
case response of
(Request.Connect _ _ _) -> pure unit
a -> Assertions.fail $ "expected a Connect, got " <> show a
Spec.it "has the correct headers" do
response <- mock "CONNECT" "" "" mockHeader
case response of
(Request.Connect headers _ _) ->
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Connect, got " <> show a
Spec.it "has the correct path" do
response <- mock "CONNECT" "test" "" StrMap.empty
case response of
(Request.Connect _ "test" _) -> pure unit
a -> Assertions.fail $ "expected the path 'test', got " <> show a
Spec.it "has the correct body" do
response <- mock "CONNECT" "" "test" StrMap.empty
case response of
(Request.Connect _ _ "test") -> pure unit
a -> Assertions.fail $ "expected the body 'test', got " <> show a
Spec.describe "with a OPTIONS" do
Spec.it "is a Options" do
response <- mock "OPTIONS" "" "" StrMap.empty
case response of
(Request.Options _ _) -> pure unit
a -> Assertions.fail $ "expected a Options, got " <> show a
Spec.it "has the correct headers" do
response <- mock "OPTIONS" "" "" mockHeader
case response of
(Request.Options headers _) ->
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Options, got " <> show a
Spec.it "has the correct path" do
response <- mock "OPTIONS" "test" "" StrMap.empty
case response of
(Request.Options _ "test") -> pure unit
a -> Assertions.fail $ "expected the path 'test', got " <> show a
Spec.describe "with a TRACE" do
Spec.it "is a Trace" do
response <- mock "TRACE" "" "" StrMap.empty
case response of
(Request.Trace _ _) -> pure unit
a -> Assertions.fail $ "expected a Trace, got " <> show a
Spec.it "has the correct headers" do
response <- mock "TRACE" "" "" mockHeader
case response of
(Request.Trace headers _) ->
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Trace, got " <> show a
Spec.it "has the correct path" do
response <- mock "TRACE" "test" "" StrMap.empty
case response of
(Request.Trace _ "test") -> pure unit
a -> Assertions.fail $ "expected the path 'test', got " <> show a
Spec.describe "with a PATCH" do
Spec.it "is a Patch" do
response <- mock "PATCH" "" "" StrMap.empty
case response of
(Request.Patch _ _ _) -> pure unit
a -> Assertions.fail $ "expected a Patch, got " <> show a
Spec.it "has the correct headers" do
response <- mock "PATCH" "" "" mockHeader
case response of
(Request.Patch headers _ _) ->
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Patch, got " <> show a
Spec.it "has the correct path" do
response <- mock "PATCH" "test" "" StrMap.empty
case response of
(Request.Patch _ "test" _) -> pure unit
a -> Assertions.fail $ "expected the path 'test', got " <> show a
Spec.it "has the correct body" do
response <- mock "PATCH" "" "test" StrMap.empty
case response of
(Request.Patch _ _ "test") -> pure unit
a -> Assertions.fail $ "expected the body 'test', got " <> show a
Spec.describe "with a GET" do
Spec.it "is a Get" do
response <- mock "GET" "" "" StrMap.empty
@ -106,7 +220,7 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
response <- mock "GET" "" "" mockHeader
case response of
(Request.Get headers _) ->
Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
Headers.lookup headers "X-Test" ?= "test"
a -> Assertions.fail $ "expected a Get, got " <> show a
Spec.it "has the correct path" do
response <- mock "GET" "test" "" StrMap.empty

View File

@ -16,8 +16,11 @@ import Node.HTTP.Client as HTTPClient
import Node.Stream as Stream
import Test.Spec as Spec
import Test.Spec.Runner as Runner
import Test.Spec.Assertions as Assertions
import Unsafe.Coerce as Coerce
infix 1 Assertions.shouldEqual as ?=
-- | A type alias encapsulating all effect types used in making a mock request.
type HTTPRequestEffects e =
( st :: ST.ST String