Browse Source

Redis get user, group

master
Christian Fischer 10 months ago
parent
commit
1ea66e8270
2 changed files with 94 additions and 240 deletions
  1. +50
    -50
      server/db.rkt
  2. +44
    -190
      server/groups.rkt

+ 50
- 50
server/db.rkt View File

@@ -1,59 +1,59 @@
#lang racket

(require db
redis
json
threading)

(provide connect-db
create-users-table
create-groups-table
create-group-masks-table
create-resources-table
)

(define (connect-db)
(sqlite3-connect #:database "./proxy.db"
#:mode 'create))


(define (create-users-table dbc)
(query-exec
dbc
"CREATE TABLE users (
user_id INTEGER PRIMARY KEY,
name TEXT NOT NULL)"))

(define (create-groups-table dbc)
(query-exec
dbc
"CREATE TABLE groups (
group_id INTEGER PRIMARY KEY,
admin_ids TEXT NOT NULL,
member_ids TEXT NOT NULL)"))

(define (create-resources-table dbc)
(query-exec
dbc
"CREATE TABLE resources (
resource_id INTEGER PRIMARY KEY,
name TEXT NOT NULL,
owner_id INTEGER NOT NULL,
resource_data TEXT NOT NULL,
resource_type TEXT NOT NULL,
FOREIGN KEY (owner_id)
REFERENCES users (user_id))"))


(define (create-group-masks-table dbc)
(query-exec
dbc
"CREATE TABLE group_masks (
mask_id INTEGER PRIMARY KEY,
resource_id INTEGER NOT NULL,
group_id INTEGER NOT NULL,
mask TEXT NOT NULL,
FOREIGN KEY (resource_id) REFERENCES resources (resource_id),
FOREIGN KEY (group_id) REFERENCES groups (group_id))"))
;; (provide )

(define (connect-redis)
(make-redis))


;; (define (connect-db)
;; (sqlite3-connect #:database "./proxy.db"
;; #:mode 'create))


;; (define (create-users-table dbc)
;; (query-exec
;; dbc
;; "CREATE TABLE users (
;; user_id INTEGER PRIMARY KEY,
;; name TEXT NOT NULL)"))

;; (define (create-groups-table dbc)
;; (query-exec
;; dbc
;; "CREATE TABLE groups (
;; group_id INTEGER PRIMARY KEY,
;; admin_ids TEXT NOT NULL,
;; member_ids TEXT NOT NULL)"))

;; (define (create-resources-table dbc)
;; (query-exec
;; dbc
;; "CREATE TABLE resources (
;; resource_id INTEGER PRIMARY KEY,
;; name TEXT NOT NULL,
;; owner_id INTEGER NOT NULL,
;; resource_data TEXT NOT NULL,
;; resource_type TEXT NOT NULL,
;; FOREIGN KEY (owner_id)
;; REFERENCES users (user_id))"))


;; (define (create-group-masks-table dbc)
;; (query-exec
;; dbc
;; "CREATE TABLE group_masks (
;; mask_id INTEGER PRIMARY KEY,
;; resource_id INTEGER NOT NULL,
;; group_id INTEGER NOT NULL,
;; mask TEXT NOT NULL,
;; FOREIGN KEY (resource_id) REFERENCES resources (resource_id),
;; FOREIGN KEY (group_id) REFERENCES groups (group_id))"))

;; (define (create-resources-table dbc)
;; (query-exec


+ 44
- 190
server/groups.rkt View File

@@ -1,6 +1,7 @@
#lang racket

(require db
redis
json
racket/set
threading
@@ -8,60 +9,23 @@



(provide select-users
select-user-id
select-user-name
insert-user
insert-group
select-groups
select-group-id
select-groups-by-user-id
add-member
del-member
;groups-by-user
;user-by-id
;; has-user?
;add-group-for-owner
(provide get-user
get-group
(struct-out user)
(struct-out group))



; A simple (placeholder) user type, to be replaced by one isomorphic
; to the GeneNetwork user type.
(struct user (id name)
#:transparent)

(define (read-user-row r)
(user (vector-ref r 0)
(vector-ref r 1)))

(define (select-users dbc)
(map read-user-row
(query-rows
dbc
"select * from users")))

(define (select-user-id dbc id)
(read-user-row
(query-maybe-row dbc
"select * from users where user_id = ?"
id)))

;; (define (select-users-id dbc ids)
;; (map read-user-row
;; (query-rows dbc
;; "select * from users where user_id

(define (select-user-name dbc name)
(read-user-row
(query-maybe-row dbc
"select * from users where name = ?"
name)))

(define (insert-user dbc name)
(query-exec
dbc
"insert into users (name) values (?)"
name))

(define (get-user dbc id)
(let ((user-json (string->jsexpr (redis-hash-get dbc "users" id))))
(user id
(dict-ref user-json "user_name"))))

; A group is a product of two sets of users, admins and members. A
; user can be either an admin or a member, not both. Logically, for
@@ -69,77 +33,45 @@
(struct group (id admins members)
#:transparent)

; TODO this should check that the provided user IDs point to existing users
(define (insert-group dbc admins members)
(let ([admin-str (jsexpr->string (set->list admins))]
[mems-str (jsexpr->string (set->list members))])
(query-exec
dbc
"insert into groups (admin_ids, member_ids)
values (?, ?)"
admin-str
mems-str)))
;; may end up having to deserialize the admins and members fields as
;; an additional step
(define (get-group dbc id)
(let ((group-json (string->jsexpr (redis-hash-get dbc "groups" id))))
(define (parse k)
(~> (dict-ref group-json k)
(string->jsexpr)
(list->set)))
(group id
(parse "admins")
(parse "members"))))

(define test-grp
(cons (list->set '(1 2 3 4))
(list->set '(5 6 7 8 9 10))))

(define (read-group-row r)
(define (ref i)
(~> (vector-ref r i)
(string->jsexpr)
(list->set)))
(group (vector-ref r 0)
(ref 1)
(ref 2)))

(define (select-groups dbc)
(map read-group-row
(query-rows dbc
"select * from groups")))

(define (select-group-id dbc id)
(read-group-row
(query-row dbc
"select * from groups where group_id = ?"
id)))

;; this is just a *terrible* way of doing it, but it's temporary and
;; i'm not about to set sqlite up with regex support just for this,
;; though for now it would probably be better to just do `select * from groups`
;; and do the filtering in racket...
(define (group-query-string column id)
(if (and (number? id)
(string? column))
(let ([id (number->string id)])
(string-append
"select * from groups where "
column " like '[" id "]' or "
column " like '[" id ",%' or "
column " like '%," id ",%' or "
column " like '%," id "]'"))
#f))


(define (select-groups-by-admin-id dbc id)
(if (number? id)
(map read-group-row
(query-rows dbc
(group-query-string "admin_ids" id)))
(error "tried to select groups where id is not a number")))

(define (select-groups-by-member-id dbc id)
(if (number? id)
(map read-group-row
(query-rows dbc
(group-query-string "member_ids" id)))
(error "tried to select groups where id is not a number")))

(define (select-groups-by-user-id dbc id)
(~> (map read-group-row
(query-rows dbc "select * from groups"))
(filter (lambda (g) (has-user? g id)) _)))

;; TODO it *might* be useful to have in gn-proxy? But for now it's
;; fine to have GN search Redis and return the group ID, if this
;; functionality is needed

;; (define (select-groups-by-admin-id dbc id)
;; (if (number? id)
;; (map read-group-row
;; (query-rows dbc
;; (group-query-string "admin_ids" id)))
;; (error "tried to select groups where id is not a number")))

;; (define (select-groups-by-member-id dbc id)
;; (if (number? id)
;; (map read-group-row
;; (query-rows dbc
;; (group-query-string "member_ids" id)))
;; (error "tried to select groups where id is not a number")))

;; (define (select-groups-by-user-id dbc id)
;; (~> (map read-group-row
;; (query-rows dbc "select * from groups"))
;; (filter (lambda (g) (has-user? g id)) _)))


;; has-member? is only used by add-member and make-admin. These functions
@@ -154,84 +86,6 @@
(define (has-user? g uid)
(or (has-admin? g uid) (has-member? g uid)))

; this API (add/del-member, promote/demote for admins) is clunky and
; more of the logic should be handled by the DB; however that can wait
; until I move over to redis.
(define (add-member dbc gid uid)
(let ([g (select-group-id dbc gid)])
(if (has-user? g uid)
#f ; user exists; do nothing
(let ([new-members (~> (group-members g)
(set-add _ uid)
(set->list)
(jsexpr->string))])
(query-exec dbc
"update groups
set member_ids = ?
where group_id = ?"
new-members
gid)))))

(define (del-member dbc gid uid)
(let ([g (select-group-id dbc gid)])
(if (not (has-member? g uid))
#f ; member doesn't exist; do nothing
(let ([new-members (~> (group-members g)
(set-remove _ uid)
(set->list)
(jsexpr->string))])
(query-exec dbc
"update groups
set member_ids = ?
where group_id = ?"
new-members
gid)))))


(define (promote-to-admin dbc gid uid)
(let ([g (select-group-id dbc gid)])
(if (not (has-member? g uid))
#f ; member doesn't exist; do nothing
(let ([new-members (~> (group-members g)
(set-remove _ uid)
(set->list)
(jsexpr->string))]
[new-admins (~> (group-admins g)
(set-add _ uid)
(set->list)
(jsexpr->string))])
(query-exec dbc
"update groups
set member_ids = ?
admin_ids = ?
where group_id = ?"
new-members
new-admins
gid)))))


(define (demote-to-member dbc gid uid)
(let ([g (select-group-id dbc gid)])
(if (not (has-admin? g uid))
#f ; admin doesn't exist; do nothing
(let ([new-members (~> (group-members g)
(set-add _ uid)
(set->list)
(jsexpr->string))]
[new-admins (~> (group-admins g)
(set-remove _ uid)
(set->list)
(jsexpr->string))])
(query-exec dbc
"update groups
set member_ids = ?
admin_ids = ?
where group_id = ?"
new-members
new-admins
gid)))))


(define (all-members g)
(set->list (set-union (group-admins g)
(group-members g))))

Loading…
Cancel
Save