hozumi/custom_client.clj

## custom_client.clj
(ns custom-client
  (:require [lamina.core :as lamina]
	    [aleph.http.client :as client]))


(defn make-connection [request] ;;http-connection is actually private.
  (assoc request :connection (client/http-connection request)))

(defn enqueue-request [{:keys [connection] :as request}]
  (lamina/run-pipeline connection
		       (fn [ch]
			 (lamina/enqueue ch request)
			 (lamina/read-channel ch))
		       #(assoc request :response %)))

(defn setting-timeout [{:keys [timeout connection] :as request}]
  (let [timeout-latch (atom false)]
    (when (pos? timeout)
      (lamina/run-pipeline (lamina/timed-channel timeout)
			   lamina/read-channel
			   (fn [_]
			     (when (compare-and-set! timeout-latch false true)
			       (lamina/run-pipeline connection
						    lamina/close)))))
    (assoc request :timeout-latch timeout-latch)))

(defn check-timeout [{:keys [timeout-latch] :as request}]
  (reset! timeout-latch true)
  request)

(defn follow-redirects [{:keys [response connection] :as request}]
  (if (#{300 301 302 303 307} (:status response))
    (do (println :redirect (get-in response [:headers "location"]))
	(lamina/run-pipeline connection lamina/close)
	(lamina/restart
	 (-> request
	     (update-in [:redirect-count] #(if-not % 1 (inc %)))
	     (assoc :url (get-in response [:headers "location"]))
	     (dissoc :query-string :uri :server-port :server-name :scheme))))
    response))


(def my-request
  (lamina/pipeline make-connection
		   setting-timeout
		   enqueue-request
		   check-timeout
		   follow-redirects))


;;;;;
> (def res (my-request {:timeout 5000, :method :get :url "http://google.com/"}))
:redirect http://www.google.com/
:redirect http://www.google.co.jp/
#'custom-client/res

> res
{:success <== [{:status 200, :headers {"date" "Sun, 13 Feb 2011 17:38:33 GMT",
 "expires" "-1", "cache-control" "private, max-age=0", "content-type" "text/html;
charset=ISO-8859-1", "set-cookie" "NID=43=FARjIcTWl5Yma2OJFOE9KMmcuUBKlg0mfl9XRa3tX
NYjY0G7aPDtzXOSMA26-cocp6QuCJGC
p-HSZKGtahv-sJkxEX7nYXEJ7D4XQOwYi_KfXTRSq5eT23oLrPrZjzSG; expires=Mon, 15-Aug-20
11 17:38:33 GMT; path=/; domain=.google.co.jp; HttpOnly", "server" "gws", "x-xss
-protection" "1; mode=block", "transfer-encoding" "chunked"}, :body <== ["<!doct
ype html><html><head><meta http-equiv=\"conten.... n})();\n</script>"]} ...],
 :error <== []}
	(ns custom-client
	(:require [lamina.core :as lamina]
	[aleph.http.client :as client]))


	(defn make-connection [request] ;;http-connection is actually private.
	(assoc request :connection (client/http-connection request)))

	(defn enqueue-request [{:keys [connection] :as request}]
	(lamina/run-pipeline connection
	(fn [ch]
	(lamina/enqueue ch request)
	(lamina/read-channel ch))
	#(assoc request :response %)))

	(defn setting-timeout [{:keys [timeout connection] :as request}]
	(let [timeout-latch (atom false)]
	(when (pos? timeout)
	(lamina/run-pipeline (lamina/timed-channel timeout)
	lamina/read-channel
	(fn [_]
	(when (compare-and-set! timeout-latch false true)
	(lamina/run-pipeline connection
	lamina/close)))))
	(assoc request :timeout-latch timeout-latch)))

	(defn check-timeout [{:keys [timeout-latch] :as request}]
	(reset! timeout-latch true)
	request)

	(defn follow-redirects [{:keys [response connection] :as request}]
	(if (#{300 301 302 303 307} (:status response))
	(do (println :redirect (get-in response [:headers "location"]))
	(lamina/run-pipeline connection lamina/close)
	(lamina/restart
	(-> request
	(update-in [:redirect-count] #(if-not % 1 (inc %)))
	(assoc :url (get-in response [:headers "location"]))
	(dissoc :query-string :uri :server-port :server-name :scheme))))
	response))


	(def my-request
	(lamina/pipeline make-connection
	setting-timeout
	enqueue-request
	check-timeout
	follow-redirects))


	;;;;;
	> (def res (my-request {:timeout 5000, :method :get :url "http://google.com/"}))
	:redirect http://www.google.com/
	:redirect http://www.google.co.jp/
	#'custom-client/res

	> res
	{:success <== [{:status 200, :headers {"date" "Sun, 13 Feb 2011 17:38:33 GMT",
	"expires" "-1", "cache-control" "private, max-age=0", "content-type" "text/html;
	charset=ISO-8859-1", "set-cookie" "NID=43=FARjIcTWl5Yma2OJFOE9KMmcuUBKlg0mfl9XRa3tX
	NYjY0G7aPDtzXOSMA26-cocp6QuCJGC
	p-HSZKGtahv-sJkxEX7nYXEJ7D4XQOwYi_KfXTRSq5eT23oLrPrZjzSG; expires=Mon, 15-Aug-20
	11 17:38:33 GMT; path=/; domain=.google.co.jp; HttpOnly", "server" "gws", "x-xss
	-protection" "1; mode=block", "transfer-encoding" "chunked"}, :body <== ["<!doct
	ype html><html><head><meta http-equiv=\"conten.... n})();\n</script>"]} ...],
	:error <== []}