hans/racket-wiki
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added mermaid and a lot of cmap changes

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-27 13:13:39 +02:00
parent 20c1584016
commit 2215d1d04a
35 changed files with 6442 additions and 350 deletions
Download Patch File Download Diff File Expand all files Collapse all files
server.rkt
+97 -4
View File
@@ -16,9 +16,15 @@
web-server/servlet-env
"private/auth.rkt"
"private/cmap-storage.rkt"
"private/cmap-styles.rkt"
"private/config.rkt"
(only-in "private/database.rkt" call-with-wiki-database)
"private/http-util.rkt"
"private/mail.rkt"
(only-in "private/migrations.rkt"
current-schema-version
database-schema-version)
"private/people.rkt"
"private/setup.rkt"
"private/storage.rkt"
"private/version.rkt"
@@ -348,6 +354,32 @@ CSS
(λ (_session)
(json-response (hash 'placements (list-concept-usage config))))))
(define (people-list-handler config req)
(require-role
config req 'reader
(lambda (_session)
(json-response (hash 'people (list-people config #t))))))
(define (people-create-handler config req)
(require-write-role
config req 'editor
(lambda (_session)
(with-handlers ((exn:fail? (lambda (e) (json-error 400 (exn-message e)))))
(define body (request-json req))
(json-response (create-person! config (hash-ref body 'name "")) #:code 201)))))
(define (people-update-handler config req id)
(require-write-role
config req 'editor
(lambda (_session)
(with-handlers ((exn:fail? (lambda (e) (json-error 400 (exn-message e)))))
(define body (request-json req))
(define active (hash-ref body 'active #t))
(unless (boolean? active)
(raise-argument-error 'people-update-handler "boolean?" active))
(define person (update-person! config id (hash-ref body 'name "") active))
(if person (json-response person) (json-error 404 "Person not found"))))))
(define (request-concept-map-document body)
(define document (hash-ref body 'document #f))
(unless (hash? document)
@@ -480,10 +512,19 @@ CSS
(require-write-role
config req 'editor
(λ (session)
(with-handlers ((exn:fail? (λ (e) (json-error 400 (exn-message e)))))
(with-handlers ((exn:fail?
(λ (e)
(if (string=? (exn-message e) "archive-concept-map!: version-conflict")
(json-error 409 "Concept map changed since it was opened")
(json-error 400 (exn-message e))))))
(define body (request-json req))
(define expected-title (hash-ref body 'confirmTitle ""))
(define base-version (hash-ref body 'baseVersion ""))
(archive-concept-map! config
slug
(wiki-user-username (wiki-session-user session)))
expected-title
(wiki-user-username (wiki-session-user session))
base-version)
(json-response (hash 'ok #t))))))
(define (request-query-value req key [default ""])
@@ -524,7 +565,9 @@ CSS
(require-role
config req 'reader
(λ (_session)
(json-response (hash 'items (list-todos config))))))
(json-response
(hash 'items (append (list-todos config)
(list-concept-todos config)))))))
(define (recent-list-handler config req)
@@ -780,7 +823,43 @@ CSS
(require-role
config req 'admin
(λ (_session)
(json-response (hash 'softwareVersion racket-wiki-version)))))
(define installed-schema-version
(call-with-wiki-database config database-schema-version))
(json-response
(hash 'softwareVersion racket-wiki-version
'databaseSchemaVersion installed-schema-version
'requiredDatabaseSchemaVersion current-schema-version)))))
(define (admin-archived-concept-maps-handler config req)
(require-role
config req 'admin
(λ (_session)
(json-response
(hash 'conceptMaps (list-archived-concept-maps config))))))
(define (cmap-styles-handler config req)
(if (string-ci=? (bytes->string/latin-1 (request-method req)) "GET")
(require-role
config req 'reader
(lambda (_session)
(json-response (hash 'styles (or (read-cmap-styles config) 'null)))))
(require-write-role
config req 'editor
(lambda (_session)
(with-handlers ([exn:fail? (lambda (e) (json-error 400 (exn-message e)))])
(define body (request-json req))
(json-response
(hash 'styles
(save-cmap-styles! config (hash-ref body 'styles '())))))))))
(define (admin-restore-concept-map-handler config req slug)
(require-write-role
config req 'admin
(λ (session)
(with-handlers ((exn:fail? (λ (e) (json-error 400 (exn-message e)))))
(json-response
(restore-concept-map!
config slug (wiki-user-username (wiki-session-user session))))))))
(define (mail-settings->jsexpr settings)
(hash 'publicUrl (hash-ref settings "public-url")
@@ -1025,8 +1104,18 @@ CSS
(λ (req) (concept-map-list-handler config req))]
[("api" "cmaps") #:method "post"
(λ (req) (concept-map-create-handler config req))]
[("api" "cmap-styles") #:method "get"
(λ (req) (cmap-styles-handler config req))]
[("api" "cmap-styles") #:method "put"
(λ (req) (cmap-styles-handler config req))]
[("api" "cmaps" "concept-usage") #:method "get"
(λ (req) (concept-usage-handler config req))]
[("api" "people") #:method "get"
(λ (req) (people-list-handler config req))]
[("api" "people") #:method "post"
(λ (req) (people-create-handler config req))]
[("api" "people" (integer-arg)) #:method "put"
(λ (req id) (people-update-handler config req id))]
[("api" "cmaps" (string-arg)) #:method "get"
(λ (req slug) (concept-map-get-handler config req slug))]
[("api" "cmaps" (string-arg) "history") #:method "get"
@@ -1061,6 +1150,10 @@ CSS
(λ (req slug stored-name) (upload-get-handler config req slug stored-name))]
[("api" "admin" "info") #:method "get"
(λ (req) (admin-info-handler config req))]
[("api" "admin" "cmaps" "archived") #:method "get"
(λ (req) (admin-archived-concept-maps-handler config req))]
[("api" "admin" "cmaps" "archived" (string-arg) "restore") #:method "post"
(λ (req slug) (admin-restore-concept-map-handler config req slug))]
[("api" "admin" "mail-settings") #:method "get"
(λ (req) (admin-mail-settings-handler config req))]
[("api" "admin" "mail-settings") #:method "put"