Browse Source

Fix mask functions to use new hash-of-lists structure

master
Christian Fischer 9 months ago
parent
commit
2434b6a5e3
3 changed files with 54 additions and 54 deletions
  1. +8
    -7
      server/groups.rkt
  2. +43
    -44
      server/privileges.rkt
  3. +3
    -3
      server/resource.rkt

+ 8
- 7
server/groups.rkt View File

@@ -43,18 +43,19 @@
(struct group (id admins members)
#:transparent)

;; may end up having to deserialize the admins and members fields as
;; an additional step
(define (get-group dbc id)
(let ((group-hash (bytes->jsexpr (redis-hash-ref dbc "groups" id))))
(let ((group-hash (bytes->jsexpr
(redis-hash-ref dbc
"groups"
(number->string id)))))
(define (parse k)
(~> (dict-ref group-hash k)
(bytes->jsexpr)
(list->set)))
(group id ;;parse to number? does it matter?
(parse "admins")
(parse "members"))))
(group id
(parse 'admins)
(parse 'members))))

;; like add-user, for testing in the REPL
(define (add-group dbc id admins members)
(redis-hash-set! dbc
"groups"


+ 43
- 44
server/privileges.rkt View File

@@ -1,54 +1,53 @@
#lang racket

(provide privilege-line
minimum-access-mask
(provide minimum-access-mask
maximum-access-mask
mask-join
apply-mask
is-action-set?
is-mask-for?)

; A `privilege-line` is a set of privileges that have a monotonically
; increasing structure, e.g. no access <- can read <- can read & write
;; (struct privilege-line (actions))
(define (privilege-line name actions)
`(,name . ,actions))

(define (action name fun)
`(,name . ,fun))


(define (minimum-access-mask pls)
(dict-map pls
(lambda (k v)
(if (and (dict? pls) (list? pls))
(cons k (caar v))
(error 'not-privilege-line)))))

(define (maximum-access-mask pls)
(dict-map pls
(lambda (k v)
(if (and (dict? pls) (list? pls))
(cons k (car (last v)))
(error 'not-privilege-line)))))

;; True if a given mask is a mask for the given map of plines; this is
;; An action set is the hash-of-lists-of-functions that define the
;; actions available on a resource type
(define (is-action-set? actions)
(and (hash? actions)
(for/and ([(k v) (in-hash actions)])
(and (dict? v) (list? v)))))

(define (minimum-access-mask actions)
(if (hash? actions)
(for/hash ([(k v) (in-hash actions)])
(values k (caar v)))
(error 'not-action-set)))

(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 plines map.
(define (is-mask-for? plines mask)
(andmap
(lambda (x)
(not (false? (assoc (dict-ref mask (car x))
(cdr x)))))
plines))
;; 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)
(lambda (access-level)
(index-of action-line access-level
(lambda (x y) (eq? (car x) y)))))

; Given a plines poset and a list of masks, return a mask with the
; 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.
(define (mask-join plines . masks)
(define (mask-index pline)
(lambda (access-level)
(index-of pline access-level
(lambda (x y) (eq? (car x) y)))))
(dict-map plines
(lambda (k v)
(cons k (argmax (mask-index v)
(map (curryr dict-ref k) masks))))))
(define (mask-join actions . masks)
(for/hash ([(k v) (in-hash actions)])
(values k (argmax (mask-index v)
(map (curryr dict-ref k) masks)))))

(define (apply-mask actions mask)
(if (is-mask-for? actions mask)
(for/hash ([(k v) (in-hash actions)])
(let ((ix (+ 1 ((mask-index v) (dict-ref mask k)))))
(values k (take v ix))))
(error 'incompatible-action-mask)))

+ 3
- 3
server/resource.rkt View File

@@ -64,12 +64,12 @@
(cons "edit" edit-metadata)))

(define dataset-file-actions
(list (cons "data" dataset-file-data)
(cons "metadata" dataset-file-metadata)))
(hash "data" dataset-file-data
"metadata" dataset-file-metadata))


(define resource-types
(list (cons 'dataset-file dataset-file-actions)))
(hash 'dataset-file dataset-file-actions))
;; future resource types, for reference (c.f. genenetwork datasets etc.)
;; dataset-publish
;; dataset-probeset


Loading…
Cancel
Save