REST endpoint that returns available actions

server/privileges.rkt

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

server/resource.rkt

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

server/rest.rkt

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