From 078a6fbd76190c48cfa5c588bb9d2174baef5852 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 6 May 2011 15:21:30 -0400 Subject: Work around a bug in Network.URI's handling of bracketed ipv6 addresses. --- GitRepo.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) (limited to 'GitRepo.hs') 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 + - -} +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" -- cgit v1.2.3