1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
module Types = struct
type info = {
app_id : string;
token_type : string;
app_name : string;
token_exp : int64;
token_valid : bool;
token_iss : int64 option;
token_meta : Json_repr.any option;
token_scopes : string list;
user_id : string;
}
type profile = {
fb_name : string;
fb_email : string;
fb_lastname : string option;
fb_firstname : string option;
fb_picture : string option;
}
end
module Encoding = struct
open Types
open Json_encoding
let picture_encoding = obj1 @@ req "data" @@
EzEncoding.ignore_enc @@ obj1 (req "url" string)
let encoding = obj1 @@ req "data" @@
EzEncoding.ignore_enc @@ conv
(fun {app_id; token_type; app_name; token_exp; token_valid; token_iss;
token_meta; token_scopes; user_id}
-> (app_id, token_type, app_name, token_exp, token_valid, token_iss,
token_meta, token_scopes, user_id))
(fun (app_id, token_type, app_name, token_exp, token_valid, token_iss,
token_meta, token_scopes, user_id)
-> {app_id; token_type; app_name; token_exp; token_valid; token_iss;
token_meta; token_scopes; user_id}) @@
obj9
(req "app_id" string)
(req "type" string)
(req "application" string)
(req "expires_at" int53)
(req "is_valid" bool)
(opt "issued_at" int53)
(opt "metadata" any_value)
(req "scopes" (list string))
(req "user_id" string)
let profile = EzEncoding.ignore_enc @@ conv
(fun {fb_email; fb_name; fb_lastname; fb_firstname; fb_picture}
-> (fb_email, fb_name, fb_lastname, fb_firstname, fb_picture))
(fun (fb_email, fb_name, fb_lastname, fb_firstname, fb_picture)
-> {fb_email; fb_name; fb_lastname; fb_firstname; fb_picture}) @@
obj5
(req "email" string)
(req "name" string)
(opt "last_name" string)
(opt "first_name" string)
(opt "picture" picture_encoding)
end
module Services = struct
open EzAPI
let arg_user_id = Arg.string ~example:"68746545" "user_id"
let input_token_param = Param.string ~descr:"input token" "input_token"
let access_token_param = Param.string ~descr:"access token" "access_token"
let fields_param = Param.string ~descr:"output fields" "fields"
let facebook_auth = BASE "https://graph.facebook.com/v8.0/"
let debug_token : (Types.info, exn, Security.none) EzAPI.service0 =
EzAPI.service
~register:false
~name:"debug_token"
~params:[input_token_param; access_token_param]
~output:Encoding.encoding
Path.(root // "debug_token")
let nodes ?name output : (string, 'a, exn, Security.none) EzAPI.service1 =
EzAPI.service
~register:false
?name
~params:[access_token_param; fields_param]
~output
EzAPI.Path.(root /: arg_user_id)
let edges ?name output : (string, 'a, exn, Security.none) EzAPI.service1 =
EzAPI.service
~register:false
?name
~params:[access_token_param; fields_param]
~output
EzAPI.Path.(root /: arg_user_id)
end
open Types
open Services
open EzReq_lwt
open Lwt.Infix
let handle_error e = Error (handle_error (fun exn -> Some (Printexc.to_string exn)) e)
let check_token ~app_secret ~app_id input_token =
let params = [
access_token_param, EzAPI.S (app_id ^ "|" ^ app_secret);
input_token_param, EzAPI.S input_token] in
get0 ~params facebook_auth debug_token >|= function
| Error e -> handle_error e
| Ok token ->
if token.app_id = app_id && token.token_valid then Ok token.user_id
else Error (400, Some "Invalid facebook token")
let fields = "email,name,last_name,first_name,picture"
let get_info ~user_id user_access_token : (profile, int * string option) result Lwt.t =
let params = [
access_token_param, EzAPI.S user_access_token;
fields_param, EzAPI.S fields
] in
get1 ~params facebook_auth (nodes ~name:"facebook_profile" Encoding.profile) user_id >|= function
| Error e -> handle_error e
| Ok pr -> Ok pr