diff --git a/basis/http/client/client-docs.factor b/basis/http/client/client-docs.factor index 9a8aa48738..0d7f7851e2 100644 --- a/basis/http/client/client-docs.factor +++ b/basis/http/client/client-docs.factor @@ -56,8 +56,7 @@ HELP: http-request HELP: with-http-request { $values { "request" request } { "quot" { $quotation "( chunk -- )" } } { "response" response } } -{ $description "Sends an HTTP request to an HTTP server, and reads the response incrementally. Chunks of data are passed to the quotation as they are read." } -{ $errors "Throws an error if the HTTP request fails." } ; +{ $description "Sends an HTTP request to an HTTP server, and reads the response incrementally. Chunks of data are passed to the quotation as they are read. Does not throw an error if the HTTP request fails; to do so, call " { $link check-response } " on the " { $snippet "response" } "." } ; ARTICLE: "http.client.get" "GET requests with the HTTP client" "Basic usage involves passing a " { $link url } " and getting a " { $link response } " and data back:" diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index cc1c67c31e..4099e3d84c 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -141,12 +141,15 @@ ERROR: download-failed response ; : check-response ( response -- response ) dup code>> success? [ download-failed ] unless ; +: check-response-with-body ( response body -- response body ) + [ >>body check-response ] keep ; + : with-http-request ( request quot -- response ) - [ (with-http-request) check-response ] with-destructors ; inline + [ (with-http-request) ] with-destructors ; inline : http-request ( request -- response data ) [ [ % ] with-http-request ] B{ } make - over content-charset>> decode ; + over content-charset>> decode check-response-with-body ; : ( url -- request ) "GET" ; diff --git a/basis/http/http-docs.factor b/basis/http/http-docs.factor index fc3f65fa56..210066176f 100644 --- a/basis/http/http-docs.factor +++ b/basis/http/http-docs.factor @@ -113,6 +113,12 @@ HELP: set-header { $notes "This word always returns the same object that was input. This allows for a “pipeline” coding style, where several header parameters are set in a row." } { $side-effects "request/response" } ; +HELP: set-basic-auth +{ $values { "request" request } { "username" string } { "password" string } } +{ $description "Sets the " { $snippet "Authorization" } " header of " { $snippet "request" } " to perform HTTP Basic authentication with the given " { $snippet "username" } " and " { $snippet "password" } "." } +{ $notes "This word always returns the same object that was input. This allows for a “pipeline” coding style, where several header parameters are set in a row." } +{ $side-effects "request" } ; + ARTICLE: "http.cookies" "HTTP cookies" "Every " { $link request } " and " { $link response } " instance can contain cookies." $nl diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 49acdb639c..4f685945aa 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -359,3 +359,8 @@ SYMBOL: a ! Test cloning [ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test [ f ] [ <404> dup clone "b" "a" put-cookie drop "a" get-cookie ] unit-test + +! Test basic auth +[ "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" ] [ "Aladdin" "open sesame" set-basic-auth "Authorization" header ] unit-test + + diff --git a/basis/http/http.factor b/basis/http/http.factor index 2b5414b299..d4acd282f8 100755 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -7,7 +7,8 @@ calendar.format present urls fry io io.encodings io.encodings.iana io.encodings.binary io.encodings.8-bit io.crlf unicode.case unicode.categories -http.parsers ; +http.parsers +base64 ; IN: http : (read-header) ( -- alist ) @@ -142,6 +143,9 @@ cookies ; : set-header ( request/response value key -- request/response ) pick header>> set-at ; +: set-basic-auth ( request username password -- request ) + ":" glue >base64 "Basic " prepend "Authorization" set-header ; + : ( -- request ) request new "1.1" >>version @@ -156,6 +160,7 @@ cookies ; : header ( request/response key -- value ) swap header>> at ; + TUPLE: response version code diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor new file mode 100644 index 0000000000..707bcceda6 --- /dev/null +++ b/extra/twitter/twitter.factor @@ -0,0 +1,22 @@ +USING: accessors assocs hashtables http http.client json.reader +kernel namespaces urls.secure urls.encoding ; +IN: twitter + +SYMBOLS: twitter-username twitter-password ; + +: set-twitter-credentials ( username password -- ) + [ twitter-username set ] [ twitter-password set ] bi* ; + +: set-request-twitter-auth ( request -- request ) + twitter-username twitter-password [ get ] bi@ set-basic-auth ; + +: update-post-data ( update -- assoc ) + "status" associate ; + +: tweet* ( string -- result ) + update-post-data "https://twitter.com/statuses/update.json" + set-request-twitter-auth + http-request nip json> ; + +: tweet ( string -- ) tweet* drop ; +