Add support for reading headers (#34)

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 $ " └──────────────────────────────────────────────┘"

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:
 

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)

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

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

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

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