Escape URI paths

phadej · phadej · commit 098031a3fd01 · 2019-09-30T10:29:08.000+03:00
Resolves haskell-github#398
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
@@ -413,7 +415,8 @@ makeHttpRequest auth r = case r of
     parseUrl' = HTTP.parseUrlThrow . T.unpack
 
     url :: Paths -> Text
-    url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths
+    url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.pack (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.*`