(load "../uri-common.scm")
(import uri-common)
(use test)

(define internal-representation-cases
  `(("scheme" ,uri-scheme ; Only a few tests; uri-common doesn't do much
     ("http:" http)
     ("" #f))
    ("port" ,uri-port
     ("http://a" 80)
     ("http://a:8080" 8080)
     ("https://a" 443)
     ("https://a:1" 1)
     ("//a" #f))
    ("username" ,uri-username
     ("//foo" #f)
     ("//@" "")
     ("//foo@" "foo")
     ("//foo:bar@" "foo")
     ("//foo:bar:qux@" "foo")
     ("//foo%20bar@" "foo bar")
     ("//foo%3Abar:qux@" "foo:bar")
     ("//foo%2Ebar@" "foo.bar" "//foo.bar@"))
    ("password ",uri-password
     ("//foo" #f)
     ("//@" #f)
     ("//foo@" #f)
     ("//foo:bar@" "bar")
     ("//foo:bar:qux@" "bar:qux")
     ("//foo:bar%20qux@" "bar qux")
     ("//foo:bar%2Equx@" "bar.qux" "//foo:bar.qux@"))
    ("path" ,uri-path
     ("http://foo" (/ ""))
     ("http://foo/" (/ ""))
     ("//foo" ()) ; Correct? No scheme, so we can't know normalization rules
     ("//foo/" (/ ""))
     ("foo%20bar" ("foo bar"))
     ("foo%2Fbar" ("foo/bar"))
     ("foo%2ebar" ("foo.bar") "foo.bar")
     ("foo/bar%2Fqux" ("foo" "bar/qux"))
     ("foo/" ("foo" ""))
     ("foo/bar:qux" ("foo" "bar:qux"))
     ("/foo%2Fbar" (/ "foo/bar"))
     ("/foo/" (/ "foo" ""))
     ("/foo:bar" (/ "foo:bar")))
    ("query ",uri-query
     ("//" ())
     ("?foo" ((foo . #t)))
     ("?foo?bar" ((foo?bar . #t)))
     ("?foo/bar" ((foo/bar . #t)))
     ("?foo%3Fbar" ((foo?bar . #t)))
     ("?foo%2Ebar" ((foo.bar . #t)) "?foo.bar"))
    ("fragment" ,uri-fragment
     ("?foo" #f)
     ("#bar" "bar")
     ("?foo#bar" "bar")
     ("#foo?bar" "foo?bar")
     ("#foo%3Fbar" "foo?bar")
     ("#foo/bar" "foo/bar")
     ("#foo%2Ebar" "foo.bar" "#foo.bar"))))

(test-group "internal representations"
  (for-each (lambda (p)
              (test-group (car p)
                (for-each (lambda (u)
                            (let ((in (first u))
                                  (internal (second u))
                                  (out (if (null? (cddr u))
                                           (first u)
                                           (third u)))
                                  (uri (uri-reference (first u))))
                              (test (sprintf "~S decoded as ~S" in internal)
                                    internal ((cadr p) uri))
                              (test (sprintf "~S encoded to ~S" internal out)
                                    out (uri->string
                                         uri
                                         (lambda (u p)
                                           (if p (conc u ":" p) u))))))
                          (cddr p))))
            internal-representation-cases))

(define update-cases
  `(("query" query:
     ("" ((foo . "bar?qux")) "?foo=bar?qux")
     ("" ((foo?bar . "qux")) "?foo?bar=qux")
     ("" ((foo . "bar&qux")) "?foo=bar%26qux")
     ("" ((foo&bar . "qux")) "?foo%26bar=qux")
     ("" ((foo . "bar=qux")) "?foo=bar%3Dqux")
     ("" ((foo=bar . "qux")) "?foo%3Dbar=qux")
     ("" ((foo . "bar") (foo . "qux")) "?foo=bar;foo=qux")) ; duplicate keys ok
    ("port" port:
     ("http://a" 80 "http://a")
     ("http://a:1234" 8080 "http://a:8080"))
    ("scheme" scheme:    ;; scheme causes reset of port, in all cases
     ("https://a" http "http://a")
     ("https://a:80" http "http://a")
     ("https://a:123" http "http://a")
     ("http://a:8080" https "https://a"))
    ))

