You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

432 lines
14 KiB

  1. #lang racket
  2. (require db
  3. redis
  4. json
  5. threading
  6. racket/file
  7. "db.rkt"
  8. "groups.rkt"
  9. "privileges.rkt")
  10. (provide (struct-out resource)
  11. get-mask-for-user
  12. get-resource
  13. resource-set-group-mask
  14. resource-types
  15. access-action
  16. serialize-resource
  17. deserialize-resource)
  18. ;; NB: the `data` field in a resource isn't the data itself,
  19. ;; instead it contains whatever data is necessary for the resource's
  20. ;; actions. The `type` designates what kind of resource it is, e.g.
  21. ;; dataset, collection, etc. The actions available depend on the
  22. ;; resource type.
  23. (struct resource
  24. (name
  25. owner
  26. data
  27. type
  28. default-mask
  29. group-masks)
  30. #:transparent)
  31. ;; The Racket JSON library can only transform hashes that have
  32. ;; symbol keys -- but Redis only deals with strings and bytestrings.
  33. ;; These functions transform the keys of a hash between the two.
  34. (define (hash-symbol->string h)
  35. (for/hash ([(k v) (in-hash h)])
  36. (values (~> k
  37. (symbol->string)
  38. (string->bytes/utf-8))
  39. v)))
  40. (define (hash-string->symbol h)
  41. (for/hash ([(k v) (in-hash h)])
  42. (values (~> k
  43. (bytes->string/utf-8)
  44. (string->symbol))
  45. v)))
  46. ;; Serializes a resource into a JSON bytestring for storage in Redis.
  47. (define (serialize-resource res)
  48. (jsexpr->bytes (hash 'name (resource-name res)
  49. 'owner_id (resource-owner res)
  50. 'data (resource-data res)
  51. 'type (symbol->string (resource-type res))
  52. 'default_mask (resource-default-mask res)
  53. 'group_masks (resource-group-masks res))))
  54. (define (deserialize-resource res)
  55. (let ((res-hash (bytes->jsexpr res)))
  56. (define (parse k)
  57. (dict-ref res-hash k))
  58. (resource (parse 'name)
  59. (parse 'owner_id)
  60. (parse 'data)
  61. (string->symbol (parse 'type))
  62. (parse 'default_mask)
  63. (parse 'group_masks))))
  64. (define (add-resource id res)
  65. (redis-hash-set! (redis-conn)
  66. "resources"
  67. id
  68. (serialize-resource res)))
  69. (define (get-resource id)
  70. (~> (redis-hash-ref (redis-conn) "resources" id)
  71. (deserialize-resource)))
  72. ;; Given a resource and a user ID, derive the access mask for that user
  73. ;; based on their group membership as stored in Redis, and return
  74. ;; the appropriate access mask.
  75. ;; TODO take owner mask into account
  76. (define (get-mask-for-user resource user-id)
  77. (let ([group-masks (resource-group-masks resource)]
  78. [groups (get-groups-by-member (redis-conn) user-id)]
  79. [initial-mask (if (eq? (resource-owner resource) user-id)
  80. (maximum-access-mask
  81. (dict-ref resource-types
  82. (resource-type resource)))
  83. (resource-default-mask resource))])
  84. (apply mask-join
  85. (dict-ref resource-types (resource-type resource))
  86. initial-mask
  87. (for/list ([g groups])
  88. ; the redis library requires symbols for keys, but the values
  89. ; are bytestrings...
  90. (~> (group-id g)
  91. (bytes->string/utf-8)
  92. (string->symbol)
  93. (hash-ref group-masks _ initial-mask))))))
  94. ;; Constructor for file-based resources
  95. (define (new-file-resource name
  96. owner-id
  97. path
  98. meta-key
  99. default-mask)
  100. (resource name
  101. owner-id
  102. (hasheq 'path path
  103. 'metadata meta-key)
  104. 'dataset-file
  105. default-mask
  106. (hasheq)))
  107. ;; Helper function for setting the access level for a group on a
  108. ;; resource. Note that this returns the updated resource, which must
  109. ;; then be put into Redis.
  110. ; grp-id must be given as a symbol
  111. (define (resource-set-group-mask res grp-id mask)
  112. (if (is-mask-for? (dict-ref resource-types (resource-type res))
  113. mask)
  114. (let* ((old-masks (resource-group-masks res))
  115. (new-masks (hash-set old-masks
  116. grp-id
  117. mask)))
  118. (struct-copy resource
  119. res
  120. [group-masks new-masks]))
  121. (error 'incompatible-action-mask)))
  122. ;; Return the action, as defined by a pair of a branch name and action
  123. ;; name, for a given resource, as accessible by the given user.
  124. ;; Returns #f if the user does not have access.
  125. (define (access-action res user-id action-pair)
  126. (let* ((branch-id (car action-pair))
  127. (action-id (cdr action-pair))
  128. (mask (get-mask-for-user res
  129. user-id))
  130. (action-set (apply-mask (dict-ref resource-types (resource-type res))
  131. mask)))
  132. (let ((action (assoc action-id (hash-ref action-set branch-id))))
  133. (if action
  134. (cdr action)
  135. no-access-action))))
  136. ;; (cdr (assoc action-id (hash-ref action-set branch-id)))))
  137. ;; The general "no access" action -- may change in the future
  138. (define no-access-action
  139. (action "no-access"
  140. (lambda (data params)
  141. 'no-access)
  142. '()))
  143. ;; Actions for file-based resources
  144. (define view-file
  145. (action "view"
  146. (lambda (data params)
  147. (file->string (hash-ref data 'path) #:mode 'text))
  148. '()))
  149. (define edit-file
  150. (action "edit"
  151. (lambda (data
  152. params)
  153. (write-to-file (dict-ref params 'contents)
  154. (hash-ref data 'path)
  155. #:exists 'replace))
  156. '(contents)))
  157. ;; Placeholder metadata actions; for now the metadata is just a single
  158. ;; redis field, will definitely change.
  159. ;; TODO the dbc should be passed as a Racket parameter rather than an
  160. ;; action param params should be provided as keyword arguments
  161. (define view-metadata
  162. (action "view"
  163. (lambda (data
  164. params)
  165. (redis-bytes-get (redis-conn)
  166. (hash-ref data 'key)))
  167. '()))
  168. (define edit-metadata
  169. (action "edit"
  170. (lambda (data
  171. params)
  172. (redis-bytes-set! (redis-conn)
  173. (hash-ref data 'key)
  174. (dict-ref params 'value)))
  175. '(value)))
  176. (define dataset-file-data
  177. (list (cons "no-access" no-access-action)
  178. (cons "view" view-file)
  179. (cons "edit" edit-file)))
  180. (define dataset-file-metadata
  181. (list (cons "no-access" no-access-action)
  182. (cons "view" view-metadata)
  183. (cons "edit" edit-metadata)))
  184. ;; The action set for file-based dataset resources.
  185. (define dataset-file-actions
  186. (hasheq 'data dataset-file-data
  187. 'metadata dataset-file-metadata))
  188. ;; The dataset-publish resource type
  189. ;; Currently only read actions
  190. (define (new-publish-resource name
  191. owner-id
  192. dataset-id
  193. trait-name
  194. default-mask)
  195. (resource name
  196. owner-id
  197. (hasheq 'dataset dataset-id
  198. 'trait trait-name)
  199. 'dataset-publish
  200. default-mask
  201. (hasheq)))
  202. ;; Function that serializes an SQL result row into a stringified JSON
  203. ;; array. Probably doesn't work with all SQL types yet!!
  204. (define (sql-result->json query-result)
  205. (jsexpr->bytes
  206. (map (lambda (x)
  207. (if (sql-null? x) 'null x))
  208. (vector->list query-result))))
  209. (define (select-publish dataset-id trait-name)
  210. (sql-result->json
  211. (query-row (mysql-conn)
  212. "SELECT
  213. PublishXRef.Id, InbredSet.InbredSetCode, Publication.PubMed_ID,
  214. Phenotype.Pre_publication_description, Phenotype.Post_publication_description, Phenotype.Original_description,
  215. Phenotype.Pre_publication_abbreviation, Phenotype.Post_publication_abbreviation,
  216. Phenotype.Lab_code, Phenotype.Submitter, Phenotype.Owner, Phenotype.Authorized_Users,
  217. Publication.Authors, Publication.Title, Publication.Abstract,
  218. Publication.Journal, Publication.Volume, Publication.Pages,
  219. Publication.Month, Publication.Year, PublishXRef.Sequence,
  220. Phenotype.Units, PublishXRef.comments
  221. FROM
  222. PublishXRef, Publication, Phenotype, PublishFreeze, InbredSet
  223. WHERE
  224. PublishXRef.Id = ? AND
  225. Phenotype.Id = PublishXRef.PhenotypeId AND
  226. Publication.Id = PublishXRef.PublicationId AND
  227. PublishXRef.InbredSetId = PublishFreeze.InbredSetId AND
  228. PublishXRef.InbredSetId = InbredSet.Id AND
  229. PublishFreeze.Id = ?"
  230. trait-name
  231. dataset-id)))
  232. (define view-publish
  233. (action "view"
  234. (lambda (data
  235. params)
  236. (select-publish (hash-ref data 'dataset)
  237. (hash-ref data 'trait)))
  238. '()))
  239. (define dataset-publish-data
  240. (list (cons "no-access" no-access-action)
  241. (cons "view" view-publish)))
  242. (define dataset-publish-actions
  243. (hasheq 'data dataset-publish-data))
  244. ;; The dataset-geno resource type
  245. ;; Currently only read actions
  246. (define (new-geno-resource name
  247. owner-id
  248. dataset-name
  249. trait-name
  250. default-mask)
  251. (resource name
  252. owner-id
  253. (hasheq 'dataset dataset-name
  254. 'trait trait-name)
  255. 'dataset-geno
  256. default-mask
  257. (hasheq)))
  258. (define (select-geno dataset-name trait-name)
  259. (sql-result->json
  260. (query-row (mysql-conn)
  261. "SELECT Geno.name, Geno.chr, Geno.mb, Geno.source2, Geno.sequence
  262. FROM Geno, GenoFreeze, GenoXRef
  263. WHERE GenoXRef.GenoFreezeId = GenoFreeze.Id AND
  264. GenoXRef.GenoId = Geno.Id AND
  265. GenoFreeze.Name = ? AND
  266. Geno.Name = ?"
  267. dataset-name
  268. trait-name)))
  269. (define view-geno
  270. (action "view"
  271. (lambda (data
  272. params)
  273. (select-geno (hash-ref data 'dataset)
  274. (hash-ref data 'trait)))
  275. '()))
  276. (define dataset-geno-data
  277. (list (cons "no-access" no-access-action)
  278. (cons "view" view-geno)))
  279. (define dataset-geno-actions
  280. (hasheq 'data dataset-geno-data))
  281. ;; The dataset-probe resource type
  282. ;; Currently only read actions
  283. (define (new-probe-resource name
  284. owner-id
  285. dataset-name
  286. trait-name
  287. default-mask)
  288. (resource name
  289. owner-id
  290. (hasheq 'dataset dataset-name
  291. 'trait trait-name)
  292. 'dataset-probe
  293. default-mask
  294. (hasheq)))
  295. (define (select-probe dataset-name trait-name)
  296. (sql-result->json
  297. (query-row (mysql-conn)
  298. "SELECT Probe.Sequence, Probe.Name
  299. FROM Probe, ProbeSet, ProbeSetFreeze, ProbeSetXRef
  300. WHERE ProbeSetXRef.ProbeSetFreezeId = ProbeSetFreeze.Id AND
  301. ProbeSetXRef.ProbeSetId = ProbeSet.Id AND
  302. ProbeSetFreeze.Name = ? AND
  303. ProbeSet.Name = ? AND
  304. Probe.ProbeSetId = ProbeSet.Id order by Probe.SerialOrder"
  305. dataset-name
  306. trait-name)))
  307. (define view-probe
  308. (action "view"
  309. (lambda (data
  310. params)
  311. (select-probe (hash-ref data 'dataset)
  312. (hash-ref data 'trait)))
  313. '()))
  314. (define dataset-probe-data
  315. (list (cons "no-access" no-access-action)
  316. (cons "view" view-probe)))
  317. (define dataset-probe-actions
  318. (hasheq 'data dataset-probe-data))
  319. ;; Helpers for adding new resources to Redis
  320. (define (add-probe-resource id
  321. name
  322. dataset-name
  323. trait-name)
  324. (define mask
  325. (hash 'data "view"))
  326. (let ((res (new-probe-resource name
  327. 0
  328. dataset-name
  329. trait-name
  330. mask)))
  331. (add-resource id res)))
  332. (define (add-publish-resource id
  333. name
  334. dataset-name
  335. trait-name)
  336. (define mask
  337. (hash 'data "view"))
  338. (let ((res (new-publish-resource name
  339. 0
  340. dataset-name
  341. trait-name
  342. mask)))
  343. (add-resource id res)))
  344. (define (add-geno-resource id
  345. name
  346. dataset-name
  347. trait-name)
  348. (define mask
  349. (hash 'data "view"))
  350. (let ((res (new-geno-resource name
  351. 0
  352. dataset-name
  353. trait-name
  354. mask)))
  355. (add-resource id res)))
  356. ;; The global mapping from resource type to action set.
  357. (define resource-types
  358. (hash 'dataset-file dataset-file-actions
  359. 'dataset-publish dataset-publish-actions
  360. 'dataset-geno dataset-geno-actions
  361. 'dataset-probe dataset-probe-actions))
  362. ;; future resource types, for reference (c.f. genenetwork datasets etc.)
  363. ;; dataset-publish
  364. ;; dataset-probeset
  365. ;; dataset-geno
  366. ;; dataset-temp
  367. ;; collection