Skip to content

Commit

Permalink
Reorganization of API modules, protection of interfaces
Browse files Browse the repository at this point in the history
  • Loading branch information
David Sheets committed Apr 21, 2010
1 parent dbe1c86 commit 8a95315
Show file tree
Hide file tree
Showing 11 changed files with 297 additions and 90 deletions.
6 changes: 5 additions & 1 deletion Makefile
View file
@@ -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
Expand Down
92 changes: 3 additions & 89 deletions api.ml
View file
@@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
36 changes: 36 additions & 0 deletions api.mli
View file
@@ -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
69 changes: 69 additions & 0 deletions dashboard.ml
View file
@@ -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)
8 changes: 8 additions & 0 deletions dashboard.mli
View file
@@ -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
23 changes: 23 additions & 0 deletions fql.ml
View file
@@ -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)]
1 change: 1 addition & 0 deletions fql.mli
View file
@@ -0,0 +1 @@
val query : Api.user -> string -> Json_type.t Lwt.t
101 changes: 101 additions & 0 deletions namespace.ml
View file
@@ -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
8 changes: 8 additions & 0 deletions namespace.mli
View file
@@ -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

0 comments on commit 8a95315

Please sign in to comment.