Skip to content
Browse files

Reorganization of API modules, protection of interfaces

  • Loading branch information...
1 parent dbe1c86 commit 8a953156c4170f6bc7ace98f8d8811329816646f @dsheets committed
Showing with 297 additions and 90 deletions.
  1. +5 −1 Makefile
  2. +3 −89 api.ml
  3. +36 −0 api.mli
  4. +69 −0 dashboard.ml
  5. +8 −0 dashboard.mli
  6. +23 −0 fql.ml
  7. +1 −0 fql.mli
  8. +101 −0 namespace.ml
  9. +8 −0 namespace.mli
  10. +38 −0 users.ml
  11. +5 −0 users.mli
View
6 Makefile
@@ -1,6 +1,10 @@
OCAMLMAKEFILE=OCamlMakefile
-SOURCES = util.ml api.ml
+SOURCES = util.ml api.mli api.ml \
+ namespace.mli namespace.ml \
+ fql.mli fql.ml \
+ users.mli users.ml \
+ dashboard.mli dashboard.ml
PREDS = camlp4o
PACKS = json-tc.syntax lwt.syntax lwt.unix cohttp
RESULT = facebook
View
92 api.ml
@@ -1,7 +1,7 @@
(*
ocaml-facebook - Facebook Platform client API in OCaml
- Copyright (C) <2009> David Sheets <sheets@alum.mit.edu>
+ Copyright (C) <2009-2010> David Sheets <sheets@alum.mit.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Library General Public License as
@@ -52,9 +52,6 @@ and user =
type user_table = (int64, user) Hashtbl.t
-let facebook_http = "http://api.facebook.com/restserver.php"
-let facebook_https = "https://api.facebook.com/restserver.php"
-
let users : user_table = Hashtbl.create 10
let application ?(timeout=None) ?cpref key sec domain =
@@ -169,6 +166,8 @@ let user app req =
else
get_user app fbp
+let uid user = user.uid
+
let gen_cookies path user =
let make = Http_cookie.make in
let serialize = Http_cookie.serialize in
@@ -199,88 +198,3 @@ let gen_cookies path user =
(fun (n,v) ->
serialize (make ~path ~domain n v))
cookies
-
-(* QUERIES *)
-
-let std_params user meth params =
- let get = [("method", meth);
- ("api_key", user.user_app.app_key);
- ("v", "1.0")] in
- let get = match user.session with None -> get
- | Some (k, _) -> ("session_key", k) :: get in
- let post = [("call_id", string_of_int user.user_app.seq);
- ("format", "JSON")] @ params in
- let pmap = AStrMap.into_map StrMap.empty (get @ post) in
- let () = user.user_app.seq <- user.user_app.seq + 1 in
- (get, ("sig", generate_sig user.user_app pmap) :: post)
-
-let url_encode = Netencoding.Url.mk_url_encoded_parameters
-
-module Namespace =
-struct
- let rec coerce = function
- | `B f -> Int64.to_string f
- | `D i -> string_of_int i
- | `S s -> s
- | `List v -> Json_io.string_of_json (json_of_list v)
- and json_coerce = function
- | `B f -> json_of_float f
- | `D i -> json_of_int i
- | `S s -> json_of_string s
- | `List v -> json_of_list v
- and json_of_int i = Json_type.Int i
- and json_of_float f = Json_type.Float f
- and json_of_string s = Json_type.String s
- and json_of_list l = Json_type.Array (List.map json_coerce l)
-
- let bind_value fn (k, v) = (k, fn v)
-
- let attempt_post headers body url =
- let rec post exnlist = function
- | 0 -> fail (Facebook_error ("Cannot connect to Facebook", exnlist))
- | n -> begin try_lwt Http_user_agent.post ~headers ~body url with
- | e -> post (e::exnlist) (n - 1)
- end
- in post [] 3
-
- let call_method ns user name params =
- let params = List.map (bind_value coerce) params in
- let get, post = std_params user ("facebook." ^ ns ^ "." ^ name) params in
- let qs = url_encode get in
- let headers = [("User-Agent", "ocaml-facebook/0.1")] in
- let body = url_encode post in
- let url = facebook_http ^ "?" ^ qs in
- lwt _, jsons = attempt_post headers body url in
- return jsons
-
- let loadr jsons =
- return (Json_io.json_of_string jsons)
-end
-
-module Users =
-struct
- include Namespace
- let call user = call_method "users" user
-
- let get_info user uids fields =
- (call user "getInfo" [("uids", `List uids);
- ("fields", `List fields)]) >>= loadr
-
- let get_standard_info user uids fields =
- (call user "getStandardInfo" [("uids", `List uids);
- ("fields", `List fields)]) >>= loadr
-
- (* TODO: Really? Mutate the world for a boolean API call?! *)
- let is_app_user user =
- (call user "isAppUser" [("uid", `B user.uid)])
- >>= (fun r -> let b = r = "true" in
- let () = save_user {user with added=b} in return b)
-end
-
-module Fql =
-struct
- include Namespace
- let call user = call_method "fql" user
-
- let query user q = call user "query" [("query", `S q)] >>= loadr
-end
View
36 api.mli
@@ -0,0 +1,36 @@
+exception Facebook_error of string * exn list
+exception Facebook_timeout
+exception Facebook_bad_sig
+
+type application = {
+ app_cookie_prefix : string option;
+ app_key : string;
+ app_sec : string;
+ app_domain : string;
+ timeout : float option;
+ mutable seq : int;
+}
+and user = {
+ uid : int64;
+ user_app : application;
+ time : float;
+ session : (string * float) option;
+ added : bool;
+ friends : user list;
+ props : (string * string) list;
+}
+
+val application :
+ ?timeout:float option ->
+ ?cpref:string -> string -> string -> string -> application Lwt.t
+
+val generate_sig : application -> string Map.Make(String).t -> string
+val validate_params :
+ application ->
+ ?ns:string -> (string * string) list -> string Map.Make(String).t Lwt.t
+
+val load_user : application -> int64 -> user
+val save_user : user -> unit
+val user : application -> Cohttp.Http_request.request -> user option Lwt.t
+val uid : user -> int64
+val gen_cookies : string -> user -> (string * string) list
View
69 dashboard.ml
@@ -0,0 +1,69 @@
+(*
+ ocaml-facebook - Facebook Platform client API in OCaml
+
+ Copyright (C) <2010> David Sheets <sheets@alum.mit.edu>
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation, version 2.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+ USA
+*)
+
+open Lwt
+open Api
+module J = Json_type.Browse
+
+let call user = Namespace.call_method "dashboard" user
+
+let tuple_list kfn vfn json = List.fold_left
+ (fun al -> function
+ | k::v::[] -> (kfn k, vfn v)::al
+ | _ -> al)
+ []
+ (J.list J.array json)
+
+let uid_of_json json = Int64.of_string (J.string json)
+
+let get_count user = (call user "getCount" [("uid", `B user.uid)]) >|= J.int
+
+let multi_get_count = function
+ | [] -> return []
+ | (ux::_) as ul -> let uids = `List (List.map (fun u -> `B u.uid) ul) in
+ (call ux "multiGetCount" [("uids", uids)])
+ >|= (tuple_list uid_of_json J.int)
+
+let set_count user i =
+ (call user "setCount" [("uid", `B user.uid); ("count", `D i)]) >|= J.bool
+
+let multi_set_count = function
+ | [] -> return []
+ | (ux::_) as ul -> let uids = `List (List.map (fun u -> `B u.uid) ul) in
+ (* yes, this method uses 'ids' instead of 'uids' *)
+ (call ux "multiSetCount" [("ids", uids)])
+ >|= (tuple_list uid_of_json J.bool)
+
+let increment_count user =
+ (call user "incrementCount" [("uid", `B user.uid)]) >|= J.bool
+
+let multi_increment_count = function
+ | [] -> return []
+ | (ux::_) as ul -> let uids = `List (List.map (fun u -> `B u.uid) ul) in
+ (call ux "multiIncrementCount" [("uids", uids)])
+ >|= (tuple_list uid_of_json J.bool)
+
+let decrement_count user =
+ (call user "decrementCount" [("uid", `B user.uid)]) >|= J.bool
+
+let multi_decrement_count = function
+ | [] -> return []
+ | (ux::_) as ul -> let uids = `List (List.map (fun u -> `B u.uid) ul) in
+ (call ux "multiDecrementCount" [("uids", uids)])
+ >|= (tuple_list uid_of_json J.bool)
View
8 dashboard.mli
@@ -0,0 +1,8 @@
+val get_count : Api.user -> int Lwt.t
+val multi_get_count : Api.user list -> (int64 * int) list Lwt.t
+val set_count : Api.user -> int -> bool Lwt.t
+val multi_set_count : Api.user list -> (int64 * bool) list Lwt.t
+val increment_count : Api.user -> bool Lwt.t
+val multi_increment_count : Api.user list -> (int64 * bool) list Lwt.t
+val decrement_count : Api.user -> bool Lwt.t
+val multi_decrement_count : Api.user list -> (int64 * bool) list Lwt.t
View
23 fql.ml
@@ -0,0 +1,23 @@
+(*
+ ocaml-facebook - Facebook Platform client API in OCaml
+
+ Copyright (C) <2010> David Sheets <sheets@alum.mit.edu>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation, version 2.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+ USA
+*)
+
+let call user = Namespace.call_method "fql" user
+
+let query user q = call user "query" [("query", `S q)]
View
1 fql.mli
@@ -0,0 +1 @@
+val query : Api.user -> string -> Json_type.t Lwt.t
View
101 namespace.ml
@@ -0,0 +1,101 @@
+(*
+ ocaml-facebook - Facebook Platform client API in OCaml
+
+ Copyright (C) <2010> David Sheets <sheets@alum.mit.edu>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation, version 2.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+ USA
+*)
+
+open Printf
+open Lwt
+open Cohttp
+open Api
+
+module StrMap = Map.Make(String)
+module AStrMap = Util.Assoc(StrMap)
+module MStrMap = Util.Map(StrMap)
+module J = Json_type.Browse
+
+type fb_data = [ `B of int64
+ | `D of int
+ | `F of float
+ | `S of string
+ | `List of fb_data list
+ ]
+
+let facebook_http = "http://api.facebook.com/restserver.php"
+let facebook_https = "https://api.facebook.com/restserver.php"
+
+let rec coerce = function
+ | `B l -> Int64.to_string l
+ | `D i -> string_of_int i
+ | `F f -> string_of_float f
+ | `S s -> s
+ | `List v -> Json_io.string_of_json (json_of_list v)
+and json_coerce = function
+ | `B l -> json_of_string (Int64.to_string l)
+ | `D i -> json_of_int i
+ | `F f -> json_of_float f
+ | `S s -> json_of_string s
+ | `List v -> json_of_list v
+and json_of_int i = Json_type.Int i
+and json_of_float f = Json_type.Float f
+and json_of_string s = Json_type.String s
+and json_of_list l = Json_type.Array (List.map json_coerce l)
+
+let bind_value fn (k, v) = (k, fn v)
+
+let std_params user meth params =
+ let get = [("method", meth);
+ ("api_key", user.user_app.app_key);
+ ("v", "1.0")] in
+ let get = match user.session with None -> get
+ | Some (k, _) -> ("session_key", k) :: get in
+ let post = [("call_id", string_of_int user.user_app.seq);
+ ("format", "JSON")] @ params in
+ let pmap = AStrMap.into_map StrMap.empty (get @ post) in
+ let () = user.user_app.seq <- user.user_app.seq + 1 in
+ (get, ("sig", generate_sig user.user_app pmap) :: post)
+
+let url_encode = Netencoding.Url.mk_url_encoded_parameters
+
+let attempt_post headers body url =
+ let rec post exnlist = function
+ | 0 -> fail (Facebook_error ("Cannot connect to Facebook", exnlist))
+ | n -> begin try_lwt Http_user_agent.post ~headers ~body url with
+ | e -> post (e::exnlist) (n - 1)
+ end
+ in post [] 3
+
+let facebook_error meth user params jo =
+ let code = J.int (List.assoc "error_code" jo) in
+ let msg = J.string (List.assoc "error_msg" jo) in
+ fail (Facebook_error (sprintf "Error %d in %s : %s" code meth msg, []))
+
+let call_method ns user name params =
+ let params = List.map (bind_value coerce) params in
+ let meth = "facebook." ^ ns ^ "." ^ name in
+ let get, post = std_params user meth params in
+ let qs = url_encode get in
+ let headers = [("User-Agent", "ocaml-facebook/0.1")] in
+ let body = url_encode post in
+ let url = facebook_http ^ "?" ^ qs in
+ lwt _, jss = attempt_post headers body url in
+ let json = Json_io.json_of_string ~recursive:true ~big_int_mode:true jss in
+ let fberr = try let jo = J.objekt json in if List.mem_assoc "error_response" jo
+ then Some jo else None
+ with Json_type.Json_error _ -> None
+ in match fberr with Some jo -> facebook_error meth user params jo
+ | None -> return json
View
8 namespace.mli
@@ -0,0 +1,8 @@
+type fb_data =
+ [ `B of int64
+ | `D of int
+ | `F of float
+ | `List of fb_data list
+ | `S of string ]
+
+val call_method : string -> Api.user -> string -> (string * fb_data) list -> Json_type.t Lwt.t
View
38 users.ml
@@ -0,0 +1,38 @@
+(*
+ ocaml-facebook - Facebook Platform client API in OCaml
+
+ Copyright (C) <2010> David Sheets <sheets@alum.mit.edu>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation, version 2.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+ USA
+*)
+
+open Lwt
+open Api
+module J = Json_type.Browse
+
+let call user = Namespace.call_method "users" user
+
+let get_info user users fields = call user "getInfo"
+ [("uids", `List (List.map (fun u -> `B u.uid) users));
+ ("fields", `List fields)]
+
+let get_standard_info user users fields = call user "getStandardInfo"
+ [("uids", `List (List.map (fun u -> `B u.uid) users));
+ ("fields", `List fields)]
+
+(* TODO: Really? Mutate the world for a boolean API call?! *)
+let is_app_user user =
+ lwt b = (call user "isAppUser" [("uid", `B user.uid)]) >|= J.bool
+ in save_user {user with added=b}; return b
View
5 users.mli
@@ -0,0 +1,5 @@
+val get_info :
+ Api.user -> Api.user list -> Namespace.fb_data list -> Json_type.t Lwt.t
+val get_standard_info :
+ Api.user -> Api.user list -> Namespace.fb_data list -> Json_type.t Lwt.t
+val is_app_user : Api.user -> bool Lwt.t

0 comments on commit 8a95315

Please sign in to comment.
Something went wrong with that request. Please try again.