Add resource & access mask tables

server/db.rkt

@@ -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

server/groups.rkt

@@ -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)

server/resource.rkt

@@ -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)))))