commit 167070c7b13dd2df2eb999ad87d65e18a1388083 from: mtmn date: Tue Jul 14 10:50:58 2026 UTC feat: add registration flow commit - 53d48eae03076a0f08cea6c78b5e85807e2406b9 commit + 167070c7b13dd2df2eb999ad87d65e18a1388083 blob - 99860fffb3892127fbbdab7a09e5829e1a31b806 blob + 6af0ed2602919ecab355ad7fdca3f4509c44e2df --- .env.example +++ .env.example @@ -7,3 +7,12 @@ AWS_ACCESS_KEY_ID= AWS_SECRET_ACCESS_KEY= AWS_S3_ADDRESSING_STYLE= AWS_ENDPOINT_URL= +REGISTRATION_ENABLED= +ADMIN_TOKEN= +ADMIN_EMAIL= +CORPUS_REGISTRATIONS_DB= +SMTP_HOST= +SMTP_PORT= +SMTP_USER= +SMTP_PASS= +SMTP_FROM= blob - cde7042199852340b13d1dbf1f9b8463fb00801a blob + 14d4b8228fae0306870ac7648d6d13b81ba33521 --- README.md +++ README.md @@ -93,7 +93,31 @@ The endpoint accepts standard ListenBrainz JSON payloa | `COSINE_API_KEY` | — | [cosine.club](https://cosine.club) API key for similar tracks | | `METRICS_ENABLED` | `false` | Set to `true` to expose Prometheus metrics at `/metrics` | | `CORS_ORIGIN` | `*` | Value for the `Access-Control-Allow-Origin` header on `/proxy` responses (e.g. `https://mtmn.name`) | +| `REGISTRATION_ENABLED` | `false` | Set to `true` to allow public self-registration at `/register` | +| `ADMIN_TOKEN` | — | Secret for the admin approval page at `/admin`; when unset, all admin routes 404 | +| `ADMIN_EMAIL` | — | Address notified by email when a new registration arrives | +| `CORPUS_REGISTRATIONS_DB` | `registrations.db` | Shared DuckDB file holding pending/approved/denied registrations | +| `SMTP_HOST` | — | SMTP server host for notification email (email is skipped if unset) | +| `SMTP_PORT` | `587` | SMTP port (STARTTLS) | +| `SMTP_USER` | — | SMTP username | +| `SMTP_PASS` | — | SMTP password | +| `SMTP_FROM` | — | From address for notification email | +### User self-registration & admin approval + +When `REGISTRATION_ENABLED=true`, visitors can request an account at `/register` +(username, name, email, and optional ListenBrainz/Last.fm usernames). Requests are +stored as _pending_ in the shared registrations database. Set `ADMIN_TOKEN` and visit +`/admin` to review them: enter the token (remembered in `localStorage`), then **approve** +(provisions the user live — no restart — and emails them their API token) or **deny** +(emails the requester). Set `ADMIN_EMAIL` + `SMTP_*` to receive/send the notifications; +without SMTP the flow still works and the token is shown in the admin UI on approval. + +Approved users persist as `approved` rows in the registrations database and are +re-loaded automatically at every startup — `users.json` is **not** modified and remains +the manual/static import mechanism (via the `add-user` CLI). If a slug is defined in both +`users.json` and an approved registration, the `users.json` entry wins. + ### Per-user configuration | Field | Default | Description | blob - 66d1154b5585c7c3d9e38838315833abeecd022c blob + d9fb2294a30528aac890909fc858c5f7f6cecf3c --- flake.lock +++ flake.lock @@ -51,11 +51,11 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1783604885, - "narHash": "sha256-tzMgSkV7kljEkqIjlgV6F+n+xD+/a35Db8bs7a4BFAo=", + "lastModified": 1783915482, + "narHash": "sha256-FmieJB8/OUvNxbkboi7+IGfIuSXY3nF/hZQm8kD0r50=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "767b0d3ec98a143ad9ed7dfc0d5553510ac27133", + "rev": "6cdc7fc76e8bf7fde9fa43a849fcaaa70e230dee", "type": "github" }, "original": { blob - aea659b15e7ddb0c66f84b122b711782450ec242 blob + 39f7a209508cf1f2778b455e20a58f5f9df7c526 --- flake.nix +++ flake.nix @@ -26,15 +26,15 @@ spagoRegistry = pkgs.fetchFromGitHub { owner = "purescript"; repo = "registry"; - rev = "9ec4b408f38d1b61069922991c86ce63a0a30022"; - hash = "sha256-pmfd6F7x8ZSEwwzJR2pzT5cvK5S1YNdZW31WhpiyfPw="; + rev = "f45e502e1948f502fca991fc064aa47b75b6eb75"; + hash = "sha256-+HEfqZv2z4eRjTqrbL0P8HF7VVOdbrQSR66mtJTing8="; }; spagoRegistryIndex = pkgs.fetchFromGitHub { owner = "purescript"; repo = "registry-index"; - rev = "c7ad501685bfbbeb1192ff3d2f19e23a2cf0e48b"; - hash = "sha256-J5SUrDrRNIRRHwyQ/k7oZi+oBXmtvcBUGs/Auf1YdzY="; + rev = "74d03082985d2e167f66b360153810edf3278fe1"; + hash = "sha256-wX19WiY9rE/C0KsMFLchnqpMfjL2QXUIXPD1wpNwDdU="; }; registryDat = generateRegistryDat {elmLock = ./elm.lock;}; @@ -58,7 +58,7 @@ name = "corpus-pnpm-source"; }; pname = "corpus"; - hash = "sha256-/cUYadYeNoFyStuEE4Ztc5jToY4BsJ2/a+CMh35OmWA="; + hash = "sha256-OFwbchn99xlSUym2wh11TrYMJmLyGAe4atkRp863xzs="; fetcherVersion = 4; }; @@ -66,7 +66,7 @@ name = "corpus-spago-deps"; outputHashAlgo = "sha256"; outputHashMode = "recursive"; - outputHash = "sha256-sdor+SLxjw/e+OQeBiEyKyWeBLVaGo2tcAxf06vxth8="; + outputHash = "sha256-Roj/G7HhLjA6PKNBt7YA9LIxP0jLc6BdnIpKDgSJvPo="; src = pkgs.lib.cleanSourceWith { src = self; blob - 4fdeab0935fe7ca5baec4c4901d6857d01b93557 blob + 943a58cf61f839fd3e162f94fa472eb1233bf868 --- package.json +++ package.json @@ -1,33 +1,34 @@ { - "name": "corpus", - "version": "2.23.2", - "description": "ListenBrainz and Last.fm frontend", - "main": "index.js", - "type": "module", - "scripts": { - "build": "spago build && esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:@duckdb/node-api --external:@aws-sdk/client-s3 --external:@aws-sdk/s3-request-presigner --external:prom-client --external:sharp --external:uuid && elm make src/Client.elm --output=client.js", - "release": "spago build && purs-backend-es build && esbuild output-es/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:@duckdb/node-api --external:@aws-sdk/client-s3 --external:@aws-sdk/s3-request-presigner --external:prom-client --external:sharp --external:uuid && elm make src/Client.elm --optimize --output=client.js && uglifyjs client.js --compress \"pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe\" | uglifyjs --mangle --output client.js", - "test": "spago test", - "tidy": "purs-tidy format-in-place src/**/*.purs" - }, - "devDependencies": { - "esbuild": "^0.28.1", - "purescript-language-server": "^0.18.5", - "purescript-psa": "^0.9.0", - "purs-backend-es": "^1.4.3", - "purs-tidy": "^0.11.1", - "spago": "^1.0.4", - "uglify-js": "^3.19.3", - "whine": "^0.0.34" - }, - "dependencies": { - "@aws-sdk/client-s3": "^3.1079.0", - "@aws-sdk/s3-request-presigner": "^3.1079.0", - "@duckdb/node-api": "1.5.4-r.1", - "dotenv": "^17.4.2", - "prom-client": "^15.1.3", - "purescript": "^0.15.16", - "sharp": "^0.35.3", - "uuid": "^14.0.1" - } + "name": "corpus", + "version": "2.23.2", + "description": "ListenBrainz and Last.fm frontend", + "main": "index.js", + "type": "module", + "scripts": { + "build": "spago build && esbuild output/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:@duckdb/node-api --external:@aws-sdk/client-s3 --external:@aws-sdk/s3-request-presigner --external:prom-client --external:sharp --external:uuid --external:nodemailer && elm make src/Client.elm --output=client.js", + "release": "spago build && purs-backend-es build && esbuild output-es/Main/index.js --bundle --platform=node --format=esm --footer:js='main();' --outfile=server.js --external:http --external:https --external:dotenv --external:url --external:@duckdb/node-api --external:@aws-sdk/client-s3 --external:@aws-sdk/s3-request-presigner --external:prom-client --external:sharp --external:uuid --external:nodemailer && elm make src/Client.elm --optimize --output=client.js && uglifyjs client.js --compress \"pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe\" | uglifyjs --mangle --output client.js", + "test": "spago test", + "tidy": "purs-tidy format-in-place src/**/*.purs" + }, + "devDependencies": { + "esbuild": "^0.28.1", + "purescript-language-server": "^0.18.5", + "purescript-psa": "^0.9.0", + "purs-backend-es": "^1.4.3", + "purs-tidy": "^0.11.1", + "spago": "^1.0.4", + "uglify-js": "^3.19.3", + "whine": "^0.0.34" + }, + "dependencies": { + "@aws-sdk/client-s3": "^3.1085.0", + "@aws-sdk/s3-request-presigner": "^3.1085.0", + "@duckdb/node-api": "1.5.4-r.1", + "dotenv": "^17.4.2", + "nodemailer": "^6.10.1", + "prom-client": "^15.1.3", + "purescript": "^0.15.16", + "sharp": "^0.35.3", + "uuid": "^14.0.1" + } } blob - 33705b8899b65be39e8cdef9d5ed3db2122ca1f2 blob + 45c95ca5466bef353104ecd6543bfc8014fdf3ef --- pnpm-lock.yaml +++ pnpm-lock.yaml @@ -9,17 +9,20 @@ importers: .: dependencies: '@aws-sdk/client-s3': - specifier: ^3.1079.0 - version: 3.1079.0 + specifier: ^3.1085.0 + version: 3.1085.0 '@aws-sdk/s3-request-presigner': - specifier: ^3.1079.0 - version: 3.1079.0 + specifier: ^3.1085.0 + version: 3.1085.0 '@duckdb/node-api': specifier: 1.5.4-r.1 version: 1.5.4-r.1 dotenv: specifier: ^17.4.2 version: 17.4.2 + nodemailer: + specifier: ^6.10.1 + version: 6.10.1 prom-client: specifier: ^15.1.3 version: 15.1.3 @@ -60,76 +63,76 @@ importers: packages: - '@aws-sdk/checksums@3.1000.12': - resolution: {integrity: sha512-RgNDWfhNRIlNEzePIRrYTNi/6q+wwRMMapojn8YVzw4ZcJRa/gxVMtUbeZARR1gmopuv6oIhMbY7J66qIQ0ynw==} + '@aws-sdk/checksums@3.1000.16': + resolution: {integrity: sha512-EKnvkXSmz3IpA99tCNuI+dLFXyZyClSm8zns9sB/elvkU+MTuomAs6toJMPMBf98/fICG/urXDkzGz0/c3yyAQ==} engines: {node: '>=20.0.0'} - '@aws-sdk/client-s3@3.1079.0': - resolution: {integrity: sha512-di9U/7Po7qlVYb2dq58ULsbBAE1pBIk53rux+50LQCvH1X+/l1Ys+BIk/QLBtdaK1nADk0xRNEBbA1QWVnMccw==} + '@aws-sdk/client-s3@3.1085.0': + resolution: {integrity: sha512-O0xe8sR50AYkwxlvRRsV0qytEO2dtXQTQ1CF3YBBdE5xtVkbu27H0vGa1mjQi1/+fbYM80AWEIPai5jZmXyubw==} engines: {node: '>=20.0.0'} - '@aws-sdk/core@3.974.27': - resolution: {integrity: sha512-WRWEgIq6vx+NU6ot3VrRu4Jovj9MIObitSi6of/GV5THDDPccBhivCRNkWJutMM+m3GvdeI3l/UbGNcoOobxOA==} + '@aws-sdk/core@3.975.1': + resolution: {integrity: sha512-8qh/6EYb7hl/ZwVfQufhbMEZs1gQIc7GbdrIf4eprQJ7cv042+74nE6l3YDfyWNzb9iPXb8fRyYSHkNIk5eE6Q==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-env@3.972.53': - resolution: {integrity: sha512-+KDA3uc/HZ1vIneGu5QMQb0gAXDYrm2vOE60+BJ7lS0YinMQ5i2oV4PR1A16XkF6K1IbSwjEHd1hQIIgMsK48w==} + '@aws-sdk/credential-provider-env@3.972.57': + resolution: {integrity: sha512-1RfJaF7SW1TOnvNGU7kaYjwUf5H3sfm+synGH1bHhRlqcnxCt3szebH3dmKEyY4tuGcbQ6ffzUT89cRitBV8OQ==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-http@3.972.55': - resolution: {integrity: sha512-1gBfkWY3RWeBlCoB9lIJjXMx45/54wxcgfzv6BY9otTmMrZPcNPi1v+MwZxxaCUg441NV3jsr1efnFNCXiW70g==} + '@aws-sdk/credential-provider-http@3.972.59': + resolution: {integrity: sha512-sRCkpTiFnCdQvuaRVjQ6SVoHu6i7RUpurVo1c4F81HWhPvUJ7Wdp5MNtSdX1O29CNXc8em3O5m52hCjVtAD9SA==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-ini@3.972.60': - resolution: {integrity: sha512-CV2md+PXvABwRjApWGhQ0wACy9WSFIhnUGrovLcjnjBCd/46TbuivLADtkF8IWNjtCQmQ+2IagSaxqBYqXBNAQ==} + '@aws-sdk/credential-provider-ini@3.973.1': + resolution: {integrity: sha512-6d8H6ZAh3ZPKZ6fe1nG2OWeZEZPtt9ravoD1dezPdPtsSkJRoxGAnFSHwKT3E/Te6fHE30zRzjV6TD12rvF6yQ==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-login@3.972.59': - resolution: {integrity: sha512-JG4S9yyA1GFzJdJXqLKrUzZbyK+VDp2QIsJD7YOicJHAhqymfHpDJIok2dLnhOdVB0I37RjdC53uOwCMVS00gw==} + '@aws-sdk/credential-provider-login@3.972.63': + resolution: {integrity: sha512-GREWRrMj0XnNKMaVa/Mauoaui26qBEHu71WWqXbwZOu/jFQOnPZjTf7u0KtGKC8VGa6VUs9kDWGgocrKNLS9vw==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-node@3.972.62': - resolution: {integrity: sha512-S6Slq3Tx7bvFk5yc34XNADyZYTX2HUXvaFAnowGRQnhjBO8J/mP62Fn7lxvJwjaDyYm/7gh9h6HEHaltRyMFXw==} + '@aws-sdk/credential-provider-node@3.972.66': + resolution: {integrity: sha512-f+qjRXZpz7sgzbc4QB+6nLKfyKFgRRXzWdXbsKPv/VhVRyHsDyq4yBWC/B75BAJpFIcUeI2XR/3gdWJ677zB4A==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-process@3.972.53': - resolution: {integrity: sha512-EhfH+MQlqOMCkXIVa8MMObPzAQqwTTtxA7KhEJiyPeuNVA8PLOOUpgK7nBrgaDaGiIDLN/9LpGdaHuDjomeRTw==} + '@aws-sdk/credential-provider-process@3.972.57': + resolution: {integrity: sha512-TiVQhuU0pbhIZAUZacbPHMyzrIdiH+lnx+PMY/Pu/b93dJrq3wdZwzUJ0TPpvNxaqbHsxJvQZW3/h/beLiKq7Q==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-sso@3.972.59': - resolution: {integrity: sha512-h8793pOjcImx0SB+VcLONcaQQ57VAvKVuqyewQMRKqqH+CSXsG2dwOeLMUJPMxLdNvL7dXOM0ueTukyNUnu5mA==} + '@aws-sdk/credential-provider-sso@3.973.1': + resolution: {integrity: sha512-3foTZUJ4821Ij60X7K3NJroygiZLnbBmarN+T//O2cjkISan90zElN3NBmgSlDrTQ7Gs6z/yO8V7h60QNcDZHQ==} engines: {node: '>=20.0.0'} - '@aws-sdk/credential-provider-web-identity@3.972.59': - resolution: {integrity: sha512-VoyO9+vl3XVmpZwn4obskrWIkrA/Jf3lSe1E3ZERlaN9u0D4YZ6+HywC3+L98QOXqZesEfedk67gRER8tK8+8w==} + '@aws-sdk/credential-provider-web-identity@3.972.63': + resolution: {integrity: sha512-8qZLFhM69eKcS37m459ctPR05Qimycm/74OPVioe6wNZabMT54GYhwBju0+J656RkMasNSawWQu+c8CmBe3TUQ==} engines: {node: '>=20.0.0'} - '@aws-sdk/middleware-sdk-s3@3.972.58': - resolution: {integrity: sha512-6uaWRRYJGhOqc9EoTSbLDf9nI/doSAb5vAwGshs5/Hlv5Ce25b246lBkbRd/77fLAi+uMI1a70mJzVyLyCEufQ==} + '@aws-sdk/middleware-sdk-s3@3.972.62': + resolution: {integrity: sha512-k8JJwYXVYlOOjWnPZDThQS1xDFJgi5Dokt73qFlDtrZAbdcint5aIdjB9XgJAAQVP5OoqcefQmh1FYXiPpvsvw==} engines: {node: '>=20.0.0'} - '@aws-sdk/nested-clients@3.997.27': - resolution: {integrity: sha512-A8PIePF9NIIOJ/4Lg1rl9xm/+QaKkHGetq+Z9wb5B+3Da31YYXRo8n7IDMh5C+HQI5eyEmjrwkGWVdYtnLtbXQ==} + '@aws-sdk/nested-clients@3.997.31': + resolution: {integrity: sha512-BDHTpwcsZHEBNEJzOg/B1BkFYJxAXY50dau/NyVWs3d51F0WgIUGSWZot/Os+N3KpDhXeaXnz37mWffAvduREw==} engines: {node: '>=20.0.0'} - '@aws-sdk/s3-request-presigner@3.1079.0': - resolution: {integrity: sha512-NfHUaND7WyLUPkO7HCF3MFg4bdscY34A4tm4dPWa31qYzhGNZarRPr/CcRgllxzPoOSD/EHfZ4fQtZnMl2xWFg==} + '@aws-sdk/s3-request-presigner@3.1085.0': + resolution: {integrity: sha512-h8fv0zGAHPCjCpmAYdCeFE6trxXxLRxza0NRIajMZdnFgugtcIWcRAdAtc7rHvRTaXsej/I5YWXbq9SgKuCKow==} engines: {node: '>=20.0.0'} - '@aws-sdk/signature-v4-multi-region@3.996.38': - resolution: {integrity: sha512-C379Sk+MiFZCfWZphKlMyLHKxV22OjoGM5KJjj5IJNJcOCWL4IGIpnEGzv1FQiRwhYXfq55SJMfxlqPE08JJ9g==} + '@aws-sdk/signature-v4-multi-region@3.996.39': + resolution: {integrity: sha512-8+srXqYIF8KYMLC4FxMLEM5Ek7kUNibJu1R4m8/fUhhNYIZZz26oGtKkCr8I/HiG2fFQxBvaGgQZT4/mqRCSnA==} engines: {node: '>=20.0.0'} - '@aws-sdk/token-providers@3.1079.0': - resolution: {integrity: sha512-cbietrLlHPhhmbnMPTuDS4Zj/KNGhY+3vVhn6dwjO6Dqzrwothzg2srtcY34T9mlICsTXn34avDoWLHSntP54A==} + '@aws-sdk/token-providers@3.1083.0': + resolution: {integrity: sha512-s0woKnxuHrExLc5L2ArIH5BMkbonHPtt+5hSBM8oknp9M6QTuUmmAmJ2E0EdzCGONrO+8+ADPqvv6UX0nNcc7A==} engines: {node: '>=20.0.0'} - '@aws-sdk/types@3.973.15': - resolution: {integrity: sha512-IULn8uBV/SMtmOIANsm4WHXIOtVPBWfOWs3WGL0j/sI+KhaYehvOw0ET+9urnn8MBpiijuU/0JOpuwKOE451PQ==} + '@aws-sdk/types@3.974.0': + resolution: {integrity: sha512-QIBrw90CDm4O0UaIIzkU6DrFdeJzEb2Va5EPEVpyldj6sHJxB6cshhStJuhZxk3wR3PmjJlYsjPmY1kNb+KGBg==} engines: {node: '>=20.0.0'} - '@aws-sdk/xml-builder@3.972.33': - resolution: {integrity: sha512-ezbwz9WpuLctm6o7P2t2naDhVVPI5jFGrVefVybhcKGjU57VIyT46pQVO0RI2RYkUdhdj2Z9uSIlAzGZE9NW9A==} + '@aws-sdk/xml-builder@3.972.34': + resolution: {integrity: sha512-wHhWL1y7sN3enBA8POrPpQM5jCcmu2ozyhbRei4c8OjVcEaEs6yLucLa/pla457ggS/ysuy7bosagz3HaJkZXA==} engines: {node: '>=20.0.0'} '@aws/lambda-invoke-store@0.3.0': @@ -543,28 +546,28 @@ packages: resolution: {integrity: sha512-gLyJlPHPZYdAk1JENA9LeHejZe1Ti77/pTeFm/nMXmQH/HFZlcS/O2XJB+L8fkbrNSqhdtlvjBVjxwUYanNH5Q==} engines: {node: '>=8.0.0'} - '@smithy/core@3.29.1': - resolution: {integrity: sha512-qoiY4nrk5OCu1+eIR1VB8l5DmON/oKiqrd5zZFAhXJXjJlLWQusKEW/SkBDAtGDcPaz86m9kfcE1lngU0GlM6A==} + '@smithy/core@3.29.3': + resolution: {integrity: sha512-L+Ys6ecjk5vwPMAKHBpPKlJ3DkqwNcnfEISXBZIsVvWG/XKXfsAP8mwIYlTeLcd2ElHdesPI8OuOmJSFAPhm6A==} engines: {node: '>=18.0.0'} - '@smithy/credential-provider-imds@4.4.6': - resolution: {integrity: sha512-B2WQ/PV/H6Jeg3lrIq6bKUfa6Hy01mtK7CGs6lhjzHA6k4aagldH6T6eEjnzKl4HI0cJnAsxfJ19pgb5PV+CVQ==} + '@smithy/credential-provider-imds@4.4.8': + resolution: {integrity: sha512-q9J7JTiXrAhB8sDp4px97uEPT7CwKH61Co78grdNQvU8QZAdiuaSRhP0tUVf2ogy36RZTrlMU1rBmDEH+cnkiA==} engines: {node: '>=18.0.0'} - '@smithy/fetch-http-handler@5.6.3': - resolution: {integrity: sha512-CwCc/7SMTj45y97MUnDTbTaxvtAsiNNRm81z3abROIuMbMsC2Iy5EKfkkVdsKrz8WExQAAMx1EJapq+9j4fFTQ==} + '@smithy/fetch-http-handler@5.6.5': + resolution: {integrity: sha512-SuqeisTyPoiIPtIYru/sGxGyXzmZ+8nnFOhC+qRPglt06Ebd1yH//CDltZB2J/3WBNVhwfUaZ0EtHB3cm2X32g==} engines: {node: '>=18.0.0'} - '@smithy/node-http-handler@4.9.3': - resolution: {integrity: sha512-qZTa4gQFUo8RM02rk6q5UVTDLNrQ1oS20LsepBzqq1QBVc/EHJ03OOUADcqMZiXHArW+Y7+OGY0BpdTwZRq/Yg==} + '@smithy/node-http-handler@4.9.5': + resolution: {integrity: sha512-bNqdxTQTxmLbomSmlkZFz8L6B/feQ2HHzw4L2zY7Ecp2XffYAZq2uzdWDdxJHJFbEvqd+SRuluJso0P8+xPdbw==} engines: {node: '>=18.0.0'} - '@smithy/signature-v4@5.6.2': - resolution: {integrity: sha512-QgHflghMoPxCJ9axiCVh8KZfbC9fuP6vkXXyK//E3cq7nLaSSyyLj0GAoqVWezYeDQmXIZhmlRvLE16jsqDK6g==} + '@smithy/signature-v4@5.6.4': + resolution: {integrity: sha512-B89bpf2t/y/wia6LZ+4JfHXYQT9PnVftsH05rgJKKIStS7r/4XSs9HOjtPoLtgcA6HCW9jVqX5DBbq7E0PAkiQ==} engines: {node: '>=18.0.0'} - '@smithy/types@4.15.1': - resolution: {integrity: sha512-x3L0XSACF6UYzKpa9biqiRMgvH5+wnFFew9Tm/grFYqgaupPwx/+ojDPpPJM8dZON3S9tjz5U+PQYsCBd1Mw5Q==} + '@smithy/types@4.16.1': + resolution: {integrity: sha512-0JFs3V2y2M9tKW5na/qxe69Zv+uxLMO7QBbhxF/FHu/Gp2NFZAAL9tWl9PU02xxo07pb3G9FTyjNc6D5uZrJIg==} engines: {node: '>=18.0.0'} '@tootallnate/once@2.0.1': @@ -631,11 +634,11 @@ packages: bowser@2.14.1: resolution: {integrity: sha512-tzPjzCxygAKWFOJP011oxFHs57HzIhOEracIgAePE4pqB3LikALKnSzUyU4MGs9/iCEUuHlAJTjTc5M+u7YEGg==} - brace-expansion@1.1.15: - resolution: {integrity: sha512-EwOCDEex4quD37XhqM3omwtMoJjr//isUZz1JopUNWms+4Z2ViyM/k1YIRePpoVNnQhENnxtFjLaxNHrT7xIUg==} + brace-expansion@1.1.16: + resolution: {integrity: sha512-IDw48K2/2kRkg9LdJxurvq3lV3aBgq0REY89duEqFRthjlPdXHKMj7EnQOXVckxzgisinf3nHfrcE2FufFLXMw==} - brace-expansion@2.1.1: - resolution: {integrity: sha512-WR1cURNjuvBLMZBMbqM0UoE+WAfdUcEV1ccD8PVBVOI+Z3ND4+SZbN8RsfT2bMuG1qwz5RFvPukSZm5fF2D5eA==} + brace-expansion@2.1.2: + resolution: {integrity: sha512-w5JZcKgdhDOgOwm8H+KgbosopHMuGcl6qbulwjtz3SM7I7P3yW1eAjzMPLrIE+NQ9vjgANKHWeMHnrT0OXW1oA==} brace-expansion@5.0.7: resolution: {integrity: sha512-7oFy703dxfY3/NLxC1fh2SUCQ0H9rmAY+5EpDVfXjUTTs+HEwR2nYaqLv+GWcTsumwxPfiz6CzCNkwXwBUwqCA==} @@ -967,8 +970,8 @@ packages: resolution: {integrity: sha512-9fkkDevMefjg0mmzWFBW8YkFP91OrizzkW3diF7CpG+S2EYdy4+TVfGwz1zeF8x7hCx1ovSPTOE9Ngib74qqUg==} engines: {node: '>=10'} - lru-cache@11.5.1: - resolution: {integrity: sha512-RPimw/7aMdv2oqRrxKwvZXcPfwBrn/JZ2xYcY9Hus/6LaS3VOAKVWKWgNLCFSiOm1ESXinjsDlidVU7JlnCN2A==} + lru-cache@11.5.2: + resolution: {integrity: sha512-4pfM1Ff0x50o0tQwb5ucw/RzNyD0/YJME6IVcStalZuMWxdt3sR3huStTtxz4PUmvZfRguvDejasvQ2kifR11g==} engines: {node: 20 || >=22} lru-cache@5.1.1: @@ -1081,6 +1084,10 @@ packages: resolution: {integrity: sha512-myRT3DiWPHqho5PrJaIRyaMv2kgYf0mUVgBNOYMuCH5Ki1yEiQaf/ZJuQ62nvpc44wL5WDbTX7yGJi1Neevw8w==} engines: {node: '>= 0.6'} + nodemailer@6.10.1: + resolution: {integrity: sha512-Z+iLaBGVaSjbIzQ4pX6XV41HrooLsQ10ZWPUehGmuantvzWoDVBnmsdUcOIDM1t+yPor5pDhVlDESgOMEGxhHA==} + engines: {node: '>=6.0.0'} + npm-run-path@3.1.0: resolution: {integrity: sha512-Dbl4A/VfiVGLgQv29URL9xshU8XDY1GeLy+fsaZ1AA8JDSfjvr5P5+pzRbWqRSBxk6/DW7MIh8lTM/PaGnP2kg==} engines: {node: '>=8'} @@ -1262,8 +1269,8 @@ packages: resolution: {integrity: sha512-7++dFhtcx3353uBaq8DDR4NuxBetBzC7ZQOhmTQInHEd6bSrXdiEyzCvG07Z44UYdLShWUyXt5M/yhz8ekcb1A==} engines: {node: '>=8'} - shell-quote@1.9.0: - resolution: {integrity: sha512-Iov+JwFv/2HcTpcwNMKd8+IWNb8tboQJNQTkAY/LLVK7gGH9jy+LGkVqPxfekHl+yMmiqXszdGWXgkfml7hjqA==} + shell-quote@1.10.0: + resolution: {integrity: sha512-w1aiOKwKuRgtwAReIIj89puqg+I7GvX4IbLrvmhXbzQsj1+Zwi4VO3+fa6ZF91TWSjIxoEkKnMeHcLEODK5ZXA==} engines: {node: '>= 0.4'} signal-exit@3.0.7: @@ -1348,8 +1355,8 @@ packages: engines: {node: '>=10'} deprecated: Old versions of tar are not supported, and contain widely publicized security vulnerabilities, which have been fixed in the current version. Please update. Support for old versions may be purchased (at exorbitant rates) by contacting i@izs.me - tar@7.5.19: - resolution: {integrity: sha512-4LeEWl96twnS2Q7Bz4MGqgazLqO+hJN63GZxXoIqh1T3VweYD997gbU1ItNsQafqqXTXd5WFyFdReLtwvRBNiw==} + tar@7.5.20: + resolution: {integrity: sha512-9FcyK4PA6+WbzlTM9WhQm6vB5W7cP7dUiPsv1g7YDwEQnQ1CGpK3MGlKk/ITVWMk05kHZuBhmVhiv8LZoy/PFQ==} engines: {node: '>=18'} tdigest@0.1.2: @@ -1496,176 +1503,176 @@ packages: snapshots: - '@aws-sdk/checksums@3.1000.12': + '@aws-sdk/checksums@3.1000.16': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/client-s3@3.1079.0': + '@aws-sdk/client-s3@3.1085.0': dependencies: - '@aws-sdk/checksums': 3.1000.12 - '@aws-sdk/core': 3.974.27 - '@aws-sdk/credential-provider-node': 3.972.62 - '@aws-sdk/middleware-sdk-s3': 3.972.58 - '@aws-sdk/signature-v4-multi-region': 3.996.38 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/fetch-http-handler': 5.6.3 - '@smithy/node-http-handler': 4.9.3 - '@smithy/types': 4.15.1 + '@aws-sdk/checksums': 3.1000.16 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/credential-provider-node': 3.972.66 + '@aws-sdk/middleware-sdk-s3': 3.972.62 + '@aws-sdk/signature-v4-multi-region': 3.996.39 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/fetch-http-handler': 5.6.5 + '@smithy/node-http-handler': 4.9.5 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/core@3.974.27': + '@aws-sdk/core@3.975.1': dependencies: - '@aws-sdk/types': 3.973.15 - '@aws-sdk/xml-builder': 3.972.33 + '@aws-sdk/types': 3.974.0 + '@aws-sdk/xml-builder': 3.972.34 '@aws/lambda-invoke-store': 0.3.0 - '@smithy/core': 3.29.1 - '@smithy/signature-v4': 5.6.2 - '@smithy/types': 4.15.1 + '@smithy/core': 3.29.3 + '@smithy/signature-v4': 5.6.4 + '@smithy/types': 4.16.1 bowser: 2.14.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-env@3.972.53': + '@aws-sdk/credential-provider-env@3.972.57': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-http@3.972.55': + '@aws-sdk/credential-provider-http@3.972.59': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/fetch-http-handler': 5.6.3 - '@smithy/node-http-handler': 4.9.3 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/fetch-http-handler': 5.6.5 + '@smithy/node-http-handler': 4.9.5 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-ini@3.972.60': + '@aws-sdk/credential-provider-ini@3.973.1': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/credential-provider-env': 3.972.53 - '@aws-sdk/credential-provider-http': 3.972.55 - '@aws-sdk/credential-provider-login': 3.972.59 - '@aws-sdk/credential-provider-process': 3.972.53 - '@aws-sdk/credential-provider-sso': 3.972.59 - '@aws-sdk/credential-provider-web-identity': 3.972.59 - '@aws-sdk/nested-clients': 3.997.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/credential-provider-imds': 4.4.6 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/credential-provider-env': 3.972.57 + '@aws-sdk/credential-provider-http': 3.972.59 + '@aws-sdk/credential-provider-login': 3.972.63 + '@aws-sdk/credential-provider-process': 3.972.57 + '@aws-sdk/credential-provider-sso': 3.973.1 + '@aws-sdk/credential-provider-web-identity': 3.972.63 + '@aws-sdk/nested-clients': 3.997.31 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/credential-provider-imds': 4.4.8 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-login@3.972.59': + '@aws-sdk/credential-provider-login@3.972.63': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/nested-clients': 3.997.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/nested-clients': 3.997.31 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-node@3.972.62': + '@aws-sdk/credential-provider-node@3.972.66': dependencies: - '@aws-sdk/credential-provider-env': 3.972.53 - '@aws-sdk/credential-provider-http': 3.972.55 - '@aws-sdk/credential-provider-ini': 3.972.60 - '@aws-sdk/credential-provider-process': 3.972.53 - '@aws-sdk/credential-provider-sso': 3.972.59 - '@aws-sdk/credential-provider-web-identity': 3.972.59 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/credential-provider-imds': 4.4.6 - '@smithy/types': 4.15.1 + '@aws-sdk/credential-provider-env': 3.972.57 + '@aws-sdk/credential-provider-http': 3.972.59 + '@aws-sdk/credential-provider-ini': 3.973.1 + '@aws-sdk/credential-provider-process': 3.972.57 + '@aws-sdk/credential-provider-sso': 3.973.1 + '@aws-sdk/credential-provider-web-identity': 3.972.63 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/credential-provider-imds': 4.4.8 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-process@3.972.53': + '@aws-sdk/credential-provider-process@3.972.57': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-sso@3.972.59': + '@aws-sdk/credential-provider-sso@3.973.1': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/nested-clients': 3.997.27 - '@aws-sdk/token-providers': 3.1079.0 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/nested-clients': 3.997.31 + '@aws-sdk/token-providers': 3.1083.0 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/credential-provider-web-identity@3.972.59': + '@aws-sdk/credential-provider-web-identity@3.972.63': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/nested-clients': 3.997.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/nested-clients': 3.997.31 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/middleware-sdk-s3@3.972.58': + '@aws-sdk/middleware-sdk-s3@3.972.62': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/signature-v4-multi-region': 3.996.38 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/signature-v4-multi-region': 3.996.39 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/nested-clients@3.997.27': + '@aws-sdk/nested-clients@3.997.31': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/signature-v4-multi-region': 3.996.38 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/fetch-http-handler': 5.6.3 - '@smithy/node-http-handler': 4.9.3 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/signature-v4-multi-region': 3.996.39 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/fetch-http-handler': 5.6.5 + '@smithy/node-http-handler': 4.9.5 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/s3-request-presigner@3.1079.0': + '@aws-sdk/s3-request-presigner@3.1085.0': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/signature-v4-multi-region': 3.996.38 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/signature-v4-multi-region': 3.996.39 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/signature-v4-multi-region@3.996.38': + '@aws-sdk/signature-v4-multi-region@3.996.39': dependencies: - '@aws-sdk/types': 3.973.15 - '@smithy/signature-v4': 5.6.2 - '@smithy/types': 4.15.1 + '@aws-sdk/types': 3.974.0 + '@smithy/signature-v4': 5.6.4 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/token-providers@3.1079.0': + '@aws-sdk/token-providers@3.1083.0': dependencies: - '@aws-sdk/core': 3.974.27 - '@aws-sdk/nested-clients': 3.997.27 - '@aws-sdk/types': 3.973.15 - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@aws-sdk/core': 3.975.1 + '@aws-sdk/nested-clients': 3.997.31 + '@aws-sdk/types': 3.974.0 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/types@3.973.15': + '@aws-sdk/types@3.974.0': dependencies: - '@smithy/types': 4.15.1 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@aws-sdk/xml-builder@3.972.33': + '@aws-sdk/xml-builder@3.972.34': dependencies: - '@smithy/types': 4.15.1 + '@smithy/types': 4.16.1 tslib: 2.8.1 '@aws/lambda-invoke-store@0.3.0': {} @@ -1932,36 +1939,36 @@ snapshots: '@opentelemetry/api@1.9.1': {} - '@smithy/core@3.29.1': + '@smithy/core@3.29.3': dependencies: - '@smithy/types': 4.15.1 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@smithy/credential-provider-imds@4.4.6': + '@smithy/credential-provider-imds@4.4.8': dependencies: - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@smithy/fetch-http-handler@5.6.3': + '@smithy/fetch-http-handler@5.6.5': dependencies: - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@smithy/node-http-handler@4.9.3': + '@smithy/node-http-handler@4.9.5': dependencies: - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@smithy/signature-v4@5.6.2': + '@smithy/signature-v4@5.6.4': dependencies: - '@smithy/core': 3.29.1 - '@smithy/types': 4.15.1 + '@smithy/core': 3.29.3 + '@smithy/types': 4.16.1 tslib: 2.8.1 - '@smithy/types@4.15.1': + '@smithy/types@4.16.1': dependencies: tslib: 2.8.1 @@ -2020,12 +2027,12 @@ snapshots: bowser@2.14.1: {} - brace-expansion@1.1.15: + brace-expansion@1.1.16: dependencies: balanced-match: 1.0.2 concat-map: 0.0.1 - brace-expansion@2.1.1: + brace-expansion@2.1.2: dependencies: balanced-match: 1.0.2 @@ -2412,7 +2419,7 @@ snapshots: slice-ansi: 4.0.0 wrap-ansi: 6.2.0 - lru-cache@11.5.1: {} + lru-cache@11.5.2: {} lru-cache@5.1.1: dependencies: @@ -2468,11 +2475,11 @@ snapshots: minimatch@3.1.5: dependencies: - brace-expansion: 1.1.15 + brace-expansion: 1.1.16 minimatch@5.1.9: dependencies: - brace-expansion: 2.1.1 + brace-expansion: 2.1.2 minimist@1.2.8: {} @@ -2552,6 +2559,8 @@ snapshots: negotiator@0.6.4: {} + nodemailer@6.10.1: {} + npm-run-path@3.1.0: dependencies: path-key: 3.1.1 @@ -2591,7 +2600,7 @@ snapshots: path-scurry@2.0.2: dependencies: - lru-cache: 11.5.1 + lru-cache: 11.5.2 minipass: 7.1.3 picomatch@2.3.2: {} @@ -2660,7 +2669,7 @@ snapshots: purescript-language-server@0.18.5: dependencies: - shell-quote: 1.9.0 + shell-quote: 1.10.0 uuid: 9.0.1 vscode-jsonrpc: 8.2.1 vscode-languageserver: 8.1.0 @@ -2766,7 +2775,7 @@ snapshots: shebang-regex@3.0.0: {} - shell-quote@1.9.0: {} + shell-quote@1.10.0: {} signal-exit@3.0.7: {} @@ -2810,7 +2819,7 @@ snapshots: spdx-expression-parse: 4.0.0 ssh2: 1.17.0 supports-color: 10.2.2 - tar: 7.5.19 + tar: 7.5.20 tmp: 0.2.7 xhr2: 0.2.1 yaml: 2.9.0 @@ -2878,7 +2887,7 @@ snapshots: mkdirp: 1.0.4 yallist: 4.0.0 - tar@7.5.19: + tar@7.5.20: dependencies: '@isaacs/fs-minipass': 4.0.1 chownr: 3.0.0 blob - ea4d6b91b397a88cce8471b84f877da25c683783 blob + e3ae02fc7487d776d2ba8adf9be69cad7a78a658 --- spago.lock +++ spago.lock @@ -36,6 +36,7 @@ "now", "prelude", "random", + "refs", "strings", "tailrec", "unsafe-coerce", @@ -61,7 +62,7 @@ }, "package_set": { "address": { - "registry": "77.11.0" + "registry": "77.13.0" }, "compiler": ">=0.15.15 <0.16.0", "content": { @@ -109,6 +110,7 @@ "bolson": "0.3.9", "bookhound": "0.1.7", "bower-json": "3.0.0", + "bytestrings": "9.0.0", "call-by-name": "4.0.1", "canvas": "6.0.0", "canvas-action": "9.0.0", @@ -267,7 +269,7 @@ "heckin": "2.0.1", "heterogeneous": "0.7.0", "homogeneous": "0.4.0", - "http-methods": "6.0.0", + "http-methods": "6.1.0", "httpurple": "4.0.0", "huffman": "0.4.0", "humdrum": "0.0.1", @@ -669,20 +671,20 @@ "yoga-docker-compose": "0.1.1", "yoga-dynamodb": "0.1.1", "yoga-elasticsearch": "0.1.1", - "yoga-fastify": "0.5.2", - "yoga-fastify-om": "0.4.4", + "yoga-fastify": "0.5.3", + "yoga-fastify-om": "0.4.5", "yoga-fetch": "1.0.1", - "yoga-fetch-om": "0.6.3", + "yoga-fetch-om": "0.7.0", "yoga-format": "1.0.0", - "yoga-heroui": "2.0.2", - "yoga-http-api": "0.3.1", + "yoga-heroui": "2.0.3", + "yoga-http-api": "0.3.2", "yoga-jaeger": "0.1.1", "yoga-json": "5.2.1", "yoga-language": "1.0.0", - "yoga-next-fastify": "0.1.1", + "yoga-next-fastify": "0.2.0", "yoga-om": "2.2.0", "yoga-om-layer": "2.1.0", - "yoga-om-strom": "0.4.2", + "yoga-om-strom": "0.4.3", "yoga-om-workerbees": "0.1.2", "yoga-opentelemetry": "0.2.0", "yoga-options": "0.1.1", @@ -1256,8 +1258,8 @@ }, "http-methods": { "type": "registry", - "version": "6.0.0", - "integrity": "sha256-S0UjrJSgwJxEsFHM/pX77dM8V4HfvvDqdHPckQrtxMs=", + "version": "6.1.0", + "integrity": "sha256-WbjEmCv6rysY/aKwlrcspyzShi5bIQy+AFpDzPMnSP4=", "dependencies": [ "either", "prelude", blob - 23de1243eaf6db8cee9a97fac4f5e57a616483fe blob + 3ec194c29780972a0ae818cb72013a41f14f86c4 --- spago.yaml +++ spago.yaml @@ -32,6 +32,7 @@ package: - now - prelude - random + - refs - strings - tailrec - unsafe-coerce @@ -52,5 +53,5 @@ package: - node-process workspace: packageSet: - registry: 77.11.0 + registry: 77.13.0 extraPackages: {} blob - 117e5c6c11447dfb307158ca9cf0565adbddf45d blob + cd9ca27d6a27892bce6b75585170f0adee80ef9b --- src/Api.elm +++ src/Api.elm @@ -1,8 +1,9 @@ -module Api exposing (fetchListens, fetchSectionData, fetchSimilarTracks, fetchStats, httpErrorToString, listensDecoder, sectionEntriesDecoder, similarTracksDecoder, statsDecoder, statsUrl) +module Api exposing (approveRegistration, denyRegistration, fetchListens, fetchRegistrations, fetchSectionData, fetchSimilarTracks, fetchStats, httpErrorToString, listensDecoder, sectionEntriesDecoder, similarTracksDecoder, statsDecoder, statsUrl, submitRegistration) import Http import Json.Decode as D exposing (Decoder) -import Types exposing (ActiveFilter, Listen, Msg(..), Period(..), SimilarTrack, Stats, StatsEntry) +import Json.Encode as E +import Types exposing (ActiveFilter, ApproveResponse, Listen, Msg(..), Period(..), Registration, SimilarTrack, Stats, StatsEntry) import Url @@ -83,6 +84,101 @@ fetchSimilarTracks idx artist track = } +submitRegistration : { slug : String, name : String, email : String, lbUser : String, lfUser : String } -> Cmd Msg +submitRegistration f = + let + optional key val = + if String.isEmpty (String.trim val) then + [] + + else + [ ( key, E.string (String.trim val) ) ] + + body = + E.object + ([ ( "slug", E.string (String.trim f.slug) ) + , ( "name", E.string (String.trim f.name) ) + , ( "email", E.string (String.trim f.email) ) + ] + ++ optional "listenbrainzUser" f.lbUser + ++ optional "lastfmUser" f.lfUser + ) + in + Http.post + { url = "/register" + , body = Http.jsonBody body + , expect = expectWhateverWithError GotRegistrationResult + } + + +{-| Like Http.expectWhatever, but surfaces the server's plaintext error body. +-} +expectWhateverWithError : (Result String () -> msg) -> Http.Expect msg +expectWhateverWithError toMsg = + Http.expectStringResponse toMsg <| + \response -> + case response of + Http.GoodStatus_ _ _ -> + Ok () + + Http.BadStatus_ _ errBody -> + Err + (if String.isEmpty errBody then + "Request failed" + + else + errBody + ) + + Http.BadUrl_ u -> + Err ("Bad URL: " ++ u) + + Http.Timeout_ -> + Err "Request timed out" + + Http.NetworkError_ -> + Err "Network error" + + +fetchRegistrations : String -> Cmd Msg +fetchRegistrations token = + Http.request + { method = "GET" + , headers = [ Http.header "Authorization" ("Bearer " ++ token) ] + , url = "/admin/registrations" + , body = Http.emptyBody + , expect = Http.expectJson GotRegistrations (D.list registrationDecoder) + , timeout = Nothing + , tracker = Nothing + } + + +approveRegistration : String -> String -> Cmd Msg +approveRegistration token id = + Http.request + { method = "POST" + , headers = [ Http.header "Authorization" ("Bearer " ++ token) ] + , url = "/admin/registrations/approve" + , body = Http.jsonBody (E.object [ ( "id", E.string id ) ]) + , expect = Http.expectJson GotApproveResult approveResponseDecoder + , timeout = Nothing + , tracker = Nothing + } + + +denyRegistration : String -> String -> Cmd Msg +denyRegistration token id = + Http.request + { method = "POST" + , headers = [ Http.header "Authorization" ("Bearer " ++ token) ] + , url = "/admin/registrations/deny" + , body = Http.jsonBody (E.object [ ( "id", E.string id ) ]) + , expect = expectWhateverWithError GotDenyResult + , timeout = Nothing + , tracker = Nothing + } + + httpErrorToString : Http.Error -> String httpErrorToString err = case err of @@ -207,3 +303,21 @@ similarTrackDecoder = (D.field "track" D.string) (D.maybe (D.field "score" D.float)) (D.maybe (D.field "video_uri" D.string)) + + +registrationDecoder : Decoder Registration +registrationDecoder = + D.map6 Registration + (D.field "id" D.string) + (D.field "slug" D.string) + (D.field "name" D.string) + (D.field "email" D.string) + (D.maybe (D.field "listenbrainzUser" D.string)) + (D.maybe (D.field "lastfmUser" D.string)) + + +approveResponseDecoder : Decoder ApproveResponse +approveResponseDecoder = + D.map2 ApproveResponse + (D.field "status" D.string) + (D.maybe (D.field "token" D.string)) blob - 7da92a3997c06064433044eb4ffadc736463c66b blob + ebb536d8b131834a75c6b15aee89863dd7290d33 --- src/Config.purs +++ src/Config.purs @@ -46,9 +46,23 @@ type AppConfig = , host :: String , metricsEnabled :: Boolean , corsOrigin :: String + , adminToken :: Maybe String + , adminEmail :: Maybe String + , registrationEnabled :: Boolean + , registrationsDb :: String + , smtp :: SmtpConfig , users :: Array UserEntry } +-- SMTP settings for notification email (SMTP_* env vars). +type SmtpConfig = + { host :: Maybe String + , port :: Int + , user :: Maybe String + , pass :: Maybe String + , from :: Maybe String + } + type S3Config = { bucket :: Maybe String , region :: String @@ -68,6 +82,26 @@ s3ConfigFromUser cfg = , addressingStyle: cfg.awsS3AddressingStyle } +-- Defaults for a self-registered user; creds and DB path are filled by fillUserConfigFromEnv. +defaultUserConfig :: String -> Maybe String -> Maybe String -> UserConfig +defaultUserConfig databaseFile listenbrainzUser lastfmUser = + { listenbrainzUser + , lastfmUser + , lastfmApiKey: Nothing + , discogsToken: Nothing + , cosineApiKey: Nothing + , databaseFile + , s3Bucket: Nothing + , s3Region: "us-east-1" + , awsAccessKeyId: Nothing + , awsSecretAccessKey: Nothing + , awsEndpointUrl: Nothing + , awsS3AddressingStyle: Nothing + , coverCacheEnabled: false + , backupEnabled: false + , backupIntervalHours: 24 + } + foreign import loadConfigImpl :: Fn3 String (String -> Effect Unit) (Json -> Effect Unit) (Effect Unit) @@ -83,6 +117,61 @@ loadConfig path = do Right users -> pure users portStr <- liftEffect $ lookupEnv "PORT" hostStr <- liftEffect $ lookupEnv "HOST" + metricsEnabledStr <- liftEffect $ lookupEnv "METRICS_ENABLED" + corsOriginStr <- liftEffect $ lookupEnv "CORS_ORIGIN" + adminToken <- liftEffect $ lookupEnv "ADMIN_TOKEN" + adminEmail <- liftEffect $ lookupEnv "ADMIN_EMAIL" + registrationEnabledStr <- liftEffect $ lookupEnv "REGISTRATION_ENABLED" + registrationsDbEnv <- liftEffect $ lookupEnv "CORPUS_REGISTRATIONS_DB" + smtpHost <- liftEffect $ lookupEnv "SMTP_HOST" + smtpPortStr <- liftEffect $ lookupEnv "SMTP_PORT" + smtpUser <- liftEffect $ lookupEnv "SMTP_USER" + smtpPass <- liftEffect $ lookupEnv "SMTP_PASS" + smtpFrom <- liftEffect $ lookupEnv "SMTP_FROM" + databasePath <- liftEffect $ lookupEnv "DATABASE_PATH" + defaultPath <- liftEffect cwd + filledUsers <- traverse + ( \u -> do + c <- fillUserConfigFromEnv u.config + pure (u { config = c }) + ) + rawUsers + let + resolvePath file = case databasePath of + Nothing -> defaultPath <> "/" <> file + Just dir -> dir <> "/" <> file + port = fromMaybe 8000 (portStr >>= Data.Int.fromString) + host = fromMaybe "127.0.0.1" hostStr + metricsEnabled = metricsEnabledStr == Just "true" + corsOrigin = fromMaybe "*" corsOriginStr + registrationEnabled = registrationEnabledStr == Just "true" + registrationsDb = resolvePath (fromMaybe "registrations.db" registrationsDbEnv) + smtp = + { host: smtpHost + , port: fromMaybe 587 (smtpPortStr >>= Data.Int.fromString) + , user: smtpUser + , pass: smtpPass + , from: smtpFrom + } + fullConfig = + { port + , host + , metricsEnabled + , corsOrigin + , adminToken + , adminEmail + , registrationEnabled + , registrationsDb + , smtp + , users: filledUsers + } + case validateConfig fullConfig of + Left msg -> throwError (error msg) + Right cfg -> pure cfg + +-- Fills shared credentials and resolves the database path from the environment. +fillUserConfigFromEnv :: UserConfig -> Aff UserConfig +fillUserConfigFromEnv cfg = do lastfmApiKey <- liftEffect $ lookupEnv "LASTFM_API_KEY" discogsToken <- liftEffect $ lookupEnv "DISCOGS_TOKEN" cosineApiKey <- liftEffect $ lookupEnv "COSINE_API_KEY" @@ -93,34 +182,23 @@ loadConfig path = do awsEndpointUrl <- liftEffect $ lookupEnv "AWS_ENDPOINT_URL" awsS3AddressingStyle <- liftEffect $ lookupEnv "AWS_S3_ADDRESSING_STYLE" databasePath <- liftEffect $ lookupEnv "DATABASE_PATH" - metricsEnabledStr <- liftEffect $ lookupEnv "METRICS_ENABLED" - corsOriginStr <- liftEffect $ lookupEnv "CORS_ORIGIN" defaultPath <- liftEffect cwd let resolvePath file = case databasePath of Nothing -> defaultPath <> "/" <> file Just dir -> dir <> "/" <> file - fillCreds cfg = cfg - { lastfmApiKey = lastfmApiKey - , discogsToken = discogsToken - , cosineApiKey = cosineApiKey - , s3Bucket = s3Bucket - , s3Region = s3Region - , awsAccessKeyId = awsAccessKeyId - , awsSecretAccessKey = awsSecretAccessKey - , awsEndpointUrl = awsEndpointUrl - , awsS3AddressingStyle = awsS3AddressingStyle - , databaseFile = resolvePath cfg.databaseFile - } - let - port = fromMaybe 8000 (portStr >>= Data.Int.fromString) - host = fromMaybe "127.0.0.1" hostStr - metricsEnabled = metricsEnabledStr == Just "true" - corsOrigin = fromMaybe "*" corsOriginStr - fullConfig = { port, host, metricsEnabled, corsOrigin, users: map (\u -> u { config = fillCreds u.config }) rawUsers } - case validateConfig fullConfig of - Left msg -> throwError (error msg) - Right cfg -> pure cfg + pure cfg + { lastfmApiKey = lastfmApiKey + , discogsToken = discogsToken + , cosineApiKey = cosineApiKey + , s3Bucket = s3Bucket + , s3Region = s3Region + , awsAccessKeyId = awsAccessKeyId + , awsSecretAccessKey = awsSecretAccessKey + , awsEndpointUrl = awsEndpointUrl + , awsS3AddressingStyle = awsS3AddressingStyle + , databaseFile = resolvePath cfg.databaseFile + } validateConfig :: AppConfig -> Either String AppConfig validateConfig cfg = do blob - /dev/null blob + 8ad678a6c3cbf5640db4d6120024c7b76b2bdd77 (mode 644) --- /dev/null +++ src/Mail.js @@ -0,0 +1,26 @@ +import nodemailer from "nodemailer"; + +export const sendMailImpl = (cfg, mail, cb) => () => { + if (!cfg.host) { + cb(new Error("SMTP is not configured (SMTP_HOST unset)"))(); + return; + } + + const transport = nodemailer.createTransport({ + host: cfg.host, + port: cfg.port || 587, + secure: false, + requireTLS: true, + auth: cfg.user && cfg.pass ? { user: cfg.user, pass: cfg.pass } : undefined, + }); + + transport + .sendMail({ + from: cfg.from || cfg.user || undefined, + to: mail.to, + subject: mail.subject, + text: mail.text, + }) + .then(() => cb(null)()) + .catch((err) => cb(err)()); +}; blob - 9f8d7db2bb5428180b5d89637e21b7ae4c035982 blob + 85fa100ac44baaa29d9033f4d37b959f5b530fda --- src/Main.purs +++ src/Main.purs @@ -2,26 +2,31 @@ module Main where import Prelude -import Config (AppConfig, UserConfig, UserEntry, loadConfig, s3ConfigFromUser) +import Config (AppConfig, UserConfig, UserEntry, defaultUserConfig, fillUserConfigFromEnv, loadConfig, s3ConfigFromUser) import Cover (serveCover) import Cosine (serveSimilar) import Data.Argonaut (decodeJson, encodeJson, parseJson, stringify) -import Data.Array (find, length) +import Data.Array (find, length, snoc) import Data.Array as Data.Array import Data.Either (Either(..), hush) -import Data.Foldable (for_, traverse_) +import Data.Foldable (any, elem, for_, traverse_) import Data.Int as Int import Data.Maybe (Maybe(..), fromMaybe) -import Data.String (Pattern(..), stripPrefix) +import Data.String (Pattern(..), stripPrefix, trim) import Data.String.Regex (Regex, regex, replace, parseFlags) import Data.Traversable (traverse) +import Data.Tuple (Tuple(..), fst) import Db (Connection, backupDb, connect, fromString, getOrCreateToken, getScrobbles, getStats, getTokenUser, initDb, initReleaseMetadata, ping, upsertScrobble, withTransaction) import Effect (Effect) import Effect.Aff (Aff, Fiber, forkAff, joinFiber, killFiber, launchAff_, try) import Effect.Aff.AVar (AVar) import Effect.Aff.AVar as Avar import Effect.Class (liftEffect) +import Effect.Ref (Ref) +import Effect.Ref as Ref import Effect.Exception as Exception +import Mail as Mail +import Registrations as Reg import Node.Encoding (Encoding(UTF8)) import Log as Log import Node.EventEmitter (on_) @@ -58,6 +63,14 @@ type UserContext = , syncFibers :: Array (Fiber Unit) } +-- Shared server state. contextsRef is mutable so approved users can go live without a restart. +type ServerEnv = + { contextsRef :: Ref (Array UserContext) + , regConn :: Connection + , regLock :: AVar Unit + , appConfig :: AppConfig + } + normalizePath :: String -> String normalizePath path = case stripPrefix (Pattern "/u/") path of Just _ -> "/u/:slug" @@ -66,10 +79,11 @@ normalizePath path = case stripPrefix (Pattern "/u/") -- Request handler -- API endpoints (/proxy, /stats, /cover, /healthz) select the user via ?user=. -- Index pages are served at / (root user) and /u/ (named users). -handleRequest :: Boolean -> String -> Array UserContext -> Request -> Response -> Effect Unit -handleRequest metricsEnabled corsOrigin contexts req res = do +handleRequest :: ServerEnv -> Request -> Response -> Effect Unit +handleRequest env req res = do let method = IM.method req let rawUrl = IM.url req + contexts <- Ref.read env.contextsRef let allUsers = map (\ctx -> { slug: ctx.slug, name: ctx.displayName }) contexts case URL.fromRelative rawUrl "http://localhost" of Nothing -> @@ -78,7 +92,7 @@ handleRequest metricsEnabled corsOrigin contexts req r let path = URL.pathname url Metrics.wrapRequest method (normalizePath path) Log.info req res do launchAff_ $ do - result <- try $ routeRequest metricsEnabled corsOrigin contexts req url path allUsers res + result <- try $ routeRequest env contexts req url path allUsers res case result of Left err -> do Log.error $ "Internal server error: " <> Exception.message err @@ -86,8 +100,8 @@ handleRequest metricsEnabled corsOrigin contexts req r Right _ -> pure unit -routeRequest :: Boolean -> String -> Array UserContext -> Request -> URL -> String -> Array { slug :: String, name :: String } -> Response -> Aff Unit -routeRequest metricsEnabled corsOrigin contexts req url path allUsers res = liftEffect $ case path of +routeRequest :: ServerEnv -> Array UserContext -> Request -> URL -> String -> Array { slug :: String, name :: String } -> Response -> Aff Unit +routeRequest env contexts req url path allUsers res = liftEffect $ case path of "/client.js" -> serveClientJs res "/favicon.png" -> @@ -95,14 +109,36 @@ routeRequest metricsEnabled corsOrigin contexts req ur "/cover.webp" -> serveAsset "image/webp" "assets/cover.webp" res "/" -> - serveIndex allUsers "" res + serveIndex regEnabled allUsers "" res + "/register" -> + if IM.method req == "POST" then + launchAff_ $ serveRegister env req res + else + serveIndex regEnabled allUsers "" res + "/admin" -> + serveIndex regEnabled allUsers "" res + "/admin/registrations" -> + if IM.method req == "GET" then + launchAff_ $ withAdmin env req res (serveListRegistrations env res) + else + serveBadRequest res "Method not allowed" + "/admin/registrations/approve" -> + if IM.method req == "POST" then + launchAff_ $ withAdmin env req res (serveApprove env req res) + else + serveBadRequest res "Method not allowed" + "/admin/registrations/deny" -> + if IM.method req == "POST" then + launchAff_ $ withAdmin env req res (serveDeny env req res) + else + serveBadRequest res "Method not allowed" "/metrics" -> - if metricsEnabled then serveMetrics res + if env.appConfig.metricsEnabled then serveMetrics res else do Log.warn "Path not found: /metrics" serveNotFound res "/proxy" -> - withUser url \ctx -> serveProxy corsOrigin ctx.conn url res + withUser url \ctx -> serveProxy env.appConfig.corsOrigin ctx.conn url res "/stats" -> withUser url \ctx -> serveStats ctx.conn url res "/cover" -> @@ -125,11 +161,12 @@ routeRequest metricsEnabled corsOrigin contexts req ur _ -> case stripPrefix (Pattern "/u/") path of Just slug -> - serveIndex allUsers slug res + serveIndex regEnabled allUsers slug res Nothing -> do Log.warn $ "Path not found: " <> path serveNotFound res where + regEnabled = env.appConfig.registrationEnabled withUser urlParam f = let slug = fromMaybe "" (getQueryParam "user" urlParam) @@ -209,14 +246,215 @@ findUserByToken contexts tokenValue = case Data.Array. _ -> findUserByToken rest tokenValue -serveIndex :: Array { slug :: String, name :: String } -> String -> Response -> Effect Unit -serveIndex allUsers slug res = do +serveIndex :: Boolean -> Array { slug :: String, name :: String } -> String -> Response -> Effect Unit +serveIndex registrationEnabled allUsers slug res = do setHeader "Content-Type" "text/html" (toOutgoingMessage res) setStatusCode 200 res let w = toWriteable (toOutgoingMessage res) - void $ writeString w UTF8 (indexHtml slug allUsers) + void $ writeString w UTF8 (indexHtml registrationEnabled slug allUsers) end w +-- 409 Conflict helper for slug collisions. +serveConflict :: Response -> String -> Effect Unit +serveConflict res message = respond "text/plain" 409 message res + +-- Extract an admin secret from an `Authorization: Bearer ` header value. +parseBearer :: Maybe String -> Maybe String +parseBearer mAuth = mAuth >>= stripPrefix (Pattern "Bearer ") + +-- Gates admin endpoints behind ADMIN_TOKEN: unset -> 404 (disabled), mismatch -> 401. +withAdmin :: ServerEnv -> Request -> Response -> Aff Unit -> Aff Unit +withAdmin env req res action = + case env.appConfig.adminToken of + Nothing -> + liftEffect $ serveNotFound res + Just secret -> do + let mToken = parseBearer (Object.lookup "authorization" (IM.headers req)) + if mToken == Just secret then action + else liftEffect $ serveUnauthorized res + +type RegisterPayload = + { slug :: String + , name :: String + , email :: String + , listenbrainzUser :: Maybe String + , lastfmUser :: Maybe String + } + +-- Trims optional input and treats an empty string as absent. +normalizeOptional :: Maybe String -> Maybe String +normalizeOptional m = case map trim m of + Just "" -> Nothing + other -> other + +-- Public registration endpoint: validates the slug, records a pending request, emails the admin. +serveRegister :: ServerEnv -> Request -> Response -> Aff Unit +serveRegister env req res = + if not env.appConfig.registrationEnabled then liftEffect $ serveNotFound res + else do + body <- readableToStringUtf8 (IM.toReadable req) + case parseJson body >>= decodeJson of + Left _ -> + liftEffect $ serveBadRequest res "Invalid JSON" + Right (payload :: RegisterPayload) -> do + let + slug = trim payload.slug + displayName = trim payload.name + email = trim payload.email + lb = normalizeOptional payload.listenbrainzUser + lf = normalizeOptional payload.lastfmUser + contexts <- liftEffect $ Ref.read env.contextsRef + let existingSlugs = map _.slug contexts + if displayName == "" || email == "" then + liftEffect $ serveBadRequest res "Name and email are required" + else if not (Reg.validSlugFormat slug) then + liftEffect $ serveBadRequest res "Invalid username: use lowercase letters, numbers and dashes" + else if Reg.isReservedSlug slug || elem slug existingSlugs then + liftEffect $ serveConflict res "That username is already taken" + else do + taken <- Reg.slugTaken env.regConn slug + if taken then + liftEffect $ serveConflict res "That username has already been requested" + else do + Reg.insertRegistration env.regConn env.regLock + { slug, displayName, email, listenbrainzUser: lb, lastfmUser: lf } + notifyAdminNewRegistration env slug displayName email + liftEffect $ respond "application/json" 200 """{"status":"ok"}""" res + +serveListRegistrations :: ServerEnv -> Response -> Aff Unit +serveListRegistrations env res = do + regs <- Reg.listByStatus env.regConn "pending" + liftEffect $ respond "application/json" 200 (stringify $ encodeJson (map regToJson regs)) res + +regToJson + :: Reg.Registration + -> { id :: String, slug :: String, name :: String, email :: String, listenbrainzUser :: Maybe String, lastfmUser :: Maybe String, status :: String, createdAt :: Int } +regToJson r = + { id: r.id + , slug: r.slug + , name: r.displayName + , email: r.email + , listenbrainzUser: r.listenbrainzUser + , lastfmUser: r.lastfmUser + , status: r.status + , createdAt: r.createdAt + } + +serveApprove :: ServerEnv -> Request -> Response -> Aff Unit +serveApprove env req res = do + body <- readableToStringUtf8 (IM.toReadable req) + case parseJson body >>= decodeJson of + Left _ -> + liftEffect $ serveBadRequest res "Invalid JSON" + Right ({ id } :: { id :: String }) -> do + mReg <- Reg.getById env.regConn id + case mReg of + Nothing -> + liftEffect $ serveNotFound res + Just reg -> + if reg.status /= "pending" then + liftEffect $ serveBadRequest res "Registration is not pending" + else do + contexts <- liftEffect $ Ref.read env.contextsRef + if any (\c -> c.slug == reg.slug) contexts then + liftEffect $ serveConflict res "That username is already taken" + else do + result <- try $ provisionUser env reg + case result of + Left err -> do + Log.error $ "Failed to provision user '" <> reg.slug <> "': " <> Exception.message err + liftEffect $ serveInternalError res + Right mToken -> do + Reg.setStatus env.regConn env.regLock id "approved" + notifyApproved env reg mToken + liftEffect $ respond "application/json" 200 + (stringify $ encodeJson { status: "approved", token: mToken }) + res + +serveDeny :: ServerEnv -> Request -> Response -> Aff Unit +serveDeny env req res = do + body <- readableToStringUtf8 (IM.toReadable req) + case parseJson body >>= decodeJson of + Left _ -> + liftEffect $ serveBadRequest res "Invalid JSON" + Right ({ id } :: { id :: String }) -> do + mReg <- Reg.getById env.regConn id + case mReg of + Nothing -> + liftEffect $ serveNotFound res + Just reg -> do + Reg.setStatus env.regConn env.regLock id "denied" + notifyDenied env reg + liftEffect $ respond "application/json" 200 """{"status":"denied"}""" res + +-- Builds a runnable UserEntry from an approved registration (users.json is not touched). +registrationUserEntry :: Reg.Registration -> Aff UserEntry +registrationUserEntry reg = do + let base = defaultUserConfig ("corpus-" <> reg.slug <> ".db") reg.listenbrainzUser reg.lastfmUser + config <- fillUserConfigFromEnv base + pure { slug: reg.slug, name: Just reg.displayName, config } + +-- Starts an approved registration as a live user, returning its new API token. +provisionUser :: ServerEnv -> Reg.Registration -> Aff (Maybe String) +provisionUser env reg = do + entry <- registrationUserEntry reg + Tuple ctx mToken <- startUser entry + liftEffect $ Ref.modify_ (\cs -> snoc cs ctx) env.contextsRef + pure mToken + +-- Sends an email if SMTP is configured, logging (never throwing) on failure. +sendMailBestEffort :: ServerEnv -> Mail.Mail -> Aff Unit +sendMailBestEffort env mail = + if Mail.isConfigured env.appConfig.smtp then do + result <- try $ Mail.sendMail env.appConfig.smtp mail + case result of + Left err -> Log.error $ "Failed to send email to " <> mail.to <> ": " <> Exception.message err + Right _ -> Log.info $ "Sent email to " <> mail.to + else + Log.warn "SMTP not configured; skipping email" + +notifyAdminNewRegistration :: ServerEnv -> String -> String -> String -> Aff Unit +notifyAdminNewRegistration env slug displayName email = + for_ env.appConfig.adminEmail \adminAddr -> + sendMailBestEffort env + { to: adminAddr + , subject: "New corpus registration: " <> slug + , text: "A new registration request is pending.\n\nUsername: " <> slug + <> "\nName: " + <> displayName + <> "\nEmail: " + <> email + <> "\n\nApprove or deny it in the admin page." + } + +notifyApproved :: ServerEnv -> Reg.Registration -> Maybe String -> Aff Unit +notifyApproved env reg mToken = + sendMailBestEffort env + { to: reg.email + , subject: "Your corpus account is approved" + , text: "Hi " <> reg.displayName + <> ",\n\nYour account '" + <> reg.slug + <> "' has been approved." + <> tokenLine + <> "\nYou can submit listens to /1/submit-listens using this token.\n" + } + where + tokenLine = case mToken of + Just t -> "\n\nYour API token: " <> t + Nothing -> "" + +notifyDenied :: ServerEnv -> Reg.Registration -> Aff Unit +notifyDenied env reg = + sendMailBestEffort env + { to: reg.email + , subject: "Your corpus registration" + , text: "Hi " <> reg.displayName + <> ",\n\nUnfortunately your registration for '" + <> reg.slug + <> "' was not approved.\n" + } + serveMetrics :: Response -> Effect Unit serveMetrics res = do launchAff_ do @@ -375,7 +613,7 @@ submitTrackMetadataToTrackMetadata (ListenBrainzSubmit } } -startUser :: UserEntry -> Aff UserContext +startUser :: UserEntry -> Aff (Tuple UserContext (Maybe String)) startUser { slug, name, config } = do Log.info $ "Starting user: " <> if slug == "" then "(root)" else slug conn <- connect config.databaseFile @@ -422,7 +660,9 @@ startUser { slug, name, config } = do else pure Nothing let displayName = fromMaybe (if slug == "" then "root" else slug) name - pure { conn, writeLock, config, slug, displayName, enrichMetadataFiber: Just enrichMetadataFiber, backupFiber, syncFibers: loopFibers } + pure $ Tuple + { conn, writeLock, config, slug, displayName, enrichMetadataFiber: Just enrichMetadataFiber, backupFiber, syncFibers: loopFibers } + mToken cleanupUser :: UserContext -> Aff Unit cleanupUser ctx = do @@ -456,10 +696,26 @@ main = do liftEffect $ Exception.throwException err Right (appConfig :: AppConfig) -> do Log.info $ "Loaded " <> show (length appConfig.users) <> " user(s) from " <> configFile - contexts <- traverse startUser appConfig.users + results <- traverse startUser appConfig.users + let jsonContexts = map fst results + -- Also start approved registrations, skipping slugs already in users.json. + regConn <- connect appConfig.registrationsDb + Reg.initRegistrations regConn + approved <- Reg.listByStatus regConn "approved" + let jsonSlugs = map _.slug jsonContexts + let toStart = Data.Array.filter (\r -> not (elem r.slug jsonSlugs)) approved + when (not (Data.Array.null toStart)) + $ Log.info + $ "Starting " <> show (length toStart) <> " approved registered user(s)" + approvedEntries <- traverse registrationUserEntry toStart + approvedResults <- traverse startUser approvedEntries + let contexts = jsonContexts <> map fst approvedResults + contextsRef <- liftEffect $ Ref.new contexts + regLock <- Avar.new unit + let env = { contextsRef, regConn, regLock, appConfig } liftEffect $ do server <- createServer - server # on_ Server.requestH (handleRequest appConfig.metricsEnabled appConfig.corsOrigin contexts) + server # on_ Server.requestH (handleRequest env) let netServer = Server.toNetServer server netServer # on_ listeningH do blob - /dev/null blob + baaaf72ce97ec9047cf137db40a157fda3c4737b (mode 644) --- /dev/null +++ src/Mail.purs @@ -0,0 +1,51 @@ +module Mail where + +import Prelude + +import Config (SmtpConfig) +import Data.Either (Either(..)) +import Data.Function.Uncurried (Fn3, runFn3) +import Data.Maybe (Maybe(..), isJust) +import Data.Nullable (Nullable, toMaybe, toNullable) +import Effect (Effect) +import Effect.Aff (Aff, makeAff, nonCanceler) +import Effect.Exception (Error) + +type SmtpConfigJs = + { host :: Nullable String + , port :: Int + , user :: Nullable String + , pass :: Nullable String + , from :: Nullable String + } + +type Mail = + { to :: String + , subject :: String + , text :: String + } + +toJs :: SmtpConfig -> SmtpConfigJs +toJs cfg = + { host: toNullable cfg.host + , port: cfg.port + , user: toNullable cfg.user + , pass: toNullable cfg.pass + , from: toNullable cfg.from + } + +-- | True when SMTP is configured (host present). +isConfigured :: SmtpConfig -> Boolean +isConfigured cfg = isJust cfg.host + +foreign import sendMailImpl + :: Fn3 SmtpConfigJs Mail (Nullable Error -> Effect Unit) (Effect Unit) + +-- | Sends one plaintext email over SMTP (STARTTLS). Wrap callers in `try`. +sendMail :: SmtpConfig -> Mail -> Aff Unit +sendMail cfg mail = makeAff \cb -> do + runFn3 sendMailImpl (toJs cfg) mail \err -> + case toMaybe err of + Just e -> cb (Left e) + Nothing -> cb (Right unit) + pure nonCanceler blob - 9cdfa4718f314da4a379fc572b8b2b3890cfd523 blob + a9c78fc0100f3b5d476251cc6b434c1bd24f97cd --- src/State.elm +++ src/State.elm @@ -1,13 +1,14 @@ module State exposing (init, subscriptions, update) -import Api exposing (fetchListens, fetchSectionData, fetchSimilarTracks, fetchStats, httpErrorToString) +import Api exposing (approveRegistration, denyRegistration, fetchListens, fetchRegistrations, fetchSectionData, fetchSimilarTracks, fetchStats, httpErrorToString, submitRegistration) import Browser import Browser.Navigation as Nav import Dict +import Ports import Set import Task import Time -import Types exposing (Flags, Model, Msg(..), Period(..), SimilarState(..), Stats, StatsEntry, Tab(..)) +import Types exposing (Flags, Model, Msg(..), Page(..), Period(..), RegField(..), SimilarState(..), Stats, StatsEntry, Tab(..)) import Url import Url.Parser exposing ((), ()) import Url.Parser.Query as Query @@ -16,11 +17,14 @@ import Url.Parser.Query as Query init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init flags url navKey = let - page = + pageNum = parsePageParam url offset = - max 0 ((page - 1) * 25) + max 0 ((pageNum - 1) * 25) + + page = + parsePage url in ( { navKey = navKey , listens = [] @@ -46,14 +50,57 @@ init flags url navKey = , searchInput = "" , activeSearch = Nothing , tabsVisible = True + , page = page + , registrationEnabled = flags.registrationEnabled + , regSlug = "" + , regName = "" + , regEmail = "" + , regLbUser = "" + , regLfUser = "" + , regSubmitting = False + , regSubmitted = False + , regError = Nothing + , adminToken = flags.adminToken + , adminTokenInput = flags.adminToken + , registrations = [] + , adminError = Nothing + , approvedToken = Nothing } - , Cmd.batch - [ fetchListens flags.userSlug 25 offset Nothing Nothing - , Task.perform GotTime Time.now - ] + , case page of + AdminPage -> + Cmd.batch + [ Task.perform GotTime Time.now + , if String.isEmpty flags.adminToken then + Cmd.none + + else + fetchRegistrations flags.adminToken + ] + + RegisterPage -> + Task.perform GotTime Time.now + + MainPage -> + Cmd.batch + [ fetchListens flags.userSlug 25 offset Nothing Nothing + , Task.perform GotTime Time.now + ] ) +parsePage : Url.Url -> Page +parsePage url = + case url.path of + "/register" -> + RegisterPage + + "/admin" -> + AdminPage + + _ -> + MainPage + + parsePageParam : Url.Url -> Int parsePageParam url = let @@ -84,89 +131,104 @@ update msg model = ( model, Nav.load href ) UrlChanged url -> - let - newUserSlug = - if String.startsWith "/u/" url.path then - String.dropLeft 3 url.path + case parsePage url of + RegisterPage -> + ( { model | page = RegisterPage }, Cmd.none ) - else - "" + AdminPage -> + ( { model | page = AdminPage, approvedToken = Nothing } + , if String.isEmpty model.adminToken then + Cmd.none - page = - parsePageParam url + else + fetchRegistrations model.adminToken + ) - targetOffset = - max 0 ((page - 1) * model.limit) + MainPage -> + let + newUserSlug = + if String.startsWith "/u/" url.path then + String.dropLeft 3 url.path - isNaked = - url.query == Nothing + else + "" - userChanged = - newUserSlug /= model.userSlug + pageNum = + parsePageParam url - needsCleanStart = - userChanged || isNaked + targetOffset = + max 0 ((pageNum - 1) * model.limit) - finalFilter = - if needsCleanStart then - Nothing + isNaked = + url.query == Nothing - else - model.activeFilter + userChanged = + newUserSlug /= model.userSlug - finalSearch = - if needsCleanStart then - Nothing + needsCleanStart = + userChanged || isNaked - else - model.activeSearch + finalFilter = + if needsCleanStart then + Nothing - finalOffset = - if needsCleanStart then - 0 + else + model.activeFilter - else - targetOffset - in - if userChanged || model.offset /= finalOffset || model.activeFilter /= finalFilter || model.activeSearch /= finalSearch then - let - newModel = - { model - | userSlug = newUserSlug - , offset = finalOffset - , activeFilter = finalFilter - , activeSearch = finalSearch - , searchInput = - if needsCleanStart then - "" + finalSearch = + if needsCleanStart then + Nothing + else + model.activeSearch + + finalOffset = + if needsCleanStart then + 0 + + else + targetOffset + in + if model.page /= MainPage || userChanged || model.offset /= finalOffset || model.activeFilter /= finalFilter || model.activeSearch /= finalSearch then + let + newModel = + { model + | userSlug = newUserSlug + , offset = finalOffset + , activeFilter = finalFilter + , activeSearch = finalSearch + , searchInput = + if needsCleanStart then + "" + + else + model.searchInput + , activeTab = ListensTab + , loading = True + , page = MainPage + } + + clearedModel = + if userChanged then + { newModel + | stats = Nothing + , expandedSections = Set.empty + , loadedSections = Set.empty + , similarStates = Dict.empty + } + else - model.searchInput - , activeTab = ListensTab - , loading = True - } + newModel + in + ( clearedModel + , fetchListens newUserSlug model.limit finalOffset finalFilter finalSearch + ) - clearedModel = - if userChanged then - { newModel - | stats = Nothing - , expandedSections = Set.empty - , loadedSections = Set.empty - , similarStates = Dict.empty - } + else + ( { model | activeTab = ListensTab, page = MainPage }, Cmd.none ) - else - newModel - in - ( clearedModel - , fetchListens newUserSlug model.limit finalOffset finalFilter finalSearch - ) - - else - ( { model | activeTab = ListensTab }, Cmd.none ) - Tick time -> - if not model.loading then + if model.page == MainPage && not model.loading then ( { model | currentTime = Just time, loading = True } , fetchListens model.userSlug model.limit model.offset model.activeFilter model.activeSearch ) @@ -470,7 +532,123 @@ update msg model = in ( { model | similarStates = newStates }, Cmd.none ) + UpdateRegField field val -> + let + m = + { model | regError = Nothing, regSubmitted = False } + in + ( case field of + FSlug -> + { m | regSlug = val } + FName -> + { m | regName = val } + + FEmail -> + { m | regEmail = val } + + FLbUser -> + { m | regLbUser = val } + + FLfUser -> + { m | regLfUser = val } + , Cmd.none + ) + + SubmitRegistration -> + if String.isEmpty (String.trim model.regSlug) || String.isEmpty (String.trim model.regName) || String.isEmpty (String.trim model.regEmail) then + ( { model | regError = Just "Username, name and email are required" }, Cmd.none ) + + else + ( { model | regSubmitting = True, regError = Nothing } + , submitRegistration + { slug = model.regSlug + , name = model.regName + , email = model.regEmail + , lbUser = model.regLbUser + , lfUser = model.regLfUser + } + ) + + GotRegistrationResult result -> + case result of + Ok () -> + ( { model | regSubmitting = False, regSubmitted = True, regError = Nothing }, Cmd.none ) + + Err msg_ -> + ( { model | regSubmitting = False, regError = Just msg_ }, Cmd.none ) + + UpdateAdminTokenInput val -> + ( { model | adminTokenInput = val }, Cmd.none ) + + SaveAdminToken -> + let + token = + String.trim model.adminTokenInput + in + ( { model | adminToken = token, adminError = Nothing } + , Cmd.batch + [ Ports.saveAdminToken token + , if String.isEmpty token then + Cmd.none + + else + fetchRegistrations token + ] + ) + + FetchRegistrations -> + ( { model | adminError = Nothing } + , if String.isEmpty model.adminToken then + Cmd.none + + else + fetchRegistrations model.adminToken + ) + + GotRegistrations result -> + case result of + Ok regs -> + ( { model | registrations = regs, adminError = Nothing }, Cmd.none ) + + Err err -> + ( { model | adminError = Just (httpErrorToString err) }, Cmd.none ) + + ApproveRegistration id -> + ( model, approveRegistration model.adminToken id ) + + DenyRegistration id -> + ( model, denyRegistration model.adminToken id ) + + GotApproveResult result -> + case result of + Ok resp -> + ( { model | approvedToken = resp.token, adminError = Nothing } + , if String.isEmpty model.adminToken then + Cmd.none + + else + fetchRegistrations model.adminToken + ) + + Err err -> + ( { model | adminError = Just (httpErrorToString err) }, Cmd.none ) + + GotDenyResult result -> + case result of + Ok () -> + ( model + , if String.isEmpty model.adminToken then + Cmd.none + + else + fetchRegistrations model.adminToken + ) + + Err msg_ -> + ( { model | adminError = Just msg_ }, Cmd.none ) + + patchStatSection : String -> List StatsEntry -> Stats -> Stats patchStatSection section entries stats = case section of blob - /dev/null blob + 46b1c3d9f7bd7d8ff8f353bb6b94338e06d45824 (mode 644) --- /dev/null +++ src/Ports.elm @@ -0,0 +1,7 @@ +port module Ports exposing (saveAdminToken) + +{-| Persists the admin token to localStorage; the initial value comes back via flags. +-} + + +port saveAdminToken : String -> Cmd msg blob - /dev/null blob + 161c64f63caa4c654cf4e243905cfea12725b77e (mode 644) --- /dev/null +++ src/Registrations.purs @@ -0,0 +1,154 @@ +module Registrations where + +import Prelude + +import Data.Argonaut.Core (Json, toNumber, toObject, toString) +import Data.Array (elem, mapMaybe, null) +import Data.DateTime.Instant (unInstant) +import Data.Either (hush) +import Data.Int as Int +import Data.Maybe (Maybe(..), fromMaybe) +import Data.String.Regex (Regex, regex, test) +import Data.String.Regex.Flags (noFlags) +import Data.Time.Duration (Milliseconds(..)) +import Data.UUID (genUUID, toString) as UUID +import Db (Connection, queryAll, run, toParam, withTransaction) +import Effect (Effect) +import Effect.Aff (Aff) +import Effect.Aff.AVar (AVar) +import Effect.Class (liftEffect) +import Effect.Now (now) +import Foreign.Object as Object + +-- A registration request. status is 'pending' | 'approved' | 'denied'; createdAt is unix seconds. +type Registration = + { id :: String + , slug :: String + , displayName :: String + , email :: String + , listenbrainzUser :: Maybe String + , lastfmUser :: Maybe String + , status :: String + , createdAt :: Int + } + +-- Fields supplied by the public registration form. +type NewRegistration = + { slug :: String + , displayName :: String + , email :: String + , listenbrainzUser :: Maybe String + , lastfmUser :: Maybe String + } + +-- Paths/route names a slug must never collide with, plus "" (the root user). +reservedSlugs :: Array String +reservedSlugs = + [ "" + , "client.js" + , "favicon.png" + , "cover.webp" + , "cover" + , "metrics" + , "proxy" + , "stats" + , "similar" + , "healthz" + , "register" + , "admin" + , "u" + , "1" + ] + +slugRegex :: Maybe Regex +slugRegex = hush $ regex "^[a-z0-9](?:[a-z0-9-]*[a-z0-9])?$" noFlags + +-- Slug must be lowercase alphanumeric/dashes (not starting/ending with a dash). +validSlugFormat :: String -> Boolean +validSlugFormat slug = case slugRegex of + Nothing -> false + Just re -> test re slug + +isReservedSlug :: String -> Boolean +isReservedSlug slug = elem slug reservedSlugs + +initRegistrations :: Connection -> Aff Unit +initRegistrations conn = + run conn + "CREATE TABLE IF NOT EXISTS registrations (id VARCHAR PRIMARY KEY, slug VARCHAR, display_name VARCHAR, email VARCHAR, listenbrainz_user VARCHAR, lastfm_user VARCHAR, status VARCHAR, created_at BIGINT, decided_at BIGINT)" + [] + +nowSeconds :: Effect Int +nowSeconds = do + Milliseconds ms <- unInstant <$> now + pure $ Int.round (ms / 1000.0) + +-- True if a pending or approved registration already claims this slug (denied ones don't). +slugTaken :: Connection -> String -> Aff Boolean +slugTaken conn slug = do + rows <- queryAll conn + "SELECT 1 FROM registrations WHERE slug = ? AND status IN ('pending','approved')" + [ toParam slug ] + pure $ not (null rows) + +insertRegistration :: Connection -> AVar Unit -> NewRegistration -> Aff Unit +insertRegistration conn lock r = do + id <- liftEffect $ map UUID.toString UUID.genUUID + createdAt <- liftEffect nowSeconds + withTransaction conn lock $ + run conn + "INSERT INTO registrations (id, slug, display_name, email, listenbrainz_user, lastfm_user, status, created_at, decided_at) VALUES (?, ?, ?, ?, ?, ?, 'pending', ?, 0)" + [ toParam id + , toParam r.slug + , toParam r.displayName + , toParam r.email + , toParam (fromMaybe "" r.listenbrainzUser) + , toParam (fromMaybe "" r.lastfmUser) + , toParam createdAt + ] + +listByStatus :: Connection -> String -> Aff (Array Registration) +listByStatus conn status = do + rows <- queryAll conn + "SELECT id, slug, display_name, email, listenbrainz_user, lastfm_user, status, created_at FROM registrations WHERE status = ? ORDER BY created_at DESC" + [ toParam status ] + pure $ mapMaybe decodeRow rows + +getById :: Connection -> String -> Aff (Maybe Registration) +getById conn id = do + rows <- queryAll conn + "SELECT id, slug, display_name, email, listenbrainz_user, lastfm_user, status, created_at FROM registrations WHERE id = ?" + [ toParam id ] + pure $ case mapMaybe decodeRow rows of + [ r ] -> Just r + _ -> Nothing + +setStatus :: Connection -> AVar Unit -> String -> String -> Aff Unit +setStatus conn lock id status = do + decidedAt <- liftEffect nowSeconds + withTransaction conn lock $ + run conn "UPDATE registrations SET status = ?, decided_at = ? WHERE id = ?" + [ toParam status, toParam decidedAt, toParam id ] + +decodeRow :: Json -> Maybe Registration +decodeRow json = do + obj <- toObject json + let str k = Object.lookup k obj >>= toString + let + strM k = case str k of + Just "" -> Nothing + other -> other + id <- str "id" + slug <- str "slug" + status <- str "status" + let createdAt = fromMaybe 0 $ Int.fromNumber =<< (Object.lookup "created_at" obj >>= toNumber) + pure + { id + , slug + , displayName: fromMaybe "" (str "display_name") + , email: fromMaybe "" (str "email") + , listenbrainzUser: strM "listenbrainz_user" + , lastfmUser: strM "lastfm_user" + , status + , createdAt + } blob - b17440e9652f7766bbfd561d1db2f2546b053118 blob + a77bc9f485b85c13813cc966cb16a396212d47b6 --- src/Templates.purs +++ src/Templates.purs @@ -3,11 +3,12 @@ module Templates where import Prelude import Data.String.Common (joinWith) -indexHtml :: String -> Array { slug :: String, name :: String } -> String -indexHtml userSlug allUsers = +indexHtml :: Boolean -> String -> Array { slug :: String, name :: String } -> String +indexHtml registrationEnabled userSlug allUsers = let encodeUser { slug, name } = "{\"slug\":\"" <> slug <> "\",\"name\":\"" <> name <> "\"}" usersJson = "[" <> joinWith "," (map encodeUser allUsers) <> "]" + registrationEnabledJson = if registrationEnabled then "true" else "false" in """ @@ -725,6 +726,138 @@ indexHtml userSlug allUsers = color: oklch(0.78 0.13 357.86); text-decoration: underline; } + + .reg-form { + display: flex; + flex-direction: column; + gap: 12px; + max-width: 480px; + margin: 20px 0; + } + + .reg-field { + display: flex; + flex-direction: column; + gap: 4px; + } + + .reg-label { + font-size: 12px; + color: oklch(0.74 0.075 225.31); + } + + .reg-input { + background: oklch(0.27 0.038 225.31); + border: 1px solid oklch(0.42 0.04 225.31); + color: oklch(0.91 0.012 225.31); + padding: 6px 10px; + border-radius: 4px; + font-family: inherit; + font-size: 13px; + } + + .reg-input.error { + border-color: oklch(0.62 0.17 25); + } + + .reg-btn { + background: oklch(0.32 0.045 225.31); + border: 1px solid oklch(0.52 0.05 225.31); + color: oklch(0.91 0.012 225.31); + padding: 8px 14px; + border-radius: 4px; + font-family: inherit; + font-size: 13px; + cursor: pointer; + align-self: flex-start; + } + + .reg-btn:hover { + background: oklch(0.38 0.05 225.31); + } + + .reg-btn:disabled { + opacity: 0.5; + cursor: default; + } + + .reg-error { + color: oklch(0.72 0.15 25); + font-size: 13px; + } + + .reg-success { + color: oklch(0.78 0.13 150); + font-size: 13px; + } + + .admin-list { + list-style: none; + padding: 0; + margin: 16px 0; + display: flex; + flex-direction: column; + gap: 10px; + } + + .admin-item { + background: oklch(0.24 0.035 225.31); + border: 1px solid oklch(0.36 0.04 225.31); + border-radius: 6px; + padding: 12px; + } + + .admin-item-meta { + font-size: 13px; + margin-bottom: 8px; + } + + .admin-item-slug { + font-weight: 700; + color: oklch(0.88 0.05 225.31); + } + + .admin-item-sub { + color: oklch(0.7 0.05 225.31); + font-size: 12px; + } + + .admin-actions { + display: flex; + gap: 8px; + } + + .approve-btn { + background: oklch(0.34 0.07 150); + border: 1px solid oklch(0.5 0.09 150); + color: oklch(0.94 0.02 150); + padding: 5px 12px; + border-radius: 4px; + font-family: inherit; + font-size: 12px; + cursor: pointer; + } + + .deny-btn { + background: oklch(0.32 0.07 25); + border: 1px solid oklch(0.5 0.1 25); + color: oklch(0.94 0.02 25); + padding: 5px 12px; + border-radius: 4px; + font-family: inherit; + font-size: 12px; + cursor: pointer; + } + + .token-box { + background: oklch(0.27 0.038 225.31); + border: 1px solid oklch(0.42 0.04 225.31); + border-radius: 4px; + padding: 10px; + margin: 12px 0; + font-size: 12px; + word-break: break-all; + } @@ -738,9 +871,24 @@ indexHtml userSlug allUsers = <> usersJson <> """; + var registrationEnabled = """ + <> registrationEnabledJson + <> + """; + var adminToken = window.localStorage.getItem('corpusAdminToken') || ''; var app = Elm.Client.init({ - flags: { userSlug: userSlug, allUsers: allUsers } + flags: { + userSlug: userSlug, + allUsers: allUsers, + registrationEnabled: registrationEnabled, + adminToken: adminToken + } }); + if (app.ports && app.ports.saveAdminToken) { + app.ports.saveAdminToken.subscribe(function (token) { + window.localStorage.setItem('corpusAdminToken', token); + }); + } """ blob - 997f7c0a7393abaea3ae558fcede5d6a046d840f blob + e5bf94c992d2350a657c28cf2277a6dfc34496eb --- src/Types.elm +++ src/Types.elm @@ -1,4 +1,4 @@ -module Types exposing (ActiveFilter, Flags, Listen, Model, Msg(..), Period(..), SimilarState(..), SimilarTrack, Stats, StatsEntry, Tab(..), UserInfo) +module Types exposing (ActiveFilter, ApproveResponse, Flags, Listen, Model, Msg(..), Page(..), Period(..), RegField(..), Registration, SimilarState(..), SimilarTrack, Stats, StatsEntry, Tab(..), UserInfo) import Browser import Browser.Navigation as Nav @@ -18,6 +18,8 @@ type alias UserInfo = type alias Flags = { userSlug : String , allUsers : List UserInfo + , registrationEnabled : Bool + , adminToken : String } @@ -31,6 +33,42 @@ type Tab | AboutTab +{-| Which top-level page the SPA shows, derived from the URL path. +-} +type Page + = MainPage + | RegisterPage + | AdminPage + + +{-| A pending registration request, as listed on the admin page. +-} +type alias Registration = + { id : String + , slug : String + , name : String + , email : String + , listenbrainzUser : Maybe String + , lastfmUser : Maybe String + } + + +type alias ApproveResponse = + { status : String + , token : Maybe String + } + + +{-| Fields of the registration form, used by the UpdateRegField message. +-} +type RegField + = FSlug + | FName + | FEmail + | FLbUser + | FLfUser + + type Period = AllTime | LastDays Int @@ -113,6 +151,25 @@ type alias Model = , searchInput : String , activeSearch : Maybe String , tabsVisible : Bool + , page : Page + , registrationEnabled : Bool + + -- Registration form + , regSlug : String + , regName : String + , regEmail : String + , regLbUser : String + , regLfUser : String + , regSubmitting : Bool + , regSubmitted : Bool + , regError : Maybe String + + -- Admin page + , adminToken : String + , adminTokenInput : String + , registrations : List Registration + , adminError : Maybe String + , approvedToken : Maybe String } @@ -143,6 +200,17 @@ type Msg | UpdateSearchInput String | SubmitSearch | ClearSearch + | UpdateRegField RegField String + | SubmitRegistration + | GotRegistrationResult (Result String ()) + | UpdateAdminTokenInput String + | SaveAdminToken + | FetchRegistrations + | GotRegistrations (Result Http.Error (List Registration)) + | ApproveRegistration String + | DenyRegistration String + | GotApproveResult (Result Http.Error ApproveResponse) + | GotDenyResult (Result String ()) | UrlRequested Browser.UrlRequest | UrlChanged Url.Url blob - 16b690a5f79203f7a4afa029828aa3b5865e8d4b blob + b5bde15141bbf08f944fb45cab62dc3bec178549 --- src/View.elm +++ src/View.elm @@ -8,7 +8,7 @@ import Html.Events exposing (on, onClick, onInput) import Json.Decode as D import Set exposing (Set) import Time -import Types exposing (Listen, Model, Msg(..), Period(..), SimilarState(..), SimilarTrack, Stats, StatsEntry, Tab(..), UserInfo) +import Types exposing (Listen, Model, Msg(..), Page(..), Period(..), RegField(..), Registration, SimilarState(..), SimilarTrack, Stats, StatsEntry, Tab(..), UserInfo) import Url @@ -21,6 +21,23 @@ view model = { title = "scrobbler" , body = [ div [ class "container" ] + (case model.page of + RegisterPage -> + [ renderRegister model ] + + AdminPage -> + [ renderAdmin model ] + + MainPage -> + [ renderMain model ] + ) + ] + } + + +renderMain : Model -> Html Msg +renderMain model = + div [] [ if model.tabsVisible then div [ class "tabs" ] [ a @@ -55,6 +72,11 @@ view model = , onClick (SwitchTab StatsTab) ] [ text "stats" ] + , if model.registrationEnabled then + a [ class "tab-btn", href "/register" ] [ text "register" ] + + else + text "" , button [ class ("tab-btn" @@ -132,10 +154,8 @@ view model = ] AboutTab -> - renderAboutView model.userSlug model.allUsers + renderAboutView model.registrationEnabled model.userSlug model.allUsers ] - ] - } renderContent : Model -> Html Msg @@ -645,8 +665,8 @@ timeAgo mNow mTimestamp = "unknown time" -renderAboutView : String -> List UserInfo -> Html Msg -renderAboutView currentSlug allUsers = +renderAboutView : Bool -> String -> List UserInfo -> Html Msg +renderAboutView registrationEnabled currentSlug allUsers = let otherUsers = List.filter (\u -> u.slug /= currentSlug) allUsers @@ -673,13 +693,159 @@ renderAboutView currentSlug allUsers = , text " and " , extLink "https://www.last.fm" "Last.fm." ] + , if registrationEnabled then + p [] [ a [ href "/register", class "about-link" ] [ text "request an account" ] ] + + else + text "" , if List.isEmpty otherUsers then text "" else div [ class "stats-section" ] - [ h2 [] [ text "friends" ] + [ h2 [] [ text "users" ] , ul [ class "about-users" ] (List.map userLink otherUsers) ] ] + + + +-- REGISTRATION + + +renderRegister : Model -> Html Msg +renderRegister model = + div [] + [ h2 [] [ text "register" ] + , if not model.registrationEnabled then + p [ class "reg-error" ] [ text "Registration is currently closed." ] + + else if model.regSubmitted then + div [] + [ p [ class "reg-success" ] + [ text "Thanks — your request has been submitted. You'll get an email once it's reviewed." ] + , p [] [ a [ href "/", class "about-link" ] [ text "back home" ] ] + ] + + else + div [ class "reg-form" ] + [ regField "username" "lowercase letters, numbers, dashes" FSlug model.regSlug + , regField "name" "display name" FName model.regName + , regField "email" "you will notified here" FEmail model.regEmail + , regField "listenbrainz user (optional)" "" FLbUser model.regLbUser + , regField "last.fm user (optional)" "" FLfUser model.regLfUser + , case model.regError of + Just err -> + p [ class "reg-error" ] [ text err ] + + Nothing -> + text "" + , button + [ class "reg-btn" + , onClick SubmitRegistration + , disabled model.regSubmitting + ] + [ text + (if model.regSubmitting then + "submitting…" + + else + "submit" + ) + ] + ] + ] + + +regField : String -> String -> RegField -> String -> Html Msg +regField label placeholderText field val = + div [ class "reg-field" ] + [ span [ class "reg-label" ] [ text label ] + , input + [ type_ "text" + , class "reg-input" + , placeholder placeholderText + , value val + , onInput (UpdateRegField field) + ] + [] + ] + + + +-- ADMIN + + +renderAdmin : Model -> Html Msg +renderAdmin model = + div [] + [ h2 [] [ text "admin" ] + , div [ class "reg-field" ] + [ span [ class "reg-label" ] [ text "admin token" ] + , input + [ type_ "password" + , class "reg-input" + , placeholder "ADMIN_TOKEN" + , value model.adminTokenInput + , onInput UpdateAdminTokenInput + ] + [] + , button [ class "reg-btn", onClick SaveAdminToken ] [ text "load" ] + ] + , case model.approvedToken of + Just token -> + div [ class "token-box" ] + [ strong [] [ text "Approved. " ] + , text ("API token: " ++ token) + ] + + Nothing -> + text "" + , case model.adminError of + Just err -> + p [ class "reg-error" ] [ text err ] + + Nothing -> + text "" + , if String.isEmpty model.adminToken then + text "" + + else if List.isEmpty model.registrations then + p [] [ text "No pending registrations." ] + + else + ul [ class "admin-list" ] + (List.map renderRegistrationItem model.registrations) + ] + + +renderRegistrationItem : Registration -> Html Msg +renderRegistrationItem reg = + li [ class "admin-item" ] + [ div [ class "admin-item-meta" ] + [ div [ class "admin-item-slug" ] [ text reg.slug ] + , div [ class "admin-item-sub" ] [ text (reg.name ++ " · " ++ reg.email) ] + , div [ class "admin-item-sub" ] [ text (regSources reg) ] + ] + , div [ class "admin-actions" ] + [ button [ class "approve-btn", onClick (ApproveRegistration reg.id) ] [ text "approve" ] + , button [ class "deny-btn", onClick (DenyRegistration reg.id) ] [ text "deny" ] + ] + ] + + +regSources : Registration -> String +regSources reg = + let + parts = + List.filterMap identity + [ Maybe.map (\u -> "ListenBrainz: " ++ u) reg.listenbrainzUser + , Maybe.map (\u -> "Last.fm: " ++ u) reg.lastfmUser + ] + in + if List.isEmpty parts then + "no sync sources" + + else + String.join " · " parts blob - 8e8fad7726de0b1cc40222bf74c0dba363919439 blob + a5ed32f417c2c97ec18386b4cbcbc55de08ea135 --- test/Main.purs +++ test/Main.purs @@ -17,7 +17,8 @@ import Types (Listen(..), ListenBrainzResponse(..), Mb import Db (FilterField(..), connect, initDb, checkExists, upsertScrobble, getScrobbles, initReleaseMetadata, upsertReleaseMetadata, getStats, dbBaseName, getOldestTs, getUnenrichedMbids, getEmptyGenreMbids, getArtistReleasesByMbids, touchGenreCheckedAt, getOrCreateToken, getTokenUser, fromString) import Data.Argonaut.Core (Json, toBoolean, toNumber, toString) import Foreign.Object as Object -import Main (submitListenToListen, findUserByToken, sanitizeDate, parseAuthToken, validateTokenJson) +import Main (submitListenToListen, findUserByToken, sanitizeDate, parseAuthToken, parseBearer, validateTokenJson) +import Registrations (getById, initRegistrations, insertRegistration, isReservedSlug, listByStatus, setStatus, slugTaken, validSlugFormat) import Cover (sanitizeKey) import Sync (listenBrainzUrl, lastfmTrackToListen, parseLastfmResponse) import S3 (getS3Url) @@ -201,7 +202,8 @@ main = runSpecAndExitProcess [consoleReporter] do (Object.lookup "valid" obj >>= toBoolean) `shouldEqual` Just true (Object.lookup "user_name" obj >>= toString) `shouldEqual` Just "User One" (Object.lookup "code" obj >>= toNumber) `shouldEqual` Just 200.0 - Left _ -> fail "validateTokenJson did not produce valid JSON" + Left _ -> + fail "validateTokenJson did not produce valid JSON" it "builds an invalid-token response for an unknown token" do let body = validateTokenJson Nothing @@ -210,7 +212,8 @@ main = runSpecAndExitProcess [consoleReporter] do Right obj -> do (Object.lookup "valid" obj >>= toBoolean) `shouldEqual` Just false Object.member "user_name" obj `shouldEqual` false - Left _ -> fail "validateTokenJson did not produce valid JSON" + Left _ -> + fail "validateTokenJson did not produce valid JSON" describe "Token Authentication" do it "should create and verify tokens" do @@ -858,3 +861,58 @@ main = runSpecAndExitProcess [consoleReporter] do , addressingStyle: Just "path" } getS3Url cfg "covers/test.jpg" `shouldEqual` "https://s3.example.com/my-bucket/covers/test.jpg" + + describe "Admin auth" do + it "parses Bearer tokens" do + parseBearer (Just "Bearer secret") `shouldEqual` Just "secret" + parseBearer (Just "Token secret") `shouldEqual` Nothing + parseBearer Nothing `shouldEqual` Nothing + + describe "Registrations" do + it "validates slug format" do + validSlugFormat "mtmn" `shouldEqual` true + validSlugFormat "a-b-1" `shouldEqual` true + validSlugFormat "Ab" `shouldEqual` false + validSlugFormat "-x" `shouldEqual` false + validSlugFormat "x-" `shouldEqual` false + validSlugFormat "" `shouldEqual` false + validSlugFormat "a b" `shouldEqual` false + + it "flags reserved slugs" do + isReservedSlug "admin" `shouldEqual` true + isReservedSlug "register" `shouldEqual` true + isReservedSlug "" `shouldEqual` true + isReservedSlug "mtmn" `shouldEqual` false + + it "insert/list/get/setStatus/slugTaken round-trip" do + conn <- connect ":memory:" + initRegistrations conn + lock <- Avar.new unit + insertRegistration conn lock + { slug: "alice" + , displayName: "Alice" + , email: "a@x.com" + , listenbrainzUser: Just "alice_lb" + , lastfmUser: Nothing + } + pending <- listByStatus conn "pending" + length pending `shouldEqual` 1 + taken <- slugTaken conn "alice" + taken `shouldEqual` true + free <- slugTaken conn "bob" + free `shouldEqual` false + case pending of + [ r ] -> do + r.slug `shouldEqual` "alice" + r.displayName `shouldEqual` "Alice" + r.listenbrainzUser `shouldEqual` Just "alice_lb" + r.lastfmUser `shouldEqual` Nothing + mReg <- getById conn r.id + map _.slug mReg `shouldEqual` Just "alice" + setStatus conn lock r.id "denied" + pending2 <- listByStatus conn "pending" + length pending2 `shouldEqual` 0 + takenAfterDeny <- slugTaken conn "alice" + takenAfterDeny `shouldEqual` false + _ -> + fail "expected one pending registration"