Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 102 lines (86 sloc) 3.629 kb
8a95315 @dsheets Reorganization of API modules, protection of interfaces
authored
1 (*
2 ocaml-facebook - Facebook Platform client API in OCaml
3
4 Copyright (C) <2010> David Sheets <sheets@alum.mit.edu>
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU Library General Public License as
8 published by the Free Software Foundation, version 2.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU Library General Public License for more details.
14
15 You should have received a copy of the GNU Library General Public
16 License along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
18 USA
19 *)
20
21 open Printf
22 open Lwt
23 open Cohttp
24 open Api
25
26 module StrMap = Map.Make(String)
27 module AStrMap = Util.Assoc(StrMap)
28 module MStrMap = Util.Map(StrMap)
29 module J = Json_type.Browse
30
31 type fb_data = [ `B of int64
32 | `D of int
33 | `F of float
34 | `S of string
35 | `List of fb_data list
36 ]
37
38 let facebook_http = "http://api.facebook.com/restserver.php"
39 let facebook_https = "https://api.facebook.com/restserver.php"
40
41 let rec coerce = function
42 | `B l -> Int64.to_string l
43 | `D i -> string_of_int i
44 | `F f -> string_of_float f
45 | `S s -> s
46 | `List v -> Json_io.string_of_json (json_of_list v)
47 and json_coerce = function
48 | `B l -> json_of_string (Int64.to_string l)
49 | `D i -> json_of_int i
50 | `F f -> json_of_float f
51 | `S s -> json_of_string s
52 | `List v -> json_of_list v
53 and json_of_int i = Json_type.Int i
54 and json_of_float f = Json_type.Float f
55 and json_of_string s = Json_type.String s
56 and json_of_list l = Json_type.Array (List.map json_coerce l)
57
58 let bind_value fn (k, v) = (k, fn v)
59
60 let std_params user meth params =
61 let get = [("method", meth);
62 ("api_key", user.user_app.app_key);
63 ("v", "1.0")] in
64 let get = match user.session with None -> get
65 | Some (k, _) -> ("session_key", k) :: get in
66 let post = [("call_id", string_of_int user.user_app.seq);
67 ("format", "JSON")] @ params in
68 let pmap = AStrMap.into_map StrMap.empty (get @ post) in
69 let () = user.user_app.seq <- user.user_app.seq + 1 in
70 (get, ("sig", generate_sig user.user_app pmap) :: post)
71
72 let url_encode = Netencoding.Url.mk_url_encoded_parameters
73
74 let attempt_post headers body url =
75 let rec post exnlist = function
76 | 0 -> fail (Facebook_error ("Cannot connect to Facebook", exnlist))
77 | n -> begin try_lwt Http_user_agent.post ~headers ~body url with
78 | e -> post (e::exnlist) (n - 1)
79 end
80 in post [] 3
81
82 let facebook_error meth user params jo =
83 let code = J.int (List.assoc "error_code" jo) in
84 let msg = J.string (List.assoc "error_msg" jo) in
85 fail (Facebook_error (sprintf "Error %d in %s : %s" code meth msg, []))
86
87 let call_method ns user name params =
88 let params = List.map (bind_value coerce) params in
89 let meth = "facebook." ^ ns ^ "." ^ name in
90 let get, post = std_params user meth params in
91 let qs = url_encode get in
92 let headers = [("User-Agent", "ocaml-facebook/0.1")] in
93 let body = url_encode post in
94 let url = facebook_http ^ "?" ^ qs in
95 lwt _, jss = attempt_post headers body url in
96 let json = Json_io.json_of_string ~recursive:true ~big_int_mode:true jss in
97 let fberr = try let jo = J.objekt json in if List.mem_assoc "error_response" jo
98 then Some jo else None
99 with Json_type.Json_error _ -> None
100 in match fberr with Some jo -> facebook_error meth user params jo
101 | None -> return json
Something went wrong with that request. Please try again.