Browse Source

Clean up and add comments

master
Christian Fischer 9 months ago
parent
commit
db47cd043c
4 changed files with 92 additions and 107 deletions
  1. +2
    -50
      server/db.rkt
  2. +22
    -26
      server/groups.rkt
  3. +36
    -12
      server/privileges.rkt
  4. +32
    -19
      server/resource.rkt

+ 2
- 50
server/db.rkt View File

@@ -1,62 +1,14 @@
#lang racket

(require db
redis
json
threading)
redis)

(provide connect-redis)

;; This should be a racket parameter
(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
;; dbc
;; "create table resources (
;; )"))

+ 22
- 26
server/groups.rkt View File

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


(provide get-user
get-group
get-groups-by-member
@@ -16,20 +15,23 @@
(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)


;; 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))))
(let ((user-hash (bytes->jsexpr
(redis-hash-ref dbc "users" id))))
(user id
(dict-ref user-hash 'user_name))))

;; This is mainly for testing locally; the proxy shouldn't create
;; users in production

;; Add a user with the given ID and name to the "users" hash in Redis.
;; NB: This is mainly for testing locally; the proxy shouldn't create
;; users in production.
(define (add-user dbc id name)
(redis-hash-set! dbc
"users"
@@ -42,6 +44,7 @@
(struct group (id admins members)
#:transparent)

;; Deserialize a group struct from bytestringified JSON
(define (deserialize-group id grp-bytes)
(let ((group-hash (bytes->jsexpr grp-bytes)))
(define (parse k)
@@ -51,38 +54,35 @@
(parse 'admins)
(parse 'members))))

;; Retrieve the given group by ID from Redis
(define (get-group dbc id)
(deserialize-group id
(redis-hash-ref dbc
"groups"
(number->string id))))

;; like add-user, for testing in the REPL
;; NB: like add-user, for testing in the REPL
(define (add-group dbc id admins members)
(redis-hash-set! dbc
"groups"
(number->string id)
(jsexpr->bytes (hash 'admins (set->list admins)
'members (set->list members)))))
(jsexpr->bytes
(hash 'admins (set->list admins)
'members (set->list members)))))

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


; Returns all groups that have the given user ID either as admin or member
(define (get-groups-by-member dbc id)
;; Search Redis and return all the groups that have the given user ID
;; as either an admin or a regular member.
;; TODO Redis almost certainly has tools to make this faster & better
(define (get-groups-by-member dbc user-id)
(define (parse e)
(deserialize-group (car e) (cdr e)))
(for/list ([group (sequence-map parse (in-redis-hash dbc "groups"))]
#:when (has-user? group id))
(for/list ([group (sequence-map parse
(in-redis-hash dbc "groups"))]
#:when (has-user? group user-id))
group))



;; has-member? is only used by add-member and make-admin. These functions
;; should probably be replaced by an interface that makes more sense
;; for our purposes.
;; Helper functions for querying groups
(define (has-admin? g uid)
(set-member? (group-admins g) uid))

@@ -91,7 +91,3 @@

(define (has-user? g uid)
(or (has-admin? g uid) (has-member? g uid)))

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

+ 36
- 12
server/privileges.rkt View File

@@ -9,6 +9,13 @@
is-action-set?
is-mask-for?)

;; The type for actions that can be run on a resource. Actions are
;; generally, but not always, unique to a single resource type. `fun`
;; is the actual function that is to be run, and must take two
;; parameters, one with the resource data, and a hash with any
;; additional required parameters, e.g. new data when editing
;; something.
;; See resource.rkt for examples
(struct
action
(id
@@ -17,49 +24,66 @@
#:transparent)


;; Run the given action on the provided data, with the given additional
;; parameters.
(define (run-action action data params)
;; TODO add check that action matches resource type by comparing
;; keys in params to req-params field in action
(action-fun action) data params)

;; An action set is the hash-of-lists-of-functions that define the
;; actions available on a resource type
;; actions available on a resource type. The hash level are the
;; different "branches" of actions, while each branch is a list
;; of actions of increasing required privilege.
(define (is-action-set? actions)
(and (hash? actions)
(for/and ([(k v) (in-hash actions)])
(and (dict? v) (list? 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.


;; True if a given mask is a mask for the given action set; this is
;; 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)))))

;; Return the mask for an action set that provides the least possible
;; level of access, i.e. only the first action in each branch.
(define (minimum-access-mask actions)
(if (hash? actions)
(for/hash ([(k v) (in-hash actions)])
(values k (caar v)))
(error 'not-action-set)))

;; Return the mask for an action set that provides full access.
(define (maximum-access-mask actions)
(if (hash? actions)
(for/hash ([(k v) (in-hash actions)])
(values k (car (last v))))
(error 'not-action-set)))

;; True if a given mask is a mask for the given action set; this is
;; 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)))))

(define (mask-index action-line)
;; Indexing function used to compare the access level of two actions
;; in a branch.
(define (mask-index branch)
(lambda (access-level)
(index-of action-line access-level
(index-of branch access-level
(lambda (x y) (string=? (car x) y)))))

; Given an action set and a list of masks, return a mask with the
; highest access level per pline that was found in the masks.
;; Return the "total" access that any number of masks for a given
;; action set cover. The access level for each branch is set to
;; the highest among the masks.
(define (mask-join actions . masks)
(for/hasheq ([(k v) (in-hash actions)])
(values k (argmax (mask-index v)
(map (curryr dict-ref k) masks)))))

;; Return a subset for the given action set as delimited by the mask.
;; The result is the accessible action set.
(define (apply-mask actions mask)
(if (is-mask-for? actions mask)
(for/hash ([(k v) (in-hash actions)])


+ 32
- 19
server/resource.rkt View File

@@ -14,17 +14,16 @@
get-resource
resource-set-group-mask
resource-types
resource-actions
access-action
serialize-resource
deserialize-resource)


; important: the `data` field in a resource isn't the data itself,
; instead it contains whatever data is necessary for the resource's
; actions. The `type` designates what kind of resource it is, e.g.
; dataset, collection, etc. The actions available depend on the
; resource type.
;; NB: the `data` field in a resource isn't the data itself,
;; instead it contains whatever data is necessary for the resource's
;; actions. The `type` designates what kind of resource it is, e.g.
;; dataset, collection, etc. The actions available depend on the
;; resource type.
(struct resource
(name
owner
@@ -34,6 +33,7 @@
group-masks)
#:transparent)

;; Serializes a resource into a JSON bytestring for storage in Redis.
(define (serialize-resource res)
(jsexpr->bytes (hash 'name (resource-name res)
'owner_id (resource-owner res)
@@ -57,7 +57,12 @@
(~> (redis-hash-ref dbc "resources" id)
(deserialize-resource)))

; TODO take owner mask into account

;; Given a resource and a user ID, derive the access mask for that user
;; based on their group membership as stored in Redis, and return
;; the appropriate access mask.

;; TODO take owner mask into account
(define (get-mask-for-user dbc resource user-id)
(let ([group-masks (resource-group-masks resource)]
[groups (get-groups-by-member dbc user-id)]
@@ -73,16 +78,25 @@
(string->symbol)
(hash-ref group-masks _ default-mask))))))

(define (new-file-resource name owner-id path meta-key default-mask)
;; Constructor for file-based resources
(define (new-file-resource name
owner-id
path
meta-key
default-mask)
(resource name
owner-id
(hasheq 'path path
'metadata meta-key)
'metadata meta-key)
'dataset-file
default-mask
(hasheq)))


;; Helper function for setting the access level for a group on a
;; resource. Note that this returns the updated resource, which must
;; then be put into Redis.

; grp-id must be given as a symbol
(define (resource-set-group-mask res grp-id mask)
(if (is-mask-for? (dict-ref resource-types (resource-type res))
@@ -114,11 +128,13 @@
(cdr action))
#f)))

;; The general "no access" action -- may change in the future
(define no-access-action
(action "no-access"
(lambda (data params)
'no-access)))

;; Actions for file-based resources
(define view-file
(action "view"
(lambda (data params)
@@ -134,8 +150,11 @@
'(contents)))


;; TODO the dbc should be passed as a Racket parameter rather than an action param
;; params should be provided as keyword arguments
;; Placeholder metadata actions; for now the metadata is just a single
;; redis field, will definitely change.

;; TODO the dbc should be passed as a Racket parameter rather than an
;; action param params should be provided as keyword arguments
(define view-metadata
(action "view"
(lambda (data
@@ -163,12 +182,13 @@
(cons "view" view-metadata)
(cons "edit" edit-metadata)))

;; The action set for file-based dataset resources.
(define dataset-file-actions
(hasheq 'data dataset-file-data
'metadata dataset-file-metadata))


; A hash mapping resource types to action sets
;; The global mapping from resource type to action set.
(define resource-types
(hash 'dataset-file dataset-file-actions))
;; future resource types, for reference (c.f. genenetwork datasets etc.)
@@ -179,13 +199,6 @@
;; collection


(define (resource-actions res)
(hash-ref resource-types
(resource-type res)))

; The owner of a resource has complete access.
(define (owner-mask res-type)
(maximum-access-mask (dict-ref resource-types res-type)))

;; (define (select-publish dbc dataset-id trait-name)
;; (query-row dbc


Loading…
Cancel
Save