network-uri 2.6.4.1 → 2.6.4.2
raw patch · 4 files changed
+108/−171 lines, 4 filesdep ~deepseq
Dependency ranges changed: deepseq
Files
- CHANGELOG.md +4/−0
- Network/URI.hs +30/−23
- network-uri.cabal +8/−2
- tests/uri001.hs +66/−146
CHANGELOG.md view
@@ -1,3 +1,7 @@+# network-uri-2.6.4.2 (2022-12-18)+* Fix warnings, `-Wtrustworthy-safe` and `-Woperator-whitespace-ext-conflict` on GHC 9.4.+* Slightly improved test coverage.+ # network-uri-2.6.4.1 (2021-02-07) * Fix: Restore "Safe" designation which was accidentally removed.
Network/URI.hs view
@@ -1,10 +1,13 @@-{-# LANGUAGE RecordWildCards, CPP #-}+#if __GLASGOW_HASKELL__ < 800+{-# LANGUAGE RecordWildCards #-}+#endif+{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift, StandaloneDeriving #-} #else {-# LANGUAGE TemplateHaskell #-} #endif-#if MIN_VERSION_template_haskell(2,12,0) && MIN_VERSION_parsec(3,13,0)+#if MIN_VERSION_template_haskell(2,12,0) && MIN_VERSION_parsec(3,1,13) {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -192,11 +195,11 @@ -- | Add a prefix to a string, unless it already has it. ensurePrefix :: String -> String -> String-ensurePrefix p s = if isPrefixOf p s then s else p ++ s+ensurePrefix p s = if p `isPrefixOf` s then s else p ++ s -- | Add a suffix to a string, unless it already has it. ensureSuffix :: String -> String -> String-ensureSuffix p s = if isSuffixOf p s then s else s ++ p+ensureSuffix p s = if p `isSuffixOf` s then s else s ++ p -- | Given a URIAuth in "nonstandard" form (lacking required separator characters), -- return one that is standard.@@ -371,17 +374,18 @@ parseAll parser filename uristr = parse newparser filename uristr where newparser =- do { res <- parser+ do { result <- parser ; eof- ; return res+ ; return result } + ------------------------------------------------------------ -- Predicates ------------------------------------------------------------ uriIsAbsolute :: URI -> Bool-uriIsAbsolute (URI {uriScheme = scheme'}) = scheme' /= ""+uriIsAbsolute URI{uriScheme = scheme'} = scheme' /= "" uriIsRelative :: URI -> Bool uriIsRelative = not . uriIsAbsolute@@ -411,7 +415,7 @@ isReserved c = isGenDelims c || isSubDelims c -- As per https://github.com/haskell/network-uri/pull/46, it was found--- that the explicit case statement was noticably faster than a nicer+-- that the explicit case statement was noticeably faster than a nicer -- expression in terms of `elem`. isGenDelims :: Char -> Bool isGenDelims c =@@ -426,7 +430,7 @@ _ -> False -- As per https://github.com/haskell/network-uri/pull/46, it was found--- that the explicit case statement was noticably faster than a nicer+-- that the explicit case statement was noticeably faster than a nicer -- expression in terms of `elem`. isSubDelims :: Char -> Bool isSubDelims c =@@ -486,7 +490,7 @@ } } -hierPart :: URIParser ((Maybe URIAuth),String)+hierPart :: URIParser (Maybe URIAuth, String) hierPart = do { _ <- try (string "//") ; ua <- uauthority@@ -543,7 +547,7 @@ ipLiteral :: URIParser String ipLiteral = do { _ <- char '['- ; ua <- ( ipv6addrz <|> ipvFuture )+ ; ua <- ipv6addrz <|> ipvFuture ; _ <- char ']' ; return $ "[" ++ ua ++ "]" }@@ -836,7 +840,7 @@ } } -relativePart :: URIParser ((Maybe URIAuth),String)+relativePart :: URIParser (Maybe URIAuth, String) relativePart = do { _ <- try (string "//") ; ua <- uauthority@@ -884,7 +888,7 @@ isAlphaChar c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') isDigitChar :: Char -> Bool-isDigitChar c = (c >= '0' && c <= '9')+isDigitChar c = c >= '0' && c <= '9' isAlphaNumChar :: Char -> Bool isAlphaNumChar c = isAlphaChar c || isDigitChar c@@ -893,7 +897,7 @@ isHexDigitChar c = isHexDigit c isSchemeChar :: Char -> Bool-isSchemeChar c = (isAlphaNumChar c) || (c `elem` "+-.")+isSchemeChar c = isAlphaNumChar c || (c `elem` "+-.") alphaChar :: URIParser Char alphaChar = satisfy isAlphaChar -- or: Parsec.letter ?@@ -948,17 +952,17 @@ , uriQuery=myquery , uriFragment=myfragment } =- (myscheme++) . (uriAuthToString userinfomap myauthority)+ (myscheme++) . uriAuthToString userinfomap myauthority . (mypath++) . (myquery++) . (myfragment++) -uriAuthToString :: (String->String) -> (Maybe URIAuth) -> ShowS+uriAuthToString :: (String->String) -> Maybe URIAuth -> ShowS uriAuthToString _ Nothing = id -- shows "" uriAuthToString userinfomap (Just URIAuth { uriUserInfo = myuinfo , uriRegName = myregname , uriPort = myport } ) =- ("//"++) . (if null myuinfo then id else ((userinfomap myuinfo)++))+ ("//"++) . (if null myuinfo then id else (userinfomap myuinfo ++)) . (myregname++) . (myport++) @@ -998,7 +1002,7 @@ | otherwise = concatMap (\i -> '%' : myShowHex i "") (utf8EncodeChar c) where myShowHex :: Int -> ShowS- myShowHex n r = case showIntAtBase 16 (toChrHex) n r of+ myShowHex n r = case showIntAtBase 16 toChrHex n r of [] -> "00" [x] -> ['0',x] cs -> cs@@ -1124,7 +1128,7 @@ | isDefined ( uriAuthority ref ) = just_segments ref { uriScheme = uriScheme base } | isDefined ( uriPath ref ) =- if (head (uriPath ref) == '/') then+ if head (uriPath ref) == '/' then just_segments ref { uriScheme = uriScheme base , uriAuthority = uriAuthority base@@ -1269,8 +1273,8 @@ relPathFrom pabs [] = pabs relPathFrom pabs base = if sa1 == sb1 -- If the first segments are equal- then if (sa1 == "/") -- and they're absolute,- then if (sa2 == sb2) -- then if the 2nd segs are equal,+ then if sa1 == "/" -- and they're absolute,+ then if sa2 == sb2 -- then if the 2nd segs are equal, then relPathFrom1 ra2 rb2 -- relativize from there. else pabs -- Otherwise it's not worth trying.@@ -1294,7 +1298,7 @@ relName = if null rp then -- If the relative path is empty, and the basenames are -- the same, then the paths must be exactly the same.- if (na == nb) then ""+ if na == nb then "" -- If the name is vulnerable to being misinterpreted, -- add a dot segment in advance to protect it. else if protect na then "./"++na@@ -1413,9 +1417,12 @@ scheme :: URI -> String scheme = orNull init . uriScheme +runShowS :: ShowS -> String+runShowS s = s ""+ {-# DEPRECATED authority "use uriAuthority, and note changed functionality" #-} authority :: URI -> String-authority = dropss . ($"") . uriAuthToString id . uriAuthority+authority = dropss . runShowS . uriAuthToString id . uriAuthority where -- Old-style authority component does not include leading '//' dropss ('/':'/':s) = s
network-uri.cabal view
@@ -1,5 +1,5 @@ name: network-uri-version: 2.6.4.1+version: 2.6.4.2 synopsis: URI manipulation description: This package provides facilities for parsing and unparsing URIs, and creating@@ -46,7 +46,8 @@ build-type: Simple cabal-version: >=1.10 tested-with:- GHC ==9.0.1+ GHC ==9.2.2 + || ==9.0.2 || ==8.10.1 || ==8.8.2 || ==8.6.5@@ -78,6 +79,11 @@ default-extensions: DeriveGeneric ghc-options: -Wall -fwarn-tabs default-language: Haskell98++ if impl(ghc >= 9.0)+ -- these flags may abort compilation with GHC-8.10+ -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295+ ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode test-suite uri hs-source-dirs: tests
tests/uri001.hs view
@@ -17,20 +17,12 @@ -- This Module contains test cases for module URI. -- -- To run this test without using Cabal to build the package--- (2013-01-05, instructions tested on MacOS):+-- (2013-01-05, instructions tested on macOS): -- 1. Install Haskell platform--- 2. cabal install test-framework--- 3. cabal install test-framework-hunit--- 4. ghc -XDeriveDataTypeable -D"MIN_VERSION_base(x,y,z)=1" ../Network/URI.hs uri001.hs+-- 2. cabal install tasty tasty-hunit tasty-quickcheck QuickCheck+-- 3. ghc -XDeriveDataTypeable -XDeriveGeneric -package QuickCheck -package tasty -package HUnit ../Network/URI.hs uri001.hs -- 5. ./uri001 ----- Previous build instructions:--- Using GHC, I compile with this command line:--- ghc --make -fglasgow-exts--- -i..\;C:\Dev\Haskell\Lib\HUnit;C:\Dev\Haskell\Lib\Parsec--- -o URITest.exe URITest -main-is URITest.main--- The -i line may need changing for alternative installations.--- -------------------------------------------------------------------------------- module Main where@@ -64,13 +56,6 @@ import qualified Test.Tasty.QuickCheck as TF import Test.QuickCheck ((==>), Property) --- Test supplied string for valid URI reference syntax--- isValidURIRef :: String -> Bool--- Test supplied string for valid absolute URI reference syntax--- isAbsoluteURIRef :: String -> Bool--- Test supplied string for valid absolute URI syntax--- isAbsoluteURI :: String -> Bool- data URIType = AbsId -- URI form (absolute, no fragment) | AbsRf -- Absolute URI reference | RelRf -- Relative URI reference@@ -102,7 +87,7 @@ , testEq ("test_isAbsoluteURI:"++u) (isAbsIdT t) (isAbsoluteURI u) ] -testURIRefComponents :: String -> (Maybe URI) -> String -> Assertion+testURIRefComponents :: String -> Maybe URI -> String -> Assertion testURIRefComponents _lab uv us = testEq ("testURIRefComponents:"++us) uv (parseURIReference us) @@ -241,19 +226,12 @@ testURIRef121 = testURIRef AbsId "http://[v9.123.abc;456.def]/" testURIRef122 = testEq "v.future authority" (Just (URIAuth "" "[v9.123.abc;456.def]" ":42"))- ((maybe Nothing uriAuthority) . parseURI $ "http://[v9.123.abc;456.def]:42/")--- URI with non-ASCII characters, fail with Network.HTTP escaping code (see below)--- Currently not supported by Network.URI, but captured here for possible future reference--- when IRI support may be added.+ (maybe Nothing uriAuthority . parseURI $ "http://[v9.123.abc;456.def]:42/")+-- URIs with non-ASCII characters (IRIs), are not supported by Network.URI, but+-- captured here for possible future reference when IRI support may be added. testURIRef123 = testURIRef AbsId "http://example.com/test123/䡥汬漬⁗潲汤/index.html" testURIRef124 = testURIRef AbsId "http://example.com/test124/Москва/index.html" --- From report by Alexander Ivanov:--- should return " 䡥汬漬⁗潲汤", but returns "Hello, World" instead--- print $ urlDecode $ urlEncode " 䡥汬漬⁗潲汤"--- should return "Москва"--- print $ urlDecode $ urlEncode "Москва"- testURIRefSuite = TF.testGroup "Test URIrefs" testURIRefList testURIRefList = [ TF.testCase "testURIRef001" testURIRef001@@ -396,15 +374,7 @@ } ) "http://user:pass@example.org:99/aaa/bbb?qqq#fff" testComponent02 = testURIRefComponents "testComponent02"- ( const Nothing- ( Just $ URI- { uriScheme = "http:"- , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")- , uriPath = "aaa/bbb"- , uriQuery = ""- , uriFragment = ""- } )- )+ Nothing "http://user:pass@example.org:99aaa/bbb" testComponent03 = testURIRefComponents "testComponent03" ( Just $ URI@@ -415,7 +385,7 @@ , uriFragment = "" } ) "http://user:pass@example.org:99?aaa/bbb"-testComponent04 = testURIRefComponents "testComponent03"+testComponent04 = testURIRefComponents "testComponent04" ( Just $ URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")@@ -424,8 +394,35 @@ , uriFragment = "#aaa/bbb" } ) "http://user:pass@example.org:99#aaa/bbb"+testComponent05 = testURIRefComponents "testComponent05"+ ( Just $ URI+ { uriScheme = "news:"+ , uriAuthority = Nothing+ , uriPath = "comp.infosystems.www.servers.unix"+ , uriQuery = ""+ , uriFragment = ""+ } )+ "news:comp.infosystems.www.servers.unix"+testComponent06 = testURIRefComponents "testComponent06"+ ( Just $ URI+ { uriScheme = "mailto:"+ , uriAuthority = Nothing+ , uriPath = "John.Doe@example.com"+ , uriQuery = ""+ , uriFragment = ""+ } )+ "mailto:John.Doe@example.com"+testComponent07 = testURIRefComponents "testComponent07"+ ( Just $ URI+ { uriScheme = "tel:"+ , uriAuthority = Nothing+ , uriPath = "+1-816-555-1212"+ , uriQuery = ""+ , uriFragment = ""+ } )+ "tel:+1-816-555-1212" -- These test cases contributed by Robert Buck (mathworks.com)-testComponent11 = testURIRefComponents "testComponent03"+testComponent11 = testURIRefComponents "testComponent11" ( Just $ URI { uriScheme = "about:" , uriAuthority = Nothing@@ -434,7 +431,7 @@ , uriFragment = "" } ) "about:"-testComponent12 = testURIRefComponents "testComponent03"+testComponent12 = testURIRefComponents "testComponent12" ( Just $ URI { uriScheme = "file:" , uriAuthority = Just (URIAuth "" "windowsauth" "")@@ -444,11 +441,14 @@ } ) "file://windowsauth/d$" -testComponentSuite = TF.testGroup "Test URIrefs" $+testComponentSuite = TF.testGroup "Test URIrefs" [ TF.testCase "testComponent01" testComponent01 , TF.testCase "testComponent02" testComponent02 , TF.testCase "testComponent03" testComponent03 , TF.testCase "testComponent04" testComponent04+ , TF.testCase "testComponent05" testComponent05+ , TF.testCase "testComponent06" testComponent06+ , TF.testCase "testComponent07" testComponent07 , TF.testCase "testComponent11" testComponent11 , TF.testCase "testComponent12" testComponent12 ]@@ -488,8 +488,8 @@ testRelative :: String -> String -> String -> String -> Assertion testRelative label base uabs urel = sequence_ [- (testRelSplit (label++"(rel)") base uabs urel),- (testRelJoin (label++"(abs)") base urel uabs)+ testRelSplit (label++"(rel)") base uabs urel,+ testRelJoin (label++"(abs)") base urel uabs ] testRelative01 = testRelative "testRelative01"@@ -627,7 +627,7 @@ "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc" -- Apparently, TimBL prefers the following way to 41, 42 above -- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html--- He also notes that there may be different relative fuctions+-- He also notes that there may be different relative functions -- that satisfy the basic equivalence axiom: -- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html testRelative56 = testRelative "testRelative56"@@ -674,9 +674,9 @@ "foo:bar" "http://example/a/b#c/../d" "http://example/a/b#c/../d" {- These (78-81) are some awkward test cases thrown up by a question on the URI list: http://lists.w3.org/Archives/Public/uri/2005Jul/0013- Mote that RFC 3986 discards path segents after the final '/' only when merging two- paths - otherwise the final segment in the base URI is mnaintained. This leads to- difficulty in constructinmg a reversible relativeTo/relativeFrom pair of functions.+ Note that RFC 3986 discards path segments after the final '/' only when merging two+ paths - otherwise the final segment in the base URI is maintained. This leads to+ difficulty in constructing a reversible relativeTo/relativeFrom pair of functions. -} testRelative78 = testRelative "testRelative78" "http://www.example.com/data/limit/.." "http://www.example.com/data/limit/test.xml"@@ -1074,7 +1074,7 @@ testShowURI01 = testEq "testShowURI01" "" (show nullURI) testShowURI02 = testEq "testShowURI02" ts02str (show ts02URI)-testShowURI03 = testEq "testShowURI03" ts03str ((uriToString id ts02URI) "")+testShowURI03 = testEq "testShowURI03" ts03str (uriToString id ts02URI "") testShowURI04 = testEq "testShowURI04" ts04str (show ts04URI) testShowURI = TF.testGroup "testShowURI"@@ -1111,11 +1111,20 @@ "hello%C3%B8%C2%A9%E6%97%A5%E6%9C%AC" (escapeURIString isUnescapedInURIComponent "helloø©日本") +-- From report by Alexander Ivanov:+-- should return " 䡥汬漬⁗潲汤", but returns "Hello, World" instead+-- print $ urlDecode $ urlEncode " 䡥汬漬⁗潲汤"+assertUnescapeEscapeInverse lab x = testEq lab x (unEscapeString $ escapeURIString isUnescapedInURIComponent x)+testUnescapeEscape01 = assertUnescapeEscapeInverse "testUnescapeEscape01" " 䡥汬漬⁗潲汤"+-- should return "Москва"+-- print $ urlDecode $ urlEncode "Москва"+testUnescapeEscape02 = assertUnescapeEscapeInverse "testUnescapeEscape02" "Москва"+ validUnicodePoint :: Char -> Bool validUnicodePoint c = case ord c of- c | c >= 0xFDD0 && c <= 0xFDEF -> False- c | c .&. 0xFFFE == 0xFFFE -> False+ a | a >= 0xFDD0 && a <= 0xFDEF -> False+ a | a .&. 0xFFFE == 0xFFFE -> False _ -> True propEscapeUnEscapeLoop :: String -> Property@@ -1129,7 +1138,7 @@ -- Test some Unicode chars high in the Basic Multilingual Plane. propEscapeUnEscapeLoopHiChars :: Char -> Property propEscapeUnEscapeLoopHiChars c' =- let c = chr $ (ord c') .|. 0xff00 in+ let c = chr $ ord c' .|. 0xff00 in validUnicodePoint c ==> [c] == (unEscapeString $! escaped c) where@@ -1143,6 +1152,8 @@ , TF.testCase "testEscapeURIString04" testEscapeURIString04 , TF.testCase "testEscapeURIString05" testEscapeURIString05 , TF.testCase "testEscapeURIString06" testEscapeURIString06+ , TF.testCase "testUnescapeEscape01" testUnescapeEscape01+ , TF.testCase "testUnescapeEscape02" testUnescapeEscape02 , TF.testProperty "propEscapeUnEscapeLoop" propEscapeUnEscapeLoop , TF.testProperty "propEscapeUnEscapeLoopHiChars" propEscapeUnEscapeLoopHiChars ]@@ -1199,17 +1210,17 @@ testRelativeTo01 = testEq "testRelativeTo01" "http://bar.org/foo" (show $- (fromJust $ parseURIReference "foo") `relativeTo` trbase)+ fromJust (parseURIReference "foo") `relativeTo` trbase) testRelativeTo02 = testEq "testRelativeTo02" "http:foo" (show $- (fromJust $ parseURIReference "http:foo") `relativeTo` trbase)+ fromJust (parseURIReference "http:foo") `relativeTo` trbase) testRelativeTo03 = testEq "testRelativeTo03" "http://bar.org/foo" (show $- (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase)+ fromJust (parseURIReference "http:foo") `nonStrictRelativeTo` trbase) testRelativeTo = TF.testGroup "testRelativeTo" [ TF.testCase "testRelativeTo01" testRelativeTo01@@ -1433,94 +1444,3 @@ -------------------------------------------------------------------------------- -- $Source: /srv/cvs/cvs.haskell.org/fptools/libraries/network/tests/URITest.hs,v $ -- $Author: gklyne $--- $Revision: 1.8 $--- $Log: URITest.hs,v $--- Revision 1.81 2012/08/01 aaronfriel--- Added additional test case for the "xip.io" service style URLs and absolute URLs prefixed with ipv4 addresses.------ Revision 1.8 2005/07/19 22:01:27 gklyne--- Added some additional test cases raised by discussion on URI@w3.org mailing list about 2005-07-19. The test p[roposed by this discussion exposed a subtle bug in relativeFrom not being an exact inverse of relativeTo.------ Revision 1.7 2005/06/06 16:31:44 gklyne--- Added two new test cases.------ Revision 1.6 2005/05/31 17:18:36 gklyne--- Added some additional test cases triggered by URI-list discussions.------ Revision 1.5 2005/04/07 11:09:37 gklyne--- Added test cases for alternate parsing functions (including deprecated 'parseabsoluteURI')------ Revision 1.4 2005/04/05 12:47:32 gklyne--- Added test case.--- Changed module name, now requires GHC -main-is to compile.--- All tests run OK with GHC 6.4 on MS-Windows.------ Revision 1.3 2004/11/05 17:29:09 gklyne--- Changed password-obscuring logic to reflect late change in revised URI--- specification (password "anonymous" is no longer a special case).--- Updated URI test module to use function 'escapeURIString'.--- (Should unEscapeString be similarly updated?)------ Revision 1.2 2004/10/27 13:06:55 gklyne--- Updated URI module function names per:--- http://www.haskell.org//pipermail/cvs-libraries/2004-October/002916.html--- Added test cases to give better covereage of module functions.------ Revision 1.1 2004/10/14 16:11:30 gklyne--- Add URI unit test to cvs.haskell.org repository------ Revision 1.17 2004/10/14 11:51:09 graham--- Confirm that URITest runs with GHC.--- Fix up some comments and other minor details.------ Revision 1.16 2004/10/14 11:45:30 graham--- Use moduke name main for GHC 6.2------ Revision 1.15 2004/08/11 11:07:39 graham--- Add new test case.------ Revision 1.14 2004/06/30 11:35:27 graham--- Update URI code to use hierarchical libraries for Parsec and Network.------ Revision 1.13 2004/06/22 16:19:16 graham--- New URI test case added.------ Revision 1.12 2004/04/21 15:13:29 graham--- Add test case------ Revision 1.11 2004/04/21 14:54:05 graham--- Fix up some tests------ Revision 1.10 2004/04/20 14:54:13 graham--- Fix up test cases related to port number in authority,--- and add some more URI decomposition tests.------ Revision 1.9 2004/04/07 15:06:17 graham--- Add extra test case--- Revise syntax in line with changes to RFC2396bis------ Revision 1.8 2004/03/17 14:34:58 graham--- Add Network.HTTP files to CVS------ Revision 1.7 2004/03/16 14:19:38 graham--- Change licence to BSD style; add nullURI definition; new test cases.------ Revision 1.6 2004/02/20 12:12:00 graham--- Add URI normalization functions------ Revision 1.5 2004/02/19 23:19:35 graham--- Network.URI module passes all test cases------ Revision 1.4 2004/02/17 20:06:02 graham--- Revised URI parser to reflect latest RFC2396bis (-04)------ Revision 1.3 2004/02/11 14:32:14 graham--- Added work-in-progress notes.------ Revision 1.2 2004/02/02 14:00:39 graham--- Fix optional host name in URI. Add test cases.------ Revision 1.1 2004/01/27 21:13:45 graham--- New URI module and test suite added,--- implementing the GHC Network.URI interface.---