Commita04ef231Recorded25 Mar 2026Repositorysigil-discourse
Add query param support, topic invites, and bug fixes for SC site
Message
- Add url-encode-string, build-query-string, and discourse-url/query to the client module for proper URL query parameter handling - Add discourse-delete/json for DELETE requests with JSON body - Add discourse-invite-to-topic (POST /t/{id}/invite.json) - Extend discourse-create-invite with optional topic-id: and group-names: - Add email: keyword filter to discourse-list-users - Fix discourse-remove-group-members to pass usernames in request body - Fix discourse-search to URL-encode query before appending to URL - Add 15 tests for query parameter builder and URL encoding
Changed
src/discourse/admin.sgl | 20 +++++++++++++++-----
src/discourse/client.sgl | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
src/discourse/groups.sgl | 5 +++--
src/discourse/search.sgl | 6 ++++--
src/discourse/topics.sgl | 11 ++++++++++-
src/discourse/users.sgl | 8 ++++++--
test/test-query.sgl | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
7 files changed, 196 insertions(+), 13 deletions(-)Diff
src/discourse/admin.sglmodified
@@ -5,6 +5,7 @@
5
(define-library (discourse admin) 6
(import (sigil core) 7
(sigil string)+8
(sigil dict) 9
(sigil json) 10
(discourse client)) 11
@@ -28,10 +29,19 @@
29
;;; Create an invite. 30
;;; 31
;;; group-ids is a comma-separated string of group IDs, or "" for none.−31
(define (discourse-create-invite base-url api-key username email group-ids)−32
(discourse-post/json api-key username−33
(discourse-url base-url "invites.json")−34
#{ email: email−35
group_ids: group-ids }))+32
;;;+33
;;; Optional keyword parameters:+34
;;; topic-id: integer topic ID — invite lands on this topic+35
;;; group-names: comma-separated string of group names (alternative to group-ids)+36
(define (discourse-create-invite base-url api-key username email group-ids+37
(keys: (topic-id #f) (group-names #f)))+38
(let ((body (dict-merge #{ email: email+39
group_ids: group-ids }+40
(dict-filter (lambda (k v) v)+41
#{ topic_id: topic-id+42
group_names: group-names }))))+43
(discourse-post/json api-key username+44
(discourse-url base-url "invites.json")+45
body))) 46
47
))src/discourse/client.sglmodified
@@ -12,10 +12,14 @@
12
13
(export discourse-auth-headers 14
discourse-url+15
discourse-url/query+16
url-encode-string+17
build-query-string 18
discourse-get/json 19
discourse-post/json 20
discourse-put/json−18
discourse-delete)+21
discourse-delete+22
discourse-delete/json) 23
24
(begin 25
@@ -36,6 +40,67 @@
40
(apply string-append base-url 41
(map (lambda (p) (string-append "/" p)) parts))) 42
+43
;; True when c is an unreserved URI character (RFC 3986 §2.3).+44
(define (url-unreserved? c)+45
(let ((code (char->integer c)))+46
(or (and (>= code 65) (<= code 90))+47
(and (>= code 97) (<= code 122))+48
(and (>= code 48) (<= code 57))+49
(memv c '(#\- #\_ #\. #\~)))))+50
+51
;;; Percent-encode a string for use in URL query values.+52
;;;+53
;;; Unreserved characters (A-Z, a-z, 0-9, -, _, ., ~) pass through;+54
;;; everything else is encoded as %XX.+55
(define (url-encode-string s)+56
(apply string-append+57
(reverse+58
(let loop ((i 0) (acc '()))+59
(if (>= i (string-length s))+60
acc+61
(let ((c (string-ref s i)))+62
(loop (+ i 1)+63
(cons (if (url-unreserved? c)+64
(string c)+65
(let ((hex (number->string (char->integer c) 16)))+66
(string-append "%"+67
(string-upcase+68
(if (< (char->integer c) 16)+69
(string-append "0" hex)+70
hex)))))+71
acc))))))))+72
+73
;;; Build a URL query string from an association list.+74
;;;+75
;;; Takes a list of (key . value) pairs and returns "?k1=v1&k2=v2".+76
;;; Values are percent-encoded. Pairs with #f values are omitted.+77
;;; Returns "" if no pairs remain after filtering.+78
(define (build-query-string params)+79
(let ((pairs (filter (lambda (p) (cdr p)) params)))+80
(if (null? pairs)+81
""+82
(string-append "?"+83
(string-join+84
(map (lambda (p)+85
(string-append (symbol->string (car p))+86
"="+87
(url-encode-string+88
(if (string? (cdr p))+89
(cdr p)+90
(number->string (cdr p))))))+91
pairs)+92
"&")))))+93
+94
;;; Build an API URL with path segments and optional query parameters.+95
;;;+96
;;; params is an association list of (key . value) pairs.+97
;;; (discourse-url/query "https://forum.example.com" '((email . "[email protected]"))+98
;;; "admin" "users" "list" "active.json")+99
;;; => "https://forum.example.com/admin/users/list/active.json?email=a%40b.com"+100
(define (discourse-url/query base-url params . parts)+101
(string-append (apply discourse-url base-url parts)+102
(build-query-string params)))+103
104
;; JSON headers for requests with a body. 105
(define (discourse-json-headers api-key username) 106
(dict-merge (discourse-auth-headers api-key username)@@ -77,4 +142,15 @@
142
(check-response 143
(http-delete url headers: (discourse-auth-headers api-key username)))) 144
+145
;;; Authenticated DELETE request with JSON body.+146
;;;+147
;;; Some Discourse endpoints (e.g., remove group members) require a+148
;;; body on DELETE requests. http-delete does not support a body,+149
;;; so we use http-request directly.+150
(define (discourse-delete/json api-key username url body)+151
(check-response+152
(http-request 'DELETE url+153
headers: (discourse-json-headers api-key username)+154
body: (json-encode body))))+155
156
))src/discourse/groups.sglmodified
@@ -51,8 +51,9 @@
51
;;; 52
;;; usernames is a comma-separated string. 53
(define (discourse-remove-group-members base-url api-key username group-id usernames)−54
(discourse-delete api-key username−55
(discourse-url base-url "groups" (number->string group-id) "members.json")))+54
(discourse-delete/json api-key username+55
(discourse-url base-url "groups" (number->string group-id) "members.json")+56
#{ usernames: usernames })) 57
58
;;; List members of a group. 59
(define (discourse-list-group-members base-url api-key username group-name)src/discourse/search.sglmodified
@@ -15,9 +15,11 @@
15
;;; 16
;;; query supports Discourse search syntax (e.g., "in:title", "#category", 17
;;; "@username", "status:open", etc.).+18
;;; The query is URL-encoded before being appended to the URL. 19
(define (discourse-search base-url api-key username query) 20
(discourse-get/json api-key username−20
(string-append (discourse-url base-url "search.json")−21
"?q=" query)))+21
(discourse-url/query base-url+22
(list (cons 'q query))+23
"search.json"))) 24
25
))src/discourse/topics.sglmodified
@@ -15,7 +15,8 @@
15
discourse-create-topic 16
discourse-update-topic 17
discourse-set-topic-status−18
discourse-delete-topic)+18
discourse-delete-topic+19
discourse-invite-to-topic) 20
21
(begin 22
@@ -71,4 +72,12 @@
72
(discourse-delete api-key username 73
(discourse-url base-url "t" (string-append (number->string topic-id) ".json")))) 74
+75
;;; Invite a user to a topic by email or username.+76
;;;+77
;;; user is an email address or username string.+78
(define (discourse-invite-to-topic base-url api-key username topic-id user)+79
(discourse-post/json api-key username+80
(discourse-url base-url "t" (number->string topic-id) "invite.json")+81
#{ user: user }))+82
83
))src/discourse/users.sglmodified
@@ -24,9 +24,13 @@
24
(discourse-url base-url "users" (string-append target ".json")))) 25
26
;;; List active users (admin endpoint).−27
(define (discourse-list-users base-url api-key username)+27
;;;+28
;;; Optional email: keyword filters by exact email address.+29
(define (discourse-list-users base-url api-key username (keys: (email #f))) 30
(discourse-get/json api-key username−29
(discourse-url base-url "admin" "users" "list" "active.json")))+31
(discourse-url/query base-url+32
(list (cons 'email email))+33
"admin" "users" "list" "active.json"))) 34
35
;;; Create a new user. 36
(define (discourse-create-user base-url api-key username name email password target-username)test/test-query.sgladded
@@ -0,0 +1,81 @@
+1
(import (sigil test)+2
(discourse client))+3
+4
;; ============================================================+5
;; url-encode-string+6
;; ============================================================+7
+8
(test-group "url-encode-string"+9
(test "passes through unreserved characters"+10
(assert-equal "hello-world_test.file~v2"+11
(url-encode-string "hello-world_test.file~v2")))+12
+13
(test "encodes spaces as %20"+14
(assert-equal "hello%20world"+15
(url-encode-string "hello world")))+16
+17
(test "encodes @ sign"+18
(assert-equal "user%40example.com"+19
(url-encode-string "[email protected]")))+20
+21
(test "encodes special characters"+22
(assert-equal "a%3Db%26c%3Dd"+23
(url-encode-string "a=b&c=d")))+24
+25
(test "handles empty string"+26
(assert-equal "" (url-encode-string "")))+27
+28
(test "encodes slash"+29
(assert-equal "path%2Fto%2Fthing"+30
(url-encode-string "path/to/thing")))+31
+32
(test "preserves digits and letters"+33
(assert-equal "ABCxyz012"+34
(url-encode-string "ABCxyz012"))))+35
+36
;; ============================================================+37
;; build-query-string+38
;; ============================================================+39
+40
(test-group "build-query-string"+41
(test "builds single parameter"+42
(assert-equal "?email=user%40example.com"+43
(build-query-string '((email . "[email protected]")))))+44
+45
(test "builds multiple parameters"+46
(assert-equal "?q=hello%20world&page=2"+47
(build-query-string '((q . "hello world") (page . 2)))))+48
+49
(test "omits #f values"+50
(assert-equal "?q=test"+51
(build-query-string '((q . "test") (email . #f)))))+52
+53
(test "returns empty string when all values are #f"+54
(assert-equal ""+55
(build-query-string '((email . #f) (page . #f)))))+56
+57
(test "returns empty string for empty list"+58
(assert-equal ""+59
(build-query-string '()))))+60
+61
;; ============================================================+62
;; discourse-url/query+63
;; ============================================================+64
+65
(test-group "discourse-url/query"+66
(test "builds URL with query parameters"+67
(assert-equal "https://forum.example.com/admin/users/list/active.json?email=user%40example.com"+68
(discourse-url/query "https://forum.example.com"+69
'((email . "[email protected]"))+70
"admin" "users" "list" "active.json")))+71
+72
(test "builds URL without query when all params are #f"+73
(assert-equal "https://forum.example.com/admin/users/list/active.json"+74
(discourse-url/query "https://forum.example.com"+75
'((email . #f))+76
"admin" "users" "list" "active.json")))+77
+78
(test "builds URL with no path segments"+79
(assert-equal "https://forum.example.com?q=test"+80
(discourse-url/query "https://forum.example.com"+81
'((q . "test"))))))