Commit6ad7881cRecorded20 Mar 2026Repositoryparlor
Initial parlor CLI and MCP server for Discourse forum management
Message
Dual-mode tool with ~33 MCP tools covering topics, posts, messages, search, categories, users, groups, and admin operations.
Changed
README.md | 79 +++++++++++++++++++++++++++++++++++++++++++++
dev-redirects.sgl | 8 +++++
package.sgl | 57 +++++++++++++++++++++++++++++++++
src/parlor/admin.sgl | 118 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/categories.sgl | 132 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/config.sgl | 53 ++++++++++++++++++++++++++++++
src/parlor/groups.sgl | 179 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/main.sgl | 257 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/messages.sgl | 123 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/posts.sgl | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/search.sgl | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/topics.sgl | 292 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/parlor/users.sgl | 183 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-config.sgl | 45 ++++++++++++++++++++++++++
14 files changed, 1746 insertions(+)Diff
README.mdadded
@@ -0,0 +1,79 @@
+1
# parlor+2
+3
A Discourse forum management tool built with [Sigil](https://codeberg.org/sigil/sigil). Works as both a CLI for humans and an MCP server for AI agents.+4
+5
## CLI Usage+6
+7
```+8
parlor topics latest # List latest topics+9
parlor topics top # List top topics+10
parlor topics get 42 # Get topic+11
parlor topics create "Title" "Body" 5 # Create topic in category 5+12
parlor topics close 42 # Close topic+13
parlor topics open 42 # Reopen topic+14
parlor topics pin 42 # Pin topic+15
parlor topics delete 42 # Delete topic+16
parlor posts get 123 # Get post+17
parlor posts create 42 "Reply body" # Reply to topic+18
parlor posts update 123 "Edited body" # Edit post+19
parlor posts delete 123 # Delete post+20
parlor messages send "Subject" "Body" "user" # Send message+21
parlor messages list username # List messages+22
parlor search "query string" # Search forum+23
parlor categories list # List categories+24
parlor categories get 5 # Get category+25
parlor categories create "Name" "0088CC" # Create category+26
parlor users get username # Get user+27
parlor users list # List users+28
parlor users create "Name" "[email protected]" "pw" un # Create user+29
parlor groups list # List groups+30
parlor groups get group-name # Get group+31
parlor groups create new-group # Create group+32
```+33
+34
## MCP Server+35
+36
Start with `parlor serve`. Exposes these tools:+37
+38
- `parlor/topics-latest`, `parlor/topics-top`, `parlor/topics-by-category`, `parlor/topics-get`, `parlor/topics-create`, `parlor/topics-update`, `parlor/topics-close`, `parlor/topics-open`, `parlor/topics-pin`, `parlor/topics-delete`+39
- `parlor/posts-get`, `parlor/posts-create`, `parlor/posts-update`, `parlor/posts-delete`+40
- `parlor/messages-send`, `parlor/messages-list`, `parlor/messages-reply`+41
- `parlor/search`+42
- `parlor/categories-list`, `parlor/categories-get`, `parlor/categories-create`+43
- `parlor/users-get`, `parlor/users-list`, `parlor/users-create`, `parlor/users-suspend`, `parlor/users-unsuspend`+44
- `parlor/groups-list`, `parlor/groups-get`, `parlor/groups-create`, `parlor/groups-add-members`, `parlor/groups-remove-members`+45
- `parlor/admin-settings`, `parlor/admin-update-setting`, `parlor/admin-invite`+46
+47
## Configuration+48
+49
parlor reads a `.env-parlor` file from the working directory at startup if present.+50
+51
Create a `.env-parlor` in your project root:+52
+53
```+54
DISCOURSE_URL=https://forum.example.com+55
DISCOURSE_API_KEY=your-api-key-here+56
DISCOURSE_USERNAME=system+57
```+58
+59
| Variable | Description | Default |+60
|----------|-------------|---------|+61
| `DISCOURSE_URL` | Instance base URL (required) | — |+62
| `DISCOURSE_API_KEY` | API key (required) | — |+63
| `DISCOURSE_USERNAME` | API username (required) | — |+64
+65
## Building+66
+67
```bash+68
sigil build --redirects dev-redirects.sgl+69
```+70
+71
The bundled binary is at `build/dev/bin/parlor`.+72
+73
## Dependencies+74
+75
- [sigil-discourse](https://codeberg.org/sigil/sigil-discourse) — Discourse API client library+76
+77
## License+78
+79
BSD-3-Clausedev-redirects.sgladded
@@ -0,0 +1,8 @@
+1
(redirects+2
repos: (list+3
(for-repo+4
url: "codeberg:sigil/sigil"+5
use: (from-path dir: "../sigil"))+6
(for-repo+7
url: "codeberg:sigil/sigil-discourse"+8
use: (from-path dir: "../sigil-discourse"))))package.sgladded
@@ -0,0 +1,57 @@
+1
;;; parlor - Discourse forum management CLI and MCP server+2
;;;+3
;;; A dual-mode tool for managing topics, posts, categories, users, groups,+4
;;; and messages on Discourse forums. Usable as a CLI by humans and as an+5
;;; MCP server by AI agents.+6
+7
(define sigil-repo "codeberg:sigil/sigil")+8
(define discourse-repo "codeberg:sigil/sigil-discourse")+9
+10
(package+11
name: "parlor"+12
version: "0.1.0"+13
description: "Discourse forum management CLI and MCP server"+14
url: "https://codeberg.org/sigil/parlor"+15
license: "BSD-3-Clause"+16
authors: (list "David Wilson <[email protected]>")+17
+18
entry: '(parlor main)+19
bundle-name: "parlor"+20
+21
configs: (list+22
(config+23
name: 'dev+24
output-dir: "build/dev"+25
debug?: #t+26
optimize: 0+27
bundle?: #t)+28
(config+29
name: 'release+30
output-dir: "build/release"+31
static?: #t+32
debug?: #f+33
optimize: 2+34
bundle?: #t))+35
+36
provides: (list+37
mcp-server: #{ name: "parlor"+38
args: #["serve"]+39
secret-env: #{ DISCOURSE_API_KEY: #t+40
DISCOURSE_USERNAME: #t+41
DISCOURSE_URL: #t } })+42
+43
dependencies: (list+44
(from-git url: sigil-repo package: "sigil-run")+45
(from-git url: sigil-repo package: "sigil-stdlib")+46
(from-git url: sigil-repo package: "sigil-tls")+47
(from-git url: sigil-repo package: "sigil-http")+48
(from-git url: sigil-repo package: "sigil-mcp")+49
(from-git url: discourse-repo package: "sigil-discourse"))+50
+51
tasks: (list+52
(task+53
name: 'build+54
description: "Compile parlor modules"+55
steps: (list+56
(compile-sigil-modules sources: "src/**/*.sgl"+57
output-dir: (config-output-subdir "lib"))))))src/parlor/admin.sgladded
@@ -0,0 +1,118 @@
+1
;;; (parlor admin) - Administrative tools.+2
;;;+3
;;; MCP tools and CLI handlers for managing site settings and invites.+4
+5
(define-library (parlor admin)+6
(import (sigil core)+7
(sigil string)+8
(sigil json)+9
(sigil array)+10
(sigil mcp server)+11
(discourse admin)+12
(parlor config))+13
(export register-admin-tools!+14
tool-admin-settings+15
tool-admin-update-setting+16
tool-admin-invite)+17
(begin+18
+19
;; ============================================================+20
;; Tool Schemas+21
;; ============================================================+22
+23
(define admin-settings-schema+24
'((type . "object")+25
(properties . ())+26
(required . ())))+27
+28
(define admin-update-setting-schema+29
'((type . "object")+30
(properties . ((name . ((type . "string")+31
(description . "Setting name")))+32
(value . ((type . "string")+33
(description . "New value")))))+34
(required . ("name" "value"))))+35
+36
(define admin-invite-schema+37
'((type . "object")+38
(properties . ((email . ((type . "string")+39
(description . "Email address to invite")))+40
(group_ids . ((type . "string")+41
(description . "Comma-separated group IDs (optional)")))))+42
(required . ("email"))))+43
+44
;; ============================================================+45
;; Formatting+46
;; ============================================================+47
+48
(define (format-setting setting)+49
(let ((name (dict-ref setting setting:))+50
(value (dict-ref setting value: ""))+51
(desc (dict-ref setting description: "")))+52
(string-append+53
name ": " (if value (->string value) "(empty)")+54
(if (and desc (not (string=? desc "")))+55
(string-append "\n " desc)+56
""))))+57
+58
(define (->string val)+59
(cond+60
((string? val) val)+61
((number? val) (number->string val))+62
((boolean? val) (if val "true" "false"))+63
(else "")))+64
+65
;; ============================================================+66
;; Tool Handlers+67
;; ============================================================+68
+69
(define (tool-admin-settings args)+70
(let* ((result (discourse-list-site-settings+71
(parlor-base-url) (parlor-api-key) (parlor-username)))+72
(settings (if result (dict-ref result site_settings: #f) #f)))+73
(if (or (not settings) (= (array-length settings) 0))+74
"No site settings found."+75
(string-append+76
"Site settings:\n\n"+77
(string-join (map format-setting (array->list settings)) "\n\n")))))+78
+79
(define (tool-admin-update-setting args)+80
(let* ((name (dict-ref args name:))+81
(value (dict-ref args value:)))+82
(discourse-update-site-setting+83
(parlor-base-url) (parlor-api-key) (parlor-username)+84
name value)+85
(string-append "Updated setting \"" name "\" to \"" value "\".")))+86
+87
(define (tool-admin-invite args)+88
(let* ((email (dict-ref args email:))+89
(group-ids (dict-ref args group_ids: "")))+90
(discourse-create-invite+91
(parlor-base-url) (parlor-api-key) (parlor-username)+92
email group-ids)+93
(string-append "Sent invite to " email ".")))+94
+95
;; ============================================================+96
;; MCP Registration+97
;; ============================================================+98
+99
(define (register-admin-tools! server register)+100
(register server+101
"parlor/admin-settings"+102
"List all site settings."+103
admin-settings-schema+104
tool-admin-settings)+105
+106
(register server+107
"parlor/admin-update-setting"+108
"Update a site setting."+109
admin-update-setting-schema+110
tool-admin-update-setting)+111
+112
(register server+113
"parlor/admin-invite"+114
"Send an invite email to a user."+115
admin-invite-schema+116
tool-admin-invite))+117
+118
))src/parlor/categories.sgladded
@@ -0,0 +1,132 @@
+1
;;; (parlor categories) - Category management tools.+2
;;;+3
;;; MCP tools and CLI handlers for listing and managing categories.+4
+5
(define-library (parlor categories)+6
(import (sigil core)+7
(sigil string)+8
(sigil json)+9
(sigil array)+10
(sigil mcp server)+11
(discourse categories)+12
(parlor config))+13
(export register-category-tools!+14
tool-categories-list+15
tool-categories-get+16
tool-categories-create)+17
(begin+18
+19
;; ============================================================+20
;; Tool Schemas+21
;; ============================================================+22
+23
(define categories-list-schema+24
'((type . "object")+25
(properties . ())+26
(required . ())))+27
+28
(define categories-get-schema+29
'((type . "object")+30
(properties . ((category_id . ((type . "integer")+31
(description . "Category ID")))))+32
(required . ("category_id"))))+33
+34
(define categories-create-schema+35
'((type . "object")+36
(properties . ((name . ((type . "string")+37
(description . "Category name")))+38
(color . ((type . "string")+39
(description . "Hex color code (e.g. 0088CC)")))+40
(text_color . ((type . "string")+41
(description . "Text hex color code (e.g. FFFFFF)")))))+42
(required . ("name" "color"))))+43
+44
;; ============================================================+45
;; Formatting+46
;; ============================================================+47
+48
(define (format-category cat)+49
(let ((id (dict-ref cat id:))+50
(name (dict-ref cat name:))+51
(desc (dict-ref cat description_text: ""))+52
(topic-count (dict-ref cat topic_count: 0)))+53
(string-append+54
"[" (number->string id) "] " name+55
(if (and desc (not (string=? desc "")))+56
(string-append " - " desc)+57
"")+58
" (" (number->string topic-count) " topics)")))+59
+60
;; ============================================================+61
;; Tool Handlers+62
;; ============================================================+63
+64
(define (tool-categories-list args)+65
(let* ((result (discourse-list-categories+66
(parlor-base-url) (parlor-api-key) (parlor-username)))+67
(cat-list (if result (dict-ref result category_list: #f) #f))+68
(categories (if cat-list (dict-ref cat-list categories: #f) #f)))+69
(if (or (not categories) (= (array-length categories) 0))+70
"No categories found."+71
(string-append+72
"Categories:\n\n"+73
(string-join (map format-category (array->list categories)) "\n")))))+74
+75
(define (tool-categories-get args)+76
(let* ((category-id (dict-ref args category_id:))+77
(result (discourse-get-category+78
(parlor-base-url) (parlor-api-key) (parlor-username)+79
category-id))+80
(cat (if result (dict-ref result category: #f) #f)))+81
(if (not cat)+82
(string-append "Category #" (number->string category-id) " not found.")+83
(let ((name (dict-ref cat name:))+84
(desc (dict-ref cat description_text: ""))+85
(topic-count (dict-ref cat topic_count: 0))+86
(color (dict-ref cat color: "")))+87
(string-append+88
"[" (number->string category-id) "] " name "\n"+89
"Color: #" color "\n"+90
"Topics: " (number->string topic-count) "\n"+91
(if (and desc (not (string=? desc "")))+92
(string-append "\n" desc)+93
""))))))+94
+95
(define (tool-categories-create args)+96
(let* ((name (dict-ref args name:))+97
(color (dict-ref args color:))+98
(text-color (dict-ref args text_color: "FFFFFF"))+99
(result (discourse-create-category+100
(parlor-base-url) (parlor-api-key) (parlor-username)+101
name color text-color))+102
(cat (if result (dict-ref result category: #f) #f)))+103
(if cat+104
(string-append "Created category \""+105
name "\" (#"+106
(number->string (dict-ref cat id: 0)) ").")+107
"Failed to create category.")))+108
+109
;; ============================================================+110
;; MCP Registration+111
;; ============================================================+112
+113
(define (register-category-tools! server register)+114
(register server+115
"parlor/categories-list"+116
"List all forum categories."+117
categories-list-schema+118
tool-categories-list)+119
+120
(register server+121
"parlor/categories-get"+122
"Get details of a specific category."+123
categories-get-schema+124
tool-categories-get)+125
+126
(register server+127
"parlor/categories-create"+128
"Create a new category."+129
categories-create-schema+130
tool-categories-create))+131
+132
))src/parlor/config.sgladded
@@ -0,0 +1,53 @@
+1
;;; (parlor config) - Configuration management.+2
;;;+3
;;; Reads Discourse credentials and instance URL from environment variables.+4
;;; Call (parlor-load-env!) at startup to load .env-parlor from the working directory.+5
+6
(define-library (parlor config)+7
(import (sigil core)+8
(sigil string)+9
(sigil process)+10
(sigil env))+11
(export parlor-api-key+12
parlor-username+13
parlor-base-url+14
parlor-load-env!)+15
(begin+16
+17
;;; Load .env-parlor from the working directory if present.+18
(define (parlor-load-env!)+19
(: -> void?)+20
(load-env-file! ".env-parlor"))+21
+22
;;; Get the Discourse API key.+23
;;;+24
;;; Raises an error if DISCOURSE_API_KEY is not set.+25
(define (parlor-api-key)+26
(: -> string?)+27
(let ((val (getenv "DISCOURSE_API_KEY")))+28
(if (and val (not (string=? val "")))+29
val+30
(error "DISCOURSE_API_KEY environment variable must be set"))))+31
+32
;;; Get the Discourse API username.+33
;;;+34
;;; This is the username that API actions are performed as.+35
;;; Raises an error if DISCOURSE_USERNAME is not set.+36
(define (parlor-username)+37
(: -> string?)+38
(let ((val (getenv "DISCOURSE_USERNAME")))+39
(if (and val (not (string=? val "")))+40
val+41
(error "DISCOURSE_USERNAME environment variable must be set"))))+42
+43
;;; Get the Discourse instance base URL.+44
;;;+45
;;; Raises an error if DISCOURSE_URL is not set.+46
(define (parlor-base-url)+47
(: -> string?)+48
(let ((val (getenv "DISCOURSE_URL")))+49
(if (and val (not (string=? val "")))+50
val+51
(error "DISCOURSE_URL environment variable must be set"))))+52
+53
))src/parlor/groups.sgladded
@@ -0,0 +1,179 @@
+1
;;; (parlor groups) - Group management tools.+2
;;;+3
;;; MCP tools and CLI handlers for listing, creating, and managing+4
;;; groups and their members.+5
+6
(define-library (parlor groups)+7
(import (sigil core)+8
(sigil string)+9
(sigil json)+10
(sigil array)+11
(sigil mcp server)+12
(discourse groups)+13
(parlor config))+14
(export register-group-tools!+15
tool-groups-list+16
tool-groups-get+17
tool-groups-create+18
tool-groups-add-members+19
tool-groups-remove-members)+20
(begin+21
+22
;; ============================================================+23
;; Tool Schemas+24
;; ============================================================+25
+26
(define groups-list-schema+27
'((type . "object")+28
(properties . ())+29
(required . ())))+30
+31
(define groups-get-schema+32
'((type . "object")+33
(properties . ((name . ((type . "string")+34
(description . "Group name")))))+35
(required . ("name"))))+36
+37
(define groups-create-schema+38
'((type . "object")+39
(properties . ((name . ((type . "string")+40
(description . "Group name")))))+41
(required . ("name"))))+42
+43
(define groups-add-members-schema+44
'((type . "object")+45
(properties . ((group_id . ((type . "integer")+46
(description . "Group ID")))+47
(usernames . ((type . "string")+48
(description . "Comma-separated usernames to add")))))+49
(required . ("group_id" "usernames"))))+50
+51
(define groups-remove-members-schema+52
'((type . "object")+53
(properties . ((group_id . ((type . "integer")+54
(description . "Group ID")))+55
(usernames . ((type . "string")+56
(description . "Comma-separated usernames to remove")))))+57
(required . ("group_id" "usernames"))))+58
+59
;; ============================================================+60
;; Formatting+61
;; ============================================================+62
+63
(define (format-group group)+64
(let ((id (dict-ref group id:))+65
(name (dict-ref group name:))+66
(member-count (dict-ref group user_count: 0)))+67
(string-append+68
name+69
" [id:" (number->string id) "]"+70
" (" (number->string member-count) " members)")))+71
+72
(define (format-member member)+73
(let ((username (dict-ref member username:))+74
(name (dict-ref member name: "")))+75
(string-append+76
username+77
(if (and name (not (string=? name "")))+78
(string-append " (" name ")")+79
""))))+80
+81
;; ============================================================+82
;; Tool Handlers+83
;; ============================================================+84
+85
(define (tool-groups-list args)+86
(let* ((result (discourse-list-groups+87
(parlor-base-url) (parlor-api-key) (parlor-username)))+88
(groups (if result (dict-ref result groups: #f) #f)))+89
(if (or (not groups) (= (array-length groups) 0))+90
"No groups found."+91
(string-append+92
"Groups:\n\n"+93
(string-join (map format-group (array->list groups)) "\n")))))+94
+95
(define (tool-groups-get args)+96
(let* ((group-name (dict-ref args name:))+97
(result (discourse-get-group+98
(parlor-base-url) (parlor-api-key) (parlor-username)+99
group-name))+100
(group (if result (dict-ref result group: #f) #f)))+101
(if (not group)+102
(string-append "Group \"" group-name "\" not found.")+103
(let ((id (dict-ref group id:))+104
(name (dict-ref group name:))+105
(member-count (dict-ref group user_count: 0))+106
(members (dict-ref result members: #f)))+107
(string-append+108
name " [id:" (number->string id) "]\n"+109
"Members: " (number->string member-count) "\n"+110
(if (and members (> (array-length members) 0))+111
(string-append "\n"+112
(string-join (map format-member (array->list members)) "\n"))+113
""))))))+114
+115
(define (tool-groups-create args)+116
(let* ((name (dict-ref args name:))+117
(result (discourse-create-group+118
(parlor-base-url) (parlor-api-key) (parlor-username)+119
name))+120
(group (if result (dict-ref result basic_group: #f) #f)))+121
(if group+122
(string-append "Created group \"" name+123
"\" (#" (number->string (dict-ref group id: 0)) ").")+124
"Failed to create group.")))+125
+126
(define (tool-groups-add-members args)+127
(let* ((group-id (dict-ref args group_id:))+128
(usernames (dict-ref args usernames:)))+129
(discourse-add-group-members+130
(parlor-base-url) (parlor-api-key) (parlor-username)+131
group-id usernames)+132
(string-append "Added " usernames " to group #"+133
(number->string group-id) ".")))+134
+135
(define (tool-groups-remove-members args)+136
(let* ((group-id (dict-ref args group_id:))+137
(usernames (dict-ref args usernames:)))+138
(discourse-remove-group-members+139
(parlor-base-url) (parlor-api-key) (parlor-username)+140
group-id usernames)+141
(string-append "Removed " usernames " from group #"+142
(number->string group-id) ".")))+143
+144
;; ============================================================+145
;; MCP Registration+146
;; ============================================================+147
+148
(define (register-group-tools! server register)+149
(register server+150
"parlor/groups-list"+151
"List all groups on the forum."+152
groups-list-schema+153
tool-groups-list)+154
+155
(register server+156
"parlor/groups-get"+157
"Get group details and members."+158
groups-get-schema+159
tool-groups-get)+160
+161
(register server+162
"parlor/groups-create"+163
"Create a new group."+164
groups-create-schema+165
tool-groups-create)+166
+167
(register server+168
"parlor/groups-add-members"+169
"Add members to a group."+170
groups-add-members-schema+171
tool-groups-add-members)+172
+173
(register server+174
"parlor/groups-remove-members"+175
"Remove members from a group."+176
groups-remove-members-schema+177
tool-groups-remove-members))+178
+179
))src/parlor/main.sgladded
@@ -0,0 +1,257 @@
+1
;;; (parlor main) - Entry point for parlor CLI and MCP server.+2
;;;+3
;;; Dispatches between MCP server mode (`parlor serve`) and CLI mode+4
;;; (`parlor <command> <args>`).+5
+6
(define-library (parlor main)+7
(import (sigil core)+8
(sigil string)+9
(sigil array)+10
(sigil process)+11
(sigil mcp server)+12
(parlor config)+13
(parlor topics)+14
(parlor posts)+15
(parlor messages)+16
(parlor search)+17
(parlor categories)+18
(parlor users)+19
(parlor groups)+20
(parlor admin))+21
(export main)+22
(begin+23
+24
;; ============================================================+25
;; MCP Server+26
;; ============================================================+27
+28
(define (run-server)+29
(let ((server (mcp-server name: "parlor" version: "0.1.0")))+30
(register-topic-tools! server mcp-server-register-tool!)+31
(register-post-tools! server mcp-server-register-tool!)+32
(register-message-tools! server mcp-server-register-tool!)+33
(register-search-tools! server mcp-server-register-tool!)+34
(register-category-tools! server mcp-server-register-tool!)+35
(register-user-tools! server mcp-server-register-tool!)+36
(register-group-tools! server mcp-server-register-tool!)+37
(register-admin-tools! server mcp-server-register-tool!)+38
(mcp-server-run server)))+39
+40
;; ============================================================+41
;; CLI+42
;; ============================================================+43
+44
(define (print-usage)+45
(display "parlor - Discourse forum management tool\n\n")+46
(display "Usage:\n")+47
(display " parlor serve Start MCP server\n")+48
(display " parlor topics latest List latest topics\n")+49
(display " parlor topics top List top topics\n")+50
(display " parlor topics get <id> Get topic\n")+51
(display " parlor topics create <title> <body> <cat-id> Create topic\n")+52
(display " parlor topics close <id> Close topic\n")+53
(display " parlor topics open <id> Reopen topic\n")+54
(display " parlor topics pin <id> Pin topic\n")+55
(display " parlor topics delete <id> Delete topic\n")+56
(display " parlor posts get <id> Get post\n")+57
(display " parlor posts create <topic-id> <body> Reply to topic\n")+58
(display " parlor posts update <id> <body> Edit post\n")+59
(display " parlor posts delete <id> Delete post\n")+60
(display " parlor messages send <title> <body> <to> Send message\n")+61
(display " parlor messages list <username> List messages\n")+62
(display " parlor search <query> Search forum\n")+63
(display " parlor categories list List categories\n")+64
(display " parlor categories get <id> Get category\n")+65
(display " parlor categories create <name> <color> Create category\n")+66
(display " parlor users get <username> Get user\n")+67
(display " parlor users list List users\n")+68
(display " parlor users create <name> <email> <pw> <un> Create user\n")+69
(display " parlor groups list List groups\n")+70
(display " parlor groups get <name> Get group\n")+71
(display " parlor groups create <name> Create group\n\n")+72
(display "Environment:\n")+73
(display " DISCOURSE_API_KEY API key (required)\n")+74
(display " DISCOURSE_USERNAME API username (required)\n")+75
(display " DISCOURSE_URL Instance URL (required)\n"))+76
+77
(define (cli-dispatch args)+78
(if (< (length args) 2)+79
(begin (print-usage) (exit 1))+80
(let ((group (car args))+81
(cmd (cadr args))+82
(rest (cddr args)))+83
(cond+84
;; topics+85
((and (string=? group "topics") (string=? cmd "latest"))+86
(display (tool-topics-latest #{}))+87
(newline))+88
+89
((and (string=? group "topics") (string=? cmd "top"))+90
(display (tool-topics-top #{}))+91
(newline))+92
+93
((and (string=? group "topics") (string=? cmd "get")+94
(>= (length rest) 1))+95
(display (tool-topics-get+96
#{ topic_id: (string->number (car rest)) }))+97
(newline))+98
+99
((and (string=? group "topics") (string=? cmd "create")+100
(>= (length rest) 3))+101
(display (tool-topics-create+102
#{ title: (car rest)+103
raw: (cadr rest)+104
category_id: (string->number (caddr rest)) }))+105
(newline))+106
+107
((and (string=? group "topics") (string=? cmd "close")+108
(>= (length rest) 1))+109
(display (tool-topics-close+110
#{ topic_id: (string->number (car rest)) }))+111
(newline))+112
+113
((and (string=? group "topics") (string=? cmd "open")+114
(>= (length rest) 1))+115
(display (tool-topics-open+116
#{ topic_id: (string->number (car rest)) }))+117
(newline))+118
+119
((and (string=? group "topics") (string=? cmd "pin")+120
(>= (length rest) 1))+121
(display (tool-topics-pin+122
#{ topic_id: (string->number (car rest)) }))+123
(newline))+124
+125
((and (string=? group "topics") (string=? cmd "delete")+126
(>= (length rest) 1))+127
(display (tool-topics-delete+128
#{ topic_id: (string->number (car rest)) }))+129
(newline))+130
+131
;; posts+132
((and (string=? group "posts") (string=? cmd "get")+133
(>= (length rest) 1))+134
(display (tool-posts-get+135
#{ post_id: (string->number (car rest)) }))+136
(newline))+137
+138
((and (string=? group "posts") (string=? cmd "create")+139
(>= (length rest) 2))+140
(display (tool-posts-create+141
#{ topic_id: (string->number (car rest))+142
raw: (cadr rest) }))+143
(newline))+144
+145
((and (string=? group "posts") (string=? cmd "update")+146
(>= (length rest) 2))+147
(display (tool-posts-update+148
#{ post_id: (string->number (car rest))+149
raw: (cadr rest) }))+150
(newline))+151
+152
((and (string=? group "posts") (string=? cmd "delete")+153
(>= (length rest) 1))+154
(display (tool-posts-delete+155
#{ post_id: (string->number (car rest)) }))+156
(newline))+157
+158
;; messages+159
((and (string=? group "messages") (string=? cmd "send")+160
(>= (length rest) 3))+161
(display (tool-messages-send+162
#{ title: (car rest)+163
raw: (cadr rest)+164
recipients: (caddr rest) }))+165
(newline))+166
+167
((and (string=? group "messages") (string=? cmd "list")+168
(>= (length rest) 1))+169
(display (tool-messages-list+170
#{ username: (car rest) }))+171
(newline))+172
+173
;; search+174
((and (string=? group "search") (>= (length rest) 0))+175
(display (tool-search+176
#{ query: cmd }))+177
(newline))+178
+179
;; categories+180
((and (string=? group "categories") (string=? cmd "list"))+181
(display (tool-categories-list #{}))+182
(newline))+183
+184
((and (string=? group "categories") (string=? cmd "get")+185
(>= (length rest) 1))+186
(display (tool-categories-get+187
#{ category_id: (string->number (car rest)) }))+188
(newline))+189
+190
((and (string=? group "categories") (string=? cmd "create")+191
(>= (length rest) 2))+192
(display (tool-categories-create+193
#{ name: (car rest)+194
color: (cadr rest)+195
text_color: (if (>= (length rest) 3)+196
(caddr rest) "FFFFFF") }))+197
(newline))+198
+199
;; users+200
((and (string=? group "users") (string=? cmd "get")+201
(>= (length rest) 1))+202
(display (tool-users-get+203
#{ username: (car rest) }))+204
(newline))+205
+206
((and (string=? group "users") (string=? cmd "list"))+207
(display (tool-users-list #{}))+208
(newline))+209
+210
((and (string=? group "users") (string=? cmd "create")+211
(>= (length rest) 4))+212
(display (tool-users-create+213
#{ name: (car rest)+214
email: (cadr rest)+215
password: (caddr rest)+216
username: (cadddr rest) }))+217
(newline))+218
+219
;; groups+220
((and (string=? group "groups") (string=? cmd "list"))+221
(display (tool-groups-list #{}))+222
(newline))+223
+224
((and (string=? group "groups") (string=? cmd "get")+225
(>= (length rest) 1))+226
(display (tool-groups-get+227
#{ name: (car rest) }))+228
(newline))+229
+230
((and (string=? group "groups") (string=? cmd "create")+231
(>= (length rest) 1))+232
(display (tool-groups-create+233
#{ name: (car rest) }))+234
(newline))+235
+236
(else+237
(display (string-append "Unknown command: " group " " cmd "\n"))+238
(print-usage)+239
(exit 1))))))+240
+241
;; ============================================================+242
;; Entry Point+243
;; ============================================================+244
+245
(define (main)+246
(parlor-load-env!)+247
(let ((args (cdr (command-line))))+248
(cond+249
((null? args)+250
(print-usage)+251
(exit 1))+252
((string=? (car args) "serve")+253
(run-server))+254
(else+255
(cli-dispatch args)))))+256
+257
))src/parlor/messages.sgladded
@@ -0,0 +1,123 @@
+1
;;; (parlor messages) - Private message tools.+2
;;;+3
;;; MCP tools and CLI handlers for sending and listing private messages.+4
+5
(define-library (parlor messages)+6
(import (sigil core)+7
(sigil string)+8
(sigil json)+9
(sigil array)+10
(sigil mcp server)+11
(discourse messages)+12
(discourse posts)+13
(parlor config))+14
(export register-message-tools!+15
tool-messages-send+16
tool-messages-list+17
tool-messages-reply)+18
(begin+19
+20
;; ============================================================+21
;; Tool Schemas+22
;; ============================================================+23
+24
(define messages-send-schema+25
'((type . "object")+26
(properties . ((title . ((type . "string")+27
(description . "Message subject")))+28
(raw . ((type . "string")+29
(description . "Message body (markdown)")))+30
(recipients . ((type . "string")+31
(description . "Comma-separated usernames")))))+32
(required . ("title" "raw" "recipients"))))+33
+34
(define messages-list-schema+35
'((type . "object")+36
(properties . ((username . ((type . "string")+37
(description . "Username to list messages for")))))+38
(required . ("username"))))+39
+40
(define messages-reply-schema+41
'((type . "object")+42
(properties . ((topic_id . ((type . "integer")+43
(description . "Message thread topic ID")))+44
(raw . ((type . "string")+45
(description . "Reply body (markdown)")))))+46
(required . ("topic_id" "raw"))))+47
+48
;; ============================================================+49
;; Formatting+50
;; ============================================================+51
+52
(define (format-message-topic topic)+53
(let ((id (dict-ref topic id:))+54
(title (dict-ref topic title:))+55
(posts-count (dict-ref topic posts_count: 0)))+56
(string-append+57
"#" (number->string id) " "+58
title+59
" (" (number->string posts-count) " messages)")))+60
+61
;; ============================================================+62
;; Tool Handlers+63
;; ============================================================+64
+65
(define (tool-messages-send args)+66
(let* ((title (dict-ref args title:))+67
(raw (dict-ref args raw:))+68
(recipients (dict-ref args recipients:))+69
(result (discourse-send-message+70
(parlor-base-url) (parlor-api-key) (parlor-username)+71
title raw recipients)))+72
(if result+73
(string-append "Sent message \"" title "\" to " recipients ".")+74
"Failed to send message.")))+75
+76
(define (tool-messages-list args)+77
(let* ((target-user (dict-ref args username:))+78
(result (discourse-list-messages+79
(parlor-base-url) (parlor-api-key) (parlor-username)+80
target-user))+81
(topics (if result (dict-ref result topic_list: #f) #f))+82
(topic-list (if topics (dict-ref topics topics: #f) #f)))+83
(if (or (not topic-list) (= (array-length topic-list) 0))+84
(string-append "No messages for " target-user ".")+85
(string-append+86
"Messages for " target-user ":\n\n"+87
(string-join (map format-message-topic (array->list topic-list)) "\n")))))+88
+89
(define (tool-messages-reply args)+90
(let* ((topic-id (dict-ref args topic_id:))+91
(raw (dict-ref args raw:))+92
(result (discourse-create-post+93
(parlor-base-url) (parlor-api-key) (parlor-username)+94
topic-id raw)))+95
(if result+96
(string-append "Replied to message thread #"+97
(number->string topic-id) ".")+98
"Failed to reply to message.")))+99
+100
;; ============================================================+101
;; MCP Registration+102
;; ============================================================+103
+104
(define (register-message-tools! server register)+105
(register server+106
"parlor/messages-send"+107
"Send a private message to one or more users."+108
messages-send-schema+109
tool-messages-send)+110
+111
(register server+112
"parlor/messages-list"+113
"List private messages for a user."+114
messages-list-schema+115
tool-messages-list)+116
+117
(register server+118
"parlor/messages-reply"+119
"Reply to a private message thread."+120
messages-reply-schema+121
tool-messages-reply))+122
+123
))src/parlor/posts.sgladded
@@ -0,0 +1,130 @@
+1
;;; (parlor posts) - Post management tools.+2
;;;+3
;;; MCP tools and CLI handlers for getting, creating, updating,+4
;;; and deleting posts within topics.+5
+6
(define-library (parlor posts)+7
(import (sigil core)+8
(sigil string)+9
(sigil json)+10
(sigil mcp server)+11
(discourse posts)+12
(parlor config))+13
(export register-post-tools!+14
tool-posts-get+15
tool-posts-create+16
tool-posts-update+17
tool-posts-delete)+18
(begin+19
+20
;; ============================================================+21
;; Tool Schemas+22
;; ============================================================+23
+24
(define posts-get-schema+25
'((type . "object")+26
(properties . ((post_id . ((type . "integer")+27
(description . "Post ID")))))+28
(required . ("post_id"))))+29
+30
(define posts-create-schema+31
'((type . "object")+32
(properties . ((topic_id . ((type . "integer")+33
(description . "Topic ID to reply to")))+34
(raw . ((type . "string")+35
(description . "Post body (markdown)")))))+36
(required . ("topic_id" "raw"))))+37
+38
(define posts-update-schema+39
'((type . "object")+40
(properties . ((post_id . ((type . "integer")+41
(description . "Post ID")))+42
(raw . ((type . "string")+43
(description . "New post body (markdown)")))))+44
(required . ("post_id" "raw"))))+45
+46
(define posts-delete-schema+47
'((type . "object")+48
(properties . ((post_id . ((type . "integer")+49
(description . "Post ID")))))+50
(required . ("post_id"))))+51
+52
;; ============================================================+53
;; Tool Handlers+54
;; ============================================================+55
+56
(define (tool-posts-get args)+57
(let* ((post-id (dict-ref args post_id:))+58
(post (discourse-get-post+59
(parlor-base-url) (parlor-api-key) (parlor-username)+60
post-id)))+61
(if (not post)+62
(string-append "Post #" (number->string post-id) " not found.")+63
(let ((username (dict-ref post username: "unknown"))+64
(cooked (dict-ref post cooked: ""))+65
(topic-id (dict-ref post topic_id: 0))+66
(post-number (dict-ref post post_number: 0)))+67
(string-append+68
"Post #" (number->string post-id)+69
" (topic #" (number->string topic-id)+70
", post " (number->string post-number) ")\n"+71
"Author: " username "\n\n"+72
(or cooked ""))))))+73
+74
(define (tool-posts-create args)+75
(let* ((topic-id (dict-ref args topic_id:))+76
(raw (dict-ref args raw:))+77
(result (discourse-create-post+78
(parlor-base-url) (parlor-api-key) (parlor-username)+79
topic-id raw)))+80
(if result+81
(string-append "Created post #"+82
(number->string (dict-ref result id: 0))+83
" in topic #" (number->string topic-id) ".")+84
"Failed to create post.")))+85
+86
(define (tool-posts-update args)+87
(let* ((post-id (dict-ref args post_id:))+88
(raw (dict-ref args raw:)))+89
(discourse-update-post+90
(parlor-base-url) (parlor-api-key) (parlor-username)+91
post-id raw)+92
(string-append "Updated post #" (number->string post-id) ".")))+93
+94
(define (tool-posts-delete args)+95
(let ((post-id (dict-ref args post_id:)))+96
(discourse-delete-post+97
(parlor-base-url) (parlor-api-key) (parlor-username)+98
post-id)+99
(string-append "Deleted post #" (number->string post-id) ".")))+100
+101
;; ============================================================+102
;; MCP Registration+103
;; ============================================================+104
+105
(define (register-post-tools! server register)+106
(register server+107
"parlor/posts-get"+108
"Get a specific post by ID."+109
posts-get-schema+110
tool-posts-get)+111
+112
(register server+113
"parlor/posts-create"+114
"Reply to a topic with a new post."+115
posts-create-schema+116
tool-posts-create)+117
+118
(register server+119
"parlor/posts-update"+120
"Edit a post's content."+121
posts-update-schema+122
tool-posts-update)+123
+124
(register server+125
"parlor/posts-delete"+126
"Delete a post."+127
posts-delete-schema+128
tool-posts-delete))+129
+130
))src/parlor/search.sgladded
@@ -0,0 +1,90 @@
+1
;;; (parlor search) - Search tools.+2
;;;+3
;;; MCP tools and CLI handlers for searching the forum.+4
+5
(define-library (parlor search)+6
(import (sigil core)+7
(sigil string)+8
(sigil json)+9
(sigil array)+10
(sigil mcp server)+11
(discourse search)+12
(parlor config))+13
(export register-search-tools!+14
tool-search)+15
(begin+16
+17
;; ============================================================+18
;; Tool Schemas+19
;; ============================================================+20
+21
(define search-schema+22
'((type . "object")+23
(properties . ((query . ((type . "string")+24
(description . "Search query (supports Discourse syntax: in:title, #category, @user, status:open)")))))+25
(required . ("query"))))+26
+27
;; ============================================================+28
;; Formatting+29
;; ============================================================+30
+31
(define (format-search-topic topic)+32
(let ((id (dict-ref topic id:))+33
(title (dict-ref topic title:))+34
(posts-count (dict-ref topic posts_count: 0)))+35
(string-append+36
"#" (number->string id) " " title+37
" (" (number->string posts-count) " posts)")))+38
+39
(define (format-search-post post)+40
(let ((id (dict-ref post id:))+41
(topic-id (dict-ref post topic_id: 0))+42
(username (dict-ref post username: "unknown"))+43
(blurb (dict-ref post blurb: "")))+44
(string-append+45
"Post #" (number->string id)+46
" in topic #" (number->string topic-id)+47
" by " username "\n"+48
" " blurb)))+49
+50
;; ============================================================+51
;; Tool Handlers+52
;; ============================================================+53
+54
(define (tool-search args)+55
(let* ((query (dict-ref args query:))+56
(result (discourse-search+57
(parlor-base-url) (parlor-api-key) (parlor-username)+58
query))+59
(topics (if result (dict-ref result topics: #f) #f))+60
(posts (if result (dict-ref result posts: #f) #f)))+61
(string-append+62
"Search results for \"" query "\":\n\n"+63
(if (and topics (> (array-length topics) 0))+64
(string-append+65
"Topics:\n"+66
(string-join (map format-search-topic (array->list topics)) "\n")+67
"\n\n")+68
"")+69
(if (and posts (> (array-length posts) 0))+70
(string-append+71
"Posts:\n"+72
(string-join (map format-search-post (array->list posts)) "\n"))+73
"")+74
(if (and (or (not topics) (= (array-length topics) 0))+75
(or (not posts) (= (array-length posts) 0)))+76
"No results found."+77
""))))+78
+79
;; ============================================================+80
;; MCP Registration+81
;; ============================================================+82
+83
(define (register-search-tools! server register)+84
(register server+85
"parlor/search"+86
"Search topics, posts, and users on the forum."+87
search-schema+88
tool-search))+89
+90
))src/parlor/topics.sgladded
@@ -0,0 +1,292 @@
+1
;;; (parlor topics) - Topic management tools.+2
;;;+3
;;; MCP tools and CLI handlers for listing, creating, updating,+4
;;; and managing forum topics.+5
+6
(define-library (parlor topics)+7
(import (sigil core)+8
(sigil string)+9
(sigil json)+10
(sigil array)+11
(sigil mcp server)+12
(discourse topics)+13
(parlor config))+14
(export register-topic-tools!+15
tool-topics-latest+16
tool-topics-top+17
tool-topics-by-category+18
tool-topics-get+19
tool-topics-create+20
tool-topics-update+21
tool-topics-close+22
tool-topics-open+23
tool-topics-pin+24
tool-topics-delete)+25
(begin+26
+27
;; ============================================================+28
;; Tool Schemas+29
;; ============================================================+30
+31
(define topics-latest-schema+32
'((type . "object")+33
(properties . ())+34
(required . ())))+35
+36
(define topics-top-schema+37
'((type . "object")+38
(properties . ())+39
(required . ())))+40
+41
(define topics-by-category-schema+42
'((type . "object")+43
(properties . ((category_slug . ((type . "string")+44
(description . "Category slug")))+45
(category_id . ((type . "integer")+46
(description . "Category ID")))))+47
(required . ("category_slug" "category_id"))))+48
+49
(define topics-get-schema+50
'((type . "object")+51
(properties . ((topic_id . ((type . "integer")+52
(description . "Topic ID")))))+53
(required . ("topic_id"))))+54
+55
(define topics-create-schema+56
'((type . "object")+57
(properties . ((title . ((type . "string")+58
(description . "Topic title")))+59
(raw . ((type . "string")+60
(description . "Topic body (markdown)")))+61
(category_id . ((type . "integer")+62
(description . "Category ID to post in")))))+63
(required . ("title" "raw" "category_id"))))+64
+65
(define topics-update-schema+66
'((type . "object")+67
(properties . ((topic_id . ((type . "integer")+68
(description . "Topic ID")))+69
(title . ((type . "string")+70
(description . "New title")))+71
(category_id . ((type . "integer")+72
(description . "New category ID")))))+73
(required . ("topic_id"))))+74
+75
(define topics-close-schema+76
'((type . "object")+77
(properties . ((topic_id . ((type . "integer")+78
(description . "Topic ID")))))+79
(required . ("topic_id"))))+80
+81
(define topics-open-schema+82
'((type . "object")+83
(properties . ((topic_id . ((type . "integer")+84
(description . "Topic ID")))))+85
(required . ("topic_id"))))+86
+87
(define topics-pin-schema+88
'((type . "object")+89
(properties . ((topic_id . ((type . "integer")+90
(description . "Topic ID")))+91
(until . ((type . "string")+92
(description . "Pin until date (ISO format, optional)")))))+93
(required . ("topic_id"))))+94
+95
(define topics-delete-schema+96
'((type . "object")+97
(properties . ((topic_id . ((type . "integer")+98
(description . "Topic ID")))))+99
(required . ("topic_id"))))+100
+101
;; ============================================================+102
;; Formatting+103
;; ============================================================+104
+105
(define (format-topic topic)+106
(let ((id (dict-ref topic id:))+107
(title (dict-ref topic title:))+108
(posts-count (dict-ref topic posts_count: 0))+109
(views (dict-ref topic views: 0)))+110
(string-append+111
"#" (number->string id) " "+112
title+113
" (" (number->string posts-count) " posts, "+114
(number->string views) " views)")))+115
+116
;; ============================================================+117
;; Tool Handlers+118
;; ============================================================+119
+120
(define (tool-topics-latest args)+121
(let* ((result (discourse-list-latest-topics+122
(parlor-base-url) (parlor-api-key) (parlor-username)))+123
(topics (if result (dict-ref result topic_list: #f) #f))+124
(topic-list (if topics (dict-ref topics topics: #f) #f)))+125
(if (or (not topic-list) (= (array-length topic-list) 0))+126
"No topics found."+127
(string-append+128
"Latest topics:\n\n"+129
(string-join (map format-topic (array->list topic-list)) "\n")))))+130
+131
(define (tool-topics-top args)+132
(let* ((result (discourse-list-top-topics+133
(parlor-base-url) (parlor-api-key) (parlor-username)))+134
(topics (if result (dict-ref result topic_list: #f) #f))+135
(topic-list (if topics (dict-ref topics topics: #f) #f)))+136
(if (or (not topic-list) (= (array-length topic-list) 0))+137
"No top topics found."+138
(string-append+139
"Top topics:\n\n"+140
(string-join (map format-topic (array->list topic-list)) "\n")))))+141
+142
(define (tool-topics-by-category args)+143
(let* ((slug (dict-ref args category_slug:))+144
(id (dict-ref args category_id:))+145
(result (discourse-list-category-topics+146
(parlor-base-url) (parlor-api-key) (parlor-username)+147
slug id))+148
(topics (if result (dict-ref result topic_list: #f) #f))+149
(topic-list (if topics (dict-ref topics topics: #f) #f)))+150
(if (or (not topic-list) (= (array-length topic-list) 0))+151
(string-append "No topics in category " slug ".")+152
(string-append+153
"Topics in " slug ":\n\n"+154
(string-join (map format-topic (array->list topic-list)) "\n")))))+155
+156
(define (tool-topics-get args)+157
(let* ((topic-id (dict-ref args topic_id:))+158
(topic (discourse-get-topic+159
(parlor-base-url) (parlor-api-key) (parlor-username)+160
topic-id)))+161
(if (not topic)+162
(string-append "Topic #" (number->string topic-id) " not found.")+163
(let ((title (dict-ref topic title:))+164
(posts-count (dict-ref topic posts_count: 0))+165
(views (dict-ref topic views: 0))+166
(post-stream (dict-ref topic post_stream: #f))+167
(posts (if post-stream (dict-ref post-stream posts: #f) #f)))+168
(string-append+169
"#" (number->string topic-id) " " title "\n"+170
"Posts: " (number->string posts-count)+171
" | Views: " (number->string views) "\n\n"+172
(if (and posts (> (array-length posts) 0))+173
(let ((first-post (array-ref posts 0)))+174
(or (dict-ref first-post cooked: "") ""))+175
""))))))+176
+177
(define (tool-topics-create args)+178
(let* ((title (dict-ref args title:))+179
(raw (dict-ref args raw:))+180
(category-id (dict-ref args category_id:))+181
(result (discourse-create-topic+182
(parlor-base-url) (parlor-api-key) (parlor-username)+183
title raw category-id)))+184
(if result+185
(string-append "Created topic #"+186
(number->string (dict-ref result topic_id: 0))+187
": " title)+188
"Failed to create topic.")))+189
+190
(define (tool-topics-update args)+191
(let* ((topic-id (dict-ref args topic_id:))+192
(title (dict-ref args title: ""))+193
(category-id (dict-ref args category_id: 0)))+194
(discourse-update-topic+195
(parlor-base-url) (parlor-api-key) (parlor-username)+196
topic-id title category-id)+197
(string-append "Updated topic #" (number->string topic-id) ".")))+198
+199
(define (tool-topics-close args)+200
(let ((topic-id (dict-ref args topic_id:)))+201
(discourse-set-topic-status+202
(parlor-base-url) (parlor-api-key) (parlor-username)+203
topic-id "closed" #t)+204
(string-append "Closed topic #" (number->string topic-id) ".")))+205
+206
(define (tool-topics-open args)+207
(let ((topic-id (dict-ref args topic_id:)))+208
(discourse-set-topic-status+209
(parlor-base-url) (parlor-api-key) (parlor-username)+210
topic-id "closed" #f)+211
(string-append "Opened topic #" (number->string topic-id) ".")))+212
+213
(define (tool-topics-pin args)+214
(let ((topic-id (dict-ref args topic_id:)))+215
(discourse-set-topic-status+216
(parlor-base-url) (parlor-api-key) (parlor-username)+217
topic-id "pinned" #t)+218
(string-append "Pinned topic #" (number->string topic-id) ".")))+219
+220
(define (tool-topics-delete args)+221
(let ((topic-id (dict-ref args topic_id:)))+222
(discourse-delete-topic+223
(parlor-base-url) (parlor-api-key) (parlor-username)+224
topic-id)+225
(string-append "Deleted topic #" (number->string topic-id) ".")))+226
+227
;; ============================================================+228
;; MCP Registration+229
;; ============================================================+230
+231
(define (register-topic-tools! server register)+232
(register server+233
"parlor/topics-latest"+234
"List the latest topics on the forum."+235
topics-latest-schema+236
tool-topics-latest)+237
+238
(register server+239
"parlor/topics-top"+240
"List the top topics on the forum ranked by popularity."+241
topics-top-schema+242
tool-topics-top)+243
+244
(register server+245
"parlor/topics-by-category"+246
"List topics in a specific category."+247
topics-by-category-schema+248
tool-topics-by-category)+249
+250
(register server+251
"parlor/topics-get"+252
"Get a specific topic with its posts."+253
topics-get-schema+254
tool-topics-get)+255
+256
(register server+257
"parlor/topics-create"+258
"Create a new topic in a category."+259
topics-create-schema+260
tool-topics-create)+261
+262
(register server+263
"parlor/topics-update"+264
"Update a topic's title or category."+265
topics-update-schema+266
tool-topics-update)+267
+268
(register server+269
"parlor/topics-close"+270
"Close a topic."+271
topics-close-schema+272
tool-topics-close)+273
+274
(register server+275
"parlor/topics-open"+276
"Reopen a closed topic."+277
topics-open-schema+278
tool-topics-open)+279
+280
(register server+281
"parlor/topics-pin"+282
"Pin a topic to the top."+283
topics-pin-schema+284
tool-topics-pin)+285
+286
(register server+287
"parlor/topics-delete"+288
"Delete a topic."+289
topics-delete-schema+290
tool-topics-delete))+291
+292
))src/parlor/users.sgladded
@@ -0,0 +1,183 @@
+1
;;; (parlor users) - User management tools.+2
;;;+3
;;; MCP tools and CLI handlers for listing, creating, and administering users.+4
+5
(define-library (parlor users)+6
(import (sigil core)+7
(sigil string)+8
(sigil json)+9
(sigil array)+10
(sigil mcp server)+11
(discourse users)+12
(parlor config))+13
(export register-user-tools!+14
tool-users-get+15
tool-users-list+16
tool-users-create+17
tool-users-suspend+18
tool-users-unsuspend)+19
(begin+20
+21
;; ============================================================+22
;; Tool Schemas+23
;; ============================================================+24
+25
(define users-get-schema+26
'((type . "object")+27
(properties . ((username . ((type . "string")+28
(description . "Username to look up")))))+29
(required . ("username"))))+30
+31
(define users-list-schema+32
'((type . "object")+33
(properties . ())+34
(required . ())))+35
+36
(define users-create-schema+37
'((type . "object")+38
(properties . ((name . ((type . "string")+39
(description . "Display name")))+40
(email . ((type . "string")+41
(description . "Email address")))+42
(password . ((type . "string")+43
(description . "Password")))+44
(username . ((type . "string")+45
(description . "Username")))))+46
(required . ("name" "email" "password" "username"))))+47
+48
(define users-suspend-schema+49
'((type . "object")+50
(properties . ((user_id . ((type . "integer")+51
(description . "User ID")))+52
(duration . ((type . "integer")+53
(description . "Suspension duration in days")))+54
(reason . ((type . "string")+55
(description . "Reason for suspension")))))+56
(required . ("user_id" "duration" "reason"))))+57
+58
(define users-unsuspend-schema+59
'((type . "object")+60
(properties . ((user_id . ((type . "integer")+61
(description . "User ID")))))+62
(required . ("user_id"))))+63
+64
;; ============================================================+65
;; Formatting+66
;; ============================================================+67
+68
(define (format-user user)+69
(let ((id (dict-ref user id:))+70
(username (dict-ref user username:))+71
(name (dict-ref user name: "")))+72
(string-append+73
username+74
(if (and name (not (string=? name "")))+75
(string-append " (" name ")")+76
"")+77
" [id:" (number->string id) "]")))+78
+79
;; ============================================================+80
;; Tool Handlers+81
;; ============================================================+82
+83
(define (tool-users-get args)+84
(let* ((target (dict-ref args username:))+85
(result (discourse-get-user+86
(parlor-base-url) (parlor-api-key) (parlor-username)+87
target))+88
(user (if result (dict-ref result user: #f) #f)))+89
(if (not user)+90
(string-append "User \"" target "\" not found.")+91
(let ((id (dict-ref user id:))+92
(username (dict-ref user username:))+93
(name (dict-ref user name: ""))+94
(trust-level (dict-ref user trust_level: 0))+95
(admin (dict-ref user admin: #f))+96
(created (dict-ref user created_at: "")))+97
(string-append+98
username+99
(if (and name (not (string=? name "")))+100
(string-append " (" name ")")+101
"")+102
"\n"+103
"ID: " (number->string id) "\n"+104
"Trust level: " (number->string trust-level) "\n"+105
"Admin: " (if admin "yes" "no") "\n"+106
"Created: " (if (and created (> (string-length created) 10))+107
(substring created 0 10)+108
(or created "")))))))+109
+110
(define (tool-users-list args)+111
(let* ((users (discourse-list-users+112
(parlor-base-url) (parlor-api-key) (parlor-username))))+113
(if (or (not users) (= (array-length users) 0))+114
"No users found."+115
(string-append+116
"Active users:\n\n"+117
(string-join (map format-user (array->list users)) "\n")))))+118
+119
(define (tool-users-create args)+120
(let* ((name (dict-ref args name:))+121
(email (dict-ref args email:))+122
(password (dict-ref args password:))+123
(target-username (dict-ref args username:))+124
(result (discourse-create-user+125
(parlor-base-url) (parlor-api-key) (parlor-username)+126
name email password target-username)))+127
(if result+128
(string-append "Created user \"" target-username "\".")+129
"Failed to create user.")))+130
+131
(define (tool-users-suspend args)+132
(let* ((user-id (dict-ref args user_id:))+133
(duration (dict-ref args duration:))+134
(reason (dict-ref args reason:)))+135
(discourse-suspend-user+136
(parlor-base-url) (parlor-api-key) (parlor-username)+137
user-id duration reason)+138
(string-append "Suspended user #" (number->string user-id)+139
" for " (number->string duration) " days.")))+140
+141
(define (tool-users-unsuspend args)+142
(let ((user-id (dict-ref args user_id:)))+143
(discourse-unsuspend-user+144
(parlor-base-url) (parlor-api-key) (parlor-username)+145
user-id)+146
(string-append "Unsuspended user #" (number->string user-id) ".")))+147
+148
;; ============================================================+149
;; MCP Registration+150
;; ============================================================+151
+152
(define (register-user-tools! server register)+153
(register server+154
"parlor/users-get"+155
"Get a user's profile by username."+156
users-get-schema+157
tool-users-get)+158
+159
(register server+160
"parlor/users-list"+161
"List active users on the forum."+162
users-list-schema+163
tool-users-list)+164
+165
(register server+166
"parlor/users-create"+167
"Create a new user account."+168
users-create-schema+169
tool-users-create)+170
+171
(register server+172
"parlor/users-suspend"+173
"Suspend a user for a specified duration."+174
users-suspend-schema+175
tool-users-suspend)+176
+177
(register server+178
"parlor/users-unsuspend"+179
"Remove suspension from a user."+180
users-unsuspend-schema+181
tool-users-unsuspend))+182
+183
))test/test-config.sgladded
@@ -0,0 +1,45 @@
+1
(import (sigil test)+2
(sigil process)+3
(parlor config))+4
+5
;; ============================================================+6
;; parlor-base-url+7
;; ============================================================+8
+9
(test-group "parlor-base-url"+10
(test "reads DISCOURSE_URL from environment"+11
(setenv! "DISCOURSE_URL" "https://test.forum.com")+12
(assert-equal "https://test.forum.com" (parlor-base-url))+13
(setenv! "DISCOURSE_URL" ""))+14
+15
(test "raises error when DISCOURSE_URL is not set"+16
(setenv! "DISCOURSE_URL" "")+17
(assert-error (parlor-base-url))))+18
+19
;; ============================================================+20
;; parlor-api-key+21
;; ============================================================+22
+23
(test-group "parlor-api-key"+24
(test "reads DISCOURSE_API_KEY from environment"+25
(setenv! "DISCOURSE_API_KEY" "test-key-123")+26
(assert-equal "test-key-123" (parlor-api-key))+27
(setenv! "DISCOURSE_API_KEY" ""))+28
+29
(test "raises error when DISCOURSE_API_KEY is not set"+30
(setenv! "DISCOURSE_API_KEY" "")+31
(assert-error (parlor-api-key))))+32
+33
;; ============================================================+34
;; parlor-username+35
;; ============================================================+36
+37
(test-group "parlor-username"+38
(test "reads DISCOURSE_USERNAME from environment"+39
(setenv! "DISCOURSE_USERNAME" "system")+40
(assert-equal "system" (parlor-username))+41
(setenv! "DISCOURSE_USERNAME" ""))+42
+43
(test "raises error when DISCOURSE_USERNAME is not set"+44
(setenv! "DISCOURSE_USERNAME" "")+45
(assert-error (parlor-username))))