(test-group "updating"
  (for-each (lambda (p)
              (test-group (car p)
               (for-each (lambda (u)
                           (let* ((slotname (cadr p))
                                  (input (second u))
                                  (oexp (third u))
                                  (oact (update-uri
                                         (uri-reference (first u))
                                         slotname input)))
                             (test (sprintf "~S -> ~S" input oexp)
                                   oexp (uri->string oact))))
                         (cddr p))))
            update-cases))

;; These are more specific tests for the query cases above, but
;; on the direct low-level interface to make it less cumbersome
(define form-urlencoded-hoehrmann-draft-cases
  `(;; This set is straight from Section 5 ("examples") in the 2006
    ;; Hoehrmann Internet-Draft for application/www-form-urlencoded,
    ;; plus two fixes for mistakes in the alternative representations
    ;; of the first testcase (missing spaces before and after the =).
    (((| a b c | . " 1  3 "))
     "+a+b+c+=+1++3+"
     "%20a%20b%20c%20=%201%20%203%20"
     "\u0020a\u0020b\u0020c\u0020=\u00201\u0020\u00203\u0020")
    (((Text . "Line1\u000ALine2"))
     "Text=Line1%0ALine2"
     "Text=Line1\u000ALine2"
     ;; !! "Text=Line1%0D%0ALine2"
     ;; !! "Text=Line1%0A%0DLine2"
     )
    ;; XXX The following 2 examples break.
    ;; Look into encoding for IRI's in uri-generic
    (((Chevron3 . "Bo\u00F6tes")) ; broken
     "Chevron3=Bo\u00F6tes"
     "Chevron3=Bo%C3%B6tes"
     ;; !! "Chevron3=Boo\u0308tes"
     )
    (((Lookup . "\u0000,\u2323,\u20AC")) ; broken
     "Lookup=%00,\u2323,\u20AC"
     "Lookup=\u0000,\u2323,\u20AC"
     ;; !! "Lookup=,\u2323,\u20AC"
     ;; !! "Lookup="
     )
    (((Cipher . "c=(m^e)%n"))
     "Cipher=c%3D(m%5Ee)%25n"
     "Cipher=c=(m%5Ee)%25n"
     "Cipher=c=(m^e)%n"
     "%43%69%70%68%65%72=%63%3d%28%6D%5E%65%29%25%6e"
     ;; !! "Cipher%3Dc%3D(m%5Ee)%25n"
     ;; !! "Cipher=c=(m^e)"
     ;; !! "Cipher=c"
     )
    (((|| . #t) (|| . #t)) ";")
    (((|| . #t) (|| . "")) ";=")
    (((|| . "") (|| . #t)) "=;")
    (((|| . "") (|| . "")) "=;=")
    (((|| . "")) "=")
    ;;(((|| . #t)) "")                    ; Can't be distinguished from ()
    (((a&b . "1") (c . "2;3") (e . "4"))
     "a%26b=1;c=2%3B3;e=4"
     "a%26b=1&c=2%3B3&e=4"
     "a%26b=1;c=2%3B3&e=4"
     "a%26b=1&c=2%3B3;e=4"
     ;; !! "a&b=1;c=2%3B3;e=4"
     ;; !! "a%26b=1&c=2;3&e=4"
     )
    (((img . #t) (avail . #t) (name . #t) (price . #t))
     "img;avail;name;price")
    (((foo+bar . "mooh+qux") (|foo bar| . "mooh qux"))
     "foo%2Bbar=mooh%2Bqux;foo+bar=mooh+qux")
    (((no+value . #t) (|no value| . #t))
     "no%2Bvalue;no+value")))

(test-group "form-urlencoding-hoehrmann-draft-cases"
  (for-each (lambda (u)
              (let* ((alist (first u))
                     (primary (second u))
                     (alternatives (cddr u)))
                (test (sprintf "encode ~S -> ~S" alist primary)
                      primary (form-urlencode alist))
                (for-each (lambda (a)
                            (test (sprintf "decode ~S -> ~S" a alist)
                                  alist (form-urldecode a)))
                          (cons primary alternatives))))
            form-urlencoded-hoehrmann-draft-cases))

(test-group "miscellaneous"
  (test "scheme doesn't reset port if port given"
        (uri-reference "https://foo:123")
        (update-uri (uri-reference "http://foo:8080")
                    port: 123 scheme: 'https))
  (test "separator string order is maintained in form-urlencode"
        '("foo=bar&qux=mooh" "foo=bar;qux=mooh")
        (list (form-urlencode '((foo . "bar") (qux . "mooh")) separator: "&;")
              (form-urlencode '((foo . "bar") (qux . "mooh")) separator: ";&"))))