1{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2--------------------------------------------------------------------------------
3--  $Id: URITest.hs,v 1.8 2005/07/19 22:01:27 gklyne Exp $
4--
5--  Copyright (c) 2004, G. KLYNE.  All rights reserved.
6--  See end of this file for licence information.
7--------------------------------------------------------------------------------
8-- |
9--  Module      :  URITest
10--  Copyright   :  (c) 2004, Graham Klyne
11--  License     :  BSD-style (see end of this file)
12--
13--  Maintainer  :  Graham Klyne
14--  Stability   :  provisional
15--  Portability :  H98
16--
17--  This Module contains test cases for module URI.
18--
19--  To run this test without using Cabal to build the package
20--  (2013-01-05, instructions tested on MacOS):
21--  1. Install Haskell platform
22--  2. cabal install test-framework
23--  3. cabal install test-framework-hunit
24--  4. ghc -XDeriveDataTypeable -D"MIN_VERSION_base(x,y,z)=1" ../Network/URI.hs uri001.hs
25--  5. ./uri001
26--
27--  Previous build instructions:
28--  Using GHC, I compile with this command line:
29--  ghc --make -fglasgow-exts
30--      -i..\;C:\Dev\Haskell\Lib\HUnit;C:\Dev\Haskell\Lib\Parsec
31--      -o URITest.exe URITest -main-is URITest.main
32--  The -i line may need changing for alternative installations.
33--
34--------------------------------------------------------------------------------
35
36module Main where
37
38import Network.URI
39    ( URI(..), URIAuth(..)
40    , nullURI
41    , rectify, rectifyAuth
42    , parseURI, parseURIReference, parseRelativeReference, parseAbsoluteURI
43    , parseAbsoluteURI
44    , isURI, isURIReference, isRelativeReference, isAbsoluteURI
45    , uriIsAbsolute, uriIsRelative
46    , relativeTo, nonStrictRelativeTo
47    , relativeFrom
48    , uriToString, uriAuthToString
49    , isUnescapedInURIComponent
50    , isUnescapedInURI, escapeURIString, unEscapeString
51    , normalizeCase, normalizeEscape, normalizePathSegments
52    , pathSegments
53    )
54
55import Test.HUnit
56
57import Data.Maybe (fromJust)
58import Data.List (intercalate)
59import System.IO (openFile, IOMode(WriteMode), hClose)
60import qualified Test.Framework as TF
61import qualified Test.Framework.Providers.HUnit as TF
62import qualified Test.Framework.Providers.QuickCheck2 as TF
63
64-- Test supplied string for valid URI reference syntax
65--   isValidURIRef :: String -> Bool
66-- Test supplied string for valid absolute URI reference syntax
67--   isAbsoluteURIRef :: String -> Bool
68-- Test supplied string for valid absolute URI syntax
69--   isAbsoluteURI :: String -> Bool
70
71data URIType = AbsId    -- URI form (absolute, no fragment)
72             | AbsRf    -- Absolute URI reference
73             | RelRf    -- Relative URI reference
74             | InvRf    -- Invalid URI reference
75isValidT :: URIType -> Bool
76isValidT InvRf = False
77isValidT _     = True
78
79isAbsRfT :: URIType -> Bool
80isAbsRfT AbsId = True
81isAbsRfT AbsRf = True
82isAbsRfT _     = False
83
84isRelRfT :: URIType -> Bool
85isRelRfT RelRf = True
86isRelRfT _     = False
87
88isAbsIdT :: URIType -> Bool
89isAbsIdT AbsId = True
90isAbsIdT _     = False
91
92testEq :: (Eq a, Show a) => String -> a -> a -> Assertion
93testEq lab a1 a2 = assertEqual lab a1 a2
94
95testURIRef :: URIType -> String -> Assertion
96testURIRef t u = sequence_
97  [ testEq ("test_isURIReference:"++u) (isValidT t) (isURIReference u)
98  , testEq ("test_isRelativeReference:"++u)  (isRelRfT t) (isRelativeReference  u)
99  , testEq ("test_isAbsoluteURI:"++u)  (isAbsIdT t) (isAbsoluteURI  u)
100  ]
101
102testURIRefComponents :: String -> (Maybe URI) -> String -> Assertion
103testURIRefComponents _lab uv us =
104    testEq ("testURIRefComponents:"++us) uv (parseURIReference us)
105
106
107testURIRef001 = testURIRef AbsRf "http://example.org/aaa/bbb#ccc"
108testURIRef002 = testURIRef AbsId "mailto:local@domain.org"
109testURIRef003 = testURIRef AbsRf "mailto:local@domain.org#frag"
110testURIRef004 = testURIRef AbsRf "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
111testURIRef005 = testURIRef RelRf "//example.org/aaa/bbb#ccc"
112testURIRef006 = testURIRef RelRf "/aaa/bbb#ccc"
113testURIRef007 = testURIRef RelRf "bbb#ccc"
114testURIRef008 = testURIRef RelRf "#ccc"
115testURIRef009 = testURIRef RelRf "#"
116testURIRef010 = testURIRef RelRf "/"
117-- escapes
118testURIRef011 = testURIRef AbsRf "http://example.org/aaa%2fbbb#ccc"
119testURIRef012 = testURIRef AbsRf "http://example.org/aaa%2Fbbb#ccc"
120testURIRef013 = testURIRef RelRf "%2F"
121testURIRef014 = testURIRef RelRf "aaa%2Fbbb"
122-- ports
123testURIRef015 = testURIRef AbsRf "http://example.org:80/aaa/bbb#ccc"
124testURIRef016 = testURIRef AbsRf "http://example.org:/aaa/bbb#ccc"
125testURIRef017 = testURIRef AbsRf "http://example.org./aaa/bbb#ccc"
126testURIRef018 = testURIRef AbsRf "http://example.123./aaa/bbb#ccc"
127-- bare authority
128testURIRef019 = testURIRef AbsId "http://example.org"
129-- IPv6 literals (from RFC2732):
130testURIRef021 = testURIRef AbsId "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html"
131testURIRef022 = testURIRef AbsId "http://[1080:0:0:0:8:800:200C:417A]/index.html"
132testURIRef023 = testURIRef AbsId "http://[3ffe:2a00:100:7031::1]"
133testURIRef024 = testURIRef AbsId "http://[1080::8:800:200C:417A]/foo"
134testURIRef025 = testURIRef AbsId "http://[::192.9.5.5]/ipng"
135testURIRef026 = testURIRef AbsId "http://[::FFFF:129.144.52.38]:80/index.html"
136testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]"
137testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]"
138testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]"
139testURIRef030 = testURIRef AbsId "http://[fe80::ff:fe00:1%25eth0]"
140-- RFC2396 test cases
141testURIRef031 = testURIRef RelRf "./aaa"
142testURIRef032 = testURIRef RelRf "../aaa"
143testURIRef033 = testURIRef AbsId "g:h"
144testURIRef034 = testURIRef RelRf "g"
145testURIRef035 = testURIRef RelRf "./g"
146testURIRef036 = testURIRef RelRf "g/"
147testURIRef037 = testURIRef RelRf "/g"
148testURIRef038 = testURIRef RelRf "//g"
149testURIRef039 = testURIRef RelRf "?y"
150testURIRef040 = testURIRef RelRf "g?y"
151testURIRef041 = testURIRef RelRf "#s"
152testURIRef042 = testURIRef RelRf "g#s"
153testURIRef043 = testURIRef RelRf "g?y#s"
154testURIRef044 = testURIRef RelRf ";x"
155testURIRef045 = testURIRef RelRf "g;x"
156testURIRef046 = testURIRef RelRf "g;x?y#s"
157testURIRef047 = testURIRef RelRf "."
158testURIRef048 = testURIRef RelRf "./"
159testURIRef049 = testURIRef RelRf ".."
160testURIRef050 = testURIRef RelRf "../"
161testURIRef051 = testURIRef RelRf "../g"
162testURIRef052 = testURIRef RelRf "../.."
163testURIRef053 = testURIRef RelRf "../../"
164testURIRef054 = testURIRef RelRf "../../g"
165testURIRef055 = testURIRef RelRf "../../../g"
166testURIRef056 = testURIRef RelRf "../../../../g"
167testURIRef057 = testURIRef RelRf "/./g"
168testURIRef058 = testURIRef RelRf "/../g"
169testURIRef059 = testURIRef RelRf "g."
170testURIRef060 = testURIRef RelRf ".g"
171testURIRef061 = testURIRef RelRf "g.."
172testURIRef062 = testURIRef RelRf "..g"
173testURIRef063 = testURIRef RelRf "./../g"
174testURIRef064 = testURIRef RelRf "./g/."
175testURIRef065 = testURIRef RelRf "g/./h"
176testURIRef066 = testURIRef RelRf "g/../h"
177testURIRef067 = testURIRef RelRf "g;x=1/./y"
178testURIRef068 = testURIRef RelRf "g;x=1/../y"
179testURIRef069 = testURIRef RelRf "g?y/./x"
180testURIRef070 = testURIRef RelRf "g?y/../x"
181testURIRef071 = testURIRef RelRf "g#s/./x"
182testURIRef072 = testURIRef RelRf "g#s/../x"
183testURIRef073 = testURIRef RelRf ""
184testURIRef074 = testURIRef RelRf "A'C"
185testURIRef075 = testURIRef RelRf "A$C"
186testURIRef076 = testURIRef RelRf "A@C"
187testURIRef077 = testURIRef RelRf "A,C"
188-- Invalid
189testURIRef080 = testURIRef InvRf "http://foo.org:80Path/More"
190testURIRef081 = testURIRef InvRf "::"
191testURIRef082 = testURIRef InvRf " "
192testURIRef083 = testURIRef InvRf "%"
193testURIRef084 = testURIRef InvRf "A%Z"
194testURIRef085 = testURIRef InvRf "%ZZ"
195testURIRef086 = testURIRef InvRf "%AZ"
196testURIRef087 = testURIRef InvRf "A C"
197-- testURIRef088 = -- (case removed)
198-- testURIRef089 = -- (case removed)
199testURIRef090 = testURIRef InvRf "A\"C"
200testURIRef091 = testURIRef InvRf "A`C"
201testURIRef092 = testURIRef InvRf "A<C"
202testURIRef093 = testURIRef InvRf "A>C"
203testURIRef094 = testURIRef InvRf "A^C"
204testURIRef095 = testURIRef InvRf "A\\C"
205testURIRef096 = testURIRef InvRf "A{C"
206testURIRef097 = testURIRef InvRf "A|C"
207testURIRef098 = testURIRef InvRf "A}C"
208-- From RFC2396:
209-- rel_segment   = 1*( unreserved | escaped |
210--                     ";" | "@" | "&" | "=" | "+" | "$" | "," )
211-- unreserved    = alphanum | mark
212-- mark          = "-" | "_" | "." | "!" | "~" | "*" | "'" |
213--                 "(" | ")"
214-- Note RFC 2732 allows '[', ']' ONLY for reserved purpose of IPv6 literals,
215-- or does it?
216testURIRef101 = testURIRef InvRf "A[C"
217testURIRef102 = testURIRef InvRf "A]C"
218testURIRef103 = testURIRef InvRf "A[**]C"
219testURIRef104 = testURIRef InvRf "http://[xyz]/"
220testURIRef105 = testURIRef InvRf "http://]/"
221testURIRef106 = testURIRef InvRf "http://example.org/[2010:836B:4179::836B:4179]"
222testURIRef107 = testURIRef InvRf "http://example.org/abc#[2010:836B:4179::836B:4179]"
223testURIRef108 = testURIRef InvRf "http://example.org/xxx/[qwerty]#a[b]"
224-- Random other things that crop up
225testURIRef111 = testURIRef AbsRf "http://example/Andr&#567;"
226testURIRef112 = testURIRef AbsId "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/"
227testURIRef113 = testURIRef AbsId "http://46229EFFE16A9BD60B9F1BE88B2DB047ADDED785/demo.mp3"
228testURIRef114 = testURIRef InvRf "http://example.org/xxx/qwerty#a#b"
229testURIRef115 = testURIRef InvRf "dcp.tcp.pft://192.168.0.1:1002:3002?fec=1&crc=0"
230testURIRef116 = testURIRef AbsId "dcp.tcp.pft://192.168.0.1:1002?fec=1&crc=0"
231testURIRef117 = testURIRef AbsId "foo://"
232-- URIs prefixed with IPv4 addresses
233testURIRef118 = testURIRef AbsId "http://192.168.0.1.example.com/"
234testURIRef119 = testURIRef AbsId "http://192.168.0.1.example.com./"
235-- URI prefixed with 3 octets of an IPv4 address and a subdomain part with a leading digit.
236testURIRef120 = testURIRef AbsId "http://192.168.0.1test.example.com/"
237-- URI with IPv(future) address
238testURIRef121 = testURIRef AbsId "http://[v9.123.abc;456.def]/"
239testURIRef122 = testEq "v.future authority"
240                       (Just (URIAuth "" "[v9.123.abc;456.def]" ":42"))
241                       ((maybe Nothing uriAuthority) . parseURI $ "http://[v9.123.abc;456.def]:42/")
242-- URI with non-ASCII characters, fail with Network.HTTP escaping code (see below)
243-- Currently not supported by Network.URI, but captured here for possible future reference
244-- when IRI support may be added.
245testURIRef123 = testURIRef AbsId "http://example.com/test123/䡥汬漬⁗潲汤/index.html"
246testURIRef124 = testURIRef AbsId "http://example.com/test124/Москва/index.html"
247
248-- From report by Alexander Ivanov:
249-- should return " 䡥汬漬⁗潲汤", but returns "Hello, World" instead
250-- print $ urlDecode $ urlEncode " 䡥汬漬⁗潲汤"
251-- should return "Москва"
252-- print $ urlDecode $ urlEncode "Москва"
253
254testURIRefSuite = TF.testGroup "Test URIrefs" testURIRefList
255testURIRefList =
256  [ TF.testCase "testURIRef001" testURIRef001
257  , TF.testCase "testURIRef002" testURIRef002
258  , TF.testCase "testURIRef003" testURIRef003
259  , TF.testCase "testURIRef004" testURIRef004
260  , TF.testCase "testURIRef005" testURIRef005
261  , TF.testCase "testURIRef006" testURIRef006
262  , TF.testCase "testURIRef007" testURIRef007
263  , TF.testCase "testURIRef008" testURIRef008
264  , TF.testCase "testURIRef009" testURIRef009
265  , TF.testCase "testURIRef010" testURIRef010
266    --
267  , TF.testCase "testURIRef011" testURIRef011
268  , TF.testCase "testURIRef012" testURIRef012
269  , TF.testCase "testURIRef013" testURIRef013
270  , TF.testCase "testURIRef014" testURIRef014
271  , TF.testCase "testURIRef015" testURIRef015
272  , TF.testCase "testURIRef016" testURIRef016
273  , TF.testCase "testURIRef017" testURIRef017
274  , TF.testCase "testURIRef018" testURIRef018
275    --
276  , TF.testCase "testURIRef019" testURIRef019
277    --
278  , TF.testCase "testURIRef021" testURIRef021
279  , TF.testCase "testURIRef022" testURIRef022
280  , TF.testCase "testURIRef023" testURIRef023
281  , TF.testCase "testURIRef024" testURIRef024
282  , TF.testCase "testURIRef025" testURIRef025
283  , TF.testCase "testURIRef026" testURIRef026
284  , TF.testCase "testURIRef027" testURIRef027
285  , TF.testCase "testURIRef028" testURIRef028
286  , TF.testCase "testURIRef029" testURIRef029
287    --
288  , TF.testCase "testURIRef031" testURIRef031
289  , TF.testCase "testURIRef032" testURIRef032
290  , TF.testCase "testURIRef033" testURIRef033
291  , TF.testCase "testURIRef034" testURIRef034
292  , TF.testCase "testURIRef035" testURIRef035
293  , TF.testCase "testURIRef036" testURIRef036
294  , TF.testCase "testURIRef037" testURIRef037
295  , TF.testCase "testURIRef038" testURIRef038
296  , TF.testCase "testURIRef039" testURIRef039
297  , TF.testCase "testURIRef040" testURIRef040
298  , TF.testCase "testURIRef041" testURIRef041
299  , TF.testCase "testURIRef042" testURIRef042
300  , TF.testCase "testURIRef043" testURIRef043
301  , TF.testCase "testURIRef044" testURIRef044
302  , TF.testCase "testURIRef045" testURIRef045
303  , TF.testCase "testURIRef046" testURIRef046
304  , TF.testCase "testURIRef047" testURIRef047
305  , TF.testCase "testURIRef048" testURIRef048
306  , TF.testCase "testURIRef049" testURIRef049
307  , TF.testCase "testURIRef050" testURIRef050
308  , TF.testCase "testURIRef051" testURIRef051
309  , TF.testCase "testURIRef052" testURIRef052
310  , TF.testCase "testURIRef053" testURIRef053
311  , TF.testCase "testURIRef054" testURIRef054
312  , TF.testCase "testURIRef055" testURIRef055
313  , TF.testCase "testURIRef056" testURIRef056
314  , TF.testCase "testURIRef057" testURIRef057
315  , TF.testCase "testURIRef058" testURIRef058
316  , TF.testCase "testURIRef059" testURIRef059
317  , TF.testCase "testURIRef060" testURIRef060
318  , TF.testCase "testURIRef061" testURIRef061
319  , TF.testCase "testURIRef062" testURIRef062
320  , TF.testCase "testURIRef063" testURIRef063
321  , TF.testCase "testURIRef064" testURIRef064
322  , TF.testCase "testURIRef065" testURIRef065
323  , TF.testCase "testURIRef066" testURIRef066
324  , TF.testCase "testURIRef067" testURIRef067
325  , TF.testCase "testURIRef068" testURIRef068
326  , TF.testCase "testURIRef069" testURIRef069
327  , TF.testCase "testURIRef070" testURIRef070
328  , TF.testCase "testURIRef071" testURIRef071
329  , TF.testCase "testURIRef072" testURIRef072
330  , TF.testCase "testURIRef073" testURIRef073
331  , TF.testCase "testURIRef074" testURIRef074
332  , TF.testCase "testURIRef075" testURIRef075
333  , TF.testCase "testURIRef076" testURIRef076
334  , TF.testCase "testURIRef077" testURIRef077
335    --
336  , TF.testCase "testURIRef080" testURIRef080
337  , TF.testCase "testURIRef081" testURIRef081
338  , TF.testCase "testURIRef082" testURIRef082
339  , TF.testCase "testURIRef083" testURIRef083
340  , TF.testCase "testURIRef084" testURIRef084
341  , TF.testCase "testURIRef085" testURIRef085
342  , TF.testCase "testURIRef086" testURIRef086
343  , TF.testCase "testURIRef087" testURIRef087
344    -- testURIRef088,
345    -- testURIRef089,
346  , TF.testCase "testURIRef090" testURIRef090
347  , TF.testCase "testURIRef091" testURIRef091
348  , TF.testCase "testURIRef092" testURIRef092
349  , TF.testCase "testURIRef093" testURIRef093
350  , TF.testCase "testURIRef094" testURIRef094
351  , TF.testCase "testURIRef095" testURIRef095
352  , TF.testCase "testURIRef096" testURIRef096
353  , TF.testCase "testURIRef097" testURIRef097
354  , TF.testCase "testURIRef098" testURIRef098
355    -- testURIRef099,
356    --
357  , TF.testCase "testURIRef101" testURIRef101
358  , TF.testCase "testURIRef102" testURIRef102
359  , TF.testCase "testURIRef103" testURIRef103
360  , TF.testCase "testURIRef104" testURIRef104
361  , TF.testCase "testURIRef105" testURIRef105
362  , TF.testCase "testURIRef106" testURIRef106
363  , TF.testCase "testURIRef107" testURIRef107
364  , TF.testCase "testURIRef108" testURIRef108
365    --
366  , TF.testCase "testURIRef111" testURIRef111
367  , TF.testCase "testURIRef112" testURIRef112
368  , TF.testCase "testURIRef113" testURIRef113
369  , TF.testCase "testURIRef114" testURIRef114
370  , TF.testCase "testURIRef115" testURIRef115
371  , TF.testCase "testURIRef116" testURIRef116
372  , TF.testCase "testURIRef117" testURIRef117
373    --
374  , TF.testCase "testURIRef118" testURIRef118
375  , TF.testCase "testURIRef119" testURIRef119
376  , TF.testCase "testURIRef120" testURIRef120
377    --
378  , TF.testCase "testURIRef121" testURIRef121
379  , TF.testCase "testURIRef122" testURIRef122
380    -- IRI test cases not currently supported
381  -- , TF.testCase "testURIRef123" testURIRef123
382  -- , TF.testCase "testURIRef124" testURIRef124
383  ]
384
385-- test decomposition of URI into components
386testComponent01 = testURIRefComponents "testComponent01"
387        ( Just $ URI
388            { uriScheme    = "http:"
389            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")
390            , uriPath      = "/aaa/bbb"
391            , uriQuery     = "?qqq"
392            , uriFragment  = "#fff"
393            } )
394        "http://user:pass@example.org:99/aaa/bbb?qqq#fff"
395testComponent02 = testURIRefComponents "testComponent02"
396        ( const Nothing
397        ( Just $ URI
398            { uriScheme    = "http:"
399            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")
400            , uriPath      = "aaa/bbb"
401            , uriQuery     = ""
402            , uriFragment  = ""
403            } )
404        )
405        "http://user:pass@example.org:99aaa/bbb"
406testComponent03 = testURIRefComponents "testComponent03"
407        ( Just $ URI
408            { uriScheme    = "http:"
409            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")
410            , uriPath      = ""
411            , uriQuery     = "?aaa/bbb"
412            , uriFragment  = ""
413            } )
414        "http://user:pass@example.org:99?aaa/bbb"
415testComponent04 = testURIRefComponents "testComponent03"
416        ( Just $ URI
417            { uriScheme    = "http:"
418            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")
419            , uriPath      = ""
420            , uriQuery     = ""
421            , uriFragment  = "#aaa/bbb"
422            } )
423        "http://user:pass@example.org:99#aaa/bbb"
424-- These test cases contributed by Robert Buck (mathworks.com)
425testComponent11 = testURIRefComponents "testComponent03"
426        ( Just $ URI
427            { uriScheme    = "about:"
428            , uriAuthority = Nothing
429            , uriPath      = ""
430            , uriQuery     = ""
431            , uriFragment  = ""
432            } )
433        "about:"
434testComponent12 = testURIRefComponents "testComponent03"
435        ( Just $ URI
436            { uriScheme    = "file:"
437            , uriAuthority = Just (URIAuth "" "windowsauth" "")
438            , uriPath      = "/d$"
439            , uriQuery     = ""
440            , uriFragment  = ""
441            } )
442        "file://windowsauth/d$"
443
444testComponentSuite = TF.testGroup "Test URIrefs" $
445  [ TF.testCase "testComponent01" testComponent01
446  , TF.testCase "testComponent02" testComponent02
447  , TF.testCase "testComponent03" testComponent03
448  , TF.testCase "testComponent04" testComponent04
449  , TF.testCase "testComponent11" testComponent11
450  , TF.testCase "testComponent12" testComponent12
451  ]
452
453-- Get reference relative to given base
454--   relativeRef :: String -> String -> String
455--
456-- Get absolute URI given base and relative reference
457--   absoluteURI :: String -> String -> String
458--
459-- Test cases taken from: http://www.w3.org/2000/10/swap/uripath.py
460-- (Thanks, Dan Connolly)
461--
462-- NOTE:  absoluteURI base (relativeRef base u) is always equivalent to u.
463-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
464
465testRelSplit :: String -> String -> String -> String -> Assertion
466testRelSplit label base uabs urel =
467    testEq label urel (mkrel puabs pubas)
468    where
469        mkrel (Just u1) (Just u2) = show (u1 `relativeFrom` u2)
470        mkrel Nothing   _         = "Invalid URI: "++urel
471        mkrel _         Nothing   = "Invalid URI: "++uabs
472        puabs = parseURIReference uabs
473        pubas = parseURIReference base
474
475testRelJoin  :: String -> String -> String -> String -> Assertion
476testRelJoin label base urel uabs =
477    testEq label uabs (mkabs purel pubas)
478    where
479        mkabs (Just u1) (Just u2) = show (u1 `relativeTo` u2)
480        mkabs Nothing   _         = "Invalid URI: "++urel
481        mkabs _         Nothing   = "Invalid URI: "++uabs
482        purel = parseURIReference urel
483        pubas = parseURIReference base
484
485testRelative :: String -> String -> String -> String -> Assertion
486testRelative label base uabs urel = sequence_
487    [
488    (testRelSplit (label++"(rel)") base uabs urel),
489    (testRelJoin  (label++"(abs)") base urel uabs)
490    ]
491
492testRelative01 = testRelative "testRelative01"
493                    "foo:xyz" "bar:abc" "bar:abc"
494testRelative02 = testRelative "testRelative02"
495                    "http://example/x/y/z" "http://example/x/abc" "../abc"
496testRelative03 = testRelative "testRelative03"
497                    "http://example2/x/y/z" "http://example/x/abc" "//example/x/abc"
498                    -- "http://example2/x/y/z" "http://example/x/abc" "http://example/x/abc"
499testRelative04 = testRelative "testRelative04"
500                    "http://ex/x/y/z" "http://ex/x/r" "../r"
501testRelative05 = testRelative "testRelative05"
502                    "http://ex/x/y/z" "http://ex/r" "/r"
503                    -- "http://ex/x/y/z" "http://ex/r" "../../r"
504testRelative06 = testRelative "testRelative06"
505                    "http://ex/x/y/z" "http://ex/x/y/q/r" "q/r"
506testRelative07 = testRelative "testRelative07"
507                    "http://ex/x/y" "http://ex/x/q/r#s" "q/r#s"
508testRelative08 = testRelative "testRelative08"
509                    "http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t"
510testRelative09 = testRelative "testRelative09"
511                    "http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"
512testRelative10 = testRelative "testRelative10"
513                    -- "http://ex/x/y" "http://ex/x/y" "y"
514                    "http://ex/x/y" "http://ex/x/y" ""
515testRelative11 = testRelative "testRelative11"
516                    -- "http://ex/x/y/" "http://ex/x/y/" "./"
517                    "http://ex/x/y/" "http://ex/x/y/" ""
518testRelative12 = testRelative "testRelative12"
519                    -- "http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq"
520                    "http://ex/x/y/pdq" "http://ex/x/y/pdq" ""
521testRelative13 = testRelative "testRelative13"
522                    "http://ex/x/y/" "http://ex/x/y/z/" "z/"
523testRelative14 = testRelative "testRelative14"
524                    -- "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal"
525                    "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "#Animal"
526testRelative15 = testRelative "testRelative15"
527                    "file:/e/x/y/z" "file:/e/x/abc" "../abc"
528testRelative16 = testRelative "testRelative16"
529                    "file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc"
530testRelative17 = testRelative "testRelative17"
531                    "file:/ex/x/y/z" "file:/ex/x/r" "../r"
532testRelative18 = testRelative "testRelative18"
533                    "file:/ex/x/y/z" "file:/r" "/r"
534testRelative19 = testRelative "testRelative19"
535                    "file:/ex/x/y" "file:/ex/x/q/r" "q/r"
536testRelative20 = testRelative "testRelative20"
537                    "file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s"
538testRelative21 = testRelative "testRelative21"
539                    "file:/ex/x/y" "file:/ex/x/q/r#" "q/r#"
540testRelative22 = testRelative "testRelative22"
541                    "file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t"
542testRelative23 = testRelative "testRelative23"
543                    "file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"
544testRelative24 = testRelative "testRelative24"
545                    -- "file:/ex/x/y" "file:/ex/x/y" "y"
546                    "file:/ex/x/y" "file:/ex/x/y" ""
547testRelative25 = testRelative "testRelative25"
548                    -- "file:/ex/x/y/" "file:/ex/x/y/" "./"
549                    "file:/ex/x/y/" "file:/ex/x/y/" ""
550testRelative26 = testRelative "testRelative26"
551                    -- "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq"
552                    "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" ""
553testRelative27 = testRelative "testRelative27"
554                    "file:/ex/x/y/" "file:/ex/x/y/z/" "z/"
555testRelative28 = testRelative "testRelative28"
556                    "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"
557                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"
558                    -- "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"
559                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"
560testRelative29 = testRelative "testRelative29"
561                    "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"
562                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"
563                    -- "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"
564                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"
565testRelative30 = testRelative "testRelative30"
566                    "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"
567testRelative31 = testRelative "testRelative31"
568                    "file:/some/dir/foo" "file:/some/dir/#" "./#"
569testRelative32 = testRelative "testRelative32"
570                    "http://ex/x/y" "http://ex/x/q:r" "./q:r"
571                    -- see RFC2396bis, section 5       ^^
572testRelative33 = testRelative "testRelative33"
573                    "http://ex/x/y" "http://ex/x/p=q:r" "./p=q:r"
574                    -- "http://ex/x/y" "http://ex/x/p=q:r" "p=q:r"
575testRelative34 = testRelative "testRelative34"
576                    "http://ex/x/y?pp/qq" "http://ex/x/y?pp/rr" "?pp/rr"
577testRelative35 = testRelative "testRelative35"
578                    "http://ex/x/y?pp/qq" "http://ex/x/y/z" "y/z"
579testRelative36 = testRelative "testRelative36"
580                    "mailto:local"
581                    "mailto:local/qual@domain.org#frag"
582                    "local/qual@domain.org#frag"
583testRelative37 = testRelative "testRelative37"
584                    "mailto:local/qual1@domain1.org"
585                    "mailto:local/more/qual2@domain2.org#frag"
586                    "more/qual2@domain2.org#frag"
587testRelative38 = testRelative "testRelative38"
588                    "http://ex/x/z?q" "http://ex/x/y?q" "y?q"
589testRelative39 = testRelative "testRelative39"
590                    "http://ex?p" "http://ex/x/y?q" "/x/y?q"
591testRelative40 = testRelative "testRelative40"
592                    "foo:a/b" "foo:a/c/d" "c/d"
593testRelative41 = testRelative "testRelative41"
594                    "foo:a/b" "foo:/c/d" "/c/d"
595testRelative42 = testRelative "testRelative42"
596                    "foo:a/b?c#d" "foo:a/b?c" ""
597testRelative43 = testRelative "testRelative42"
598                    "foo:a" "foo:b/c" "b/c"
599testRelative44 = testRelative "testRelative44"
600                    "foo:/a/y/z" "foo:/a/b/c" "../b/c"
601testRelative45 = testRelJoin "testRelative45"
602                    "foo:a" "./b/c" "foo:b/c"
603testRelative46 = testRelJoin "testRelative46"
604                    "foo:a" "/./b/c" "foo:/b/c"
605testRelative47 = testRelJoin "testRelative47"
606                    "foo://a//b/c" "../../d" "foo://a/d"
607testRelative48 = testRelJoin "testRelative48"
608                    "foo:a" "." "foo:"
609testRelative49 = testRelJoin "testRelative49"
610                    "foo:a" ".." "foo:"
611
612-- add escape tests
613testRelative50 = testRelative "testRelative50"
614                    "http://example/x/y%2Fz" "http://example/x/abc" "abc"
615testRelative51 = testRelative "testRelative51"
616                    "http://example/a/x/y/z" "http://example/a/x%2Fabc" "../../x%2Fabc"
617testRelative52 = testRelative "testRelative52"
618                    "http://example/a/x/y%2Fz" "http://example/a/x%2Fabc" "../x%2Fabc"
619testRelative53 = testRelative "testRelative53"
620                    "http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc"
621testRelative54 = testRelative "testRelative54"
622                    "http://ex/x/y" "http://ex/x/q%3Ar" "q%3Ar"
623testRelative55 = testRelative "testRelative55"
624                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"
625-- Apparently, TimBL prefers the following way to 41, 42 above
626-- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html
627-- He also notes that there may be different relative fuctions
628-- that satisfy the basic equivalence axiom:
629-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
630testRelative56 = testRelative "testRelative56"
631                    "http://example/x/y/z" "http://example/x%2Fabc" "/x%2Fabc"
632testRelative57 = testRelative "testRelative57"
633                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"
634
635-- Other oddball tests
636    -- Check segment normalization code:
637testRelative60 = testRelJoin "testRelative60"
638                    "ftp://example/x/y" "http://example/a/b/../../c" "http://example/c"
639testRelative61 = testRelJoin "testRelative61"
640                    "ftp://example/x/y" "http://example/a/b/c/../../" "http://example/a/"
641testRelative62 = testRelJoin "testRelative62"
642                    "ftp://example/x/y" "http://example/a/b/c/./" "http://example/a/b/c/"
643testRelative63 = testRelJoin "testRelative63"
644                    "ftp://example/x/y" "http://example/a/b/c/.././" "http://example/a/b/"
645testRelative64 = testRelJoin "testRelative64"
646                    "ftp://example/x/y" "http://example/a/b/c/d/../../../../e" "http://example/e"
647testRelative65 = testRelJoin "testRelative65"
648                    "ftp://example/x/y" "http://example/a/b/c/d/../.././../../e" "http://example/e"
649    -- Check handling of queries and fragments with non-relative paths
650testRelative70 = testRelative "testRelative70"
651                    "mailto:local1@domain1?query1" "mailto:local2@domain2"
652                    "local2@domain2"
653testRelative71 = testRelative "testRelative71"
654                    "mailto:local1@domain1" "mailto:local2@domain2?query2"
655                    "local2@domain2?query2"
656testRelative72 = testRelative "testRelative72"
657                    "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"
658                    "local2@domain2?query2"
659testRelative73 = testRelative "testRelative73"
660                    "mailto:local@domain?query1" "mailto:local@domain?query2"
661                    "?query2"
662testRelative74 = testRelative "testRelative74"
663                    "mailto:?query1" "mailto:local@domain?query2"
664                    "local@domain?query2"
665testRelative75 = testRelative "testRelative75"
666                    "mailto:local@domain?query1" "mailto:local@domain?query2"
667                    "?query2"
668testRelative76 = testRelative "testRelative76"
669                    "foo:bar" "http://example/a/b?c/../d"  "http://example/a/b?c/../d"
670testRelative77 = testRelative "testRelative77"
671                    "foo:bar" "http://example/a/b#c/../d"  "http://example/a/b#c/../d"
672{- These (78-81) are some awkward test cases thrown up by a question on the URI list:
673     http://lists.w3.org/Archives/Public/uri/2005Jul/0013
674   Mote that RFC 3986 discards path segents after the final '/' only when merging two
675   paths - otherwise the final segment in the base URI is mnaintained.  This leads to
676   difficulty in constructinmg a reversible relativeTo/relativeFrom pair of functions.
677-}
678testRelative78 = testRelative "testRelative78"
679                    "http://www.example.com/data/limit/.." "http://www.example.com/data/limit/test.xml"
680                    "test.xml"
681testRelative79 = testRelative "testRelative79"
682                    "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"
683testRelative80 = testRelative "testRelative80"
684                    "file:/some/dir/foo" "file:/some/dir/#" "./#"
685testRelative81 = testRelative "testRelative81"
686                    "file:/some/dir/.." "file:/some/dir/#blort" "./#blort"
687
688-- testRelative  base abs rel
689-- testRelSplit  base abs rel
690-- testRelJoin   base rel abs
691testRelative91 = testRelSplit "testRelative91"
692                    "http://example.org/base/uri" "http:this"
693                    "this"
694testRelative92 = testRelJoin "testRelative92"
695                    "http://example.org/base/uri" "http:this"
696                    "http:this"
697testRelative93 = testRelJoin "testRelative93"
698                    "http:base" "http:this"
699                    "http:this"
700testRelative94 = testRelJoin "testRelative94"
701                    "f:/a" ".//g"
702                    "f://g"
703testRelative95 = testRelJoin "testRelative95"
704                    "f://example.org/base/a" "b/c//d/e"
705                    "f://example.org/base/b/c//d/e"
706testRelative96 = testRelJoin "testRelative96"
707                    "mid:m@example.ord/c@example.org" "m2@example.ord/c2@example.org"
708                    "mid:m@example.ord/m2@example.ord/c2@example.org"
709testRelative97 = testRelJoin "testRelative97"
710                    "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" "mini1.xml"
711                    "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/mini1.xml"
712testRelative98 = testRelative "testRelative98"
713                    "foo:a/y/z" "foo:a/b/c" "../b/c"
714testRelative99 = testRelJoin "testRelative99"
715                    "f:/a/" "..//g"
716                    "f://g"
717
718
719testRelativeSuite = TF.testGroup "Test Relative URIs" testRelativeList
720testRelativeList  =
721  [ TF.testCase "testRelative01" testRelative01
722  , TF.testCase "testRelative02" testRelative02
723  , TF.testCase "testRelative03" testRelative03
724  , TF.testCase "testRelative04" testRelative04
725  , TF.testCase "testRelative05" testRelative05
726  , TF.testCase "testRelative06" testRelative06
727  , TF.testCase "testRelative07" testRelative07
728  , TF.testCase "testRelative08" testRelative08
729  , TF.testCase "testRelative09" testRelative09
730  , TF.testCase "testRelative10" testRelative10
731  , TF.testCase "testRelative11" testRelative11
732  , TF.testCase "testRelative12" testRelative12
733  , TF.testCase "testRelative13" testRelative13
734  , TF.testCase "testRelative14" testRelative14
735  , TF.testCase "testRelative15" testRelative15
736  , TF.testCase "testRelative16" testRelative16
737  , TF.testCase "testRelative17" testRelative17
738  , TF.testCase "testRelative18" testRelative18
739  , TF.testCase "testRelative19" testRelative19
740  , TF.testCase "testRelative20" testRelative20
741  , TF.testCase "testRelative21" testRelative21
742  , TF.testCase "testRelative22" testRelative22
743  , TF.testCase "testRelative23" testRelative23
744  , TF.testCase "testRelative24" testRelative24
745  , TF.testCase "testRelative25" testRelative25
746  , TF.testCase "testRelative26" testRelative26
747  , TF.testCase "testRelative27" testRelative27
748  , TF.testCase "testRelative28" testRelative28
749  , TF.testCase "testRelative29" testRelative29
750  , TF.testCase "testRelative30" testRelative30
751  , TF.testCase "testRelative31" testRelative31
752  , TF.testCase "testRelative32" testRelative32
753  , TF.testCase "testRelative33" testRelative33
754  , TF.testCase "testRelative34" testRelative34
755  , TF.testCase "testRelative35" testRelative35
756  , TF.testCase "testRelative36" testRelative36
757  , TF.testCase "testRelative37" testRelative37
758  , TF.testCase "testRelative38" testRelative38
759  , TF.testCase "testRelative39" testRelative39
760  , TF.testCase "testRelative40" testRelative40
761  , TF.testCase "testRelative41" testRelative41
762  , TF.testCase "testRelative42" testRelative42
763  , TF.testCase "testRelative43" testRelative43
764  , TF.testCase "testRelative44" testRelative44
765  , TF.testCase "testRelative45" testRelative45
766  , TF.testCase "testRelative46" testRelative46
767  , TF.testCase "testRelative47" testRelative47
768  , TF.testCase "testRelative48" testRelative48
769  , TF.testCase "testRelative49" testRelative49
770    --
771  , TF.testCase "testRelative50" testRelative50
772  , TF.testCase "testRelative51" testRelative51
773  , TF.testCase "testRelative52" testRelative52
774  , TF.testCase "testRelative53" testRelative53
775  , TF.testCase "testRelative54" testRelative54
776  , TF.testCase "testRelative55" testRelative55
777  , TF.testCase "testRelative56" testRelative56
778  , TF.testCase "testRelative57" testRelative57
779    --
780  , TF.testCase "testRelative60" testRelative60
781  , TF.testCase "testRelative61" testRelative61
782  , TF.testCase "testRelative62" testRelative62
783  , TF.testCase "testRelative63" testRelative63
784  , TF.testCase "testRelative64" testRelative64
785  , TF.testCase "testRelative65" testRelative65
786    --
787  , TF.testCase "testRelative70" testRelative70
788  , TF.testCase "testRelative71" testRelative71
789  , TF.testCase "testRelative72" testRelative72
790  , TF.testCase "testRelative73" testRelative73
791  , TF.testCase "testRelative74" testRelative74
792  , TF.testCase "testRelative75" testRelative75
793  , TF.testCase "testRelative76" testRelative76
794  , TF.testCase "testRelative77" testRelative77
795  -- Awkward cases:
796  , TF.testCase "testRelative78" testRelative78
797  , TF.testCase "testRelative79" testRelative79
798  , TF.testCase "testRelative80" testRelative80
799  , TF.testCase "testRelative81" testRelative81
800    --
801  -- , TF.testCase "testRelative90" testRelative90
802  , TF.testCase "testRelative91" testRelative91
803  , TF.testCase "testRelative92" testRelative92
804  , TF.testCase "testRelative93" testRelative93
805  , TF.testCase "testRelative94" testRelative94
806  , TF.testCase "testRelative95" testRelative95
807  , TF.testCase "testRelative96" testRelative96
808  , TF.testCase "testRelative97" testRelative97
809  , TF.testCase "testRelative98" testRelative98
810  , TF.testCase "testRelative99" testRelative99
811  ]
812
813-- RFC2396 relative-to-absolute URI tests
814
815rfcbase  = "http://a/b/c/d;p?q"
816-- normal cases, RFC2396bis 5.4.1
817testRFC01 = testRelJoin "testRFC01" rfcbase "g:h" "g:h"
818testRFC02 = testRelJoin "testRFC02" rfcbase "g" "http://a/b/c/g"
819testRFC03 = testRelJoin "testRFC03" rfcbase "./g" "http://a/b/c/g"
820testRFC04 = testRelJoin "testRFC04" rfcbase "g/" "http://a/b/c/g/"
821testRFC05 = testRelJoin "testRFC05" rfcbase "/g" "http://a/g"
822testRFC06 = testRelJoin "testRFC06" rfcbase "//g" "http://g"
823testRFC07 = testRelJoin "testRFC07" rfcbase "?y" "http://a/b/c/d;p?y"
824testRFC08 = testRelJoin "testRFC08" rfcbase "g?y" "http://a/b/c/g?y"
825testRFC09 = testRelJoin "testRFC09" rfcbase "?q#s" "http://a/b/c/d;p?q#s"
826testRFC23 = testRelJoin "testRFC10" rfcbase "#s" "http://a/b/c/d;p?q#s"
827testRFC10 = testRelJoin "testRFC11" rfcbase "g#s" "http://a/b/c/g#s"
828testRFC11 = testRelJoin "testRFC12" rfcbase "g?y#s" "http://a/b/c/g?y#s"
829testRFC12 = testRelJoin "testRFC13" rfcbase ";x" "http://a/b/c/;x"
830testRFC13 = testRelJoin "testRFC14" rfcbase "g;x" "http://a/b/c/g;x"
831testRFC14 = testRelJoin "testRFC15" rfcbase "g;x?y#s" "http://a/b/c/g;x?y#s"
832testRFC24 = testRelJoin "testRFC16" rfcbase "" "http://a/b/c/d;p?q"
833testRFC15 = testRelJoin "testRFC17" rfcbase "." "http://a/b/c/"
834testRFC16 = testRelJoin "testRFC18" rfcbase "./" "http://a/b/c/"
835testRFC17 = testRelJoin "testRFC19" rfcbase ".." "http://a/b/"
836testRFC18 = testRelJoin "testRFC20" rfcbase "../" "http://a/b/"
837testRFC19 = testRelJoin "testRFC21" rfcbase "../g" "http://a/b/g"
838testRFC20 = testRelJoin "testRFC22" rfcbase "../.." "http://a/"
839testRFC21 = testRelJoin "testRFC23" rfcbase "../../" "http://a/"
840testRFC22 = testRelJoin "testRFC24" rfcbase "../../g" "http://a/g"
841-- abnormal cases, RFC2396bis 5.4.2
842testRFC31 = testRelJoin "testRFC31" rfcbase "?q" rfcbase
843testRFC32 = testRelJoin "testRFC32" rfcbase "../../../g" "http://a/g"
844testRFC33 = testRelJoin "testRFC33" rfcbase "../../../../g" "http://a/g"
845testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/g"
846testRFC35 = testRelJoin "testRFC35" rfcbase "/../g" "http://a/g"
847testRFC36 = testRelJoin "testRFC36" rfcbase "g." "http://a/b/c/g."
848testRFC37 = testRelJoin "testRFC37" rfcbase ".g" "http://a/b/c/.g"
849testRFC38 = testRelJoin "testRFC38" rfcbase "g.." "http://a/b/c/g.."
850testRFC39 = testRelJoin "testRFC39" rfcbase "..g" "http://a/b/c/..g"
851testRFC40 = testRelJoin "testRFC40" rfcbase "./../g" "http://a/b/g"
852testRFC41 = testRelJoin "testRFC41" rfcbase "./g/." "http://a/b/c/g/"
853testRFC42 = testRelJoin "testRFC42" rfcbase "g/./h" "http://a/b/c/g/h"
854testRFC43 = testRelJoin "testRFC43" rfcbase "g/../h" "http://a/b/c/h"
855testRFC44 = testRelJoin "testRFC44" rfcbase "g;x=1/./y" "http://a/b/c/g;x=1/y"
856testRFC45 = testRelJoin "testRFC45" rfcbase "g;x=1/../y" "http://a/b/c/y"
857testRFC46 = testRelJoin "testRFC46" rfcbase "g?y/./x" "http://a/b/c/g?y/./x"
858testRFC47 = testRelJoin "testRFC47" rfcbase "g?y/../x" "http://a/b/c/g?y/../x"
859testRFC48 = testRelJoin "testRFC48" rfcbase "g#s/./x" "http://a/b/c/g#s/./x"
860testRFC49 = testRelJoin "testRFC49" rfcbase "g#s/../x" "http://a/b/c/g#s/../x"
861testRFC50 = testRelJoin "testRFC50" rfcbase "http:x" "http:x"
862
863-- Null path tests
864-- See RFC2396bis, section 5.2,
865-- "If the base URI's path component is the empty string, then a single
866--  slash character is copied to the buffer"
867testRFC60 = testRelative "testRFC60" "http://ex"     "http://ex/x/y?q" "/x/y?q"
868testRFC61 = testRelJoin  "testRFC61" "http://ex"     "x/y?q"           "http://ex/x/y?q"
869testRFC62 = testRelative "testRFC62" "http://ex?p"   "http://ex/x/y?q" "/x/y?q"
870testRFC63 = testRelJoin  "testRFC63" "http://ex?p"   "x/y?q"           "http://ex/x/y?q"
871testRFC64 = testRelative "testRFC64" "http://ex#f"   "http://ex/x/y?q" "/x/y?q"
872testRFC65 = testRelJoin  "testRFC65" "http://ex#f"   "x/y?q"           "http://ex/x/y?q"
873testRFC66 = testRelative "testRFC66" "http://ex?p"   "http://ex/x/y#g" "/x/y#g"
874testRFC67 = testRelJoin  "testRFC67" "http://ex?p"   "x/y#g"           "http://ex/x/y#g"
875testRFC68 = testRelative "testRFC68" "http://ex"     "http://ex/"      "/"
876testRFC69 = testRelJoin  "testRFC69" "http://ex"     "./"              "http://ex/"
877testRFC70 = testRelative "testRFC70" "http://ex"     "http://ex/a/b"   "/a/b"
878testRFC71 = testRelative "testRFC71" "http://ex/a/b" "http://ex"       "./"
879
880testRFC2396Suite = TF.testGroup "Test RFC2396 examples" testRFC2396List
881testRFC2396List  =
882  [ TF.testCase "testRFC01" testRFC01
883  , TF.testCase "testRFC02" testRFC02
884  , TF.testCase "testRFC03" testRFC03
885  , TF.testCase "testRFC04" testRFC04
886  , TF.testCase "testRFC05" testRFC05
887  , TF.testCase "testRFC06" testRFC06
888  , TF.testCase "testRFC07" testRFC07
889  , TF.testCase "testRFC08" testRFC08
890  , TF.testCase "testRFC09" testRFC09
891  , TF.testCase "testRFC10" testRFC10
892  , TF.testCase "testRFC11" testRFC11
893  , TF.testCase "testRFC12" testRFC12
894  , TF.testCase "testRFC13" testRFC13
895  , TF.testCase "testRFC14" testRFC14
896  , TF.testCase "testRFC15" testRFC15
897  , TF.testCase "testRFC16" testRFC16
898  , TF.testCase "testRFC17" testRFC17
899  , TF.testCase "testRFC18" testRFC18
900  , TF.testCase "testRFC19" testRFC19
901  , TF.testCase "testRFC20" testRFC20
902  , TF.testCase "testRFC21" testRFC21
903  , TF.testCase "testRFC22" testRFC22
904  , TF.testCase "testRFC23" testRFC23
905  , TF.testCase "testRFC24" testRFC24
906    -- testRFC30,
907  , TF.testCase "testRFC31" testRFC31
908  , TF.testCase "testRFC32" testRFC32
909  , TF.testCase "testRFC33" testRFC33
910  , TF.testCase "testRFC34" testRFC34
911  , TF.testCase "testRFC35" testRFC35
912  , TF.testCase "testRFC36" testRFC36
913  , TF.testCase "testRFC37" testRFC37
914  , TF.testCase "testRFC38" testRFC38
915  , TF.testCase "testRFC39" testRFC39
916  , TF.testCase "testRFC40" testRFC40
917  , TF.testCase "testRFC41" testRFC41
918  , TF.testCase "testRFC42" testRFC42
919  , TF.testCase "testRFC43" testRFC43
920  , TF.testCase "testRFC44" testRFC44
921  , TF.testCase "testRFC45" testRFC45
922  , TF.testCase "testRFC46" testRFC46
923  , TF.testCase "testRFC47" testRFC47
924  , TF.testCase "testRFC48" testRFC48
925  , TF.testCase "testRFC49" testRFC49
926  , TF.testCase "testRFC50" testRFC50
927    --
928  , TF.testCase "testRFC60" testRFC60
929  , TF.testCase "testRFC61" testRFC61
930  , TF.testCase "testRFC62" testRFC62
931  , TF.testCase "testRFC63" testRFC63
932  , TF.testCase "testRFC64" testRFC64
933  , TF.testCase "testRFC65" testRFC65
934  , TF.testCase "testRFC66" testRFC66
935  , TF.testCase "testRFC67" testRFC67
936  , TF.testCase "testRFC68" testRFC68
937  , TF.testCase "testRFC69" testRFC69
938  , TF.testCase "testRFC70" testRFC70
939  ]
940
941-- And some other oddballs:
942mailbase = "mailto:local/option@domain.org?notaquery#frag"
943testMail01 = testRelJoin "testMail01"
944            mailbase "more@domain"
945            "mailto:local/more@domain"
946testMail02 = testRelJoin "testMail02"
947            mailbase "#newfrag"
948            "mailto:local/option@domain.org?notaquery#newfrag"
949testMail03 = testRelJoin "testMail03"
950            mailbase "l1/q1@domain"
951            "mailto:local/l1/q1@domain"
952
953testMail11 = testRelJoin "testMail11"
954             "mailto:local1@domain1?query1" "mailto:local2@domain2"
955             "mailto:local2@domain2"
956testMail12 = testRelJoin "testMail12"
957             "mailto:local1@domain1" "mailto:local2@domain2?query2"
958             "mailto:local2@domain2?query2"
959testMail13 = testRelJoin "testMail13"
960             "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"
961             "mailto:local2@domain2?query2"
962testMail14 = testRelJoin "testMail14"
963             "mailto:local@domain?query1" "mailto:local@domain?query2"
964             "mailto:local@domain?query2"
965testMail15 = testRelJoin "testMail15"
966             "mailto:?query1" "mailto:local@domain?query2"
967             "mailto:local@domain?query2"
968testMail16 = testRelJoin "testMail16"
969             "mailto:local@domain?query1" "?query2"
970             "mailto:local@domain?query2"
971testInfo17 = testRelJoin "testInfo17"
972             "info:name/1234/../567" "name/9876/../543"
973             "info:name/name/543"
974testInfo18 = testRelJoin "testInfo18"
975             "info:/name/1234/../567" "name/9876/../543"
976             "info:/name/name/543"
977
978testOddballSuite = TF.testGroup "Test oddball examples" testOddballList
979testOddballList  =
980  [ TF.testCase "testMail01" testMail01
981  , TF.testCase "testMail02" testMail02
982  , TF.testCase "testMail03" testMail03
983  , TF.testCase "testMail11" testMail11
984  , TF.testCase "testMail12" testMail12
985  , TF.testCase "testMail13" testMail13
986  , TF.testCase "testMail14" testMail14
987  , TF.testCase "testMail15" testMail15
988  , TF.testCase "testMail16" testMail16
989  , TF.testCase "testInfo17" testInfo17
990  ]
991
992--  Normalization tests
993
994--  Case normalization; cf. RFC2396bis section 6.2.2.1
995--  NOTE:  authority case normalization is not performed
996testNormalize01 = testEq "testNormalize01"
997                  "http://EXAMPLE.com/Root/%2A?%2B#%2C"
998                  (normalizeCase "HTTP://EXAMPLE.com/Root/%2a?%2b#%2c")
999
1000--  Encoding normalization; cf. RFC2396bis section 6.2.2.2
1001testNormalize11 = testEq "testNormalize11"
1002                  "HTTP://EXAMPLE.com/Root/~Me/"
1003                  (normalizeEscape "HTTP://EXAMPLE.com/Root/%7eMe/")
1004testNormalize12 = testEq "testNormalize12"
1005                  "foo:%40AZ%5b%60az%7b%2f09%3a-._~"
1006                  (normalizeEscape "foo:%40%41%5a%5b%60%61%7a%7b%2f%30%39%3a%2d%2e%5f%7e")
1007testNormalize13 = testEq "testNormalize13"
1008                  "foo:%3a%2f%3f%23%5b%5d%40"
1009                  (normalizeEscape "foo:%3a%2f%3f%23%5b%5d%40")
1010
1011--  Path segment normalization; cf. RFC2396bis section 6.2.2.4
1012testNormalize21 = testEq "testNormalize21"
1013                    "http://example/c"
1014                    (normalizePathSegments "http://example/a/b/../../c")
1015testNormalize22 = testEq "testNormalize22"
1016                    "http://example/a/"
1017                    (normalizePathSegments "http://example/a/b/c/../../")
1018testNormalize23 = testEq "testNormalize23"
1019                    "http://example/a/b/c/"
1020                    (normalizePathSegments "http://example/a/b/c/./")
1021testNormalize24 = testEq "testNormalize24"
1022                    "http://example/a/b/"
1023                    (normalizePathSegments "http://example/a/b/c/.././")
1024testNormalize25 = testEq "testNormalize25"
1025                    "http://example/e"
1026                    (normalizePathSegments "http://example/a/b/c/d/../../../../e")
1027testNormalize26 = testEq "testNormalize26"
1028                    "http://example/e"
1029                    (normalizePathSegments "http://example/a/b/c/d/../.././../../e")
1030testNormalize27 = testEq "testNormalize27"
1031                    "http://example/e"
1032                    (normalizePathSegments "http://example/a/b/../.././../../e")
1033testNormalize28 = testEq "testNormalize28"
1034                    "foo:e"
1035                    (normalizePathSegments "foo:a/b/../.././../../e")
1036
1037testNormalizeSuite = TF.testGroup "testNormalizeSuite"
1038  [ TF.testCase "testNormalize01" testNormalize01
1039  , TF.testCase "testNormalize11" testNormalize11
1040  , TF.testCase "testNormalize12" testNormalize12
1041  , TF.testCase "testNormalize13" testNormalize13
1042  , TF.testCase "testNormalize21" testNormalize21
1043  , TF.testCase "testNormalize22" testNormalize22
1044  , TF.testCase "testNormalize23" testNormalize23
1045  , TF.testCase "testNormalize24" testNormalize24
1046  , TF.testCase "testNormalize25" testNormalize25
1047  , TF.testCase "testNormalize26" testNormalize26
1048  , TF.testCase "testNormalize27" testNormalize27
1049  , TF.testCase "testNormalize28" testNormalize28
1050  ]
1051
1052-- URI formatting (show) tests
1053
1054ts02URI = URI   { uriScheme    = "http:"
1055                , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")
1056                , uriPath      = "/aaa/bbb"
1057                , uriQuery     = "?ccc"
1058                , uriFragment  = "#ddd/eee"
1059                }
1060
1061ts04URI = URI   { uriScheme    = "http:"
1062                , uriAuthority = Just (URIAuth "user:anonymous@" "example.org" ":99")
1063                , uriPath      = "/aaa/bbb"
1064                , uriQuery     = "?ccc"
1065                , uriFragment  = "#ddd/eee"
1066                }
1067
1068ts02str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee"
1069ts03str = "http://user:pass@example.org:99/aaa/bbb?ccc#ddd/eee"
1070ts04str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee"
1071
1072testShowURI01 = testEq "testShowURI01" ""      (show nullURI)
1073testShowURI02 = testEq "testShowURI02" ts02str (show ts02URI)
1074testShowURI03 = testEq "testShowURI03" ts03str ((uriToString id ts02URI) "")
1075testShowURI04 = testEq "testShowURI04" ts04str (show ts04URI)
1076
1077testShowURI = TF.testGroup "testShowURI"
1078  [ TF.testCase "testShowURI01" testShowURI01
1079  , TF.testCase "testShowURI02" testShowURI02
1080  , TF.testCase "testShowURI03" testShowURI03
1081  , TF.testCase "testShowURI04" testShowURI04
1082  ]
1083
1084
1085-- URI escaping tests
1086
1087te01str = "http://example.org/az/09-_/.~:/?#[]@!$&'()*+,;="
1088te02str = "http://example.org/a</b>/c%/d /e"
1089te02esc = "http://example.org/a%3C/b%3E/c%25/d%20/e"
1090
1091testEscapeURIString01 = testEq "testEscapeURIString01"
1092    te01str (escapeURIString isUnescapedInURI te01str)
1093
1094testEscapeURIString02 = testEq "testEscapeURIString02"
1095    te02esc (escapeURIString isUnescapedInURI te02str)
1096
1097testEscapeURIString03 = testEq "testEscapeURIString03"
1098    te01str (unEscapeString te01str)
1099
1100testEscapeURIString04 = testEq "testEscapeURIString04"
1101    te02str (unEscapeString te02esc)
1102
1103testEscapeURIString05 = testEq "testEscapeURIString05"
1104    "http%3A%2F%2Fexample.org%2Faz%2F09-_%2F.~%3A%2F%3F%23%5B%5D%40%21%24%26%27%28%29%2A%2B%2C%3B%3D"
1105    (escapeURIString isUnescapedInURIComponent te01str)
1106
1107testEscapeURIString06 = testEq "testEscapeURIString06"
1108    "hello%C3%B8%C2%A9%E6%97%A5%E6%9C%AC"
1109    (escapeURIString isUnescapedInURIComponent "helloø©日本")
1110
1111propEscapeUnEscapeLoop :: String -> Bool
1112propEscapeUnEscapeLoop s = s == (unEscapeString $! escaped)
1113        where
1114        escaped = escapeURIString (const False) s
1115        {-# NOINLINE escaped #-}
1116
1117testEscapeURIString = TF.testGroup "testEscapeURIString"
1118  [ TF.testCase "testEscapeURIString01" testEscapeURIString01
1119  , TF.testCase "testEscapeURIString02" testEscapeURIString02
1120  , TF.testCase "testEscapeURIString03" testEscapeURIString03
1121  , TF.testCase "testEscapeURIString04" testEscapeURIString04
1122  , TF.testCase "testEscapeURIString05" testEscapeURIString05
1123  , TF.testCase "testEscapeURIString06" testEscapeURIString06
1124  , TF.testProperty "propEscapeUnEscapeLoop" propEscapeUnEscapeLoop
1125  ]
1126
1127-- URI string normalization tests
1128
1129tn01str = "eXAMPLE://a/b/%7bfoo%7d"
1130tn01nrm = "example://a/b/%7Bfoo%7D"
1131
1132tn02str = "example://a/b/%63/"
1133tn02nrm = "example://a/b/c/"
1134
1135tn03str = "example://a/./b/../b/c/foo"
1136tn03nrm = "example://a/b/c/foo"
1137
1138tn04str = "eXAMPLE://a/b/%7bfoo%7d"     -- From RFC2396bis, 6.2.2
1139tn04nrm = "example://a/b/%7Bfoo%7D"
1140
1141tn06str = "file:/x/..//y"
1142tn06nrm = "file://y"
1143
1144tn07str = "file:x/..//y/"
1145tn07nrm = "file:/y/"
1146
1147testNormalizeURIString01 = testEq "testNormalizeURIString01"
1148    tn01nrm (normalizeCase tn01str)
1149testNormalizeURIString02 = testEq "testNormalizeURIString02"
1150    tn02nrm (normalizeEscape tn02str)
1151testNormalizeURIString03 = testEq "testNormalizeURIString03"
1152    tn03nrm (normalizePathSegments tn03str)
1153testNormalizeURIString04 = testEq "testNormalizeURIString04"
1154    tn04nrm ((normalizeCase . normalizeEscape . normalizePathSegments) tn04str)
1155testNormalizeURIString05 = testEq "testNormalizeURIString05"
1156    tn04nrm ((normalizePathSegments . normalizeEscape . normalizeCase) tn04str)
1157testNormalizeURIString06 = testEq "testNormalizeURIString06"
1158    tn06nrm (normalizePathSegments tn06str)
1159testNormalizeURIString07 = testEq "testNormalizeURIString07"
1160    tn07nrm (normalizePathSegments tn07str)
1161
1162testNormalizeURIString = TF.testGroup "testNormalizeURIString"
1163  [ TF.testCase "testNormalizeURIString01" testNormalizeURIString01
1164  , TF.testCase "testNormalizeURIString02" testNormalizeURIString02
1165  , TF.testCase "testNormalizeURIString03" testNormalizeURIString03
1166  , TF.testCase "testNormalizeURIString04" testNormalizeURIString04
1167  , TF.testCase "testNormalizeURIString05" testNormalizeURIString05
1168  , TF.testCase "testNormalizeURIString06" testNormalizeURIString06
1169  , TF.testCase "testNormalizeURIString07" testNormalizeURIString07
1170  ]
1171
1172-- Test strict vs non-strict relativeTo logic
1173
1174trbase = fromJust $ parseURIReference "http://bar.org/"
1175
1176testRelativeTo01 = testEq "testRelativeTo01"
1177    "http://bar.org/foo"
1178    (show $
1179      (fromJust $ parseURIReference "foo") `relativeTo` trbase)
1180
1181testRelativeTo02 = testEq "testRelativeTo02"
1182    "http:foo"
1183    (show $
1184      (fromJust $ parseURIReference "http:foo") `relativeTo` trbase)
1185
1186testRelativeTo03 = testEq "testRelativeTo03"
1187    "http://bar.org/foo"
1188    (show $
1189      (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase)
1190
1191testRelativeTo = TF.testGroup "testRelativeTo"
1192  [ TF.testCase "testRelativeTo01" testRelativeTo01
1193  , TF.testCase "testRelativeTo02" testRelativeTo02
1194  , TF.testCase "testRelativeTo03" testRelativeTo03
1195  ]
1196
1197-- Test alternative parsing functions
1198testAltFn01 = testEq "testAltFn01" "Just http://a.b/c#f"
1199    (show . parseURI $ "http://a.b/c#f")
1200testAltFn02 = testEq "testAltFn02" "Just http://a.b/c#f"
1201    (show . parseURIReference $ "http://a.b/c#f")
1202testAltFn03 = testEq "testAltFn03" "Just c/d#f"
1203    (show . parseRelativeReference $ "c/d#f")
1204testAltFn04 = testEq "testAltFn04" "Nothing"
1205    (show . parseRelativeReference $ "http://a.b/c#f")
1206testAltFn05 = testEq "testAltFn05" "Just http://a.b/c"
1207    (show . parseAbsoluteURI $ "http://a.b/c")
1208testAltFn06 = testEq "testAltFn06" "Nothing"
1209    (show . parseAbsoluteURI $ "http://a.b/c#f")
1210testAltFn07 = testEq "testAltFn07" "Nothing"
1211    (show . parseAbsoluteURI $ "c/d")
1212testAltFn08 = testEq "testAltFn08" "Just http://a.b/c"
1213    (show . parseAbsoluteURI $ "http://a.b/c")
1214
1215testAltFn11 = testEq "testAltFn11" True  (isURI "http://a.b/c#f")
1216testAltFn12 = testEq "testAltFn12" True  (isURIReference "http://a.b/c#f")
1217testAltFn13 = testEq "testAltFn13" True  (isRelativeReference "c/d#f")
1218testAltFn14 = testEq "testAltFn14" False (isRelativeReference "http://a.b/c#f")
1219testAltFn15 = testEq "testAltFn15" True  (isAbsoluteURI "http://a.b/c")
1220testAltFn16 = testEq "testAltFn16" False (isAbsoluteURI "http://a.b/c#f")
1221testAltFn17 = testEq "testAltFn17" False (isAbsoluteURI "c/d")
1222
1223testAltFn = TF.testGroup "testAltFn"
1224  [ TF.testCase "testAltFn01" testAltFn01
1225  , TF.testCase "testAltFn02" testAltFn02
1226  , TF.testCase "testAltFn03" testAltFn03
1227  , TF.testCase "testAltFn04" testAltFn04
1228  , TF.testCase "testAltFn05" testAltFn05
1229  , TF.testCase "testAltFn06" testAltFn06
1230  , TF.testCase "testAltFn07" testAltFn07
1231  , TF.testCase "testAltFn08" testAltFn08
1232  , TF.testCase "testAltFn11" testAltFn11
1233  , TF.testCase "testAltFn12" testAltFn12
1234  , TF.testCase "testAltFn13" testAltFn13
1235  , TF.testCase "testAltFn14" testAltFn14
1236  , TF.testCase "testAltFn15" testAltFn15
1237  , TF.testCase "testAltFn16" testAltFn16
1238  , TF.testCase "testAltFn17" testAltFn17
1239  ]
1240
1241testUriIsAbsolute :: String -> Assertion
1242testUriIsAbsolute str =
1243    assertBool str (uriIsAbsolute uri)
1244    where
1245    Just uri = parseURIReference str
1246
1247testUriIsRelative :: String -> Assertion
1248testUriIsRelative str =
1249    assertBool str (uriIsRelative uri)
1250    where
1251    Just uri = parseURIReference str
1252
1253testIsAbsolute = TF.testGroup "testIsAbsolute"
1254  [ TF.testCase "testIsAbsolute01" $ testUriIsAbsolute "http://google.com"
1255  , TF.testCase "testIsAbsolute02" $ testUriIsAbsolute "ftp://p.x.ca/woo?hai=a"
1256  , TF.testCase "testIsAbsolute03" $ testUriIsAbsolute "mailto:bob@example.com"
1257  ]
1258
1259testIsRelative = TF.testGroup "testIsRelative"
1260  [ TF.testCase "testIsRelative01" $ testUriIsRelative "//google.com"
1261  , TF.testCase "testIsRelative02" $ testUriIsRelative "/hello"
1262  , TF.testCase "testIsRelative03" $ testUriIsRelative "this/is/a/path"
1263  , TF.testCase "testIsRelative04" $ testUriIsRelative "?what=that"
1264  ]
1265
1266testPathSegmentsRoundTrip :: URI -> Assertion
1267testPathSegmentsRoundTrip u =
1268  let segs = pathSegments u
1269
1270      dropSuffix _suf []              = []
1271      dropSuffix suf [x] | suf == x   = []
1272                         | otherwise = [x]
1273      dropSuffix suf (x:xs)          = x : dropSuffix suf xs
1274
1275      dropPrefix _pre []                 = []
1276      dropPrefix pre (x:xs) | pre == x   = xs
1277                            | otherwise = (x:xs)
1278      strippedUriPath = dropSuffix '/' $ dropPrefix '/' $ uriPath u
1279  in
1280     (Data.List.intercalate "/" segs @?= strippedUriPath)
1281
1282assertJust _f Nothing = assertFailure "URI failed to parse"
1283assertJust f  (Just x) = f x
1284
1285testPathSegments = TF.testGroup "testPathSegments"
1286  [ TF.testCase "testPathSegments03" $
1287        assertJust testPathSegmentsRoundTrip $ parseURIReference ""
1288  , TF.testCase "testPathSegments04" $
1289        assertJust testPathSegmentsRoundTrip $ parseURIReference "/"
1290  , TF.testCase "testPathSegments05" $
1291        assertJust testPathSegmentsRoundTrip $ parseURIReference "//"
1292  , TF.testCase "testPathSegments06" $
1293        assertJust testPathSegmentsRoundTrip $ parseURIReference "foo//bar/"
1294  , TF.testCase "testPathSegments07" $
1295        assertJust testPathSegmentsRoundTrip $ parseURIReference "/foo//bar/"
1296  , TF.testCase "testPathSegments03" $
1297        assertJust testPathSegmentsRoundTrip $ parseURI "http://example.org"
1298  , TF.testCase "testPathSegments04" $
1299        assertJust testPathSegmentsRoundTrip $ parseURI "http://example.org/"
1300  , TF.testCase "testPathSegments05" $
1301        assertJust testPathSegmentsRoundTrip $ parseURI "http://example.org//"
1302  , TF.testCase "testPathSegments06" $
1303        assertJust testPathSegmentsRoundTrip $ parseURI "http://ex.ca/foo//bar/"
1304  , TF.testCase "testPathSegments07" $
1305        assertJust testPathSegmentsRoundTrip $ parseURI "http://ex.ca/foo//bar/"
1306  ]
1307
1308testRectify = TF.testGroup "testRectify"
1309  [ TF.testCase "" $ testEq "testRectify"
1310    (show $ rectify $ URI { uriScheme = "http" ,
1311                            uriAuthority = Just (URIAuth "ezra" "www.google.com" "80") ,
1312                            uriPath = "/foo/bar" ,
1313                            uriQuery = "foo=bar&baz=quz" ,
1314                            uriFragment = "chap10" })
1315    "http://ezra@www.google.com:80/foo/bar?foo=bar&baz=quz#chap10"
1316  , -- According to RFC2986, any URL without a // does not have an authority component.
1317    -- Therefore tag: URIs have all their content in the path component. This is supported
1318    -- by the urn: example in section 3. Note that tag: URIs have no leading slash on their
1319    -- path component.
1320    TF.testCase "" $ testEq "testRectify"
1321    "tag:timothy@hpl.hp.com,2001:web/externalHome"
1322    (show $ rectify $ URI { uriScheme = "tag" ,
1323                            uriAuthority = Nothing,
1324                            uriPath = "timothy@hpl.hp.com,2001:web/externalHome",
1325                            uriQuery = "" ,
1326                            uriFragment = "" })
1327  , TF.testCase "" $ testEq "testRectifyAuth"
1328    "//ezra@www.google.com:80"
1329    ((uriAuthToString id . Just . rectifyAuth $ URIAuth "ezra" "www.google.com" "80") "")
1330  ]
1331
1332-- Full test suite
1333allTests =
1334  [ testURIRefSuite
1335  , testComponentSuite
1336  , testRelativeSuite
1337  , testRFC2396Suite
1338  , testOddballSuite
1339  , testNormalizeSuite
1340  , testShowURI
1341  , testEscapeURIString
1342  , testNormalizeURIString
1343  , testRelativeTo
1344  , testAltFn
1345  , testIsAbsolute
1346  , testIsRelative
1347  , testPathSegments
1348  , testRectify
1349  ]
1350
1351main = TF.defaultMain allTests
1352
1353runTestFile t = do
1354    h <- openFile "a.tmp" WriteMode
1355    _ <- runTestText (putTextToHandle h False) t
1356    hClose h
1357tf = runTestFile
1358tt = runTestTT
1359
1360-- Miscellaneous values for hand-testing/debugging in Hugs:
1361
1362uref = testURIRefSuite
1363tr01 = testRelative01
1364tr02 = testRelative02
1365tr03 = testRelative03
1366tr04 = testRelative04
1367rel  = testRelativeSuite
1368rfc  = testRFC2396Suite
1369oddb = testOddballSuite
1370
1371(Just bu02) = parseURIReference "http://example/x/y/z"
1372(Just ou02) = parseURIReference "../abc"
1373(Just ru02) = parseURIReference "http://example/x/abc"
1374-- fileuri = testURIReference "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/"
1375
1376cu02 = ou02 `relativeTo` bu02
1377
1378--------------------------------------------------------------------------------
1379--
1380--  Copyright (c) 2004, G. KLYNE.  All rights reserved.
1381--  Distributed as free software under the following license.
1382--
1383--  Redistribution and use in source and binary forms, with or without
1384--  modification, are permitted provided that the following conditions
1385--  are met:
1386--
1387--  - Redistributions of source code must retain the above copyright notice,
1388--  this list of conditions and the following disclaimer.
1389--
1390--  - Redistributions in binary form must reproduce the above copyright
1391--  notice, this list of conditions and the following disclaimer in the
1392--  documentation and/or other materials provided with the distribution.
1393--
1394--  - Neither name of the copyright holders nor the names of its
1395--  contributors may be used to endorse or promote products derived from
1396--  this software without specific prior written permission.
1397--
1398--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS
1399--  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1400--  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1401--  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1402--  HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
1403--  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
1404--  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
1405--  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1406--  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
1407--  TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
1408--  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1409--
1410--------------------------------------------------------------------------------
1411-- $Source: /srv/cvs/cvs.haskell.org/fptools/libraries/network/tests/URITest.hs,v $
1412-- $Author: gklyne $
1413-- $Revision: 1.8 $
1414-- $Log: URITest.hs,v $
1415-- Revision 1.81 2012/08/01           aaronfriel
1416-- Added additional test case for the "xip.io" service style URLs and absolute URLs prefixed with ipv4 addresses.
1417--
1418-- Revision 1.8  2005/07/19 22:01:27  gklyne
1419-- 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.
1420--
1421-- Revision 1.7  2005/06/06 16:31:44  gklyne
1422-- Added two new test cases.
1423--
1424-- Revision 1.6  2005/05/31 17:18:36  gklyne
1425-- Added some additional test cases triggered by URI-list discussions.
1426--
1427-- Revision 1.5  2005/04/07 11:09:37  gklyne
1428-- Added test cases for alternate parsing functions (including deprecated 'parseabsoluteURI')
1429--
1430-- Revision 1.4  2005/04/05 12:47:32  gklyne
1431-- Added test case.
1432-- Changed module name, now requires GHC -main-is to compile.
1433-- All tests run OK with GHC 6.4 on MS-Windows.
1434--
1435-- Revision 1.3  2004/11/05 17:29:09  gklyne
1436-- Changed password-obscuring logic to reflect late change in revised URI
1437-- specification (password "anonymous" is no longer a special case).
1438-- Updated URI test module to use function 'escapeURIString'.
1439-- (Should unEscapeString be similarly updated?)
1440--
1441-- Revision 1.2  2004/10/27 13:06:55  gklyne
1442-- Updated URI module function names per:
1443-- http://www.haskell.org//pipermail/cvs-libraries/2004-October/002916.html
1444-- Added test cases to give better covereage of module functions.
1445--
1446-- Revision 1.1  2004/10/14 16:11:30  gklyne
1447-- Add URI unit test to cvs.haskell.org repository
1448--
1449-- Revision 1.17  2004/10/14 11:51:09  graham
1450-- Confirm that URITest runs with GHC.
1451-- Fix up some comments and other minor details.
1452--
1453-- Revision 1.16  2004/10/14 11:45:30  graham
1454-- Use moduke name main for GHC 6.2
1455--
1456-- Revision 1.15  2004/08/11 11:07:39  graham
1457-- Add new test case.
1458--
1459-- Revision 1.14  2004/06/30 11:35:27  graham
1460-- Update URI code to use hierarchical libraries for Parsec and Network.
1461--
1462-- Revision 1.13  2004/06/22 16:19:16  graham
1463-- New URI test case added.
1464--
1465-- Revision 1.12  2004/04/21 15:13:29  graham
1466-- Add test case
1467--
1468-- Revision 1.11  2004/04/21 14:54:05  graham
1469-- Fix up some tests
1470--
1471-- Revision 1.10  2004/04/20 14:54:13  graham
1472-- Fix up test cases related to port number in authority,
1473-- and add some more URI decomposition tests.
1474--
1475-- Revision 1.9  2004/04/07 15:06:17  graham
1476-- Add extra test case
1477-- Revise syntax in line with changes to RFC2396bis
1478--
1479-- Revision 1.8  2004/03/17 14:34:58  graham
1480-- Add Network.HTTP files to CVS
1481--
1482-- Revision 1.7  2004/03/16 14:19:38  graham
1483-- Change licence to BSD style;  add nullURI definition; new test cases.
1484--
1485-- Revision 1.6  2004/02/20 12:12:00  graham
1486-- Add URI normalization functions
1487--
1488-- Revision 1.5  2004/02/19 23:19:35  graham
1489-- Network.URI module passes all test cases
1490--
1491-- Revision 1.4  2004/02/17 20:06:02  graham
1492-- Revised URI parser to reflect latest RFC2396bis (-04)
1493--
1494-- Revision 1.3  2004/02/11 14:32:14  graham
1495-- Added work-in-progress notes.
1496--
1497-- Revision 1.2  2004/02/02 14:00:39  graham
1498-- Fix optional host name in URI.  Add test cases.
1499--
1500-- Revision 1.1  2004/01/27 21:13:45  graham
1501-- New URI module and test suite added,
1502-- implementing the GHC Network.URI interface.
1503--
1504