Browse Source

REST endpoint that returns available actions

master
Christian Fischer 11 months ago
parent
commit
322388f60d
3 changed files with 126 additions and 132 deletions
  1. +2
    -2
      server/privileges.rkt
  2. +49
    -130
      server/resource.rkt
  3. +75
    -0
      server/rest.rkt

+ 2
- 2
server/privileges.rkt View File

@@ -36,12 +36,12 @@
(define (mask-index action-line)
(lambda (access-level)
(index-of action-line access-level
(lambda (x y) (eq? (car x) y)))))
(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.
(define (mask-join actions . masks)
(for/hash ([(k v) (in-hash actions)])
(for/hasheq ([(k v) (in-hash actions)])
(values k (argmax (mask-index v)
(map (curryr dict-ref k) masks)))))



+ 49
- 130
server/resource.rkt View File

@@ -10,6 +10,13 @@
"privileges.rkt")

(provide (struct-out resource)
get-mask-for-user
get-resource
resource-set-group-mask
resource-types
resource-actions
serialize-resource
deserialize-resource
;; user-canonical-mask
;; user-masks
;; resource-set-mask
@@ -55,7 +62,8 @@
(~> (redis-hash-ref dbc "resources" id)
(deserialize-resource)))

(define (get-masks-for-user dbc resource user-id)
; 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)]
[default-mask (resource-default-mask resource)])
@@ -70,7 +78,6 @@
(string->symbol)
(hash-ref group-masks _ default-mask))))))


(define (new-file-resource name owner-id path meta-key default-mask)
(resource name
owner-id
@@ -126,8 +133,8 @@
(cons "edit" edit-metadata)))

(define dataset-file-actions
(hash 'data dataset-file-data
'metadata dataset-file-metadata))
(hasheq 'data dataset-file-data
'metadata dataset-file-metadata))


; A hash mapping resource types to action sets
@@ -141,134 +148,46 @@
;; collection



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

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



(define (select-publish dbc dataset-id trait-name)
(query-row dbc
"SELECT
PublishXRef.Id, InbredSet.InbredSetCode, Publication.PubMed_ID,
Phenotype.Pre_publication_description, Phenotype.Post_publication_description, Phenotype.Original_description,
Phenotype.Pre_publication_abbreviation, Phenotype.Post_publication_abbreviation,
Phenotype.Lab_code, Phenotype.Submitter, Phenotype.Owner, Phenotype.Authorized_Users,
Publication.Authors, Publication.Title, Publication.Abstract,
Publication.Journal, Publication.Volume, Publication.Pages,
Publication.Month, Publication.Year, PublishXRef.Sequence,
Phenotype.Units, PublishXRef.comments
FROM
PublishXRef, Publication, Phenotype, PublishFreeze, InbredSet
WHERE
PublishXRef.Id = ? AND
Phenotype.Id = PublishXRef.PhenotypeId AND
Publication.Id = PublishXRef.PublicationId AND
PublishXRef.InbredSetId = PublishFreeze.InbredSetId AND
PublishXRef.InbredSetId = InbredSet.Id AND
PublishFreeze.Id = ?"
trait-name
dataset-id))



(define (select-geno dbc dataset-name trait-name)
(query-row dbc
"SELECT Geno.name Geno.chr Geno.mb Geno.source2 Geno.sequence
FROM Geno, GenoFreeze, GenoXRef
WHERE GenoXRef.GenoFreezeId = GenoFreeze.Id AND
GenoXRef.GenoId = Geno.Id AND
GenoFreeze.Name = ? AND
Geno.Name = ?"
dataset-name
trait-name))


; Given a resource and a user, get the masks for that user based
; on the per-group masks in the resource privileges.

; 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.

; 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)))
(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)))

; Given a resource and a user, calculate the user's canonical access mask
; based on the user's group membership, whether or not they're an admin,
; and whether or not they're the resource owner.

