Skip to content

Tasks should be transmitted with DELETE requests, too #227

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
samoht merged 1 commit into from
Jul 14, 2015
Merged

Tasks should be transmitted with DELETE requests, too #227

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 11 additions & 7 deletions lib/http/irmin_http.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -162,11 +162,6 @@ module Helper (Client: Cohttp_lwt.Client) = struct
let get_stream t path ?query fn =
map_get t path ?query (map_stream_response fn)

let delete t path fn =
let uri = uri_append t path in
Log.debug "delete %s" (Uri.path uri);
Client.delete ~headers uri >>= map_string_response fn

let make_body ?task body =
let str l = Ezjsonm.to_string (`O l) in
let str_t = Irmin.Task.to_json in
Expand All @@ -186,6 +181,12 @@ module Helper (Client: Cohttp_lwt.Client) = struct
in
short_body, body

let delete t ~task path fn =
let uri = uri_append t path in
let short_body, body = make_body ?task None in
Log.debug "delete %s %s" (Uri.path uri) short_body;
Client.delete ?body ~headers uri >>= map_string_response fn

let map_post t ~task path ?query body fn =
let uri = make_uri t path query in
let short_body, body = make_body ?task body in
Expand Down Expand Up @@ -284,7 +285,7 @@ module RW (Client: Cohttp_lwt.Client) (K: Irmin.Hum.S) (V: Tc.S0) = struct
let update t key value =
post t ~task:None ["update"; K.to_hum key] (some @@ V.to_json value) Tc.unit

let remove t key = delete t ["remove"; K.to_hum key] Tc.unit
let remove t key = delete ~task:None t ["remove"; K.to_hum key] Tc.unit

module CS = Tc.Pair(Tc.Option(V))(Tc.Option(V))

Expand Down Expand Up @@ -523,7 +524,10 @@ struct
let err_not_persistent = invalid_arg "Irmin_http.%s: not a persistent branch"

let get t = get (uri t)
let delete t = delete (uri t)

let delete t =
let task = Some (task t) in
delete (uri t) ~task

let post t path ?query body =
let task = Some (task t) in
Expand Down
25 changes: 23 additions & 2 deletions lib/http/irmin_http_server.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -689,8 +689,29 @@ module Make (HTTP: SERVER) (D: DATE) (S: Irmin.S) = struct
let query = Uri.query uri in
let return_dnone = Lwt.return (None, None) in
begin match Cohttp.Request.meth req with
| `DELETE
| `GET -> return_dnone
| `DELETE ->
Cohttp_lwt_body.length body >>= fun (len, body) ->
if len = 0L then
return_dnone
else begin
Cohttp_lwt_body.to_string body >>= fun b ->
let short_body =
if String.length b > 80 then String.sub b 0 80 ^ ".." else b
in
Log.debug "process DELETE: length=%Ld body=%S" len short_body;
try match Ezjsonm.from_string b with
| `O l ->
let task =
try Some (Irmin.Task.of_json @@ List.assoc "task" l)
with Not_found -> None
in
Lwt.return (task, None)
| _ ->
error "process: wrong parameters"
with e ->
error "process: not a valid JSON body %S [%s]" b (Printexc.to_string e)
end
| `POST ->
Cohttp_lwt_body.length body >>= fun (len, body) ->
if len = 0L then
Expand All @@ -700,7 +721,7 @@ module Make (HTTP: SERVER) (D: DATE) (S: Irmin.S) = struct
let short_body =
if String.length b > 80 then String.sub b 0 80 ^ ".." else b
in
Log.debug "process: length=%Ld body=%S" len short_body;
Log.debug "process POST: length=%Ld body=%S" len short_body;
try match Ezjsonm.from_string b with
| `O l ->
let params = try Some (List.assoc "params" l) with Not_found -> None in
Expand Down