#lang racket/base
;; $Id: test-uri.rkt,v 1.6 2011/03/04 07:49:01 neilpair Exp $
;; See file uri.rkt for legal info.

(require (planet neil/testeez:1:2)
         "uri.rkt")

(testeez
 "uri"

 (test/equal "" (uri-escape-i "")            "")
 (test/equal "" (uri-escape-i "a b")         "a%20b")
 (test/equal "" (uri-escape-i "a b c")       "a%20b%20c")
 (test/equal "" (uri-escape-i "aaa bbb ccc") "aaa%20bbb%20ccc")
 (test/equal "" (uri-escape-i " a ")         "%20a%20")
 (test/equal "" (uri-escape-i "a/b")         "a%2Fb")
 (test/equal "" (uri-escape-i "a%b")         "a%25b")

 (test/equal "" (uri-plusescape-i "")            "")
 (test/equal "" (uri-plusescape-i "a b")         "a+b")
 (test/equal "" (uri-plusescape-i "a b c")       "a+b+c")
 (test/equal "" (uri-plusescape-i "aaa bbb ccc") "aaa+bbb+ccc")
 (test/equal "" (uri-plusescape-i " a ")         "+a+")
 (test/equal "" (uri-plusescape-i "a/b")         "a%2Fb")
 (test/equal "" (uri-plusescape-i "a%b")         "a%25b")

 (test/equal "" (uri-unescape-i "")                "")
 (test/equal "" (uri-unescape-i "%")               "%")
 (test/equal "" (uri-unescape-i "%0")              "%0")
 (test/equal "" (uri-unescape-i "%1")              "%1")
 (test/equal "" (uri-unescape-i "a%20b")           "a b")
 (test/equal "" (uri-unescape-i "a%20b%20c")       "a b c")
 (test/equal "" (uri-unescape-i "aaa%20bbb%20ccc") "aaa bbb ccc")
 (test/equal "" (uri-unescape-i "%20a%20")         " a ")
 (test/equal "" (uri-unescape-i "a%2Fb")           "a/b")
 (test/equal "" (uri-unescape-i "a%2fb")           "a/b")
 (test/equal "" (uri-unescape-i "a%25b")           "a%b")

 (test/equal "" (string->uripath "")    '(0))
 (test/equal "" (string->uripath ".")   '(0 #f))
 (test/equal "" (string->uripath "..")  '(1))
 (test/equal "" (string->uripath "./")  '(0 #f))
 (test/equal "" (string->uripath "../") '(1 #f))
 (test/equal "" (string->uripath "/")   '(#f))
 (test/equal "" (string->uripath "/.")  '(#f))
 (test/equal "" (string->uripath "/..") '(1))

 (test/equal "" (string->uripath "a/b")            '(0 "b" "a"))
 (test/equal "" (string->uripath "/a/b")           '("b" "a"))
 (test/equal "" (string->uripath "./a/b")          '(0 "b" "a"))
 (test/equal "" (string->uripath "/./a/b")         '("b" "a"))
 (test/equal "" (string->uripath "/../a/b")        '(1 "b" "a"))
 (test/equal "" (string->uripath "/../../a/b")     '(2 "b" "a"))
 (test/equal "" (string->uripath "/../../../a/b")  '(3 "b" "a"))
 (test/equal "" (string->uripath "/a/../b")        '("b"))
 (test/equal "" (string->uripath "/a/../../b")     '(1 "b"))
 (test/equal "" (string->uripath "/a/../../../b")  '(2 "b"))
 (test/equal "" (string->uripath "a/../b")         '(0 "b"))
 (test/equal "" (string->uripath "a/../../b")      '(1 "b"))
 (test/equal "" (string->uripath "a/../../../b")   '(2 "b"))

 (test/equal "" (string->uripath "/")     '(#f))
 (test/equal "" (string->uripath "//")    '(#f #f))
 (test/equal "" (string->uripath "///")   '(#f #f #f))
 (test/equal "" (string->uripath "/a/")   '(#f "a"))

 (test/equal "" (string->uripath "//a")   '("a" #f))
 (test/equal "" (string->uripath "/;p/a") '("a" (#f "p")))
 (test/equal "" (string->uripath "///a")  '("a" #f #f))

 (test/equal "empty path segment at start of absolute path"
             (string->uripath "//a/b")
             '("b" "a" #f))
 (test/equal "empty path segment at start of relative path"
             (string->uripath ".//a/b")
             '(0 "b" "a" #f))
 (test/equal "empty path segment with param at start of absolute path"
             (string->uripath "/;p/a/b")
             '("b" "a" (#f "p")))
 (test/equal "empty path segment with param at start of relative path"
             (string->uripath ";p/a/b")
             '(0 "b" "a" (#f "p")))
 (test/equal "empty path segment in middle of path"
             (string->uripath "/a//b/")
             '(#f "b" #f "a"))
 (test/equal "empty path segment with parameter in middle of path"
             (string->uripath "/a/;p/b/")
             '(#f "b" (#f "p") "a"))
 (test/equal "empty path segment with parameter at end of path"
             (string->uripath "/a/b/;p")
             '((#f "p") "b" "a"))

 (test/equal "empty path parameter"
             (string->uripath "/a/;/b")
             '("b" (#f #f) "a"))
 (test/equal "multiple empty path parameters"
             (string->uripath "/a/;;;/b")
             '("b" (#f #f #f #f) "a"))

 (test/equal "path segment beginning with dot"
             (string->uripath "/a/.b/c")
             '("c" ".b" "a"))
 (test/equal "path segment beginning with double-dot"
             (string->uripath "/a/..b/c")
             '("c" "..b" "a"))

 (test/equal ""
             (uri-path "../../a/b;p1/c/d;p2;p3/;p5")
             '(2 (#f "p5") ("d" "p2" "p3") "c" ("b" "p1") "a"))

 (test/equal ""
             (uri-path/noparams "../../a/b;p1/c/d;p2;p3/e/;p5")
             '(2 #f "e" "d" "c" "b" "a"))

 (test/equal ""
             (string->uriquery "q=fiendish+scheme&case&foo=&x=1%2B2")
             '(("q"    . "fiendish scheme")
               ("case" . #t)
               ("foo"  . "")
               ("x"    . "1+2")))

 (test/equal "" (string->uriquery "")    '())
 (test/equal "" (string->uriquery "&")   '())
 (test/equal "" (string->uriquery "&&")  '())
 (test/equal "" (string->uriquery "x&&") '(("x" . #t)))
 (test/equal "" (string->uriquery "&&x") '(("x" . #t)))

 (test/equal ""
             (uriquery-value (string->uriquery "x=a%20b") "x")
             "a b")
 (test/equal ""
             (uriquery-value (string->uriquery "x=a%20b") "y")
             #f)
 (test/equal ""
             (uriquery-value (string->uriquery "x=") "x")
             "")
 (test/equal ""
             (uriquery-value (string->uriquery "x=&") "x")
             "")
 (test/equal ""
             (uriquery-value (string->uriquery "x") "x")
             #t)
 (test/equal ""
             (uriquery-value (string->uriquery "x&") "x")
             #t)

 (test/equal ""
             (resolved-uripath '(2 "c" "b" "a") '(#f "z" "y" "x"))
             '("c" "b" "a" "x"))

 (test/equal ""
             (uripath->string
              (resolved-uripath (string->uripath "../../a/b/c")
                                (string->uripath "/x/y/z/")))
             "/x/a/b/c")

 (test/equal ""
             (uri->string (uri-with-fragment (string->uri "http://www/foo#bar") "x y z"))
             "http://www/foo#x%20y%20z")

 (test/equal ""
             (uri->string (uri-with-fragment/escaped (string->uri "http://www/foo#bar") "x y z"))
             "http://www/foo#x y z")

 (test/equal ""
             (string->uriserver "")
             #f)

 (test/equal ""
             (string->uriserver "myhost")
             "myhost")

 (test/equal ""
             (string->uriserver "myhost:80")
             '(#f "myhost" 80))

 (test/equal ""
             (string->uriserver "myuser@myhost")
             '("myuser" "myhost" #f))

 (test/equal ""
             (string->uriserver "myuser@myhost:80")
             '("myuser" "myhost" 80))

 (test/equal ""
             (string->uriserver "john%20smith@f%6F%4F:8%30")
             '("john smith" "foo" 80))

 (test/equal ""
             (string/default-portnum->uriserver "www.foo:80" 80)
             "www.foo")

 (test/equal ""
             (string/default-portnum->uriserver "www.foo:8080" 80)
             '(#f "www.foo" 8080))

 (test/equal ""
             (string/default-portnum->uriserver "u@www.foo:80" 80)
             '("u" "www.foo" #f))

 (test/equal ""
             (string/default-portnum->uriserver "u@www.foo:8080" 80)
             '("u" "www.foo" 8080))

 (test/equal ""
             (string/default-portnum->uriserver ":80" 80)
             #f)

 (test/equal ""
             (string/default-portnum->uriserver ":8080" 80)
             '(#f #f 8080))

 (test/equal ""
             (uri-uriserver (string->uri "//www:80/"))
             '(#f "www" 80))

 (test/equal ""
             (uri-uriserver (resolved-uri (string->uri "//www:80/") (string->uri "http:")))
             "www")

 (test/equal ""
             (uri-server-portnum (string->uri "http:"))
             80)

 (test/equal ""
             (uri-server-portnum (string->uri "http://www/"))
             80)

 (test/equal ""
             (uri-server-portnum (string->uri "http://www:80/"))
             80)

 (test/equal ""
             (uri-server-portnum (string->uri "http://www:8080/"))
             8080)

 (test/equal ""
             (uri->string (resolved-uri (string->uri ".././.././././foo.html")
                                        (string->uri "http://www/aaa/bbb/ccc/index.html")))
             "http://www/aaa/foo.html")

 (test/equal ""
             (uri->string (resolved-uri (string->uri ".") (string->uri "http://www")))
             ;; TODO: There might not be any good answer to this one.  Maybe
             ;; just leave off the "/.", so long as that doesn't make
             ;; anything in the rest of the URI ambiguous?
             "http://www/.")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "x") (string->uri "http://www/a/b/c/")))
             "http://www/a/b/c/x")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "../x") (string->uri "http://www/a/b/c/")))
             "http://www/a/b/x")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "../../x") (string->uri "http://www/a/b/c/")))
             "http://www/a/x")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "../../") (string->uri "http://www/a/b/c/")))
             "http://www/a/")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "../..") (string->uri "http://www/a/b/c/")))
             ;; TODO: This seems probably right, but we should check with an
             ;; authoritative source.
             "http://www/a/b")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "mailto:foo@bar") (string->uri "http://www/a/index.html")))
             "mailto:foo@bar")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "www/a/index.html") (string->uri "mailto:foo@bar")))
             "mailto:www/a/index.html")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "//www:80/") (string->uri "http:")))
             "http://www/")

 (test/equal ""
             (uri->string (resolved-uri (string->uri "/foo?x=1&y=a%20b&z") (string->uri "http:")))
             "http:/foo?x=1&y=a%20b&z")

 (test/equal ""
             (uri->string (absolute-uri (string->uri "http:foo")))
             "http:/foo")

 (test/equal ""
             (uri->string (absolute-uri (string->uri "http:?xxx")))
             "http:/?xxx")

 (test/equal ""
             (uri->string (absolute-uri (string->uri "http:../foo")))
             "http:/foo")

 (test/equal ""
             (uri->string (absolute-uri (string->uri "http:")))
             "http:/")

 (test/equal ""

             (uri->string (absolute-uri (string->uri "mailto:foo")))
             "mailto:foo")

 (test/equal ""
             (uripath->string '(#f))
             "/")

 (test/equal ""
             (uripath->string/leading-slash '(#f))
             "/")

 (test/equal ""
             (uripath->string (string->uripath "//a"))
             "//a")

 (test/equal ""
             (uripath->string/leading-slash (string->uripath "//a"))
             "/.//a")

 ;; New representation and resolver tests to fix "" and "." path semantics:

 (test/equal ""
             (uri->string (resolved-uri (string->uri "") (string->uri "http://www/foo/bar/index.html")))
             "http://www/foo/bar/index.html")

 (test/equal ""
             (uri->string (resolved-uri (string->uri ".") (string->uri "http://www/foo/bar/index.html")))
             "http://www/foo/bar/")

 (test/equal ""
             (string->uripath "")
             '(0))

 (test/equal ""
             (string->uripath ".")
             '(0 #f))

 (test/equal ""
             (string->uripath "/")
             '(#f))

 (test/equal ""
             (uri->string (resolved-uri (string->uri "//www/") (string->uri "http:")))
             "http://www/")

 (test/equal ""
             (uri-path (string->uri "//www:80/"))
             '(#f))

 ;; RFC3986 sec. 5.4.1:

 (test/equal "" (uri->string (resolved-uri (string->uri "g:h")     (string->uri "http://a/b/c/d;p?q"))) "g:h")
 (test/equal "" (uri->string (resolved-uri (string->uri "g")       (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "./g")     (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "g/")      (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g/")
 (test/equal "" (uri->string (resolved-uri (string->uri "/g")      (string->uri "http://a/b/c/d;p?q"))) "http://a/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "//g")     (string->uri "http://a/b/c/d;p?q"))) "http://g")
 (test/equal "" (uri->string (resolved-uri (string->uri "?y")      (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/d;p?y")
 (test/equal "" (uri->string (resolved-uri (string->uri "g?y")     (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g?y")
 (test/equal "" (uri->string (resolved-uri (string->uri "#s")      (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/d;p?q#s")
 (test/equal "" (uri->string (resolved-uri (string->uri "g#s")     (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g#s")
 (test/equal "" (uri->string (resolved-uri (string->uri "g?y#s")   (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g?y#s")
 (test/equal "" (uri->string (resolved-uri (string->uri ";x")      (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/;x")
 (test/equal "" (uri->string (resolved-uri (string->uri "g;x")     (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g;x")
 (test/equal "" (uri->string (resolved-uri (string->uri "g;x?y#s") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g;x?y#s")
 (test/equal "" (uri->string (resolved-uri (string->uri "")        (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/d;p?q")
 (test/equal "" (uri->string (resolved-uri (string->uri ".")       (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/")
 (test/equal "" (uri->string (resolved-uri (string->uri "./")      (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/")
 (test/equal "" (uri->string (resolved-uri (string->uri "..")      (string->uri "http://a/b/c/d;p?q"))) "http://a/b/")
 (test/equal "" (uri->string (resolved-uri (string->uri "../")     (string->uri "http://a/b/c/d;p?q"))) "http://a/b/")
 (test/equal "" (uri->string (resolved-uri (string->uri "../g")    (string->uri "http://a/b/c/d;p?q"))) "http://a/b/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "../..")   (string->uri "http://a/b/c/d;p?q"))) "http://a/")
 (test/equal "" (uri->string (resolved-uri (string->uri "../../")  (string->uri "http://a/b/c/d;p?q"))) "http://a/")
 (test/equal "" (uri->string (resolved-uri (string->uri "../../g") (string->uri "http://a/b/c/d;p?q"))) "http://a/g")

 ;; RFC3986 sec. 5.4.1:

 (test/equal "" (uri->string (resolved-uri (string->uri "../../../g") (string->uri "http://a/b/c/d;p?q"))) "http://a/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "../../../../g") (string->uri "http://a/b/c/d;p?q"))) "http://a/g")

 (test/equal "" (uri->string (resolved-uri (string->uri "/./g") (string->uri "http://a/b/c/d;p?q"))) "http://a/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "/../g") (string->uri "http://a/b/c/d;p?q"))) "http://a/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "g.") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g.")
 (test/equal "" (uri->string (resolved-uri (string->uri ".g") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/.g")
 (test/equal "" (uri->string (resolved-uri (string->uri "g..") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g..")
 (test/equal "" (uri->string (resolved-uri (string->uri "..g") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/..g")

 (test/equal "" (uri->string (resolved-uri (string->uri "./../g") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/g")
 (test/equal "" (uri->string (resolved-uri (string->uri "./g/.") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g/")
 (test/equal "" (uri->string (resolved-uri (string->uri "g/./h") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g/h")
 (test/equal "" (uri->string (resolved-uri (string->uri "g/../h") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/h")
 (test/equal "" (uri->string (resolved-uri (string->uri "g;x=1/./y") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g;x=1/y")
 (test/equal "" (uri->string (resolved-uri (string->uri "g;x=1/../y") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/y")

 (test/equal "" (uri->string (resolved-uri (string->uri "g?/./x") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g?y/./x")
 (test/equal "" (uri->string (resolved-uri (string->uri "g?y/../x") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g?y/../x")
 (test/equal "" (uri->string (resolved-uri (string->uri "g#s/./x") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g#s/./x")
 (test/equal "" (uri->string (resolved-uri (string->uri "g#s/../x") (string->uri "http://a/b/c/d;p?q"))) "http://a/b/c/g#s/../x")

 ;; (test/equal ""
 ;; (uri-with-scheme "http://w/" https-uri-scheme)
 ;; "https://w/")
 ;;
 ;; (test/equal ""
 ;; (uri-with-scheme "http://w:80/" https-uri-scheme)
 ;; "https://w/")
 ;;
 ;; (test/equal ""
 ;; (uri-with-scheme "http://w:8080/" https-uri-scheme)
 ;; "https://w:8080/")

 ;; "imap://minbari.org/gray-council;UIDVALIDITY=385759045/;UID=20"
 ;; "imap://michael@minbari.org/users.*;type=list"
 ;; "imap://psicorp.org/~peter/%E6%97%A5%E6%9C%AC%E8%AA%9E/%E5%8F%B0%E5%8C%97"
 ;; "imap://;AUTH=KERBEROS_V4@minbari.org/gray-council/;uid=20/;section=1.2"
 ;; "imap://;AUTH=*@minbari.org/gray%20council?SUBJECT%20shadows"

 ;; ANTIRESOLVED

 ;; (test/equal
 ;;  "Equivalent"
 ;;  (antiresolved-uripath '("c" "b" "a")
 ;;                        '("c" "b" "a"))
 ;;  '(0))
 ;;
 ;; (test/equal
 ;;  "Same length, only top segment different"
 ;;  (antiresolved-uripath '("x" "c" "b" "a")
 ;;                        '("p" "c" "b" "a"))
 ;;  '(0 "x"))
 ;;
 ;; (test/equal
 ;;  "Same length, everything different"
 ;;  (antiresolved-uripath '("z" "y" "x")
 ;;                        '("c" "b" "a"))
 ;;  '(2 "z" "y" "x"))

 ;; (test/equal
 ;;  "Same length, shared base"
 ;;  (antiresolved-uripath '("z" "y" "x" "c" "b" "a")
 ;;                        '("r" "q" "p" "c" "b" "a"))
 ;;  '(2 "z" "y" "x"))
 ;;
 ;;  (test/equal
 ;;   "Same length, identical base"
 ;;   (let ((tail '("b" "a")))
 ;;     (antiresolved-uripath (cons "z" (cons "y" (cons "x" (cons "c" tail))))
 ;;                           (cons "r" (cons "q" (cons "p" (cons "c" tail))))))
 ;;   '(2 "z" "y" "x"))
 ;;
 ;;  (test/equal
 ;;   "Equivalent"
 ;;   (antiresolved-uripath '("c" "b" "a")
 ;;                         '("c" "b" "a"))
 ;;   '(0))
 ;;
 ;;  (test/equal
 ;;   "A longer, entirely shared base #1"
 ;;   (antiresolved-uripath '("d" "c" "b" "a")
 ;;                         '("c" "b" "a"))
 ;;   '(0 "d" "c"))
 ;;
 ;;  (test/equal
 ;;   "A longer, entirely shared base #2"
 ;;   (antiresolved-uripath '("e" "d" "c" "b" "a")
 ;;                         '("c" "b" "a"))
 ;;   '(0 "e" "d" "c"))
 ;;
 ;;  (test/equal
 ;;   "A longer, entirely shared base #3"
 ;;   (antiresolved-uripath '("f" "e" "d" "c" "b" "a")
 ;;                         '("c" "b" "a"))
 ;;   '(0 "f" "e" "d" "c"))
 ;;
 ;;  (test/equal
 ;;   "A longer, entirely shared base #4"
 ;;   (antiresolved-uripath '("g" "f" "e" "d" "c" "b" "a")
 ;;                         '("c" "b" "a"))
 ;;   '(0 "g" "f" "e" "d" "c"))
 ;;
 ;;  (test/equal
 ;;   "A longer, partially shared base #1"
 ;;   (antiresolved-uripath '("e" "d" "c" "b" "a")
 ;;                         '("y" "x" "c" "b" "a"))
 ;;   '(1 "e" "d"))
 ;;
 ;;  (test/equal
 ;;   "A longer, partially shared base #2"
 ;;   (antiresolved-uripath '("f" "e" "d" "c" "b" "a")
 ;;                         '("y" "x" "c" "b" "a"))
 ;;   '(1 "f" "e" "d"))
 ;;
 ;;  (test/equal
 ;;   "A longer, partially shared base #3"
 ;;   (antiresolved-uripath '("g" "f" "e" "d" "c" "b" "a")
 ;;                         '("y" "x" "c" "b" "a"))
 ;;   '(1 "g" "f" "e" "d"))
 ;;
 ;;  (test/equal
 ;;   "A longer, partially shared base #4"
 ;;   (antiresolved-uripath '("g" "f" "e" "d" "c" "b" "a")
 ;;                         '("z" "y" "x" "c" "b" "a"))
 ;;   '(2 "g" "f" "e" "d"))
 ;;
 ;;  (test/equal
 ;;   "B longer, partially shared base"
 ;;   (antiresolved-uripath '("d" "c" "b" "a")
 ;;                         '("z" "y" "x" "c" "b" "a"))
 ;;   '(2 "d"))
 ;;
 ;;  (test/equal
 ;;   "B longer, all different"
 ;;   (antiresolved-uripath '("z" "y" "x")
 ;;                         '("f" "e" "d" "c" "b" "a"))
 ;;   '(5 "z" "y" "x"))

 )