; 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?)

; 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.

; 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
;; res
;; [group-masks (dict-set
;; (resource-group-masks res)
;; gid
;; mask)])
;; #f))
;; (define (select-publish dbc dataset-id trait-name)
;; (query-row dbc
;; "SELECT
;; PublishXRef.Id, InbredSet.InbredSetCode, Publication.PubMed_ID,
;; Phenotype.Pre_publication_description, Phenotype.Post_publication_description, Phenotype.Original_description,
;; Phenotype.Pre_publication_abbreviation, Phenotype.Post_publication_abbreviation,
;; Phenotype.Lab_code, Phenotype.Submitter, Phenotype.Owner, Phenotype.Authorized_Users,
;; Publication.Authors, Publication.Title, Publication.Abstract,
;; Publication.Journal, Publication.Volume, Publication.Pages,
;; Publication.Month, Publication.Year, PublishXRef.Sequence,
;; Phenotype.Units, PublishXRef.comments
;; FROM
;; PublishXRef, Publication, Phenotype, PublishFreeze, InbredSet
;; WHERE
;; PublishXRef.Id = ? AND
;; Phenotype.Id = PublishXRef.PhenotypeId AND
;; Publication.Id = PublishXRef.PublicationId AND
;; PublishXRef.InbredSetId = PublishFreeze.InbredSetId AND
;; PublishXRef.InbredSetId = InbredSet.Id AND
;; PublishFreeze.Id = ?"
;; trait-name
;; dataset-id))



;; (define (select-geno dbc dataset-name trait-name)
;; (query-row dbc
;; "SELECT Geno.name Geno.chr Geno.mb Geno.source2 Geno.sequence
;; FROM Geno, GenoFreeze, GenoXRef
;; WHERE GenoXRef.GenoFreezeId = GenoFreeze.Id AND
;; GenoXRef.GenoId = Geno.Id AND
;; GenoFreeze.Name = ? AND
;; Geno.Name = ?"
;; dataset-name
;; trait-name))

+ 75
- 0
server/rest.rkt View File

@@ -0,0 +1,75 @@
#lang racket

(require db
redis
json
threading
racket/match
web-server/http
web-server/servlet-dispatch
web-server/web-server
"db.rkt"
"groups.rkt"
"privileges.rkt"
"resource.rkt")


;;;; Endpoints

(define redis-conn (connect-redis))

;; example endpoint
(define (age req)
(define binds (request-bindings/raw req))
(define message
(match (list (bindings-assq #"name" binds)
(bindings-assq #"age" binds))
[(list #f #f)
"Anonymous is unknown years old."]

[(list #f (binding:form _ age))
(format "Anonymous is ~a years old." age)]

[(list (binding:form _ name) #f)
(format "~a is unknown years old." name)]
[(list (binding:form _ name)
(binding:form _ age))
(format "~a is ~a years old." name age)]))
(response/output
(lambda (out)
(displayln message out))))

;; Query available actions for a resource, for a given user
(define (query-available req)
(define binds (request-bindings/raw req))
(define message
(match (list (bindings-assq #"resource" binds)
(bindings-assq #"user" binds))
[(list #f #f)
"provide resource and user id"]
[(list (binding:form _ res-id)
(binding:form _ user-id))
(let* ((res (get-resource redis-conn res-id))
(mask (get-mask-for-user
redis-conn
res
(string->number
(bytes->string/utf-8 user-id)))))
(jsexpr->bytes mask))]))
(response/output
(lambda (out)
(displayln message out))))

;; Attempt to run an action on a resource as a given user
;; TODO

;; Run the server (will be moved to another module later)
(define stop
(serve
#:dispatch (dispatch/servlet query-available)
#:listen-ip "127.0.0.1"
#:port 8080))

(with-handlers ([exn:break? (lambda (e)
(stop))])
(sync/enable-break never-evt))

Loading…
Cancel
Save