Work around a bug in Network.URI's handling of bracketed ipv6 addresses.

1 files changed, 15 insertions, 3 deletions

diff --git a/GitRepo.hs b/GitRepo.hs
index 9ecaa8ffc..49024abe0 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -280,9 +280,21 @@ urlScheme :: Repo -> String
 urlScheme Repo { location = Url u } = uriScheme u
 urlScheme repo = assertUrl repo $ error "internal"
 
+{- Work around a bug in the real uriRegName
+ - <http://trac.haskell.org/network/ticket/40> -}
+uriRegName' :: URIAuth -> String
+uriRegName' a = fixup $ uriRegName a
+	where
+		fixup x@('[':rest)
+			| rest !! len == ']' = take len rest
+			| otherwise = x
+			where
+				len  = (length rest) - 1
+		fixup x = x
+
 {- Hostname of an URL repo. -}
 urlHost :: Repo -> String
-urlHost = urlAuthPart uriRegName
+urlHost = urlAuthPart uriRegName'
 
 {- Port of an URL repo, if it has a nonstandard one. -}
 urlPort :: Repo -> Maybe Integer
@@ -294,11 +306,11 @@ urlPort r =
 
 {- Hostname of an URL repo, including any username (ie, "user@host") -}
 urlHostUser :: Repo -> String
-urlHostUser r = urlAuthPart uriUserInfo r ++ urlAuthPart uriRegName r
+urlHostUser r = urlAuthPart uriUserInfo r ++ urlAuthPart uriRegName' r
 
 {- The full authority portion an URL repo. (ie, "user@host:port") -}
 urlAuthority :: Repo -> String
-urlAuthority Repo { location = Url u } = uriUserInfo a ++ uriRegName a ++ uriPort a
+urlAuthority Repo { location = Url u } = uriUserInfo a ++ uriRegName' a ++ uriPort a
 	where
 		a = fromMaybe (error $ "bad url " ++ show u) (uriAuthority u)
 urlAuthority repo = assertUrl repo $ error "internal"