Browse Source

Add resource & access mask tables

master
Christian Fischer 1 year ago
parent
commit
e99735b9b0
3 changed files with 118 additions and 58 deletions
  1. +33
    -7
      server/db.rkt
  2. +15
    -1
      server/groups.rkt
  3. +70
    -50
      server/resource.rkt

+ 33
- 7
server/db.rkt View File

@@ -7,6 +7,8 @@
(provide connect-db
create-users-table
create-groups-table
create-group-masks-table
create-resources-table
)

(define (connect-db)
@@ -17,17 +19,41 @@
(define (create-users-table dbc)
(query-exec
dbc
"create table users (
user_id integer primary key,
name text not null)"))
"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)"))
"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,
content 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


+ 15
- 1
server/groups.rkt View File

@@ -6,7 +6,18 @@
threading
"db.rkt")

(provide ;group-by-id


(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?
@@ -143,6 +154,9 @@
(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)


+ 70
- 50
server/resource.rkt View File

@@ -1,42 +1,67 @@
#lang racket

(require "groups.rkt"
(require db
json
threading
"db.rkt"
"groups.rkt"
"privileges.rkt")

(provide (struct-out resource)
user-canonical-mask
user-masks
resource-set-mask
get-actions
pl-edit-view)
;; user-canonical-mask
;; user-masks
;; resource-set-mask
;; get-actions
;; pl-edit-view
)

(struct resource (name owner content plines group-masks))

(define (select-resources dbc)
(query-rows dbc
"select * from resources"))

(define (insert-resource dbc name owner content type)
(query-exec dbc
"insert into resources (name, owner_id, content, resource_type)
values (?,?,?,?)"
name
owner
content
type))




; Given a resource and a user, get the masks for that user based
; on the per-group masks in the resource privileges.
(define (user-masks res u)
(define masks
(map (lambda (x)
(dict-ref (resource-group-masks res)
x
; TODO the minimum access mask should be defined on a per-resource basis
(minimum-access-mask (resource-plines res))))
(map group-id (groups-by-user u))))
(if (empty? masks)
(list (minimum-access-mask (resource-plines res)))
masks))

; TODO rewrite
;; (define (user-masks res u)
;; (define masks
;; (map (lambda (x)
;; (dict-ref (resource-group-masks res)
;; x
;; ; TODO the minimum access mask should be defined on a per-resource basis
;; (minimum-access-mask (resource-plines res))))
;; (map group-id (groups-by-user u))))
;; (if (empty? masks)
;; (list (minimum-access-mask (resource-plines res)))
;; masks))


; Given a resource and a mask, calculate the actual mask in case the
; mask has admin privileges. Admins have the maximum access privileges,
; except their admin privileges may be limited.
(define (admin-mask res m)
(define admin-level (dict-ref m 'admin))
(if (eq? admin-level 'not-admin)
m
(dict-set (maximum-access-mask (resource-plines res))
'admin
admin-level)))

; TODO rewrite
;; (define (admin-mask res m)
;; (define admin-level (dict-ref m 'admin))
;; (if (eq? admin-level 'not-admin)
;; m
;; (dict-set (maximum-access-mask (resource-plines res))
;; 'admin
;; admin-level)))

; The owner of a resource has complete access.
(define (owner-mask res)
@@ -49,28 +74,34 @@
; TODO: Support default minimum access levels based on if the resource
; is public or private (perhaps just a group mask keyed to the global
; user/guest group?)
(define (user-canonical-mask res u)
(if (eq? u (resource-owner res))
(owner-mask res)
(admin-mask res
(apply mask-join
(resource-plines res)
(user-masks res u)))))

; TODO rewrite
;; (define (user-canonical-mask res u)
;; (if (eq? u (resource-owner res))
;; (owner-mask res)
;; (admin-mask res
;; (apply mask-join
;; (resource-plines res)
;; (user-masks res u)))))

; Given a resource and a user, return all actions the user has access to perform;
; Return format is an alist of alists; it's a subset of the resource's plines field.
(define (get-actions res u)
(define mask (user-canonical-mask res u))
(dict-map (resource-plines res)
(λ (k v)
(cons k (reverse
(memf (λ (x)
(eq? (dict-ref mask k) (car x)))
(reverse v)))))))

; TODO rewrite
;; (define (get-actions res u)
;; (define mask (user-canonical-mask res u))
;; (dict-map (resource-plines res)
;; (λ (k v)
;; (cons k (reverse
;; (memf (λ (x)
;; (eq? (dict-ref mask k) (car x)))
;; (reverse v)))))))

;; Given a resource, a group ID, and a mask that fits the resource,
;; returns a new resource with the corresponding group's mask updated
;; to the given mask. Returns #f if the mask doesn't fit.

; TODO rewrite
(define (resource-set-mask res gid mask)
(if (is-mask-for? (resource-plines res) mask)
(struct-copy resource
@@ -80,14 +111,3 @@
gid
mask)])
#f))


;; Constructor for a pline with actions for no access, getting, and
;; modifying something.
(define (pl-edit-view name
no-access
get
mod)
`(,name (no-access . ,no-access)
(view . ,get)
(edit . ,(λ (f) (mod f)))))

Loading…
Cancel
Save