Use CaseInsensitiveString for Headers (#138)

* v0.8.1

* Add failing tests for `Headers`

There's currently a bug with `Headers`:
if a header is created with uppercase characters, it can never be found.
The problem is that we only look for lowercase characters in the
`Lookup` instance for `Headers`.

* Convert `Headers` to use `CaseInsensitiveString`

In an effort to be more true to HTTP,
we make the header keys case-insensitive.
This fixes the issue of looking up a header where the casing is different,
Since `CaseInsensitiveString`s compare in a way that ignore casing.

The API for consumers for `Headers` stays the same,
but we get more correct code.
A win for all!

bower.json

@@ -38,6 +38,7 @@
     "purescript-node-streams": "^4.0.0",
     "purescript-nullable": "^4.1.1",
     "purescript-options": "^4.0.0",
+    "purescript-ordered-collections": "^1.6.1",
     "purescript-prelude": "^4.0.1",
     "purescript-psci-support": "^4.0.0",
     "purescript-refs": "^4.1.0",

src/HTTPure/Headers.purs

@@ -11,8 +11,11 @@ import Prelude
 
 import Effect as Effect
 import Foreign.Object as Object
+import Data.Foldable as Foldable
+import Data.FoldableWithIndex as FoldableWithIndex
+import Data.Map as Map
 import Data.Newtype as Newtype
-import Data.String as String
+import Data.String.CaseInsensitive as CaseInsensitive
 import Data.TraversableWithIndex as TraversableWithIndex
 import Data.Tuple as Tuple
 import Node.HTTP as HTTP
@@ -22,21 +25,21 @@ import HTTPure.Lookup ((!!))
 
 -- | The `Headers` type is just sugar for a `Object` of `Strings`
 -- | that represents the set of headers in an HTTP request or response.
-newtype Headers = Headers (Object.Object String)
+newtype Headers = Headers (Map.Map CaseInsensitive.CaseInsensitiveString String)
 derive instance newtypeHeaders :: Newtype.Newtype Headers _
 
 -- | Given a string, return a `Maybe` containing the value of the matching
 -- | header, if there is any.
 instance lookup :: Lookup.Lookup Headers String String where
-  lookup (Headers headers') key = headers' !! String.toLower key
+  lookup (Headers headers') key = headers' !! key
 
 -- | Allow a `Headers` to be represented as a string. This string is formatted
 -- | in HTTP headers format.
 instance show :: Show Headers where
   show (Headers headers') =
-    Object.foldMap showField headers' <> "\n"
+    FoldableWithIndex.foldMapWithIndex showField headers' <> "\n"
     where
-      showField key value = key <> ": " <> value <> "\n"
+      showField key value = Newtype.unwrap key <> ": " <> value <> "\n"
 
 -- | Compare two `Headers` objects by comparing the underlying `Objects`.
 instance eq :: Eq Headers where
@@ -44,26 +47,35 @@ instance eq :: Eq Headers where
 
 -- | Allow one `Headers` objects to be appended to another.
 instance semigroup :: Semigroup Headers where
-  append (Headers a) (Headers b) = Headers $ Object.union b a
+  append (Headers a) (Headers b) = Headers $ Map.union b a
 
 -- | Get the headers out of a HTTP `Request` object.
 read :: HTTP.Request -> Headers
-read = HTTP.requestHeaders >>> Headers
+read = HTTP.requestHeaders >>> Object.fold insertField Map.empty >>> Headers
+  where
+    insertField x key value =
+      Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
 
 -- | Given an HTTP `Response` and a `Headers` object, return an effect that will
 -- | write the `Headers` to the `Response`.
 write :: HTTP.Response -> Headers -> Effect.Effect Unit
 write response (Headers headers') = void $
-  TraversableWithIndex.traverseWithIndex (HTTP.setHeader response) headers'
+  TraversableWithIndex.traverseWithIndex writeField headers'
+  where
+    writeField key value = HTTP.setHeader response (Newtype.unwrap key) value
 
 -- | Return a `Headers` containing nothing.
 empty :: Headers
-empty = Headers Object.empty
+empty = Headers Map.empty
 
 -- | Convert an `Array` of `Tuples` of 2 `Strings` to a `Headers` object.
 headers :: Array (Tuple.Tuple String String) -> Headers
-headers = Object.fromFoldable >>> Headers
+headers = Foldable.foldl insertField Map.empty >>> Headers
+  where
+    insertField x (Tuple.Tuple key value) =
+      Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
 
 -- | Create a singleton header from a key-value pair.
 header :: String -> String -> Headers
-header key = Object.singleton key >>> Headers
+header key =
+  Map.singleton (CaseInsensitive.CaseInsensitiveString key) >>> Headers

src/HTTPure/Lookup.purs

@@ -8,8 +8,10 @@ module HTTPure.Lookup
 import Prelude
 
 import Data.Array as Array
+import Data.Map as Map
 import Data.Maybe as Maybe
 import Data.Monoid as Monoid
+import Data.String.CaseInsensitive as CaseInsensitive
 import Foreign.Object as Object
 
 -- | Types that implement the `Lookup` class can be looked up by some key to
@@ -38,6 +40,14 @@ instance lookupArray :: Lookup (Array t) Int t where
 instance lookupObject :: Lookup (Object.Object t) String t where
   lookup = flip Object.lookup
 
+
+-- | The instance of `Lookup` for a `Map CaseInsensitiveString` converts the
+-- | `String` to a `CaseInsensitiveString` for lookup.
+instance lookupMapCaseInsensitiveString ::
+  Lookup (Map.Map CaseInsensitive.CaseInsensitiveString t) String t where
+
+  lookup set key = Map.lookup (CaseInsensitive.CaseInsensitiveString key) set
+
 -- | This simple helper works on any `Lookup` instance where the return type is
 -- | a `Monoid`, and is the same as `lookup` except that it returns a `t`
 -- | instead of a `Maybe t`. If `lookup` would return `Nothing`, then `at`

test/Test/HTTPure/HeadersSpec.purs

@@ -22,6 +22,13 @@ lookupSpec = Spec.describe "lookup" do
     Spec.describe "when searching with uppercase" do
       Spec.it "is Just the string" do
         Headers.header "x-test" "test" !! "X-Test" ?= Maybe.Just "test"
+    Spec.describe "when the string is uppercase" do
+      Spec.describe "when searching with lowercase" do
+        Spec.it "is Just the string" do
+          Headers.header "X-Test" "test" !! "x-test" ?= Maybe.Just "test"
+      Spec.describe "when searching with uppercase" do
+        Spec.it "is Just the string" do
+          Headers.header "X-Test" "test" !! "X-Test" ?= Maybe.Just "test"
   Spec.describe "when the string is not in the header set" do
     Spec.it "is Nothing" do
       ((Headers.empty !! "X-Test") :: Maybe.Maybe String) ?= Maybe.Nothing