commit 9eadd119054a9e65b0ce6053fc2e386f5fdb2f9b
parent a19c9b4436674bec22a1b55d9b83fed150072e84
Author: mtmn <miro@haravara.org>
Date: Fri, 24 Apr 2026 20:30:34 +0200
feat: deprecate .dhall users file, fmt
Diffstat:
4 files changed, 76 insertions(+), 56 deletions(-)
diff --git a/docs/architecture.md b/docs/architecture.md
@@ -36,7 +36,7 @@ Uses an S3-compatible bucket to cache cover art images.
## Multi-User Support
-Corpus runs as a single server process serving multiple users. User configuration is defined in `users.dhall`, compiled to `users.json` at build time.
+Corpus runs as a single server process serving multiple users. User configuration is defined in `users.json`, managed via the built-in CLI commands.
### Routing
- `/` and `/u/<slug>` — serve the Elm SPA for the root user and named users respectively
@@ -45,10 +45,31 @@ Corpus runs as a single server process serving multiple users. User configuratio
- `/1/submit-listens` — ListenBrainz-compatible scrobble submission endpoint (requires `Authorization: Token <token>` header)
- `/metrics` — Prometheus metrics (no user parameter; covers all users; only available when `METRICS_ENABLED=true`)
+### User Management
+
+Users are managed via built-in CLI commands. The server must not be running when modifying `users.json`.
+
+```sh
+# Add a new user (creates the DB, prints the API token once)
+node server.js add-user --slug filip --name "Filip" --db filip.db
+
+# Optional: link a ListenBrainz or Last.fm account at creation time
+node server.js add-user --slug filip --name "Filip" --db filip.db \
+ --listenbrainz-user filip --lastfm-user filiplfm
+
+# List all users
+node server.js list-users
+
+# Regenerate the API token for a user
+node server.js reset-token --slug filip
+```
+
+The API token is only printed once on creation or reset — store it securely. It is used for the `/1/submit-listens` endpoint via `Authorization: Token <token>`.
+
### Configuration
User configuration is split into two layers:
-1. **`users.dhall`** (build-time, non-sensitive): defines user slugs, source usernames, database filenames, and feature flags. Compiled to `users.json` at build time via `dhall-to-json`. The server reads this file at startup from the path in `CORPUS_USERS_FILE` (defaults to `users.json`).
+1. **`users.json`** (non-sensitive): defines user slugs, source usernames, database filenames, and feature flags. Managed via CLI (`add-user`, `reset-token`, `list-users`). The server reads this file at startup from the path in `CORPUS_USERS_FILE` (defaults to `users.json`).
2. **Environment variables** (runtime, sensitive): shared API keys and S3 credentials are read from the environment at startup and applied to all users.
@@ -84,7 +105,7 @@ This prevents data corruption and ensures that any in-progress operations are co
| `PORT` | `8000` | HTTP listen port |
| `METRICS_ENABLED` | `false` | Set to `true` to enable the Prometheus `/metrics` endpoint |
-### users.dhall Fields
+### users.json Fields
| Field | Type | Purpose |
|---|---|---|
@@ -156,7 +177,7 @@ Node.js default metrics (GC, event loop, memory) are also collected via `prom-cl
- **Language**: [PureScript](https://purescript.org) (server), [Elm](https://elm-lang.org) (frontend)
- **Runtime**: [Node.js](https://nodejs.org)
- **Database**: [DuckDB](https://duckdb.org) (one file per user)
-- **Config**: [Dhall](https://dhall-lang.org) → JSON (compiled at build time)
+- **Config**: JSON (`users.json`, managed via CLI)
- **Bundling**: [spago](https://github.com/purescript/spago) + [esbuild](https://esbuild.github.io/) (server), [elm make](https://guide.elm-lang.org/install/elm.html) (frontend)
- **Environment**: [Nix](https://nixos.org) for reproducible development shells and container builds
diff --git a/justfile b/justfile
@@ -2,8 +2,9 @@ help:
@just --list
-# Convert users.dhall to users.json
+# DEPRECATED: users.dhall is no longer the source of truth. Use `just add-user` instead.
generate-users-json:
+ @echo "Warning: users.dhall is deprecated. Manage users with: just add-user / just list-users / just reset-token"
dhall-to-json --file users.dhall > users.json
# Setup npm and spago
diff --git a/src/Command.purs b/src/Command.purs
@@ -9,7 +9,7 @@ import Data.Array (catMaybes, find, snoc)
import Data.Array as Array
import Data.Either (Either(..))
import Data.Foldable (for_)
-import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Tuple (Tuple(..))
import Db as Db
import Effect.Aff (Aff)
@@ -19,17 +19,16 @@ import Effect.Exception (error)
import Foreign.Object as Object
import Node.Encoding (Encoding(UTF8))
import Node.FS.Aff as FSA
-import Node.Process (cwd, exit, lookupEnv)
+import Node.Process (cwd, exit', lookupEnv)
import Unsafe.Coerce (unsafeCoerce)
foreign import prettyStringify :: Json -> String
getFlag :: String -> Array String -> Maybe String
-getFlag flag args = case Array.uncons args of
- Nothing -> Nothing
- Just { head: k, tail: rest } ->
- if k == flag then map _.head (Array.uncons rest)
- else getFlag flag rest
+getFlag flag args = do
+ { head: k, tail: rest } <- Array.uncons args
+ if k == flag then map _.head (Array.uncons rest)
+ else getFlag flag rest
resolvePath :: String -> Maybe String -> String -> String
resolvePath defaultDir mDbPath file = case mDbPath of
@@ -69,65 +68,58 @@ writeUsersJson configFile users =
$ fromObject
$ Object.fromFoldable [ Tuple "users" (fromArray users) ]
+printUsage :: Aff Unit
+printUsage = liftEffect do
+ log "Usage:"
+ log " add-user --slug <slug> --db <file> [--name <name>] [--listenbrainz-user <user>] [--lastfm-user <user>]"
+ log " reset-token --slug <slug>"
+ log " list-users"
+ exit' 1
+
run :: String -> Array String -> Aff Unit
run configFile args = case Array.uncons args of
Just { head: "add-user", tail: rest } -> addUser configFile rest
Just { head: "reset-token", tail: rest } -> resetToken configFile rest
Just { head: "list-users" } -> listUsers configFile
- _ -> liftEffect do
- log "Usage:"
- log " add-user --slug <slug> --db <file> [--name <name>] [--listenbrainz-user <user>] [--lastfm-user <user>]"
- log " reset-token --slug <slug>"
- log " list-users"
- exit 1
+ _ -> printUsage
addUser :: String -> Array String -> Aff Unit
addUser configFile args = do
let
- mSlug = getFlag "--slug" args
- mDb = getFlag "--db" args
mName = getFlag "--name" args
mLbUser = getFlag "--listenbrainz-user" args
mLfUser = getFlag "--lastfm-user" args
- case mSlug, mDb of
- Nothing, _ -> liftEffect $ log "Error: --slug is required" *> exit 1
- _, Nothing -> liftEffect $ log "Error: --db is required" *> exit 1
- Just slug, Just dbFile -> do
- users <- readUsersJson configFile
- case find (\u -> (toObject u >>= Object.lookup "slug" >>= toString) == Just slug) users of
- Just _ -> liftEffect $ log ("Error: user '" <> slug <> "' already exists") *> exit 1
- Nothing -> do
- let newEntry = encodeUserEntry { slug, name: mName, dbFile, lbUser: mLbUser, lfUser: mLfUser }
- writeUsersJson configFile (snoc users newEntry)
- conn <- Db.connect dbFile
- Db.initDb conn
- Db.initReleaseMetadata conn
- mToken <- Db.getOrCreateToken conn slug
- liftEffect $ for_ mToken \token ->
- log $ "Created user '" <> slug <> "'. API token: " <> token
+ slug <- maybe (liftEffect $ log "Error: --slug is required" *> exit' 1) pure (getFlag "--slug" args)
+ dbFile <- maybe (liftEffect $ log "Error: --db is required" *> exit' 1) pure (getFlag "--db" args)
+ users <- readUsersJson configFile
+ when (isJust $ find (\u -> (toObject u >>= Object.lookup "slug" >>= toString) == Just slug) users)
+ $ liftEffect
+ $ log ("Error: user '" <> slug <> "' already exists") *> exit' 1
+ let newEntry = encodeUserEntry { slug, name: mName, dbFile, lbUser: mLbUser, lfUser: mLfUser }
+ writeUsersJson configFile (snoc users newEntry)
+ conn <- Db.connect dbFile
+ Db.initDb conn
+ Db.initReleaseMetadata conn
+ mToken <- Db.getOrCreateToken conn slug
+ liftEffect $ for_ mToken \token ->
+ log $ "Created user '" <> slug <> "'. API token: " <> token
resetToken :: String -> Array String -> Aff Unit
resetToken configFile args = do
- let mSlug = getFlag "--slug" args
- case mSlug of
- Nothing -> liftEffect $ log "Error: --slug is required" *> exit 1
- Just slug -> do
- users <- readUsersJson configFile
- case find (\u -> (toObject u >>= Object.lookup "slug" >>= toString) == Just slug) users of
- Nothing -> liftEffect $ log ("Error: user '" <> slug <> "' not found") *> exit 1
- Just userJson -> do
- let mDbFile = toObject userJson >>= Object.lookup "config" >>= toObject >>= Object.lookup "databaseFile" >>= toString
- case mDbFile of
- Nothing -> throwError (error $ "Cannot read databaseFile for user '" <> slug <> "'")
- Just dbFile -> do
- defaultDir <- liftEffect cwd
- mDbPath <- liftEffect $ lookupEnv "DATABASE_PATH"
- let fullPath = resolvePath defaultDir mDbPath dbFile
- conn <- Db.connect fullPath
- Db.run conn "DELETE FROM api_tokens WHERE slug = ?" [ unsafeCoerce slug ]
- mToken <- Db.getOrCreateToken conn slug
- liftEffect $ for_ mToken \token ->
- log $ "New token for '" <> slug <> "': " <> token
+ slug <- maybe (liftEffect $ log "Error: --slug is required" *> exit' 1) pure (getFlag "--slug" args)
+ users <- readUsersJson configFile
+ userJson <- maybe (liftEffect $ log ("Error: user '" <> slug <> "' not found") *> exit' 1) pure
+ $ find (\u -> (toObject u >>= Object.lookup "slug" >>= toString) == Just slug) users
+ dbFile <- maybe (throwError $ error $ "Cannot read databaseFile for user '" <> slug <> "'") pure
+ $ toObject userJson >>= Object.lookup "config" >>= toObject >>= Object.lookup "databaseFile" >>= toString
+ defaultDir <- liftEffect cwd
+ mDbPath <- liftEffect $ lookupEnv "DATABASE_PATH"
+ let fullPath = resolvePath defaultDir mDbPath dbFile
+ conn <- Db.connect fullPath
+ Db.run conn "DELETE FROM api_tokens WHERE slug = ?" [ unsafeCoerce slug ]
+ mToken <- Db.getOrCreateToken conn slug
+ liftEffect $ for_ mToken \token ->
+ log $ "New token for '" <> slug <> "': " <> token
listUsers :: String -> Aff Unit
listUsers configFile = do
diff --git a/users.dhall b/users.dhall
@@ -1,3 +1,9 @@
+-- DEPRECATED: users.dhall is no longer the source of truth.
+-- Manage users directly in users.json using the CLI:
+-- node server.js add-user --slug <slug> --db <file> [--name <name>]
+-- node server.js list-users
+-- node server.js reset-token --slug <slug>
+
let UserConfig =
{ name : Optional Text
, listenbrainzUser : Optional Text
