Create separate types for request and response headers

docs/Examples/BinaryResponse/Main.purs

@@ -3,13 +3,13 @@ module Examples.BinaryResponse.Main where
 import Prelude
 import Effect.Console (log)
 import Node.FS.Aff (readFile)
-import HTTPure (ServerM, Request, ResponseM, Headers, serve, ok', header)
+import HTTPure (ServerM, Request, ResponseM, ResponseHeaders, serve, ok', header)
 
 -- | The path to the file containing the response to send
 filePath :: String
 filePath = "./docs/Examples/BinaryResponse/circle.png"
 
-responseHeaders :: Headers
+responseHeaders :: ResponseHeaders
 responseHeaders = header "Content-Type" "image/png"
 
 -- | Respond with image data when run

docs/Examples/Headers/Main.purs

@@ -2,10 +2,10 @@ module Examples.Headers.Main where
 
 import Prelude
 import Effect.Console (log)
-import HTTPure (ServerM, Headers, Request, ResponseM, (!@), header, serve, ok')
+import HTTPure (ServerM, ResponseHeaders, Request, ResponseM, (!@), header, serve, ok')
 
 -- | The headers that will be included in every response.
-responseHeaders :: Headers
+responseHeaders :: ResponseHeaders
 responseHeaders = header "X-Example" "hello world!"
 
 -- | Route to the correct handler

src/HTTPure.purs

@@ -1,6 +1,7 @@
 module HTTPure
   ( module HTTPure.Body
-  , module HTTPure.Headers
+  , module HTTPure.RequestHeaders
+  , module HTTPure.ResponseHeaders
   , module HTTPure.Lookup
   , module HTTPure.Method
   , module HTTPure.Path
@@ -12,12 +13,13 @@ module HTTPure
   ) where
 
 import HTTPure.Body (toBuffer, toStream, toString)
-import HTTPure.Headers (Headers, empty, header, headers)
+import HTTPure.ResponseHeaders (ResponseHeaders, empty, header, headers)
 import HTTPure.Lookup (at, (!@), has, (!?), lookup, (!!))
 import HTTPure.Method (Method(..))
 import HTTPure.Path (Path)
 import HTTPure.Query (Query)
 import HTTPure.Request (Request, fullPath)
+import HTTPure.RequestHeaders (RequestHeaders, read)
 import HTTPure.Response
   ( Response
   , ResponseM

src/HTTPure/Body.purs

@@ -17,7 +17,7 @@ import Effect.Aff (Aff, makeAff, nonCanceler)
 import Effect.Class (liftEffect)
 import Effect.Ref (Ref)
 import Effect.Ref (read, modify, new, write) as Ref
-import HTTPure.Headers (Headers, header)
+import HTTPure.ResponseHeaders (ResponseHeaders, header)
 import Node.Buffer (Buffer, concat, fromString, size)
 import Node.Buffer (toString) as Buffer
 import Node.Encoding (Encoding(UTF8))
@@ -101,7 +101,7 @@ class Body b where
   -- | things like `Content-Type`, `Content-Length`, and `Transfer-Encoding`.
   -- | Note that any headers passed in a response helper such as `ok'` will take
   -- | precedence over these.
-  defaultHeaders :: b -> Effect Headers
+  defaultHeaders :: b -> Effect ResponseHeaders
   -- | Given a body value and a Node HTTP `Response` value, write the body value
   -- | to the Node response.
   write :: b -> Response -> Aff Unit

src/HTTPure/Request.purs

@@ -11,8 +11,8 @@ import Effect.Class (liftEffect)
 import Foreign.Object (isEmpty, toArrayWithKey)
 import HTTPure.Body (RequestBody)
 import HTTPure.Body (read) as Body
-import HTTPure.Headers (Headers)
-import HTTPure.Headers (read) as Headers
+import HTTPure.RequestHeaders (RequestHeaders)
+import HTTPure.RequestHeaders (read) as Headers
 import HTTPure.Method (Method)
 import HTTPure.Method (read) as Method
 import HTTPure.Path (Path)
@@ -31,7 +31,7 @@ type Request =
   { method :: Method
   , path :: Path
   , query :: Query
-  , headers :: Headers
+  , headers :: RequestHeaders
   , body :: RequestBody
   , httpVersion :: Version
   , url :: String

src/HTTPure/RequestHeaders.purs

@@ -0,0 +1,48 @@
+module HTTPure.RequestHeaders
+  ( RequestHeaders(..)
+  , empty
+  , read
+  ) where
+
+import Prelude
+
+import Data.FoldableWithIndex (foldMapWithIndex)
+import Data.Newtype (class Newtype)
+import Data.String as String
+import Foreign.Object (Object, union)
+import Foreign.Object as Object
+import HTTPure.Lookup (class Lookup, (!!))
+import Node.HTTP (Request, requestHeaders)
+
+-- | The `RequestHeaders` type is just sugar for a `Object` of `Strings`
+-- | that represents the set of headers in an HTTP request.
+newtype RequestHeaders = RequestHeaders (Object String)
+
+derive instance newtypeRequestHeaders :: Newtype RequestHeaders _
+
+-- | Given a string. return a `Maybe` containing the value of the matching
+-- | request header, if there is any.
+instance lookupRequestHeaders :: Lookup RequestHeaders String String where
+  lookup (RequestHeaders headers') key = headers' !! (String.toLower key)
+
+-- | Allow a `RequestHeaders` to be represented as a string. This string is
+-- | formatted in HTTP headers format.
+instance showRequestHeaders :: Show RequestHeaders where
+  show (RequestHeaders headers') = foldMapWithIndex showField headers' <> "\n"
+    where
+    showField key value = key <> ": " <> value <> "\n"
+
+-- | Compare two `RequestHeaders` objects by comparing the underlying `Objects`.
+instance eqRequestHeaders :: Eq RequestHeaders where
+  eq (RequestHeaders a) (RequestHeaders b) = eq a b
+
+-- | Allow one `RequestHeaders` objects to be appended to another.
+instance semigroupRequestHeaders :: Semigroup RequestHeaders where
+  append (RequestHeaders a) (RequestHeaders b) = RequestHeaders $ union b a
+
+-- | Get the request headers out of a HTTP `Request` object.
+read :: Request -> RequestHeaders
+read = requestHeaders >>> RequestHeaders
+
+empty :: RequestHeaders
+empty = RequestHeaders Object.empty