diff --git a/Documentation/Examples/Headers/Main.purs b/Documentation/Examples/Headers/Main.purs index c2ba7f5..7ecf9cc 100644 --- a/Documentation/Examples/Headers/Main.purs +++ b/Documentation/Examples/Headers/Main.purs @@ -1,6 +1,6 @@ module Headers where -import Prelude (discard, pure, show, (<>), ($)) +import Prelude (discard, flip, pure, show, (<>), ($), (<<<)) import Control.Monad.Eff.Console as Console import Data.StrMap as StrMap @@ -14,16 +14,27 @@ port = 8082 portS :: String portS = show port --- | Say 'hello world!' when run -sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e -sayHello _ = pure $ HTTPure.OK (StrMap.singleton "X-Example" "hello world!") "" +-- | Read X-Input back to the body and set the X-Example header +sayHello :: HTTPure.Headers -> HTTPure.Response +sayHello = HTTPure.OK responseHeaders <<< flip HTTPure.lookup "X-Input" + where + responseHeaders = StrMap.singleton "X-Example" "hello world!" + +-- | Route to the correct handler +router :: forall e. HTTPure.Request -> HTTPure.ResponseM e +router (HTTPure.Get headers _) = pure $ sayHello headers +router _ = pure $ HTTPure.OK StrMap.empty "" -- | Boot up the server main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) -main = HTTPure.serve port sayHello do - Console.log $ " ┌──────────────────────────────────────────────────────────────┐" - Console.log $ " │ Server now up on port " <> portS <> " │" - Console.log $ " │ │" - Console.log $ " │ To test, run: │" - Console.log $ " │ > curl -v localhost:" <> portS <> " # => ... X-Example: hello world! │" - Console.log $ " └──────────────────────────────────────────────────────────────┘" +main = HTTPure.serve port router do + Console.log $ " ┌──────────────────────────────────────────────┐" + Console.log $ " │ Server now up on port " <> portS <> " │" + Console.log $ " │ │" + Console.log $ " │ To test, run: │" + Console.log $ " │ > curl -H 'X-Input: test' -v localhost:" <> portS <> " │" + Console.log $ " │ # => ... │" + Console.log $ " │ # => ...< X-Example: hello world! │" + Console.log $ " │ # => ... │" + Console.log $ " │ # => test │" + Console.log $ " └──────────────────────────────────────────────┘" diff --git a/Documentation/Examples/Headers/Readme.md b/Documentation/Examples/Headers/Readme.md index 129f25d..96762c8 100644 --- a/Documentation/Examples/Headers/Readme.md +++ b/Documentation/Examples/Headers/Readme.md @@ -1,7 +1,9 @@ # Headers Example -This is a basic example of working with headers. It will return the 'X-Example' -response header with the value 'hello world!'. +This is a basic example of working with headers. It will respond to an HTTP GET +on any url and will read the header 'X-Input' and return the contents in the +response body. It will also return the 'X-Example' response header with the +value 'hello world!'. To run the example server, run: diff --git a/Library/HTTPure.purs b/Library/HTTPure.purs index 692928e..8d74649 100644 --- a/Library/HTTPure.purs +++ b/Library/HTTPure.purs @@ -1,9 +1,11 @@ module HTTPure - ( module HTTPure.Request + ( module HTTPure.Headers + , module HTTPure.Request , module HTTPure.Response , module HTTPure.Server ) where +import HTTPure.Headers (Headers, lookup) import HTTPure.Request (Request(..)) import HTTPure.Response (ResponseM, Response(..)) import HTTPure.Server (ServerM, serve) diff --git a/Library/HTTPure/Headers.purs b/Library/HTTPure/Headers.purs index 5548f45..75529c9 100644 --- a/Library/HTTPure/Headers.purs +++ b/Library/HTTPure/Headers.purs @@ -1,11 +1,13 @@ module HTTPure.Headers ( Headers + , lookup , write ) where -import Prelude (Unit, bind, pure, unit, ($)) +import Prelude (Unit, bind, flip, pure, unit, ($), (<<<)) import Data.Maybe as Maybe +import Data.String as StringUtil import Data.StrMap as StrMap import Data.Traversable as Traversable import Node.HTTP as HTTP @@ -16,6 +18,11 @@ import HTTPure.HTTPureM as HTTPureM -- | set of headers sent or received in an HTTP request or response. type Headers = StrMap.StrMap String +-- | Return the value of the given header. +lookup :: Headers -> String -> String +lookup headers = + Maybe.fromMaybe "" <<< flip StrMap.lookup headers <<< StringUtil.toLower + -- | Write a set of headers to the given HTTP Response. write :: forall e. HTTP.Response -> Headers -> HTTPureM.HTTPureM e Unit write response headers = do diff --git a/Test/HTTPure/HeadersSpec.purs b/Test/HTTPure/HeadersSpec.purs index b335fd4..f04088d 100644 --- a/Test/HTTPure/HeadersSpec.purs +++ b/Test/HTTPure/HeadersSpec.purs @@ -11,6 +11,21 @@ import HTTPure.Headers as Headers import HTTPure.SpecHelpers as SpecHelpers +lookupSpec :: SpecHelpers.Test +lookupSpec = Spec.describe "lookup" do + Spec.describe "when the string is in the header set" do + Spec.describe "when searching with lowercase" do + Spec.it "is the string" do + Headers.lookup mockHeaders "x-test" `Assertions.shouldEqual` "test" + Spec.describe "when searching with uppercase" do + Spec.it "is the string" do + Headers.lookup mockHeaders "X-Test" `Assertions.shouldEqual` "test" + Spec.describe "when the string is not in the header set" do + Spec.it "is an empty string" do + Headers.lookup StrMap.empty "X-Test" `Assertions.shouldEqual` "" + where + mockHeaders = StrMap.singleton "x-test" "test" + writeSpec :: SpecHelpers.Test writeSpec = Spec.describe "write" do Spec.it "writes the headers to the response" do @@ -22,4 +37,5 @@ writeSpec = Spec.describe "write" do headersSpec :: SpecHelpers.Test headersSpec = Spec.describe "Headers" do + lookupSpec writeSpec diff --git a/Test/HTTPure/RequestSpec.purs b/Test/HTTPure/RequestSpec.purs index eef6ac0..78823f3 100644 --- a/Test/HTTPure/RequestSpec.purs +++ b/Test/HTTPure/RequestSpec.purs @@ -1,11 +1,12 @@ module HTTPure.RequestSpec where -import Prelude (discard, pure, show, unit, (<>), ($)) +import Prelude (discard, pure, show, unit, (<>), ($), (<<<)) import Data.StrMap as StrMap import Test.Spec as Spec import Test.Spec.Assertions as Assertions +import HTTPure.Headers as Headers import HTTPure.Request as Request import HTTPure.SpecHelpers as SpecHelpers @@ -32,49 +33,70 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do Spec.describe "with a POST" do Spec.it "is a Post" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "POST" "") of + case mock "POST" "" StrMap.empty of (Request.Post _ _ _) -> pure unit a -> Assertions.fail $ "expected a Post, got " <> show a - Spec.pending "has the correct headers" + Spec.it "has the correct headers" do + case mock "POST" "" mockHeader of + (Request.Post headers _ _) -> + Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test" + a -> Assertions.fail $ "expected a Post, got " <> show a Spec.it "has the correct path" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "POST" "test") of + case mock "POST" "test" StrMap.empty of (Request.Post _ "test" _) -> pure unit a -> Assertions.fail $ "expected the path 'test', got " <> show a Spec.pending "has the correct body" Spec.describe "with a PUT" do Spec.it "is a Put" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "PUT" "") of + case mock "PUT" "" StrMap.empty of (Request.Put _ _ _) -> pure unit a -> Assertions.fail $ "expected a Put, got " <> show a - Spec.pending "has the correct headers" + Spec.it "has the correct headers" do + case mock "PUT" "" mockHeader of + (Request.Put headers _ _) -> + Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test" + a -> Assertions.fail $ "expected a Put, got " <> show a Spec.it "has the correct path" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "PUT" "test") of + case mock "PUT" "test" StrMap.empty of (Request.Put _ "test" _) -> pure unit a -> Assertions.fail $ "expected the path 'test', got " <> show a Spec.pending "has the correct body" Spec.describe "with a DELETE" do Spec.it "is a Delete" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "DELETE" "") of + case mock "DELETE" "" StrMap.empty of (Request.Delete _ _) -> pure unit a -> Assertions.fail $ "expected a Delete, got " <> show a - Spec.pending "has the correct headers" + Spec.it "has the correct headers" do + case mock "DELETE" "" mockHeader of + (Request.Delete headers _) -> + Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test" + a -> Assertions.fail $ "expected a Delete, got " <> show a Spec.it "has the correct path" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "DELETE" "test") of + case mock "DELETE" "test" StrMap.empty of (Request.Delete _ "test") -> pure unit a -> Assertions.fail $ "expected the path 'test', got " <> show a Spec.describe "with a GET" do Spec.it "is a Get" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "GET" "") of + case mock "GET" "" StrMap.empty of (Request.Get _ _) -> pure unit a -> Assertions.fail $ "expected a Get, got " <> show a + Spec.it "has the correct headers" do + case mock "GET" "" mockHeader of + (Request.Get headers _) -> + Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test" + a -> Assertions.fail $ "expected a Get, got " <> show a Spec.it "has the correct path" do - case Request.fromHTTPRequest (SpecHelpers.mockRequest "GET" "test") of + case mock "GET" "test" StrMap.empty of (Request.Get _ "test") -> pure unit a -> Assertions.fail $ "expected the path 'test', got " <> show a - Spec.pending "has the correct headers" + + where + mock path body = + Request.fromHTTPRequest <<< SpecHelpers.mockRequest path body + mockHeader = StrMap.singleton "x-test" "test" requestSpec :: SpecHelpers.Test requestSpec = Spec.describe "Request" do diff --git a/Test/HTTPure/SpecHelpers.purs b/Test/HTTPure/SpecHelpers.purs index cec2e47..296d6b7 100644 --- a/Test/HTTPure/SpecHelpers.purs +++ b/Test/HTTPure/SpecHelpers.purs @@ -91,8 +91,13 @@ getHeader :: forall e s. getHeader url header = extractHeader header <$> getResponse url -- | Mock an HTTP Request object -mockRequest :: String -> String -> HTTP.Request -mockRequest method url = Coerce.unsafeCoerce { method: method, url: url } +mockRequest :: String -> String -> StrMap.StrMap String -> HTTP.Request +mockRequest method url headers = + Coerce.unsafeCoerce + { method: method + , url: url + , headers: headers + } -- | An effect encapsulating creating a mock response object foreign import data MOCK_RESPONSE :: Eff.Effect