futur.blue
objective categorical abstract machine language personal data server
Multi account session support
+1
-1
pegasus/lib/api/account_/login.ml
+1
-1
pegasus/lib/api/account_/login.ml
···
33
33
~props:{redirect_url; csrf_token; error= Some error}
34
34
| Some {did; _} ->
35
35
let%lwt () = Dream.invalidate_session ctx.req in
36
-
let%lwt () = Dream.set_session_field ctx.req "did" did in
36
+
let%lwt () = Session.log_in_did ctx.req did in
37
37
Dream.redirect ctx.req redirect_url )
38
38
| _ ->
39
39
let redirect_url = "/account" in
+1
pegasus/lib/api/oauth_/token.ml
+1
pegasus/lib/api/oauth_/token.ml
+5
-3
pegasus/lib/oauth/queries.ml
+5
-3
pegasus/lib/oauth/queries.ml
···
103
103
record_out]
104
104
~refresh_token
105
105
106
-
let update_oauth_token conn ~old_refresh_token ~new_refresh_token ~expires_at =
106
+
let update_oauth_token conn ~old_refresh_token ~new_refresh_token ~expires_at
107
+
~ip ~user_agent =
107
108
Util.use_pool conn
108
109
@@ [%rapper
109
110
execute
110
111
{sql|
111
112
UPDATE oauth_tokens
112
113
SET refresh_token = %string{new_refresh_token},
113
-
expires_at = %int{expires_at}
114
+
expires_at = %int{expires_at}, last_ip = %string{ip},
115
+
last_user_agent = %string?{user_agent}
114
116
WHERE refresh_token = %string{old_refresh_token}
115
117
|sql}]
116
-
~new_refresh_token ~expires_at ~old_refresh_token
118
+
~new_refresh_token ~expires_at ~old_refresh_token ~ip ~user_agent
117
119
118
120
let delete_oauth_token_by_refresh conn refresh_token =
119
121
Util.use_pool conn
+84
pegasus/lib/session.ml
+84
pegasus/lib/session.ml
···
1
+
type data =
2
+
{ current_did: string option [@default None]
3
+
; logged_in_dids: string list [@default []] }
4
+
[@@deriving yojson {strict= false}]
5
+
6
+
let default = {current_did= None; logged_in_dids= []}
7
+
8
+
module Raw = struct
9
+
let set_session req data =
10
+
Dream.set_session_field req "pegasus.session"
11
+
(data_to_yojson data |> Yojson.Safe.to_string)
12
+
13
+
let get_session req =
14
+
match Dream.session_field req "pegasus.session" with
15
+
| Some data -> (
16
+
match
17
+
data_of_yojson (try Yojson.Safe.from_string data with _ -> `Null)
18
+
with
19
+
| Ok data ->
20
+
Lwt.return_some data
21
+
| Error _ ->
22
+
let%lwt () = set_session req default in
23
+
Lwt.return_some default )
24
+
| None ->
25
+
Lwt.return_none
26
+
27
+
let clear_session req = Dream.set_session_field req "pegasus.session" ""
28
+
29
+
let get_current_did req =
30
+
match%lwt get_session req with
31
+
| Some {current_did; _} when current_did <> None ->
32
+
Lwt.return current_did
33
+
| _ ->
34
+
Lwt.return_none
35
+
36
+
let set_current_did req did =
37
+
match%lwt get_session req with
38
+
| Some {logged_in_dids; _} ->
39
+
let%lwt () = set_session req {current_did= Some did; logged_in_dids} in
40
+
Lwt.return_unit
41
+
| None ->
42
+
Lwt.return_unit
43
+
44
+
let get_logged_in_dids req =
45
+
match%lwt get_session req with
46
+
| Some {logged_in_dids; _} ->
47
+
Lwt.return logged_in_dids
48
+
| None ->
49
+
Lwt.return []
50
+
51
+
let set_logged_in_dids req dids =
52
+
match%lwt get_session req with
53
+
| Some {current_did; _} ->
54
+
let%lwt () = set_session req {current_did; logged_in_dids= dids} in
55
+
Lwt.return_unit
56
+
| None ->
57
+
Lwt.return_unit
58
+
end
59
+
60
+
open Raw
61
+
62
+
let log_in_did ?(set_current = true) req did =
63
+
match%lwt get_session req with
64
+
| Some {current_did; logged_in_dids} ->
65
+
let%lwt () =
66
+
set_session req
67
+
{ current_did= (if set_current then Some did else current_did)
68
+
; logged_in_dids= did :: logged_in_dids }
69
+
in
70
+
Lwt.return_unit
71
+
| None ->
72
+
Lwt.return_unit
73
+
74
+
let log_out_did req did =
75
+
match%lwt get_session req with
76
+
| Some {current_did; logged_in_dids} ->
77
+
let%lwt () =
78
+
set_session req
79
+
{ current_did
80
+
; logged_in_dids= List.filter (fun d -> d <> did) logged_in_dids }
81
+
in
82
+
Lwt.return_unit
83
+
| None ->
84
+
Lwt.return_unit