From f38c5987ee554d43f38b822daec627e72cbdac29 Mon Sep 17 00:00:00 2001
From: Connor Prussin <connor@prussin.net>
Date: Fri, 29 Sep 2017 09:52:21 -0700
Subject: [PATCH] Add fullPath function for inspecting and logging full
 resolved request path (#81)

---
 docs/Examples/Middleware/Main.purs |  6 ++++--
 src/HTTPure.purs                   |  2 +-
 src/HTTPure/Request.purs           | 15 +++++++++++++++
 test/HTTPure/RequestSpec.purs      | 31 ++++++++++++++++++++++++++++++
 4 files changed, 51 insertions(+), 3 deletions(-)

diff --git a/docs/Examples/Middleware/Main.purs b/docs/Examples/Middleware/Main.purs
index 10d18d0..0b0a635 100644
--- a/docs/Examples/Middleware/Main.purs
+++ b/docs/Examples/Middleware/Main.purs
@@ -21,10 +21,12 @@ loggingMiddleware :: forall e.
                      HTTPure.Request ->
                      HTTPure.ResponseM (console :: Console.CONSOLE | e)
 loggingMiddleware router request = do
-  EffClass.liftEff $ Console.log $ "Request starting for " <> show request.path
+  EffClass.liftEff $ Console.log $ "Request starting for " <> path
   response <- router request
-  EffClass.liftEff $ Console.log $ "Request ending for " <> show request.path
+  EffClass.liftEff $ Console.log $ "Request ending for " <> path
   pure response
+  where
+    path = HTTPure.fullPath request
 
 -- | A middleware that adds the X-Middleware header to the response, if it
 -- | wasn't already in the response
diff --git a/src/HTTPure.purs b/src/HTTPure.purs
index 873a3f0..f8bccbf 100644
--- a/src/HTTPure.purs
+++ b/src/HTTPure.purs
@@ -12,7 +12,7 @@ import HTTPure.Headers (Headers, empty, header, headers)
 import HTTPure.Lookup (lookup, (!!))
 import HTTPure.Method (Method(..))
 import HTTPure.Path (Path)
-import HTTPure.Request (Request)
+import HTTPure.Request (Request, fullPath)
 import HTTPure.Response
   ( ResponseM
   , response, response'
diff --git a/src/HTTPure/Request.purs b/src/HTTPure/Request.purs
index 104f942..6a2ce93 100644
--- a/src/HTTPure/Request.purs
+++ b/src/HTTPure/Request.purs
@@ -1,11 +1,14 @@
 module HTTPure.Request
   ( Request
   , fromHTTPRequest
+  , fullPath
   ) where
 
 import Prelude
 
 import Control.Monad.Aff as Aff
+import Data.String as String
+import Data.StrMap as StrMap
 import Node.HTTP as HTTP
 
 import HTTPure.Body as Body
@@ -25,6 +28,18 @@ type Request =
   , body :: Body.Body
   }
 
+-- | Return the full resolved path, including query parameters. This may not
+-- | match the requested path--for instance, if there are empty path segments in
+-- | the request--but it is equivalent.
+fullPath :: Request -> String
+fullPath request = "/" <> path <> questionMark <> queryParams
+  where
+    path = String.joinWith "/" request.path
+    questionMark = if StrMap.isEmpty request.query then "" else "?"
+    queryParams = String.joinWith "&" queryParamsArr
+    queryParamsArr = StrMap.toArrayWithKey stringifyQueryParam request.query
+    stringifyQueryParam key value = key <> "=" <> value
+
 -- | Given an HTTP `Request` object, this method will convert it to an HTTPure
 -- | `Request` object.
 fromHTTPRequest :: forall e.
diff --git a/test/HTTPure/RequestSpec.purs b/test/HTTPure/RequestSpec.purs
index 8d620aa..0efb614 100644
--- a/test/HTTPure/RequestSpec.purs
+++ b/test/HTTPure/RequestSpec.purs
@@ -36,6 +36,37 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
       SpecHelpers.mockRequest "POST" "/test?a=b" "body" mockHeaders
     mockRequest = mockHTTPRequest >>= Request.fromHTTPRequest
 
+fullPathSpec :: SpecHelpers.Test
+fullPathSpec = Spec.describe "fullPath" do
+  Spec.describe "without query parameters" do
+    Spec.it "is correct" do
+      mock <- mockRequest "/foo/bar"
+      Request.fullPath mock ?= "/foo/bar"
+  Spec.describe "with empty path segments" do
+    Spec.it "strips the empty segments" do
+      mock <- mockRequest "//foo////bar/"
+      Request.fullPath mock ?= "/foo/bar"
+  Spec.describe "with only query parameters" do
+    Spec.it "is correct" do
+      mock <- mockRequest "?a=b&c=d"
+      Request.fullPath mock ?= "/?a=b&c=d"
+  Spec.describe "with only empty query parameters" do
+    Spec.it "is has the default value of 'true' for the empty parameters" do
+      mock <- mockRequest "?a"
+      Request.fullPath mock ?= "/?a=true"
+  Spec.describe "with empty query parameters" do
+    Spec.it "strips out the empty arameters" do
+      mock <- mockRequest "?a=b&&&"
+      Request.fullPath mock ?= "/?a=b"
+  Spec.describe "with a mix of segments and query parameters" do
+    Spec.it "is correct" do
+      mock <- mockRequest "/foo///bar/?&a=b&&c"
+      Request.fullPath mock ?= "/foo/bar?a=b&c=true"
+  where
+    mockHTTPRequest path = SpecHelpers.mockRequest "POST" path "body" []
+    mockRequest path = mockHTTPRequest path >>= Request.fromHTTPRequest
+
 requestSpec :: SpecHelpers.Test
 requestSpec = Spec.describe "Request" do
   fromHTTPRequestSpec
+  fullPathSpec