http.client, automatically add basic auth from urls if present

basis/http/client/client-docs.factor

@@ -281,6 +281,7 @@ $nl
     "http.client.encoding"
     "http.client.errors"
 }
+"For authentication, only Basic Access Authentication is implemented, using the username/password from the target url. Alternatively, the " { $link set-basic-auth } " word can be called on the " { $link request } " object."
 { $see-also "urls" } ;
 
 ABOUT: "http.client"

basis/http/client/client.factor

@@ -37,9 +37,16 @@ ERROR: too-many-redirects ;
 : set-cookie-header ( header cookies -- header )
     unparse-cookie "cookie" pick set-at ;
 
+: ?set-basic-auth ( header url name -- header )
+    swap [
+        [ username>> ] [ password>> ] bi 2dup and
+        [ basic-auth swap pick set-at ] [ 3drop ] if
+    ] [ drop ] if* ;
+
 : write-request-header ( request -- request )
     dup header>> >hashtable
     over url>> host>> [ set-host-header ] when
+    over url>> "Authorization" ?set-basic-auth
     over post-data>> [ set-post-data-headers ] when*
     over cookies>> [ set-cookie-header ] unless-empty
     write-header ;

basis/http/http.factor

@@ -143,8 +143,11 @@ redirects ;
 : set-header ( request/response value key -- request/response )
     pick header>> set-at ;
 
+: basic-auth ( username password -- str )
+    ":" glue >base64 "Basic " "" prepend-as ;
+
 : set-basic-auth ( request username password -- request )
-    ":" glue >base64 "Basic " "" prepend-as "Authorization" set-header ;
+    basic-auth "Authorization" set-header ;
 
 : <request> ( -- request )
     request new