Merge pull request #2 from chfi/development

Development

readme.org

@@ -43,7 +43,7 @@ on the resource type.
 
 #+begin_src js
 { "name": "r1",
-  "owner_id": 0,
+  "owner_id": "7733c380-b83f-45de-a8b5-17e1bc3738a9",
   "data": { "path": "test1.txt",
             "metadata": "test1" },
   "type": "dataset-file",
@@ -77,7 +77,7 @@ action, namely viewing data.
 A JSON example:
 #+begin_src js
 { "name": "some-resource",
-  "owner_id": 0,
+  "owner_id": "7733c380-b83f-45de-a8b5-17e1bc3738a9",
   "data": { "dataset": "BXDGeno",
             "trait": "rs365781" },
   "type": "dataset-geno",
@@ -100,7 +100,7 @@ dataset-geno.
 A JSON example:
 #+begin_src js
 { "name": "some-resource",
-  "owner_id": 0,
+  "owner_id": "7733c380-b83f-45de-a8b5-17e1bc3738a9",
   "data": { "dataset": "1",
             "trait": "17465" },
   "type": "dataset-publish",

server/groups.rkt

@@ -23,10 +23,12 @@
 ;; Retrieve the given user by ID from Redis; deserializes from JSON
 ;; TODO update this when we update the user struct
 (define (get-user dbc id)
-  (let ((user-hash (bytes->jsexpr
-                    (redis-hash-ref dbc "users" id))))
-    (user id
-          (dict-ref user-hash 'email_address))))
+  (let ((user-hash  (redis-hash-ref dbc "users" id)))
+    (if (false? user-hash)
+        (error (format "User not found in Redis: ~a"
+                       id))
+        (user id
+              (dict-ref user-hash 'email_address)))))
 
 
 ;; Add a user with the given ID and name to the "users" hash in Redis.
@@ -56,10 +58,14 @@
 
 ;; Retrieve the given group by ID from Redis
 (define (get-group dbc id)
-  (deserialize-group id
-                     (redis-hash-ref dbc
-                                     "groups"
-                                     id)))
+  (let ((grp (redis-hash-ref dbc
+                             "groups"
+                             id)))
+    (if (false? grp)
+        (error (format "Group not found in Redis: ~a"
+                       id))
+        (deserialize-group id grp))))
+
 
 ;; NB: like add-user, for testing in the REPL
 (define (add-group dbc id admins members)

server/privileges.rkt

@@ -1,6 +1,7 @@
 #lang racket
 
 (provide (struct-out action)
+         action-set->hash
          minimum-access-mask
          maximum-access-mask
          run-action
@@ -18,8 +19,7 @@
 ;; See resource.rkt for examples
 (struct
   action
-  (id
-   fun
+  (fun
    req-params)
   #:transparent)
 
@@ -40,6 +40,15 @@
        (for/and ([(k v) (in-hash actions)])
          (and (dict? v) (list? v)))))
 
+
+;; It's useful to be able to partially represent an action set as
+;; a tree, to show exactly what actions are available, in general,
+;; on a resource type
+(define (action-set->hash actions)
+  (for/hash ([(k v) (in-hash actions)])
+    (values k (map car v))))
+
+
 ;; A mask is a map from action branches to action IDs. In a sense
 ;; it is a subset of the action set; though it doesn't actually
 ;; contain the actions, it does describe which actions can be used.
@@ -49,8 +58,10 @@
 ;; the case if both have the same keys, and each value in the mask
 ;; exists in the list at the corresponding key in the action set hash.
 (define (is-mask-for? actions mask)
-  (for/and ([(k v) (in-hash actions)])
-    (not (false? (assoc (dict-ref mask k) v)))))
+  (and (for/and ([(k v) (in-hash actions)])
+         (not (false? (assoc (dict-ref mask k #f) v))))
+       (for/and ([(k v) (in-hash mask)])
+         (not (false? (dict-ref actions k #f))))))
 
 ;; Return the mask for an action set that provides the least possible
 ;; level of access, i.e. only the first action in each branch.
@@ -90,3 +101,60 @@
         (let ((ix (+ 1 ((mask-index v) (dict-ref mask k)))))
           (values k (take v ix))))
       (error 'incompatible-action-mask)))
+
+
+(module+ test
+  (require rackunit)
+  ;; is-mask-for?
+  (define action-set
+    (hasheq 'a (list (cons "a1" 'a1)
+                     (cons "a2" 'a2))
+            'b (list (cons "b1" 'b1)
+                     (cons "b2" 'b2))))
+  (define correct-mask
+    (hasheq 'a "a1"
+            'b "b2"))
+  (test-case
+      "Every branch in the action set is represented by the mask"
+    (let ((mask-missing-branch (hasheq 'a "a1")))
+      (check-true (is-mask-for? action-set
+                                correct-mask))
+      (check-false (is-mask-for? action-set
+                                 mask-missing-branch))))
+  (test-case
+      "Masks with additional branches are incorrect"
+    (let ((mask-extra-branch (hash-set correct-mask
+                                       'c "c1")))
+      (check-false (is-mask-for? action-set
+                                 mask-extra-branch))))
+  (test-case
+      "Masks with a branch that has an action not in the set are incorrect"
+    (let ((mask-wrong-action (hash-set correct-mask
+                                       'a "a3")))
+      (check-false (is-mask-for? action-set
+                                 mask-wrong-action))))
+
+  ;; minimum/maximum-access-mask
+  (test-case
+      "Minimum/maximum access masks are masks for the action set"
+    (let ((min-mask (minimum-access-mask action-set))
+          (max-mask (maximum-access-mask action-set)))
+      (check-true (is-mask-for? action-set min-mask))
+      (check-true (is-mask-for? action-set max-mask))))
+
+  ;; mask-join
+  (test-case
+      "The join of a number of masks for an action set is a mask for
+that action set, and is the union of the access levels"
+    (let ((action-set (hash-set action-set
+                                'c
+                                (list (cons "c1" 'c1)
+                                      (cons "c2" 'c2))))
+          (mask1 (hash-set correct-mask
+                           'c "c1"))
+          (mask2 (hash-set correct-mask
+                           'c "c2")))
+      (let ((joined (mask-join action-set mask1 mask2)))
+        (check-true (is-mask-for? action-set joined))
+        (check-equal? "c2"
+                      (hash-ref joined 'c))))))