objective categorical abstract machine language personal data server
Implement migrations (& oauth_tokens migration)
+214
-157
+86
migrations/001_initial_schema.sql
+86
migrations/001_initial_schema.sql
···
1
+
CREATE TABLE IF NOT EXISTS actors (
2
+
id INTEGER PRIMARY KEY,
3
+
did TEXT NOT NULL UNIQUE,
4
+
handle TEXT NOT NULL UNIQUE,
5
+
email TEXT NOT NULL UNIQUE,
6
+
password_hash TEXT NOT NULL,
7
+
signing_key TEXT NOT NULL,
8
+
preferences TEXT NOT NULL,
9
+
created_at INTEGER NOT NULL,
10
+
deactivated_at INTEGER
11
+
);
12
+
13
+
CREATE INDEX IF NOT EXISTS actors_did_idx ON actors (did);
14
+
CREATE INDEX IF NOT EXISTS actors_handle_idx ON actors (handle);
15
+
CREATE INDEX IF NOT EXISTS actors_email_idx ON actors (email);
16
+
17
+
CREATE TABLE IF NOT EXISTS invite_codes (
18
+
code TEXT PRIMARY KEY,
19
+
did TEXT NOT NULL,
20
+
remaining INTEGER NOT NULL
21
+
);
22
+
23
+
CREATE TABLE IF NOT EXISTS firehose (
24
+
seq INTEGER PRIMARY KEY,
25
+
time INTEGER NOT NULL,
26
+
t TEXT NOT NULL,
27
+
data BLOB NOT NULL
28
+
);
29
+
30
+
CREATE TABLE IF NOT EXISTS revoked_tokens (
31
+
did TEXT NOT NULL,
32
+
jti TEXT NOT NULL,
33
+
revoked_at INTEGER NOT NULL,
34
+
PRIMARY KEY (did, jti)
35
+
);
36
+
37
+
CREATE TABLE IF NOT EXISTS oauth_requests (
38
+
request_id TEXT PRIMARY KEY,
39
+
client_id TEXT NOT NULL,
40
+
request_data TEXT NOT NULL,
41
+
dpop_jkt TEXT,
42
+
expires_at INTEGER NOT NULL,
43
+
created_at INTEGER NOT NULL
44
+
);
45
+
46
+
CREATE INDEX IF NOT EXISTS oauth_requests_expires_idx ON oauth_requests(expires_at);
47
+
48
+
CREATE TABLE IF NOT EXISTS oauth_codes (
49
+
code TEXT PRIMARY KEY,
50
+
request_id TEXT NOT NULL REFERENCES oauth_requests(request_id) ON DELETE CASCADE,
51
+
authorized_by TEXT,
52
+
authorized_at INTEGER,
53
+
expires_at INTEGER NOT NULL,
54
+
used BOOLEAN DEFAULT FALSE
55
+
);
56
+
57
+
CREATE INDEX IF NOT EXISTS oauth_codes_expires_idx ON oauth_codes(expires_at);
58
+
59
+
CREATE TABLE IF NOT EXISTS oauth_tokens (
60
+
refresh_token TEXT UNIQUE NOT NULL,
61
+
client_id TEXT NOT NULL,
62
+
did TEXT NOT NULL,
63
+
dpop_jkt TEXT,
64
+
scope TEXT NOT NULL,
65
+
expires_at INTEGER NOT NULL
66
+
);
67
+
68
+
CREATE INDEX IF NOT EXISTS oauth_tokens_refresh_idx ON oauth_tokens(refresh_token);
69
+
70
+
CREATE TRIGGER IF NOT EXISTS cleanup_expired_oauth_requests
71
+
AFTER INSERT ON oauth_requests
72
+
BEGIN
73
+
DELETE FROM oauth_requests WHERE expires_at < unixepoch() * 1000;
74
+
END;
75
+
76
+
CREATE TRIGGER IF NOT EXISTS cleanup_expired_oauth_codes
77
+
AFTER INSERT ON oauth_codes
78
+
BEGIN
79
+
DELETE FROM oauth_codes WHERE expires_at < unixepoch() * 1000 OR used = 1;
80
+
END;
81
+
82
+
CREATE TRIGGER IF NOT EXISTS cleanup_expired_oauth_tokens
83
+
AFTER INSERT ON oauth_tokens
84
+
BEGIN
85
+
DELETE FROM oauth_tokens WHERE expires_at < unixepoch() * 1000;
86
+
END;
+4
migrations/002_track_oauth_sessions.sql
+4
migrations/002_track_oauth_sessions.sql
+3
pegasus/lib/api/oauth_/token.ml
+3
pegasus/lib/api/oauth_/token.ml
···
76
76
() )
77
77
in
78
78
let now_sec = int_of_float (Unix.gettimeofday ()) in
79
+
let now_ms = Util.now_ms () in
79
80
let expires_in =
80
81
Constants.access_token_expiry_ms / 1000
81
82
in
···
101
102
; did
102
103
; dpop_jkt= proof.jkt
103
104
; scope= orig_req.scope
105
+
; created_at= now_ms
106
+
; last_refreshed_at= now_ms
104
107
; expires_at }
105
108
in
106
109
let nonce = Dpop.next_nonce () in
+1
-153
pegasus/lib/data_store.ml
+1
-153
pegasus/lib/data_store.ml
···
21
21
open Types
22
22
23
23
module Queries = struct
24
-
let create_tables conn =
25
-
let$! () =
26
-
[%rapper
27
-
execute
28
-
{sql| CREATE TABLE IF NOT EXISTS actors (
29
-
id INTEGER PRIMARY KEY,
30
-
did TEXT NOT NULL UNIQUE,
31
-
handle TEXT NOT NULL UNIQUE,
32
-
email TEXT NOT NULL UNIQUE,
33
-
password_hash TEXT NOT NULL,
34
-
signing_key TEXT NOT NULL,
35
-
preferences TEXT NOT NULL,
36
-
created_at INTEGER NOT NULL,
37
-
deactivated_at INTEGER
38
-
)
39
-
|sql}]
40
-
() conn
41
-
in
42
-
let$! () =
43
-
[%rapper
44
-
execute
45
-
{sql| CREATE INDEX IF NOT EXISTS actors_did_idx ON actors (did);
46
-
CREATE INDEX IF NOT EXISTS actors_handle_idx ON actors (handle);
47
-
CREATE INDEX IF NOT EXISTS actors_email_idx ON actors (email);
48
-
|sql}]
49
-
() conn
50
-
in
51
-
let$! () =
52
-
[%rapper
53
-
execute
54
-
{sql| CREATE TABLE IF NOT EXISTS invite_codes (
55
-
code TEXT PRIMARY KEY,
56
-
did TEXT NOT NULL,
57
-
remaining INTEGER NOT NULL
58
-
)
59
-
|sql}]
60
-
() conn
61
-
in
62
-
let$! () =
63
-
[%rapper
64
-
execute
65
-
{sql| CREATE TABLE IF NOT EXISTS firehose (
66
-
seq INTEGER PRIMARY KEY,
67
-
time INTEGER NOT NULL,
68
-
t TEXT NOT NULL,
69
-
data BLOB NOT NULL
70
-
)
71
-
|sql}]
72
-
() conn
73
-
in
74
-
let$! () =
75
-
[%rapper
76
-
execute
77
-
(* no need to store issued tokens, just revoked ones; stolen from millipds https://github.com/DavidBuchanan314/millipds/blob/8f89a01e7d367a2a46f379960e9ca50347dcce71/src/millipds/database.py#L253 *)
78
-
{sql| CREATE TABLE IF NOT EXISTS revoked_tokens (
79
-
did TEXT NOT NULL,
80
-
jti TEXT NOT NULL,
81
-
revoked_at INTEGER NOT NULL,
82
-
PRIMARY KEY (did, jti)
83
-
)
84
-
|sql}]
85
-
() conn
86
-
in
87
-
let$! () =
88
-
[%rapper
89
-
execute
90
-
{sql| CREATE TABLE IF NOT EXISTS oauth_requests (
91
-
request_id TEXT PRIMARY KEY,
92
-
client_id TEXT NOT NULL,
93
-
request_data TEXT NOT NULL,
94
-
dpop_jkt TEXT,
95
-
expires_at INTEGER NOT NULL,
96
-
created_at INTEGER NOT NULL
97
-
)
98
-
|sql}]
99
-
() conn
100
-
in
101
-
let$! () =
102
-
[%rapper
103
-
execute
104
-
{sql| CREATE TABLE IF NOT EXISTS oauth_codes (
105
-
code TEXT PRIMARY KEY,
106
-
request_id TEXT NOT NULL REFERENCES oauth_requests(request_id) ON DELETE CASCADE,
107
-
authorized_by TEXT,
108
-
authorized_at INTEGER,
109
-
expires_at INTEGER NOT NULL,
110
-
used BOOLEAN DEFAULT FALSE
111
-
)
112
-
|sql}]
113
-
() conn
114
-
in
115
-
let$! () =
116
-
[%rapper
117
-
execute
118
-
{sql| CREATE TABLE IF NOT EXISTS oauth_tokens (
119
-
refresh_token TEXT UNIQUE NOT NULL,
120
-
client_id TEXT NOT NULL,
121
-
did TEXT NOT NULL,
122
-
dpop_jkt TEXT,
123
-
scope TEXT NOT NULL,
124
-
expires_at INTEGER NOT NULL
125
-
)
126
-
|sql}]
127
-
() conn
128
-
in
129
-
let$! () =
130
-
[%rapper
131
-
execute
132
-
{sql| CREATE INDEX IF NOT EXISTS oauth_requests_expires_idx ON oauth_requests(expires_at);
133
-
CREATE INDEX IF NOT EXISTS oauth_codes_expires_idx ON oauth_codes(expires_at);
134
-
CREATE INDEX IF NOT EXISTS oauth_tokens_refresh_idx ON oauth_tokens(refresh_token);
135
-
|sql}]
136
-
() conn
137
-
in
138
-
let$! () =
139
-
[%rapper
140
-
execute
141
-
{sql| CREATE TRIGGER IF NOT EXISTS cleanup_expired_oauth_requests
142
-
AFTER INSERT ON oauth_requests
143
-
BEGIN
144
-
DELETE FROM oauth_requests WHERE expires_at < unixepoch() * 1000;
145
-
END
146
-
|sql}
147
-
syntax_off]
148
-
() conn
149
-
in
150
-
let$! () =
151
-
[%rapper
152
-
execute
153
-
{sql| CREATE TRIGGER IF NOT EXISTS cleanup_expired_oauth_codes
154
-
AFTER INSERT ON oauth_codes
155
-
BEGIN
156
-
DELETE FROM oauth_codes WHERE expires_at < unixepoch() * 1000 OR used = 1;
157
-
END
158
-
|sql}
159
-
syntax_off]
160
-
() conn
161
-
in
162
-
let$! () =
163
-
[%rapper
164
-
execute
165
-
{sql| CREATE TRIGGER IF NOT EXISTS cleanup_expired_oauth_tokens
166
-
AFTER INSERT ON oauth_tokens
167
-
BEGIN
168
-
DELETE FROM oauth_tokens WHERE expires_at < unixepoch() * 1000;
169
-
END
170
-
|sql}
171
-
syntax_off]
172
-
() conn
173
-
in
174
-
Lwt.return_ok ()
175
-
176
24
let create_actor =
177
25
[%rapper
178
26
execute
···
315
163
Util.mkfile_p Util.Constants.pegasus_db_filepath ~perm:0o644 ;
316
164
Util.connect_sqlite ?create ?write Util.Constants.pegasus_db_location
317
165
318
-
let init conn : unit Lwt.t = Util.use_pool conn Queries.create_tables
166
+
let init conn : unit Lwt.t = Migrations.run_migrations conn
319
167
320
168
let create_actor ~did ~handle ~email ~password ~signing_key conn =
321
169
let password_hash = Bcrypt.hash password |> Bcrypt.string_of_hash in
+114
pegasus/lib/migrations.ml
+114
pegasus/lib/migrations.ml
···
1
+
[@@@ocaml.warning "-33"]
2
+
3
+
open Lwt.Infix
4
+
5
+
type migration = {id: int; name: string; applied_at: int}
6
+
7
+
module Queries = struct
8
+
open Util.Rapper
9
+
open Util.Syntax
10
+
11
+
let create_migrations_table =
12
+
[%rapper
13
+
execute
14
+
{sql| CREATE TABLE IF NOT EXISTS schema_migrations (
15
+
id INTEGER PRIMARY KEY,
16
+
name TEXT NOT NULL,
17
+
applied_at INTEGER NOT NULL
18
+
)
19
+
|sql}]
20
+
()
21
+
22
+
let get_applied_migrations =
23
+
[%rapper
24
+
get_many
25
+
{sql| SELECT @int{id}, @string{name}, @int{applied_at}
26
+
FROM schema_migrations
27
+
ORDER BY id ASC
28
+
|sql}
29
+
record_out]
30
+
()
31
+
32
+
let record_migration =
33
+
[%rapper
34
+
execute
35
+
{sql| INSERT INTO schema_migrations (id, name, applied_at)
36
+
VALUES (%int{id}, %string{name}, %int{applied_at})
37
+
|sql}]
38
+
end
39
+
40
+
let execute_raw db_path sql =
41
+
let db = Sqlite3.db_open db_path in
42
+
try
43
+
let rc = Sqlite3.exec db sql in
44
+
let _ = Sqlite3.db_close db in
45
+
match rc with
46
+
| Sqlite3.Rc.OK ->
47
+
Lwt.return_ok ()
48
+
| _ ->
49
+
let err_msg = Sqlite3.errmsg db in
50
+
Lwt.return_error (Failure ("sql error: " ^ err_msg))
51
+
with e ->
52
+
let _ = Sqlite3.db_close db in
53
+
Lwt.return_error e
54
+
55
+
let parse_migration_filename filename =
56
+
try
57
+
let regex = Str.regexp "^\\([0-9]+\\)_\\(.*\\)\\.sql$" in
58
+
if Str.string_match regex filename 0 then
59
+
let id = Str.matched_group 1 filename |> int_of_string in
60
+
let name = Str.matched_group 2 filename in
61
+
Some (id, name, filename)
62
+
else None
63
+
with _ -> None
64
+
65
+
let read_migration_files migrations_dir =
66
+
try
67
+
let files = Sys.readdir migrations_dir |> Array.to_list in
68
+
let migrations =
69
+
files
70
+
|> List.filter_map (fun filename ->
71
+
match parse_migration_filename filename with
72
+
| Some (id, name, _) ->
73
+
let full_path = Filename.concat migrations_dir filename in
74
+
Some (id, name, full_path)
75
+
| None ->
76
+
None )
77
+
|> List.sort (fun (id1, _, _) (id2, _, _) -> compare id1 id2)
78
+
in
79
+
Lwt.return migrations
80
+
with Sys_error _ -> Lwt.return []
81
+
82
+
let run_migration conn (id, name, filepath) =
83
+
let%lwt () = Lwt_io.printlf "running migration %03d: %s" id name in
84
+
let%lwt sql_content =
85
+
Lwt_io.with_file ~mode:Lwt_io.Input filepath (fun ic -> Lwt_io.read ic)
86
+
in
87
+
let%lwt result = execute_raw Util.Constants.pegasus_db_filepath sql_content in
88
+
let%lwt () =
89
+
match result with Ok () -> Lwt.return_unit | Error e -> raise e
90
+
in
91
+
let applied_at = Util.now_ms () in
92
+
let%lwt () =
93
+
Util.use_pool conn (Queries.record_migration ~id ~name ~applied_at)
94
+
in
95
+
Lwt_io.printlf "migration %03d applied successfully" id
96
+
97
+
let run_migrations ?(migrations_dir = "migrations") conn =
98
+
let%lwt () = Util.use_pool conn Queries.create_migrations_table in
99
+
let%lwt applied =
100
+
Util.use_pool conn Queries.get_applied_migrations
101
+
>|= List.map (fun m -> m.id)
102
+
in
103
+
let%lwt available = read_migration_files migrations_dir in
104
+
let pending =
105
+
List.filter (fun (id, _, _) -> not (List.mem id applied)) available
106
+
in
107
+
match pending with
108
+
| [] ->
109
+
Lwt_io.printl "no pending migrations"
110
+
| _ ->
111
+
let%lwt () =
112
+
Lwt_io.printlf "found %d pending migrations" (List.length pending)
113
+
in
114
+
Lwt_list.iter_s (run_migration conn) pending
+4
-4
pegasus/lib/oauth/queries.ml
+4
-4
pegasus/lib/oauth/queries.ml
···
83
83
@@ [%rapper
84
84
execute
85
85
{sql|
86
-
INSERT INTO oauth_tokens (refresh_token, client_id, did, dpop_jkt, scope, expires_at)
87
-
VALUES (%string{refresh_token}, %string{client_id}, %string{did}, %string{dpop_jkt}, %string{scope}, %int{expires_at})
86
+
INSERT INTO oauth_tokens (refresh_token, client_id, did, dpop_jkt, scope, created_at, expires_at, last_refreshed_at)
87
+
VALUES (%string{refresh_token}, %string{client_id}, %string{did}, %string{dpop_jkt}, %string{scope}, %int{created_at}, %int{expires_at}, %int{last_refreshed_at})
88
88
|sql}
89
89
record_in]
90
90
token
···
95
95
get_opt
96
96
{sql|
97
97
SELECT @string{refresh_token}, @string{client_id}, @string{did},
98
-
@string{dpop_jkt}, @string{scope}, @int{expires_at}
98
+
@string{dpop_jkt}, @string{scope}, @int{created_at}, @int{expires_at}, @int{last_refreshed_at}
99
99
FROM oauth_tokens
100
100
WHERE refresh_token = %string{refresh_token}
101
101
|sql}
···
129
129
get_many
130
130
{sql|
131
131
SELECT @string{refresh_token}, @string{client_id}, @string{did},
132
-
@string{dpop_jkt}, @string{scope}, @int{expires_at}
132
+
@string{dpop_jkt}, @string{scope}, @int{created_at}, @int{expires_at}, @int{last_refreshed_at}
133
133
FROM oauth_tokens
134
134
WHERE did = %string{did}
135
135
ORDER BY expires_at ASC