From 2bb9448ebcbb98acfdbaac7ab6c1536ea907d631 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 12 Feb 2009 22:39:26 -0600 Subject: [PATCH 1/3] add set-basic-auth to http, and make http-request stuff the response body in the error message on failure --- basis/http/client/client-docs.factor | 3 +-- basis/http/client/client.factor | 7 +++++-- basis/http/http-docs.factor | 6 ++++++ basis/http/http-tests.factor | 5 +++++ basis/http/http.factor | 7 ++++++- 5 files changed, 23 insertions(+), 5 deletions(-) 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 From 7f8e890f1f05458f8357e218158cea01d7f4a075 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 12 Feb 2009 22:39:48 -0600 Subject: [PATCH 2/3] twitta --- extra/twitter/twitter.factor | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 extra/twitter/twitter.factor diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor new file mode 100644 index 0000000000..eceb40c1c2 --- /dev/null +++ b/extra/twitter/twitter.factor @@ -0,0 +1,22 @@ +USING: accessors assocs hashtables http http.client json.reader +kernel namespaces 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 ; + From 92f3ae39ad8aaa458253500752f1fb46dfe2d56a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 12 Feb 2009 22:56:46 -0600 Subject: [PATCH 3/3] gotta load urls.secure to use https --- extra/twitter/twitter.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/twitter/twitter.factor b/extra/twitter/twitter.factor index eceb40c1c2..707bcceda6 100644 --- a/extra/twitter/twitter.factor +++ b/extra/twitter/twitter.factor @@ -1,5 +1,5 @@ USING: accessors assocs hashtables http http.client json.reader -kernel namespaces urls.encoding ; +kernel namespaces urls.secure urls.encoding ; IN: twitter SYMBOLS: twitter-username twitter-password ;