-
Notifications
You must be signed in to change notification settings - Fork 20
/
Copy pathkeychain.lisp
174 lines (162 loc) · 7.61 KB
/
keychain.lisp
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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
(in-package :turtl)
(defvalidator validate-keychain-entry
(("id" :type id :required t)
("user_id" :type id :required t)
("type" :type string :required t :max-length 24)
("item_id" :type string :required t)
("body" :type string :required t))
:old t)
(defafun get-keychain-entry-by-id (future) (key-id)
"Get a keychain entry by its id."
(alet* ((sock (db-sock))
(query (r:r (:get (:table "keychain") key-id)))
(entry (r:run sock query)))
(r:disconnect sock)
(finish future entry)))
(defafun get-user-keychain (future) (user-id)
"Get all keychain entries for a user."
(alet* ((sock (db-sock))
(query (r:r
(:filter
(:get-all
(:table "keychain")
user-id
:index (db-index "keychain" "user_id"))
(r:fn (k)
(:~ (:has-fields k "deleted"))))))
(cursor (r:run sock query))
(entries (r:to-array sock cursor)))
(r:stop/disconnect sock cursor)
(finish future entries)))
(adefun get-keychain-entries-by-item-ids (user-id item-ids)
"Get all keychain entries for the given user ID/item IDs."
(alet* ((sock (db-sock))
(query (r:r
;; TODO: compound index maybe??
(:filter
(:get-all
(:table "keychain")
item-ids
:index (db-index "keychain" "item_id"))
(r:fn (entry)
(:== user-id (:attr entry "user_id"))))))
(cursor (r:run sock query))
(entries (r:to-array sock cursor)))
(r:stop/disconnect sock cursor)
entries))
(defafun add-keychain-entry (future) (user-id key-data)
"Add a new keychain entry for the given user."
(setf (gethash "user_id" key-data) user-id)
(validate-keychain-entry (key-data future)
(alet* ((sock (db-sock))
(query (r:r (:insert
(:table "keychain")
key-data)))
(nil (r:run sock query))
(sync-ids (add-sync-record user-id
"keychain"
(gethash "id" key-data)
"add")))
(r:disconnect sock)
(setf (gethash "sync_ids" key-data) sync-ids)
(finish future key-data))))
(defafun edit-keychain-entry (future) (user-id key-id key-data)
"Edit a keychain entry."
(alet* ((entry (get-keychain-entry-by-id key-id)))
(if entry
(if (string= (gethash "user_id" entry) user-id)
(validate-keychain-entry (key-data future :edit t)
(setf (gethash "id" key-data) key-id)
(remhash "user_id" key-data)
(alet* ((sock (db-sock))
(query (r:r (:update
(:get (:table "keychain") key-id)
key-data)))
(nil (r:run sock query))
(sync-ids (add-sync-record user-id "keychain" key-id "edit")))
(r:disconnect sock)
(setf (gethash "sync_ids" key-data) sync-ids)
(finish future key-data)))
(signal-error future (make-instance 'insufficient-privileges
:msg "You're trying to edit a keychain entry that isn't yours.")))
(signal-error future (make-instance 'not-found
:msg "Keychain entry not found.")))))
(adefun do-delete-keychain-entry (user-id key-id)
"Run a keychain delete."
(alet* ((sock (db-sock))
(query (r:r (:delete (:get (:table "keychain") key-id))))
(nil (r:run sock query))
(sync-ids (add-sync-record user-id "keychain" key-id "delete")))
(r:disconnect sock)
sync-ids))
(adefun delete-keychain-entry (user-id key-id)
"Delete a keychain entry w/ permissions check."
;; check that the user owns it first
(alet* ((entry (get-keychain-entry-by-id key-id)))
(if entry
(if (string= (gethash "user_id" entry) user-id)
(do-delete-keychain-entry user-id key-id)
(error (make-instance 'insufficient-privileges
:msg "You're trying to delete a keychain entry that isn't yours.")))
;; no entry? fail silently
#())))
(defafun delete-keychain-entries (future) (user-id item-id)
"Delete all keychain entries that are attached to the given item ID."
(alet* ((sock (db-sock))
(query (r:r (:get-all (:table "keychain") item-id :index (db-index "keychain" "item_id"))))
(cursor (r:run sock query))
(entries (r:to-array sock cursor))
(sync-records nil))
(if (zerop (length entries))
(progn
(r:disconnect sock)
(finish future 0))
(wait (adolist (entry (coerce entries 'list))
(push (make-sync-record user-id "keychain" (gethash "id" entry) "delete") sync-records))
(wait (insert-sync-records sync-records)
(alet* ((query (r:r (:delete (:get-all (:table "keychain") item-id :index (db-index "keychain" "item_id")))))
(nil (r:run sock query)))
(r:disconnect sock)
(finish future (length entries))))))))
(adefun delete-keychain-tree (from-user-id user-id board-id)
"Grab a board's tree data (board, child boards, all notes contained therein)
and for each item we no longer have at least read access to, remove that
item's keychain entry (if it exists)."
(multiple-promise-bind (boards notes)
(get-board-tree
board-id
:user-id user-id
:perm-filter (lambda (type user-id data board-perms)
(case type
(:board
(let* ((cur-board-id (gethash "id" data))
(perm-entry (gethash cur-board-id board-perms)))
;; remove any boards we still have some level of
;; permissions for. this includes the board being
;; unshared
(and perm-entry
(< 0 (gethash "perms" perm-entry 0)))))
(:note
(user-can-read-note-p user-id data board-perms)))))
(alet* ((item-ids (loop for item across (concatenate 'vector boards notes)
collect (gethash "id" item)))
(keychain-entries (get-keychain-entries-by-item-ids user-id item-ids))
(sock (db-sock))
(query (r:r
(:delete
(:get-all
(:table "keychain")
(map 'list (lambda (k) (gethash "id" k)) keychain-entries)))))
(nil (unless (zerop (length keychain-entries))
(r:run sock query)))
(sync-records (map 'vector
(lambda (ke) (make-sync-record from-user-id
"keychain"
(gethash "id" ke)
"delete"
:rel-ids (list user-id)
:no-auto-add-user t))
keychain-entries))
(nil (insert-sync-records sync-records)))
;; return the sync id(s)
(map 'vector (lambda (s) (gethash "id" s)) sync-records))))