basis/urls/urls-tests.factor

   1 IN: urls.tests
   2 USING: io.sockets io.sockets.secure urls urls.private tools.test prettyprint
   3 arrays kernel assocs present accessors ;
   4
   5 CONSTANT: urls
   6     {
   7         {
   8             T{ url
   9                 { protocol "http" }
  10                 { host "www.apple.com" }
  11                 { port 1234 }
  12                 { path "/a/path" }
  13                 { query H{ { "a" "b" } } }
  14                 { anchor "foo" }
  15             }
  16             "http://www.apple.com:1234/a/path?a=b#foo"
  17         }
  18         {
  19             T{ url
  20                 { protocol "http" }
  21                 { host "www.apple.com" }
  22                 { path "/a/path" }
  23                 { query H{ { "a" "b" } } }
  24                 { anchor "foo" }
  25             }
  26             "http://www.apple.com/a/path?a=b#foo"
  27         }
  28         {
  29             T{ url
  30                 { protocol "http" }
  31                 { host "www.apple.com" }
  32                 { port 1234 }
  33                 { path "/another/fine/path" }
  34                 { anchor "foo" }
  35             }
  36             "http://www.apple.com:1234/another/fine/path#foo"
  37         }
  38         {
  39             T{ url
  40                 { path "/a/relative/path" }
  41                 { anchor "foo" }
  42             }
  43             "/a/relative/path#foo"
  44         }
  45         {
  46             T{ url
  47                 { path "/a/relative/path" }
  48             }
  49             "/a/relative/path"
  50         }
  51         {
  52             T{ url
  53                 { path "a/relative/path" }
  54             }
  55             "a/relative/path"
  56         }
  57         {
  58             T{ url
  59                 { path "bar" }
  60                 { query H{ { "a" "b" } } }
  61             }
  62             "bar?a=b"
  63         }
  64         {
  65             T{ url
  66                 { protocol "ftp" }
  67                 { host "ftp.kernel.org" }
  68                 { username "slava" }
  69                 { path "/" }
  70             }
  71             "ftp://slava@ftp.kernel.org/"
  72         }
  73         {
  74             T{ url
  75                 { protocol "ftp" }
  76                 { host "ftp.kernel.org" }
  77                 { username "slava" }
  78                 { password "secret" }
  79                 { path "/" }
  80             }
  81             "ftp://slava:secret@ftp.kernel.org/"
  82         }
  83         {
  84             T{ url
  85                { protocol "http" }
  86                { host "foo.com" }
  87                { path "/" }
  88                { query H{ { "a" f } } }
  89             }
  90             "http://foo.com/?a"
  91         }
  92     }
  93
  94 urls [
  95     [ 1array ] [ [ >url ] curry ] bi* unit-test
  96 ] assoc-each
  97
  98 urls [
  99     swap [ 1array ] [ [ present ] curry ] bi* unit-test
 100 ] assoc-each
 101
 102 [ "b" ] [ "a" "b" url-append-path ] unit-test
 103
 104 [ "a/b" ] [ "a/c" "b" url-append-path ] unit-test
 105
 106 [ "a/b" ] [ "a/" "b" url-append-path ] unit-test
 107
 108 [ "/b" ] [ "a" "/b" url-append-path ] unit-test
 109
 110 [ "/b" ] [ "a/b/" "/b" url-append-path ] unit-test
 111
 112 [ "/xxx/bar" ] [ "/xxx/baz" "bar" url-append-path ] unit-test
 113
 114 [
 115     T{ url
 116         { protocol "http" }
 117         { host "www.apple.com" }
 118         { port 1234 }
 119         { path "/a/path" }
 120     }
 121 ] [
 122     T{ url
 123         { protocol "http" }
 124         { host "www.apple.com" }
 125         { port 1234 }
 126         { path "/foo" }
 127     }
 128
 129     T{ url
 130         { path "/a/path" }
 131     }
 132
 133     derive-url
 134 ] unit-test
 135
 136 [
 137     T{ url
 138         { protocol "http" }
 139         { host "www.apple.com" }
 140         { port 1234 }
 141         { path "/a/path/relative/path" }
 142         { query H{ { "a" "b" } } }
 143         { anchor "foo" }
 144     }
 145 ] [
 146     T{ url
 147         { protocol "http" }
 148         { host "www.apple.com" }
 149         { port 1234 }
 150         { path "/a/path/" }
 151     }
 152
 153     T{ url
 154         { path "relative/path" }
 155         { query H{ { "a" "b" } } }
 156         { anchor "foo" }
 157     }
 158
 159     derive-url
 160 ] unit-test
 161
 162 [
 163     T{ url
 164         { protocol "http" }
 165         { host "www.apple.com" }
 166         { port 1234 }
 167         { path "/a/path/relative/path" }
 168         { query H{ { "a" "b" } } }
 169         { anchor "foo" }
 170     }
 171 ] [
 172     T{ url
 173         { protocol "http" }
 174         { host "www.apple.com" }
 175         { port 1234 }
 176         { path "/a/path/" }
 177     }
 178
 179     T{ url
 180         { path "relative/path" }
 181         { query H{ { "a" "b" } } }
 182         { anchor "foo" }
 183     }
 184
 185     derive-url
 186 ] unit-test
 187
 188 [
 189     T{ url
 190         { protocol "http" }
 191         { host "www.apple.com" }
 192         { path "/xxx/baz" }
 193     }
 194 ] [
 195     T{ url
 196         { protocol "http" }
 197         { host "www.apple.com" }
 198         { path "/xxx/bar" }
 199     }
 200
 201     T{ url
 202         { path "baz" }
 203     }
 204
 205     derive-url
 206 ] unit-test
 207
 208 [
 209     T{ url
 210         { protocol "https" }
 211         { host "www.apple.com" }
 212     }
 213 ] [
 214     T{ url
 215         { protocol "http" }
 216         { host "www.apple.com" }
 217         { port 80 }
 218     }
 219
 220     T{ url
 221         { protocol "https" }
 222         { host "www.apple.com" }
 223     }
 224
 225     derive-url
 226 ] unit-test
 227
 228 ! Support //foo.com, which has the same protocol as the url we derive from
 229 [ URL" http://foo.com" ]
 230 [ URL" http://google.com" URL" //foo.com" derive-url ] unit-test
 231
 232 [ URL" https://foo.com" ]
 233 [ URL" https://google.com" URL" //foo.com" derive-url ] unit-test
 234
 235 [ "a" ] [
 236     <url> "a" "b" set-query-param "b" query-param
 237 ] unit-test
 238
 239 [ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] unit-test
 240
 241 [ "http://www.foo.com/" ] [ "http://www.foo.com:80" >url present ] unit-test
 242
 243 [ f ] [ URL" /gp/redirect.html/002-7009742-0004012?location=http://advantage.amazon.com/gp/vendor/public/join%26token%3d77E3769AB3A5B6CF611699E150DC33010761CE12" protocol>> ] unit-test
 244
 245 [
 246     T{ url
 247         { protocol "http" }
 248         { host "localhost" }
 249         { query H{ { "foo" "bar" } } }
 250         { path "/" }
 251     }
 252 ]
 253 [ "http://localhost?foo=bar" >url ] unit-test
 254
 255 [
 256     T{ url
 257         { protocol "http" }
 258         { host "localhost" }
 259         { query H{ { "foo" "bar" } } }
 260         { path "/" }
 261     }
 262 ]
 263 [ "http://localhost/?foo=bar" >url ] unit-test
 264
 265 [ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test
 266
 267 [ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
 268
 269 [ T{ inet { host "google.com" } { port 80 } } ]
 270 [ URL" http://google.com/" url-addr ] unit-test
 271
 272 [
 273     T{ secure
 274        { addrspec T{ inet { host "google.com" } { port 443 } } }
 275     }
 276 ]
 277 [ URL" https://google.com/" url-addr ] unit-test