Merge pull request haskell-github#404 from phadej/escape-paths

phadej · web-flow · commit 1eb7257055b6 · 2019-09-30T11:04:36.000+03:00
Escape URI paths
diff --git a/.gitignore b/.gitignore
@@ -1,3 +1,4 @@
+.env
 dist
 dist-newstyle
 .ghc.environment.*
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,5 +1,7 @@
 ## Changes for 0.23
 
+- Escape URI paths
+  [#404](https://github.com/phadej/github/pull/404)
 - Add OwnerBot to OwnerType
   [#399](https://github.com/phadej/github/pull/399)
 - Make File.fileSha optional
diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
@@ -67,7 +67,7 @@ import Control.Monad.Catch        (MonadCatch (..), MonadThrow)
 import Control.Monad.Trans.Class  (lift)
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
 import Data.Aeson                 (eitherDecode)
-import Data.List                  (find)
+import Data.List                  (find, intercalate)
 import Data.String                (fromString)
 import Data.Tagged                (Tagged (..))
 import Data.Version               (showVersion)
@@ -79,7 +79,9 @@ import Network.HTTP.Client
 import Network.HTTP.Link.Parser (parseLinkHeaderBS)
 import Network.HTTP.Link.Types  (Link (..), LinkParam (..), href, linkParams)
 import Network.HTTP.Types       (Method, RequestHeaders, Status (..))
-import Network.URI              (URI, parseURIReference, relativeTo)
+import Network.URI
+       (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference,
+       relativeTo)
 
 import qualified Data.ByteString              as BS
 import qualified Data.ByteString.Lazy         as LBS
@@ -409,11 +411,12 @@ makeHttpRequest auth r = case r of
             . setMethod (toMethod m)
             $ req
   where
-    parseUrl' :: MonadThrow m => Text -> m HTTP.Request
-    parseUrl' = HTTP.parseUrlThrow . T.unpack
+    parseUrl' :: MonadThrow m => String -> m HTTP.Request
+    parseUrl' = HTTP.parseUrlThrow
 
-    url :: Paths -> Text
-    url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths
+    url :: Paths -> String
+    url paths = maybe "https://api.github.com" T.unpack (endpoint =<< auth) ++ "/" ++ intercalate "/" paths' where
+        paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths
 
     setReqHeaders :: HTTP.Request -> HTTP.Request
     setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req }

Original file line number	Diff line number	Diff line change
`@@ -1,3 +1,4 @@`
	`1`	`+.env`
`1`	`2`	`dist`
`2`	`3`	`dist-newstyle`
`3`	`4`	`.ghc.environment.*`