http.client, proxy defaults to http protocol like for the target

diff --git a/basis/http/client/client-tests.factor b/basis/http/client/client-tests.factor
index 0f4a36fb7b9283ef91aad0ee7ded0b9cd5f9b8a7..23cd7ea7f49bb14452435ab35b32c1a1cd26fb3c 100644 (file)
--- a/basis/http/client/client-tests.factor
+++ b/basis/http/client/client-tests.factor
@@ -191,6 +191,22 @@ CONSTANT: classic-proxy-settings H{
     ] with-variables
 ] unit-test
 
+{ URL" http://localhost:3128" } [
+    { { "http.proxy" "localhost:3128" } } [
+       "google.com" "GET" <client-request> ?default-proxy proxy-url>>
+    ] with-variables
+] unit-test
+
+{ URL" http://localhost:3128" } [
+    "google.com" "GET" <client-request>
+    URL" localhost:3128" >>proxy-url ?default-proxy proxy-url>>
+] unit-test
+
+{ URL" http://localhost:3128" } [
+    "google.com" "GET" <client-request>
+    "localhost:3128" >>proxy-url ?default-proxy proxy-url>>
+] unit-test
+
 { URL" http://proxysec.private:3128" } [
     classic-proxy-settings [
        "https://google.com" "GET" <client-request> ?default-proxy proxy-url>>

diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor
index b439d313843feab1339b5a66d87b7420fbad1e80..df58573343847590ae19b04c8e3b7383089dde08 100644 (file)
--- a/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@ -204,10 +204,20 @@ SYMBOL: redirects
         [ "HTTP_PROXY" os-env ] unless*
     ] if ;
 
+: misparsed-url? ( url -- url' )
+    [ protocol>> not ] [ host>> not ] [ path>> ]
+    tri and and ;
+
+: request-url ( url -- url' )
+    dup >url dup misparsed-url? [
+        drop dup url? [ present ] when
+        "http://" prepend >url
+    ] [ nip ] if ensure-port ;
+
 : ?default-proxy ( request -- request' )
     dup get-default-proxy
-    over proxy-url>> 2dup and [
-        pick no-proxy? [ nip ] [ [ >url ] dip derive-url ] if
+    over proxy-url>> dup [ request-url ] when 2dup and [
+        pick no-proxy? [ nip ] [ [ request-url ] dip derive-url ] if
     ] [ nip ] if check-proxy ;
 
 : (with-http-request) ( request quot: ( chunk -- ) -- response )
@@ -237,16 +247,6 @@ SYMBOL: redirects
         [ do-redirect ] [ nip ] if
     ] with-variable ; inline recursive
 
-: misparsed-url? ( url -- url' )
-    [ protocol>> not ] [ host>> not ] [ path>> ]
-    tri and and ;
-
-: request-url ( url -- url' )
-    dup >url dup misparsed-url? [
-        drop dup url? [ present ] when
-        "http://" prepend >url
-    ] [ nip ] if ensure-port ;
-
 : <client-request> ( url method -- request )
     <request>
         swap >>method