Source file facebook.ml

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
129
130
131
132
133
134
135
136
137
138
(**************************************************************************)
(*                                                                        *)
(*                 Copyright 2018-2023 OCamlPro                           *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

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