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.
 
 

437 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
  126. action-pair
  127. #:user [user-id 'anonymous])
  128. (let* ((branch-id (car action-pair))
  129. (action-id (cdr action-pair))
  130. (mask (if (eq? user-id 'anonymous)
  131. (resource-default-mask res)
  132. (get-mask-for-user res
  133. user-id)))
  134. (action-set (apply-mask (dict-ref resource-types
  135. (resource-type res))
  136. mask)))
  137. (let ((action (assoc action-id (hash-ref action-set branch-id))))
  138. (if action
  139. (cdr action)
  140. no-access-action))))
  141. ;; (cdr (assoc action-id (hash-ref action-set branch-id)))))
  142. ;; The general "no access" action -- may change in the future
  143. (define no-access-action
  144. (action "no-access"
  145. (lambda (data params)
  146. 'no-access)
  147. '()))
  148. ;; Actions for file-based resources
  149. (define view-file
  150. (action "view"
  151. (lambda (data params)
  152. (file->string (hash-ref data 'path) #:mode 'text))
  153. '()))
  154. (define edit-file
  155. (action "edit"
  156. (lambda (data
  157. params)
  158. (write-to-file (dict-ref params 'contents)
  159. (hash-ref data 'path)
  160. #:exists 'replace))
  161. '(contents)))
  162. ;; Placeholder metadata actions; for now the metadata is just a single
  163. ;; redis field, will definitely change.
  164. ;; TODO the dbc should be passed as a Racket parameter rather than an
  165. ;; action param params should be provided as keyword arguments
  166. (define view-metadata
  167. (action "view"
  168. (lambda (data
  169. params)
  170. (redis-bytes-get (redis-conn)
  171. (hash-ref data 'key)))
  172. '()))
  173. (define edit-metadata
  174. (action "edit"
  175. (lambda (data
  176. params)
  177. (redis-bytes-set! (redis-conn)
  178. (hash-ref data 'key)
  179. (dict-ref params 'value)))
  180. '(value)))
  181. (define dataset-file-data
  182. (list (cons "no-access" no-access-action)
  183. (cons "view" view-file)
  184. (cons "edit" edit-file)))
  185. (define dataset-file-metadata
  186. (list (cons "no-access" no-access-action)
  187. (cons "view" view-metadata)
  188. (cons "edit" edit-metadata)))
  189. ;; The action set for file-based dataset resources.
  190. (define dataset-file-actions
  191. (hasheq 'data dataset-file-data
  192. 'metadata dataset-file-metadata))
  193. ;; The dataset-publish resource type
  194. ;; Currently only read actions
  195. (define (new-publish-resource name
  196. owner-id
  197. dataset-id
  198. trait-name
  199. default-mask)
  200. (resource name
  201. owner-id
  202. (hasheq 'dataset dataset-id
  203. 'trait trait-name)
  204. 'dataset-publish
  205. default-mask
  206. (hasheq)))
  207. ;; Function that serializes an SQL result row into a stringified JSON
  208. ;; array. Probably doesn't work with all SQL types yet!!
  209. (define (sql-result->json query-result)
  210. (jsexpr->bytes
  211. (map (lambda (x)
  212. (if (sql-null? x) 'null x))
  213. (vector->list query-result))))
  214. (define (select-publish dataset-id trait-name)
  215. (sql-result->json
  216. (query-row (mysql-conn)
  217. "SELECT
  218. PublishXRef.Id, InbredSet.InbredSetCode, Publication.PubMed_ID,
  219. Phenotype.Pre_publication_description, Phenotype.Post_publication_description, Phenotype.Original_description,
  220. Phenotype.Pre_publication_abbreviation, Phenotype.Post_publication_abbreviation,
  221. Phenotype.Lab_code, Phenotype.Submitter, Phenotype.Owner, Phenotype.Authorized_Users,
  222. Publication.Authors, Publication.Title, Publication.Abstract,
  223. Publication.Journal, Publication.Volume, Publication.Pages,
  224. Publication.Month, Publication.Year, PublishXRef.Sequence,
  225. Phenotype.Units, PublishXRef.comments
  226. FROM
  227. PublishXRef, Publication, Phenotype, PublishFreeze, InbredSet
  228. WHERE
  229. PublishXRef.Id = ? AND
  230. Phenotype.Id = PublishXRef.PhenotypeId AND
  231. Publication.Id = PublishXRef.PublicationId AND
  232. PublishXRef.InbredSetId = PublishFreeze.InbredSetId AND
  233. PublishXRef.InbredSetId = InbredSet.Id AND
  234. PublishFreeze.Id = ?"
  235. trait-name
  236. dataset-id)))
  237. (define view-publish
  238. (action "view"
  239. (lambda (data
  240. params)
  241. (select-publish (hash-ref data 'dataset)
  242. (hash-ref data 'trait)))
  243. '()))
  244. (define dataset-publish-data
  245. (list (cons "no-access" no-access-action)
  246. (cons "view" view-publish)))
  247. (define dataset-publish-actions
  248. (hasheq 'data dataset-publish-data))
  249. ;; The dataset-geno resource type
  250. ;; Currently only read actions
  251. (define (new-geno-resource name
  252. owner-id
  253. dataset-name
  254. trait-name
  255. default-mask)
  256. (resource name
  257. owner-id
  258. (hasheq 'dataset dataset-name
  259. 'trait trait-name)
  260. 'dataset-geno
  261. default-mask
  262. (hasheq)))
  263. (define (select-geno dataset-name trait-name)
  264. (sql-result->json
  265. (query-row (mysql-conn)
  266. "SELECT Geno.name, Geno.chr, Geno.mb, Geno.source2, Geno.sequence
  267. FROM Geno, GenoFreeze, GenoXRef
  268. WHERE GenoXRef.GenoFreezeId = GenoFreeze.Id AND
  269. GenoXRef.GenoId = Geno.Id AND
  270. GenoFreeze.Name = ? AND
  271. Geno.Name = ?"
  272. dataset-name
  273. trait-name)))
  274. (define view-geno
  275. (action "view"
  276. (lambda (data
  277. params)
  278. (select-geno (hash-ref data 'dataset)
  279. (hash-ref data 'trait)))
  280. '()))
  281. (define dataset-geno-data
  282. (list (cons "no-access" no-access-action)
  283. (cons "view" view-geno)))
  284. (define dataset-geno-actions
  285. (hasheq 'data dataset-geno-data))
  286. ;; The dataset-probe resource type
  287. ;; Currently only read actions
  288. (define (new-probe-resource name
  289. owner-id
  290. dataset-name
  291. trait-name
  292. default-mask)
  293. (resource name
  294. owner-id
  295. (hasheq 'dataset dataset-name
  296. 'trait trait-name)
  297. 'dataset-probe
  298. default-mask
  299. (hasheq)))
  300. (define (select-probe dataset-name trait-name)
  301. (sql-result->json
  302. (query-row (mysql-conn)
  303. "SELECT Probe.Sequence, Probe.Name
  304. FROM Probe, ProbeSet, ProbeSetFreeze, ProbeSetXRef
  305. WHERE ProbeSetXRef.ProbeSetFreezeId = ProbeSetFreeze.Id AND
  306. ProbeSetXRef.ProbeSetId = ProbeSet.Id AND
  307. ProbeSetFreeze.Name = ? AND
  308. ProbeSet.Name = ? AND
  309. Probe.ProbeSetId = ProbeSet.Id order by Probe.SerialOrder"
  310. dataset-name
  311. trait-name)))
  312. (define view-probe
  313. (action "view"
  314. (lambda (data
  315. params)
  316. (select-probe (hash-ref data 'dataset)
  317. (hash-ref data 'trait)))
  318. '()))
  319. (define dataset-probe-data
  320. (list (cons "no-access" no-access-action)
  321. (cons "view" view-probe)))
  322. (define dataset-probe-actions
  323. (hasheq 'data dataset-probe-data))
  324. ;; Helpers for adding new resources to Redis
  325. (define (add-probe-resource id
  326. name
  327. dataset-name
  328. trait-name)
  329. (define mask
  330. (hash 'data "view"))
  331. (let ((res (new-probe-resource name
  332. 0
  333. dataset-name
  334. trait-name
  335. mask)))
  336. (add-resource id res)))
  337. (define (add-publish-resource id
  338. name
  339. dataset-name
  340. trait-name)
  341. (define mask
  342. (hash 'data "view"))
  343. (let ((res (new-publish-resource name
  344. 0
  345. dataset-name
  346. trait-name
  347. mask)))
  348. (add-resource id res)))
  349. (define (add-geno-resource id
  350. name
  351. dataset-name
  352. trait-name)
  353. (define mask
  354. (hash 'data "view"))
  355. (let ((res (new-geno-resource name
  356. 0
  357. dataset-name
  358. trait-name
  359. mask)))
  360. (add-resource id res)))
  361. ;; The global mapping from resource type to action set.
  362. (define resource-types
  363. (hash 'dataset-file dataset-file-actions
  364. 'dataset-publish dataset-publish-actions
  365. 'dataset-geno dataset-geno-actions
  366. 'dataset-probe dataset-probe-actions))
  367. ;; future resource types, for reference (c.f. genenetwork datasets etc.)
  368. ;; dataset-publish
  369. ;; dataset-probeset
  370. ;; dataset-geno
  371. ;; dataset-temp
  372. ;; collection