Luke Plant avatar Luke Plant committed 228857a

Added 'requestUriRaw' accessor for Request

Comments (0)

Files changed (2)

src/Web/Request.hs

                    , Request
                    , RequestOptions(..)
                     -- ** Components of Request
-                   , requestMethod, pathInfo, environment
+                   , requestMethod
+                   , pathInfo
+                   , requestUriRaw
+                   , environment
                     -- ** Constructors for Request
                    , mkRequest, buildCGIRequest
                    )
 requestMethod :: Request -> String
 requestMethod request = fromJust $ Map.lookup "REQUEST_METHOD" $ environment request
 
--- | Returns the path info of the request, with leading forward slash removed.
+-- | Returns the path info of the request, with any leading forward slash removed,
+-- and percent encoded chars interpreted according to the encoding.
 pathInfo request = let pi = Map.lookup "PATH_INFO" $ environment request
                        -- Normalise to having no leading slash
                        adjusted = case pi of
                                     Nothing -> ""
                                     Just ('/':rest) -> rest
                                     Just path -> path
-                       -- PATH_INFO contains Haskell strings, but they
-                       -- may contain uninterpreted byte sequences
-                       -- instead of Unicode chars.  We re-pack as
-                       -- bytes (BS.pack discards anything > \255),
-                       -- and then re-interpret.
-                       bytes = BS.pack adjusted
-                   in (decoder $ requestEncoding request) bytes
+                   in repack adjusted (requestEncoding request)
+
+-- | Repacks bytes in a string according to an encoding
+--
+-- PATH_INFO and other vars contains Haskell strings, but they
+-- contain uninterpreted byte sequences instead of Unicode chars.  We
+-- re-pack as bytes (BS.pack discards anything > \255), and then
+-- re-interpret.
+repack str encoding = let bytes = BS.pack str
+                      in (decoder encoding) bytes
+
+-- | Returns the URI requested by the client, with percent encoding intact
+requestUriRaw :: Request -> Maybe String
+requestUriRaw request = Map.lookup "REQUEST_URI" $ environment request
 
 
 -- | Creates a Request object according to the CGI protocol

testsuite/tests/Tests/Web/Request.hs

 testPath = "foo/bar" ~=? pathInfo (mkRequest [("PATH_INFO", "/foo/bar")] "" utf8Encoding)
 testPathMissing = "" ~=? pathInfo (mkRequest [] "" utf8Encoding)
 testPathUtf8 = "\233" ~=? pathInfo (mkRequest [("PATH_INFO", "\195\169")] "" utf8Encoding)
+testRequestUriRaw = Just "/root/foo/%C3%A9/" ~=? requestUriRaw (mkRequest [("REQUEST_URI","/root/foo/%C3%A9/")
+                                                                          ,("PATH_INFO","/foo/\195\169/")] "" utf8Encoding)
 
 tests = test [
           testMethod
         , testPath
         , testPathMissing
         , testPathUtf8
+        , testRequestUriRaw
         ]
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.