Permalink
Browse files

[enhance] http_client,web_client: more_headers argument is now a stri…

…ng list instead of a bare optional string
  • Loading branch information...
1 parent 567e041 commit 3098bdcfc5065c6ce0ecf0ad86c78f899a808328 @Aqua-Ye Aqua-Ye committed Feb 18, 2012
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -22,7 +22,7 @@
@author David Rajchenbach-Teller
**)
-#<Debugvar:TESTING>
+#<Debugvar:HTTP_CLIENT_DEBUG>
open Http_common
@@ -37,18 +37,12 @@ let parse_response str =
`Success (res, String.sub str pos (String.length str - pos))
with Trx_runtime.SyntaxError (pos, str) -> `Failure (Printf.sprintf "Http_client: parse response error: %s (pos:%d)" str pos)
-(* let get_dialog command = *)
-(* pLet (write command) (fun _ -> *)
-(* pLet read_all (fun (_, buf) -> *)
-(* pDo close *)
-(* (return buf))) *)
-
exception Timeout
let place_request (sched: Scheduler.t) ~hostname ~port ~path
?client_certificate ?verify_params
?(secure=false) ~request_kind ?(auth="")
- ?(more_headers="") ?(data="")
+ ?(more_headers=[]) ?(data="")
?(client_name=client_name)
?(timeout=Time.seconds 36)
?err_cont ~success ~failure () =
@@ -83,7 +77,7 @@ let place_request (sched: Scheduler.t) ~hostname ~port ~path
else Network.Unsecured
in
let port_spec = Network.make_port_spec ~protocol:http machine port in
- let command = Printf.sprintf "%s %s %s%s%sHost: %s%sUser-Agent: %s%s%s%s"
+ let command = Printf.sprintf "%s %s %s%s%sHost: %s%sUser-Agent: %s%s%s%s%s"
request_kind
path
http_version
@@ -93,8 +87,10 @@ let place_request (sched: Scheduler.t) ~hostname ~port ~path
Base.crlf
client_name
Base.crlf
- (if more_headers = "" then Base.crlf
- else Printf.sprintf "%s%s" more_headers Base.crlf)
+ (List.fold_left (
+ fun acc h -> Printf.sprintf "%s%s%s" acc h Base.crlf
+ ) "" more_headers)
+ Base.crlf
data
in
let start conn =
@@ -145,7 +141,7 @@ let default_failure = function
let get (sched: Scheduler.t) hostname port path
?client_certificate ?verify_params
?(secure=false) ?(auth="")
- ?(more_headers="") ?err_cont ?(failure=default_failure) cont =
+ ?(more_headers=[]) ?err_cont ?(failure=default_failure) cont =
place_request sched ~hostname ~port ~path
~request_kind:"GET"
?client_certificate ?verify_params
@@ -157,21 +153,15 @@ let get (sched: Scheduler.t) hostname port path
?failure
()
-(* let rec retry n = *)
-(* if n <= 0 then failwith "Http_client: too much failures"; *)
-(* Protocol.apply conn (get_dialog command) (fun res -> *)
-(* match check res with *)
-(* | None -> retry (n - 1) *)
-(* | Some x -> cont x) *)
-(* in retry 2 *)
-
let post (sched: Scheduler.t) hostname port path
?client_certificate ?verify_params
?(secure=false) ?(auth="") mime_type
?(length=(-1)) ?err_cont ?(failure=default_failure) data cont =
let length = if length = (-1) then String.length data else length in
- let more_headers =
- Printf.sprintf "Content-Length: %d%sContent-Type: %s%s" length Base.crlf mime_type Base.crlf in
+ let more_headers = [
+ Printf.sprintf "Content-Length: %d" length;
+ Printf.sprintf "Content-Type: %s" mime_type;
+ ] in
place_request sched ~hostname ~port ~path
~request_kind:"POST"
?client_certificate ?verify_params
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -56,7 +56,7 @@ val get :
?verify_params:SslAS.ssl_verify_params ->
?secure:bool ->
?auth:string ->
- ?more_headers:string ->
+ ?more_headers:string list ->
?err_cont:(exn -> unit) ->
?failure:([ `Cannot_parse_response of string | `Timeout | `Unknown_machine of string ] -> unit) ->
(Requestdef.Value.value Requestdef.ResponseHeader.t * string -> unit) ->
@@ -73,7 +73,7 @@ val place_request :
?secure:bool ->
request_kind:string ->
?auth:string ->
- ?more_headers:string ->
+ ?more_headers:string list ->
?data:string ->
?client_name:string ->
?timeout:Time.t ->
@@ -478,7 +478,7 @@ let default_scheduler = BslScheduler.opa
option(SSL.policy), \
option(time_t), \
option(string), \
- option(string), \
+ opa[list(string)], \
(string, \
int, \
string, \
@@ -524,10 +524,11 @@ let default_scheduler = BslScheduler.opa
ServerLib.make_record cons
in QmlCpsServerLib.return cont_failure opa_e
in
+ let more_headers = BslNativeLib.opa_list_to_ocaml_list (fun h -> h) more_headers in
let _ = Http_client.place_request default_scheduler ~request_kind ?data ~hostname ~port ~path
~secure:is_secure ?auth ?client_certificate:private_key ?verify_params:policy
?timeout:(Option.map Time.milliseconds timeout)
- ?client_name:custom_agent ?more_headers ~err_cont
+ ?client_name:custom_agent ~more_headers ~err_cont
~success
~failure
()
@@ -101,20 +101,16 @@ CouchDb = {{
// General helper funs
@private
- gen_headers(auth : CouchDb.authentication_method, maybe_rev : option(string))
- : option(string) =
+ gen_headers(auth : CouchDb.authentication_method, maybe_rev : list(string))
+ : list(string) =
maybe_auth =
match auth
- | {None} -> ""
+ | {None} -> []
| {HttpLogin = ~{user pass}} ->
encoded = Crypto.Base64.encode("{user}:{pass}")
- "Authorization: Basic {encoded}\r\n"
- | ~{Session} -> "Cookie: {Session}\r\n"
- tmp = Option.default("", Option.map((rev -> "ETAG: {rev}\r\n"), maybe_rev))
- ^ maybe_auth
- match tmp with
- "" -> {none}
- some -> ~{some}
+ ["Authorization: Basic {encoded}"]
+ | ~{Session} -> ["Cookie: {Session}"]
+ maybe_rev ++ maybe_auth
@private
gen_uri(host : string, path : string) : outcome(Uri.uri, CouchDb.failure) =
@@ -151,7 +147,7 @@ CouchDb = {{
| ~{failure} -> ~{failure}
| {success = uri} ->
opts =
- custom_headers = gen_headers(auth, {none})
+ custom_headers = gen_headers(auth, [])
{ WebClient.Put.default_options with ~mimetype ~custom_headers }
match WebClient.Put.try_put_with_options(uri, content, opts)
| {failure = Communication} -> {failure = ~{Communication}}
@@ -171,7 +167,7 @@ CouchDb = {{
| ~{failure} -> ~{failure}
| {success = uri} ->
opts =
- custom_headers = gen_headers(auth, {none})
+ custom_headers = gen_headers(auth, [])
{ WebClient.Delete.default_options with ~custom_headers }
match WebClient.Delete.try_delete_with_options(uri, opts)
| {failure = Communication} -> {failure = ~{Communication}}
@@ -189,7 +185,7 @@ CouchDb = {{
* Example: [list_all(auth, host)]
* @param host The location of the couchdb server.
*/
- list_all(auth, host) = really_get(auth, host, "_all_dbs", {none})
+ list_all(auth, host) = really_get(auth, host, "_all_dbs", [])
create(auth, the_db : CouchDb.db_infos) : CouchDb.result =
mime = WebClient.Post.default_options.mimetype
@@ -206,7 +202,7 @@ CouchDb = {{
| ~{failure} -> ~{failure}
| {success = uri} ->
opts =
- custom_headers = gen_headers(auth, {none})
+ custom_headers = gen_headers(auth, [])
{ WebClient.Delete.default_options with ~custom_headers }
match WebClient.Delete.try_delete_with_options(uri, opts)
| {failure = Communication} -> {failure = ~{Communication}}
@@ -216,10 +212,10 @@ CouchDb = {{
else {success = {FormatedJson = (code, Json.deserialize(content))} }
infos(auth, the_db : CouchDb.db_infos) : CouchDb.result =
- really_get(auth, the_db.location, the_db.name, {none})
+ really_get(auth, the_db.location, the_db.name, [])
get_revs_limit(auth, the_db : CouchDb.db_infos) : outcome(int, CouchDb.failure)=
- match get_request(auth, the_db.location, "{the_db.name}/_revs_limit", {none})
+ match get_request(auth, the_db.location, "{the_db.name}/_revs_limit", [])
~{failure} -> ~{failure}
{success = {RawResponse = ~{content ... }}} ->
{success = Int.of_string(content)}
@@ -243,7 +239,7 @@ CouchDb = {{
*/
get(auth : CouchDb.authentication_method, the_db : CouchDb.db_infos,
doc_name : CouchDb.doc_id) : CouchDb.result =
- really_get(auth, the_db.location, "{the_db.name}/{doc_name}", {none})
+ really_get(auth, the_db.location, "{the_db.name}/{doc_name}", [])
/**
* Same as [get] but with an additionnal parameter to specify a revision.
@@ -252,22 +248,22 @@ CouchDb = {{
the_db : CouchDb.db_infos,
doc_name : CouchDb.doc_id,
rev : CouchDb.revision) : CouchDb.result =
- really_get(auth, the_db.location, "{the_db.name}/{doc_name}", {some = rev})
+ really_get(auth, the_db.location, "{the_db.name}/{doc_name}", [rev])
/**
* Example: [get_attachment(auth, dbinfos, docid, name)]
* @param name of the attached file.
*/
get_attachment(auth, the_db : CouchDb.db_infos, docname : CouchDb.doc_id,
name : string) : CouchDb.result =
- get_request(auth, the_db.location, "{the_db.name}/{docname}/{name}", {none})
+ get_request(auth, the_db.location, "{the_db.name}/{docname}/{name}", [])
head(auth, the_db:CouchDb.db_infos, docid:CouchDb.doc_id) : CouchDb.result =
match gen_uri(the_db.location, "{the_db.name}/{docid}")
| ~{failure} -> ~{failure}
| {success = uri} ->
opts =
- custom_headers = gen_headers(auth, {none})
+ custom_headers = gen_headers(auth, [])
{ WebClient.Head.default_options with ~custom_headers }
match WebClient.Head.try_head_with_options(uri, opts)
| {failure = Communication} -> {failure = ~{Communication}}
@@ -288,7 +284,7 @@ CouchDb = {{
| {success = uri} ->
opts =
{ WebClient.Post.default_options with
- custom_headers = gen_headers(auth, {none})
+ custom_headers = gen_headers(auth, [])
content = {some = content}
mimetype = "application/json" }
match WebClient.Post.try_post_with_options(uri, opts)
@@ -333,9 +329,7 @@ CouchDb = {{
| ~{failure} -> ~{failure}
| {success = uri} ->
opts =
- headers = match gen_headers(auth, {none})
- | {none} -> {some = "Destination: {dst}\r\n"}
- | ~{some} -> {some = "{some}Destination: {dst}\r\n"}
+ headers = gen_headers(auth, []) ++ ["Destination: {dst}"]
{
operation = "COPY"
auth = {none}
@@ -387,14 +381,14 @@ CouchDb = {{
* @param host address of the couchdb server.
*/
get_root(auth : CouchDb.authentication_method, host) : CouchDb.result =
- really_get(auth, host, "", {none})
+ really_get(auth, host, "", [])
/**
* Example: [get_active_tasks(auth, host)]
* @param host address of the couchdb server.
*/
get_active_tasks(a : CouchDb.authentication_method, h) : CouchDb.result =
- really_get(a, h, "_active_tasks", {none})
+ really_get(a, h, "_active_tasks", [])
/**
* Example: [get_log_tail(auth, host)]
@@ -403,7 +397,7 @@ CouchDb = {{
*/
get_log_tail(auth : CouchDb.authentication_method, host, len:option(int)) : CouchDb.result =
path = match len with {none} -> "_log" | ~{some} -> "_log?bytes={some}"
- get_request(auth, host, path, {none})
+ get_request(auth, host, path, [])
}}
/**
@@ -450,7 +444,7 @@ CouchDb = {{
* @param host −
*/
infos(auth : CouchDb.authentication_method, host) : CouchDb.result =
- really_get(auth, host, "_session", {none})
+ really_get(auth, host, "_session", [])
}}
}}
@@ -80,7 +80,7 @@ type Dropbox.metadata = {
/**
* Type of an element in a Dropbox folder
- *
+ *
* Note that an empty folder will have its [content] field
* to [some([])] and that [none] for this field just means
* that there was no information about the folder files.
@@ -130,7 +130,7 @@ type Dropbox.file = {
do_shift(forward,h,min) =
d = { Duration.zero with ~forward ~h ~min }
|> Duration.of_human_readable
- Date.advance(_, d)
+ Date.advance(_, d)
shift(forward,h,m) =
do_shift(forward,int_of_text(h),int_of_text(m))
tmz = parser
@@ -254,7 +254,7 @@ type Dropbox.file = {
access_token_uri = "https://api.dropbox.com/1/oauth/access_token"
http_method = http_method
inlined_auth = false
- custom_headers = none
+ custom_headers = []
} : OAuth.parameters)
wget(host, path, params, creds:Dropbox.creds, parse_fun) =
@@ -57,7 +57,7 @@ type OAuth.parameters = {
authorize_uri : string
http_method : OAuth.method
inlined_auth : bool
- custom_headers : option(string)
+ custom_headers : list(string)
}
type OAuth.token = {
@@ -476,7 +476,7 @@ type Twitter.rate_limit = {
access_token_uri = "https://api.twitter.com/oauth/access_token"
http_method = http_method
inlined_auth = false
- custom_headers = none
+ custom_headers = []
} : OAuth.parameters)
@@ -619,7 +619,7 @@ Twitter(conf:Twitter.configuration) = {{
access_token_uri = "https://api.twitter.com/oauth/access_token"
http_method = {POST}
inlined_auth = false
- custom_headers = none
+ custom_headers = []
} : OAuth.parameters
Oops, something went wrong.

0 comments on commit 3098bdc

Please sign in to comment.