diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn new file mode 100644 index 0000000..e46f7aa --- /dev/null +++ b/.clj-kondo/config.edn @@ -0,0 +1,109 @@ +{:linters + {:aliased-namespace-symbol {:level :error} + :aliased-namespace-var-usage {:level :error} + :aliased-referred-var {:level :error} + :case-quoted-test {:level :error} + :case-symbol-test {:level :error} + :clj-kondo-config {:level :error} + :cond-else {:level :error} + :condition-always-true {:level :error} + :consistent-alias {:level :error + :aliases {clojure.edn edn + clojure.set set + clojure.spec.alpha s + clojure.spec.gen.alpha gen + clojure.string str + clojure.test t}} + :def-fn {:level :error} + :deprecated-namespace {:level :error} + :deprecated-var {:level :error} + :destructured-or-always-evaluates {:level :error} + :destructured-or-binding-of-same-map {:level :error} + :discouraged-java-method {:level :error} + :discouraged-namespace {:level :error} + :discouraged-tag {:level :error} + :discouraged-var {:level :error} + :do-template {:level :error} + :docstring-leading-trailing-whitespace {:level :error} + :docstring-no-summary {:level :error} + :duplicate-key-args {:level :error} + :duplicate-refer {:level :error} + :earmuffed-var-not-dynamic {:level :error} + :equals-expected-position {:level :error + :position :first} + :equals-false {:level :error} + :equals-float {:level :error} + :equals-nil {:level :error} + :equals-true {:level :error} + :if-nil-return {:level :error} + :inline-def {:level :error} + :is-message-not-string {:level :error} + :keyword-binding {:level :error} + :line-length {:level :error + :max-line-length 120} + :locking-suspicious-lock {:level :error} + :loop-without-recur {:level :error} + :main-without-gen-class {:level :error} + :min-clj-kondo-version {:level :error} + :minus-one {:level :error} + :missing-body-in-when {:level :error} + :missing-clause-in-try {:level :error} + :missing-docstring {:level :error} + :missing-else-branch {:level :error} + :missing-protocol-method {:level :error} + :missing-test-assertion {:level :error} + :multiple-async-in-deftest {:level :error} + :non-arg-vec-return-type-hint {:level :error} + :not-empty? {:level :error} + :plus-one {:level :error} + :reduce-without-init {:level :error} + :redundant-call {:level :error} + :redundant-do {:level :error} + :redundant-expression {:level :error} + :redundant-fn-wrapper {:level :error} + :redundant-format {:level :error} + :redundant-ignore {:level :error} + :redundant-let {:level :error} + :redundant-let-binding {:level :error} + :redundant-nested-call {:level :error} + :redundant-primitive-coercion {:level :error} + :redundant-str-call {:level :error} + :refer {:level :error} + :refer-all {:level :error} + :redefined-var {:level :error} + :schema-misplaced-return {:level :error} + :self-requiring-namespace {:level :error} + :shadowed-fn-param {:level :error} + :shadowed-var {:level :error} + :single-key-in {:level :error} + :single-logical-operand {:level :error} + :single-operand-comparison {:level :error} + :underscore-in-namespace {:level :error} + :unbound-destructuring-default {:level :error} + :uninitialized-var {:level :error} + :unreachable-code {:level :error} + :unresolved-excluded-var {:level :error} + :unresolved-namespace {:level :error} + :unresolved-protocol-method {:level :error} + :unresolved-var {:level :error} + :unquote-not-syntax-quoted {:level :error} + :unsorted-imports {:level :error} + :unsorted-required-namespaces {:level :error + :sort :case-insensitive} + :unused-alias {:level :error} + :unused-binding {:level :error + :exclude-destructured-keys-in-fn-args false + :exclude-destructured-as false + :exclude-defmulti-args false} + :unused-excluded-var {:level :error} + :unused-import {:level :error} + :unused-namespace {:level :error + :simple-libspec false} + :unused-private-var {:level :error} + :unused-referred-var {:level :error} + :unused-value {:level :error} + :use {:level :error} + :used-underscored-binding {:level :error} + :var-same-name-except-case {:level :error} + :warn-on-reflection {:level :error + :warn-only-on-interop true}}} diff --git a/.github/workflows/clojure.yml b/.github/workflows/clojure.yml index a9d4dd3..2d070a2 100644 --- a/.github/workflows/clojure.yml +++ b/.github/workflows/clojure.yml @@ -23,7 +23,7 @@ jobs: name: Set up Java with: distribution: temurin - java-version: 11 + java-version: 21 - uses: actions/setup-python@v4 name: Set up Python with: @@ -34,10 +34,6 @@ jobs: with: path: ~/.cache/pre-commit key: ${{ runner.os }}-pre-commit-${{ hashFiles('.pre-commit-config.yaml') }} - - name: Docker cache - uses: ScribeMD/docker-cache@0.3.6 - with: - key: ${{ runner.os }}-docker-${{ hashFiles('.pre-commit-config.yaml') }} - uses: actions/cache@v3 name: Clojure cache with: @@ -47,19 +43,79 @@ jobs: ~/.clojure ~/.cpcache key: ${{ runner.os }}-clojure-${{ hashFiles('deps.edn') }} - - name: Install Clojure - run: | - curl -L -O https://github.com/clojure/brew-install/releases/latest/download/posix-install.sh - chmod +x posix-install.sh - sudo ./posix-install.sh - rm posix-install.sh + - name: Install Clojure tools + uses: DeLaGuardo/setup-clojure@13 + with: + cli: latest + bb: latest + clj-kondo: 2026.01.19 + cljstyle: 0.15.0 - name: Run pre-commit hooks run: | pip install -r requirements.txt - pre-commit run --all-files - - name: Run clj tests - run: bin/test clj - - name: Run cljs tests + SKIP=kaocha-test pre-commit run --all-files + - name: Run tests run: | npm install - bin/test cljs + bin/kaocha + - name: Upload coverage artifact + if: always() + uses: actions/upload-artifact@v4 + with: + name: coverage-report + path: target/coverage + if-no-files-found: warn + - name: Upload JUnit XML artifact + if: always() + uses: actions/upload-artifact@v4 + with: + name: junit-xml + path: target/test-results/junit.xml + if-no-files-found: warn + + spec-parity: + runs-on: ubuntu-latest + + env: + SQIDS_SPEC_DIR: ${{ github.workspace }}/target/sqids-spec + + steps: + - uses: actions/checkout@v3 + name: Check out repository + - uses: actions/checkout@v3 + name: Check out sqids-spec + with: + repository: sqids/sqids-spec + ref: main + path: target/sqids-spec + - uses: actions/setup-node@v4 + name: Set up Node + with: + node-version: lts/* + cache: npm + cache-dependency-path: | + package-lock.json + target/sqids-spec/package-lock.json + - uses: actions/setup-java@v4 + name: Set up Java + with: + distribution: temurin + java-version: 21 + - uses: actions/cache@v3 + name: Clojure cache + with: + path: | + ~/.m2/repository + ~/.gitlibs + ~/.clojure + ~/.cpcache + key: ${{ runner.os }}-clojure-${{ hashFiles('deps.edn') }} + - name: Install Clojure tools + uses: DeLaGuardo/setup-clojure@13 + with: + cli: latest + - name: Install sqids-spec dependencies + working-directory: target/sqids-spec + run: npm ci + - name: Run sqids-spec parity + run: bin/parity diff --git a/.gitignore b/.gitignore index 6172e3a..f21339d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ -*.class *.iml +*.class +*.iml *.jar *.log *.swp @@ -7,13 +8,19 @@ .calva/output-window/ .classpath .clj-kondo/.cache +.cljs_node_repl/ .cpcache +.cpcache/ .eastwood .factorypath .hg/ .hgignore .idea .lein-* +.lein-deps-sum +.lein-failures +.lein-plugins/ +.lein-repl-history .lsp/.cache .lsp/sqlite.db .nrepl-* @@ -28,9 +35,14 @@ .sw* .vscode /checkouts +/checkouts/ /classes +/classes/ +/lib/ +/out /src/gen /target +/target/ Brewfile.lock.json cljs-test-runner-out/ node_modules/ diff --git a/.markdownlint-cli2.yaml b/.markdownlint-cli2.yaml new file mode 100644 index 0000000..74e68e0 --- /dev/null +++ b/.markdownlint-cli2.yaml @@ -0,0 +1,5 @@ +--- +config: + MD013: false +ignores: + - node_modules/** diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 106dc15..11f50b8 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,38 +1,52 @@ repos: - - repo: https://github.com/clj-kondo/clj-kondo - rev: v2023.10.20 - hooks: - - id: clj-kondo-docker - pass_filenames: false - require_serial: true - repo: https://github.com/pre-commit/pre-commit-hooks - rev: v4.5.0 + rev: v6.0.0 hooks: - id: check-shebang-scripts-are-executable - id: trailing-whitespace - id: end-of-file-fixer - id: check-added-large-files - repo: https://github.com/scop/pre-commit-shfmt - rev: v3.7.0-4 + rev: v3.12.0-2 hooks: - - id: shfmt-docker - entry: mvdan/shfmt:v3.7.0 + - id: shfmt args: [-w, -s, -i, "2"] - repo: https://github.com/koalaman/shellcheck-precommit - rev: v0.9.0 + rev: v0.11.0 hooks: - id: shellcheck - repo: local hooks: + - id: clj-kondo + name: clj-kondo + entry: bin/_clj-kondo --lint src test bin/update-blocklist build.clj deps.edn tests.edn shadow-cljs.edn + language: system + pass_filenames: false + require_serial: true - id: cljstyle name: cljstyle entry: bin/_cljstyle fix language: system types: [file] + - id: kaocha-test + name: kaocha-test + entry: bin/kaocha + language: system + pass_filenames: false + always_run: true + require_serial: true + - id: markdownlint-cli2 + name: markdownlint-cli2 + language: node + entry: markdownlint-cli2 + additional_dependencies: ["markdownlint-cli2@0.21.0"] + types: [markdown] + args: ["--config", ".markdownlint-cli2.yaml", "--fix"] - id: prettier name: prettier - language: docker_image - entry: tmknom/prettier + language: node + entry: prettier + additional_dependencies: ["prettier@3.8.1"] types: [text] args: [--write, --list-different, --ignore-unknown] - id: git-diff diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..2afc913 --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,69 @@ +# Repository Guidelines + +## Project Structure & Module Organization + +- Core library code lives in `src/org/sqids/`. +- Cross-platform API is in `clojure.cljc`; specs are colocated in owning `.cljc` namespaces (`alphabet`, `block_list`, `encoding`, `decoding`, `init`, `results`). +- Spec generator helpers live in mirrored namespaces under `src/org/sqids/clojure/generators/`. +- Platform-specific helper functions are in `platform.clj` (JVM) and `platform.cljs` (CLJS). +- Sqids algorithm logic is implemented in-repo (`alphabet.cljc`, `encoding.cljc`, `decoding.cljc`, `block_list.cljc`, `init.cljc`). +- Bundled data assets are in `resources/` (for example `resources/org/sqids/clojure/blocklist.json`). +- Tests are under `test/org/sqids/clojure/*_test.cljc`. +- The upstream parity harness lives in `test/org/sqids/clojure/parity*.clj` with its Node helper in `test-resources/`. +- Tooling scripts are in `bin/` (`setup`, `kaocha`, `parity`, `repl`, `_clj-kondo`, `_cljstyle`, `update-blocklist`). + +## Build, Test, and Development Commands + +- `bin/setup`: installs local prerequisites (`brew bundle`, `npm install`) on macOS/Homebrew setups. +- `bin/kaocha`: runs all Kaocha suites (JVM `clojure.test`, automatic `clojure.spec.test.check`, and CLJS) with coverage output in `target/coverage/` and JUnit XML in `target/test-results/junit.xml`. +- `SQIDS_SPEC_DIR=/path/to/sqids-spec bin/parity`: runs the JVM-only upstream parity check against a checked-out `sqids-spec` reference repo. +- `bin/repl clj` / `bin/repl cljs`: starts interactive REPLs. +- `bin/update-blocklist`: refreshes `resources/org/sqids/clojure/blocklist.json` from `sqids-spec`. +- `pre-commit run --all-files`: runs local hooks; CI mirrors this as `SKIP=kaocha-test pre-commit run --all-files` followed by `bin/kaocha`. +- `clojure -T:build jar` and `clojure -T:build install`: build and install the jar locally. + +## Project Patterns + +- Treat `AGENTS.md` as a repo table of contents, not an encyclopedia: point to the system-of-record files for behavior, build, tests, lint, and generated data before adding new prose here. +- Prefer checked-in repo knowledge over chat or PR context; if code, tests, and docs disagree, the repository wins and stale guidance should be fixed in the same change. +- Treat `bin/kaocha` as the single test entrypoint for local runs, pre-commit, and CI; avoid re-introducing split CLJ/CLJS wrappers. +- Keep `tests.edn` as the source of truth for suite and report behavior (`:unit`, `:cljs`, `:generative-fdef-checks`, cloverage, JUnit XML target). +- Keep test automation in sync: when pre-commit hook IDs or test commands change, update `.github/workflows/clojure.yml` (`SKIP=...`) in the same commit. +- Prefer local/system hooks and wrappers over Docker hooks (`clj-kondo`, `cljstyle`, `shfmt`, `prettier`); avoid adding Docker-based hook runners. +- Move invariants into mechanical enforcement whenever possible; prefer `clj-kondo`, `cljstyle`, pre-commit, Kaocha, and CI checks over reviewer memory or PR prose. +- Keep algorithm code total in internal namespaces: only public `org.sqids.clojure/{sqids,encode,decode}` should throw. +- Model internal success/failure with `org.sqids.clojure.results` envelopes and staged `results/conform`, `results/bind`, `results/attempt` pipelines. +- Keep tool versions pinned in project config (`deps.edn`, `.pre-commit-config.yaml`); CI may use `latest` for bootstrap tools, but lint/format/test versions should remain explicit. +- Treat `resources/org/sqids/clojure/blocklist.json` as generated data; update it via `bin/update-blocklist` rather than manual edits. +- Add nested `AGENTS.md` files only when a subtree has materially different rules or maintenance needs; keep them short, additive, and scoped to local deltas rather than copying the root guide. +- Pair every `AGENTS.md` with a human-facing `README.md` in the same scope. `AGENTS.md` directs agent behavior; `README.md` explains layout, intent, and workflows for humans. +- When adding a new subsystem, ship code, tests, lint/config enforcement, docstrings, and navigation docs together. +- Keep docs aligned with tooling changes: update `README.md` and this file in the same PR when commands or test flow change. +- When behavior changes, update tests, docstrings, and README examples in the same commit so the contract stays synchronized. +- Preserve public API behavior for `sqids`, `encode`, and `decode`; behavior changes must include deterministic tests and release notes updates. +- Keep upstream parity checks in the shared JS-safe integer domain; this library intentionally supports larger JVM integers than `sqids-spec` can represent. + +## Coding Style & Naming Conventions + +- Follow `.cljstyle`: 2-space indentation and one blank padding line between top-level forms. +- Run formatting before commits: `bin/_cljstyle fix`. +- Lint with pre-commit (includes `clj-kondo`, `cljstyle`, `kaocha-test`, `shellcheck`, `shfmt`, `markdownlint-cli2`, `prettier`, and a clean `git-diff` check). +- `clj-kondo` is intentionally strict in `.clj-kondo/config.edn`; run `bin/_clj-kondo --lint src test bin/update-blocklist build.clj deps.edn tests.edn shadow-cljs.edn` before pushing. +- Every `def`, `defn`, and `defmacro` needs a high-quality docstring. Treat docstrings as living contracts: explain purpose, inputs, return shape, invariants, and failure semantics when they are not obvious from the name alone. +- Keep docstring enforcement strict. If `clj-kondo` stops catching missing docstrings on new function-like forms, tighten the linter or hooks instead of weakening the rule. +- Namespace/file naming follows Clojure conventions: `kebab-case` namespaces and `*_test.cljc` test files. + +## Testing Guidelines + +- Primary framework: `clojure.test` executed by Kaocha; generative spec checks run via a `:kaocha.type/spec.test.check` suite. +- Coverage is enforced at 100% via `:cloverage/opts :fail-threshold`; CI artifacts include `target/coverage/lcov.info` and `target/coverage/codecov.json`. +- Add tests beside related behavior in `test/org/sqids/clojure/`. +- Keep tests deterministic and cover both encode/decode behavior and invalid-input paths. +- Before opening a PR, run `bin/kaocha`. + +## Commit & Pull Request Guidelines + +- Match existing history: short, imperative commit subjects (for example `Fix sqids-javascript link`, `Improve caching`). +- Keep commits focused; separate refactors from behavior changes when possible. +- PRs should include: purpose, key changes, and verification steps/commands run. +- Link relevant issues when applicable and update `CHANGELOG.md` for release-facing changes. diff --git a/Brewfile b/Brewfile index f9b60e1..064ee79 100644 --- a/Brewfile +++ b/Brewfile @@ -1,8 +1,10 @@ # frozen_string_literal: true tap 'borkdude/brew' +tap 'babashka/brew' brew 'borkdude/brew/clj-kondo' +brew 'babashka/brew/babashka' brew 'clojure' brew 'pre-commit' diff --git a/CHANGELOG.md b/CHANGELOG.md index a5bb9fd..d5ad62b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,14 @@ # CHANGELOG -**v1.0.15**: +## Unreleased + +## v1.1.0 + +- Replaced external runtime wrappers with a shared pure Clojure/ClojureScript + Sqids implementation. +- Added a local default blocklist resource and expanded spec-alignment tests. +- Updated contributor/development documentation and script usage text. + +## v1.0.15 - Initial implementation diff --git a/README.md b/README.md index 336208d..e60b57a 100644 --- a/README.md +++ b/README.md @@ -7,32 +7,27 @@ YouTube-looking IDs from numbers. It's good for link shortening, fast & URL-safe ID generation and decoding back into numbers for quicker database lookups. -`sqids-clojure` supports both Clojure and ClojureScript! In a Clojure -environment, `sqids-clojure` wraps -[`sqids-java`](https://github.com/sqids/sqids-java). In a ClojureScript -environment, `sqids-clojure` wraps -[`sqids-javascript`](https://github.com/sqids/sqids-javascript). - -If you notice any issues with decoding or encoding, these are likely an issue in -the upstream wrapped Sqids library. +`sqids-clojure` supports both Clojure and ClojureScript with a shared pure +implementation in this repository. ## Getting started [CLI/`deps.edn`](https://clojure.org/reference/deps_and_cli) dependency -information: +information (replace with the latest version from +[Clojars](https://clojars.org/org.sqids/sqids-clojure)): ```clojure ;; maven -org.sqids/sqids-clojure {:mvn/version "1.0.15"} +org.sqids/sqids-clojure {:mvn/version "1.1.0"} ``` [Leiningen](https://leiningen.org/) dependency information: ```clojure -[org.sqids/sqids-clojure "1.0.15"] +[org.sqids/sqids-clojure "1.1.0"] ``` -After installation, require `sqids-clojure`: +After installation, require the `org.sqids.clojure` namespace: ```clojure (require '[org.sqids.clojure :as sqids]) @@ -53,6 +48,50 @@ Simple encode & decode: (sqids/decode sqids id)) ; [1 2 3] ``` +## Development + +Run the local checks before opening a PR: + +```bash +bin/setup +bin/_clj-kondo --lint src test bin/update-blocklist build.clj deps.edn tests.edn shadow-cljs.edn +bin/kaocha +pre-commit run --all-files +``` + +Run the upstream parity check against a checked-out `sqids-spec` repository: + +```bash +SQIDS_SPEC_DIR=/path/to/sqids-spec bin/parity +``` + +`bin/setup` is optimized for macOS/Homebrew (`brew bundle` + `npm install`). +On other platforms, install Java, Clojure CLI, Babashka, Node.js, Python, and +`pre-commit` manually, then run `npm install`. + +`bin/kaocha` runs all configured Kaocha suites (`clojure.test`, automatic +`clojure.spec.test.check`, and ClojureScript). It enforces 100% cloverage on +the tracked runtime namespaces and writes reports to `target/coverage/`: +`index.html`, `lcov.info`, and `codecov.json`. It also emits JUnit XML to +`target/test-results/junit.xml`. + +`bin/parity` is a separate JVM-only check. It uses `clojure.spec` generators +within the shared JavaScript-safe integer domain, evaluates the same cases with +the checked-out `sqids-spec` TypeScript implementation, and compares those +results to this library. + +Generator-heavy `clojure.spec` helpers live in mirrored namespaces under +`src/org/sqids/clojure/generators/`, while the owning runtime namespaces keep +the specs and algorithm code. + +Refresh the default bundled blocklist from the Sqids spec repository: + +```bash +bin/update-blocklist +``` + +This updates `resources/org/sqids/clojure/blocklist.json`. + > **Note** > 🚧 Because of the algorithm's design, **multiple IDs can decode back into the > same sequence of numbers**. If it's important to your design that IDs are diff --git a/bin/_clj-kondo b/bin/_clj-kondo new file mode 100755 index 0000000..51952b0 --- /dev/null +++ b/bin/_clj-kondo @@ -0,0 +1,7 @@ +#!/usr/bin/env bash + +if command -v clj-kondo >/dev/null; then + clj-kondo "$@" +else + clojure -M:clj-kondo "$@" +fi diff --git a/bin/kaocha b/bin/kaocha new file mode 100755 index 0000000..0cf2703 --- /dev/null +++ b/bin/kaocha @@ -0,0 +1,5 @@ +#!/usr/bin/env bash + +set -euxfo pipefail + +clojure -M:dev:clj:test "$@" diff --git a/bin/parity b/bin/parity new file mode 100755 index 0000000..80943fb --- /dev/null +++ b/bin/parity @@ -0,0 +1,7 @@ +#!/usr/bin/env bash + +set -euxfo pipefail + +: "${SQIDS_SPEC_DIR:?SQIDS_SPEC_DIR must point to a checked-out sqids-spec repository}" + +clojure -M:dev:clj -m org.sqids.clojure.parity-runner "$@" diff --git a/bin/repl b/bin/repl index 2324627..ea96f26 100755 --- a/bin/repl +++ b/bin/repl @@ -10,7 +10,7 @@ cljs) npx shadow-cljs -A:dev node-repl ;; *) - : "Usage: bin/repl clj|cljs" >&2 + echo "Usage: bin/repl clj|cljs" >&2 exit 1 ;; esac diff --git a/bin/test b/bin/test deleted file mode 100755 index 034bd23..0000000 --- a/bin/test +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/env bash - -set -euxfo pipefail - -case "${1:-}" in -clj) - clojure -M:dev:clj:test - ;; -cljs) - npx shadow-cljs -A:dev compile test - node target/cljs-tests.js - ;; -*) - : "Usage: bin/run-tests clj|cljs" - exit 1 - ;; -esac diff --git a/bin/update-blocklist b/bin/update-blocklist new file mode 100755 index 0000000..c11f841 --- /dev/null +++ b/bin/update-blocklist @@ -0,0 +1,75 @@ +#!/usr/bin/env bb + +(set! *warn-on-reflection* true) + +(require + '[babashka.fs :as fs] + '[cheshire.core :as json] + '[clojure.string :as str]) + +(def default-source-url + "Default upstream Sqids blocklist JSON URL." + "https://raw.githubusercontent.com/sqids/sqids-spec/main/src/blocklist.json") + +(def script-path + "Canonical path to this script." + (fs/canonicalize *file*)) + +(def repo-root + "Repository root directory derived from `script-path`." + (-> script-path fs/parent fs/parent)) + +(def default-output-path + "Default destination for the generated bundled blocklist." + (str (fs/path repo-root "resources" "org" "sqids" "clojure" "blocklist.json"))) + +(def source-url + "Effective source URL, optionally overridden by the first CLI argument." + (or (first *command-line-args*) default-source-url)) + +(def output-path + "Effective output path, optionally overridden by the second CLI argument." + (or (second *command-line-args*) default-output-path)) + +(defn fail + "Prints `message` to stderr and exits with a non-zero status." + [message] + (binding [*out* *err*] + (println message)) + (System/exit 1)) + +(defn normalize-words + "Normalizes fetched words into a trimmed, sorted vector of unique strings." + [words] + (->> words + (map str/trim) + (remove str/blank?) + set + sort + vec)) + +(defn parse-words + "Parses upstream JSON and returns normalized blocklist entries." + [body] + (let [data + (try + (json/parse-string body) + (catch Exception e + (fail (str "Failed to parse upstream blocklist JSON: " (.getMessage e)))))] + (when-not (and (sequential? data) (every? string? data)) + (fail "Expected a JSON array of strings")) + (normalize-words data))) + +(defn run + "Fetches the upstream blocklist and writes the bundled JSON artifact." + [] + (let [body (try + (slurp source-url) + (catch Exception e + (fail (str "Failed to fetch blocklist: " (.getMessage e))))) + words (parse-words body)] + (fs/create-dirs (fs/parent output-path)) + (spit output-path (str (json/generate-string words {:pretty true}) "\n")) + (println (str "Wrote " (count words) " blocklist entries to " output-path)))) + +(run) diff --git a/build.clj b/build.clj index 1043e8a..148b93a 100644 --- a/build.clj +++ b/build.clj @@ -1,22 +1,27 @@ (ns build - (:refer-clojure :exclude [test]) (:require [clojure.string :as str] [clojure.tools.build.api :as b] [deps-deploy.deps-deploy :as dd])) -(def lib 'org.sqids/sqids-clojure) +(def lib + "Library coordinate for release artifacts." + 'org.sqids/sqids-clojure) (def versions + "Map of release and snapshot version strings." (let [major 1 - minor 0 - commits {:release (b/git-count-revs nil) + minor 1 + patch {:release 0 :snapshot "9999-SNAPSHOT"}] - (update-vals commits #(str/join "." [major minor %])))) + (update-vals patch #(str/join "." [major minor %])))) -(def class-dir "target/classes") +(def class-dir + "Compilation output directory used by tools.build." + "target/classes") (defn- pom-template + "Builds pom metadata entries for a given version." [version] [[:description "Official Clojure port of Sqids. Generate short YouTube-looking IDs from numbers."] [:url "https://github.com/sqids/sqids-clojure"] @@ -34,6 +39,7 @@ [:tag (str "v" version)]]]) (defn jar-opts + "Returns normalized build options for jar/install/deploy tasks." [opts] (let [version (versions (if (:snapshot opts) :snapshot :release))] (assoc opts @@ -43,7 +49,7 @@ :basis (b/create-basis {:aliases [:clj]}) :class-dir class-dir :target "target" - :src-dirs ["src"] + :src-dirs ["src" "resources"] :pom-data (pom-template version)))) (defn jar @@ -54,7 +60,7 @@ (println "\nWriting pom.xml...") (b/write-pom opts) (println "\nCopying source...") - (b/copy-dir {:src-dirs ["src"] :target-dir class-dir}) + (b/copy-dir {:src-dirs ["src" "resources"] :target-dir class-dir}) (println "\nBuilding JAR..." (:jar-file opts)) (b/jar opts)) opts) diff --git a/deps.edn b/deps.edn index 176dfbd..04b41de 100644 --- a/deps.edn +++ b/deps.edn @@ -1,18 +1,17 @@ {:paths - ["src"] + ["src" "resources"] :deps - {borkdude/dynaload {:mvn/version "0.3.5"}} + {} :aliases {:clj {:extra-deps - {org.clojure/clojure {:mvn/version "1.11.1"} - org.sqids/sqids {:mvn/version "0.1.0"}}} + {org.clojure/clojure {:mvn/version "1.12.4"}}} :cljs {:extra-deps - {thheller/shadow-cljs {:mvn/version "2.26.2"}}} + {thheller/shadow-cljs {:mvn/version "3.3.6"}}} :dev {:extra-paths @@ -20,21 +19,25 @@ :extra-deps {expound/expound {:mvn/version "0.9.0"} - org.clojure/test.check {:mvn/version "1.1.1"} - org.clojure/tools.namespace {:mvn/version "1.4.4"} + org.clojure/data.json {:mvn/version "2.5.1"} + org.clojure/test.check {:mvn/version "1.1.3"} + org.clojure/tools.namespace {:mvn/version "1.5.1"} orchestra/orchestra {:mvn/version "2021.01.01-1"}}} :test {:extra-deps - {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1" :git/sha "dfb30dd"}} - :main-opts ["-m" "cognitect.test-runner"]} + {lambdaisland/kaocha {:mvn/version "1.91.1392"} + com.lambdaisland/kaocha-cljs {:mvn/version "1.9.181"} + lambdaisland/kaocha-junit-xml {:mvn/version "1.17.101"} + lambdaisland/kaocha-cloverage {:mvn/version "1.1.89"}} + :main-opts ["-m" "kaocha.runner"]} :cljstyle {:replace-deps {mvxcvi/cljstyle {:mvn/version "0.15.0"}} :main-opts ["-m" "cljstyle.main"]} :clj-kondo - {:replace-deps {clj-kondo/clj-kondo {:mvn/version "2023.10.20"}} + {:replace-deps {clj-kondo/clj-kondo {:mvn/version "2026.01.19"}} :main-opts ["-m" "clj-kondo.main"]} :build @@ -46,5 +49,5 @@ build} :nrepl - {:extra-deps {nrepl/nrepl {:mvn/version "1.1.0"}} + {:extra-deps {nrepl/nrepl {:mvn/version "1.6.0"}} :main-opts ["-m" "nrepl.cmdline" "--interactive" "--color"]}}} diff --git a/dev/org/sqids/clojure/test_runner.cljc b/dev/org/sqids/clojure/test_runner.cljc deleted file mode 100644 index 92ec04c..0000000 --- a/dev/org/sqids/clojure/test_runner.cljc +++ /dev/null @@ -1,12 +0,0 @@ -(ns org.sqids.clojure.test-runner - (:require - [clojure.test :as t] - [org.sqids.clojure.alphabet-test] - [org.sqids.clojure.block-list-test] - [org.sqids.clojure.encoding-test] - [org.sqids.clojure.min-length-test] - [org.sqids.clojure.spec-test])) - -(defn run-all-tests - [] - (t/run-all-tests #"^org\.sqids\.clojure\..*-test$")) diff --git a/package-lock.json b/package-lock.json index 94fab0e..0012c1f 100644 --- a/package-lock.json +++ b/package-lock.json @@ -4,11 +4,9 @@ "requires": true, "packages": { "": { - "dependencies": { - "sqids": "0.3.0" - }, "devDependencies": { - "shadow-cljs": "^3.3.6" + "shadow-cljs": "^3.3.6", + "ws": "^8.19.0" } }, "node_modules/base64-js": { @@ -163,11 +161,6 @@ "source-map": "^0.6.0" } }, - "node_modules/sqids": { - "version": "0.3.0", - "resolved": "https://registry.npmjs.org/sqids/-/sqids-0.3.0.tgz", - "integrity": "sha512-lOQK1ucVg+W6n3FhRwwSeUijxe93b51Bfz5PMRMihVf1iVkl82ePQG7V5vwrhzB11v0NtsR25PSZRGiSomJaJw==" - }, "node_modules/which": { "version": "5.0.0", "resolved": "https://registry.npmjs.org/which/-/which-5.0.0.tgz", diff --git a/package.json b/package.json index 27bdddb..e49e688 100644 --- a/package.json +++ b/package.json @@ -1,8 +1,6 @@ { - "dependencies": { - "sqids": "0.3.0" - }, "devDependencies": { - "shadow-cljs": "^3.3.6" + "shadow-cljs": "^3.3.6", + "ws": "^8.19.0" } } diff --git a/resources/org/sqids/clojure/blocklist.json b/resources/org/sqids/clojure/blocklist.json new file mode 100644 index 0000000..7506493 --- /dev/null +++ b/resources/org/sqids/clojure/blocklist.json @@ -0,0 +1,562 @@ +[ + "0rgasm", + "1d10t", + "1d1ot", + "1di0t", + "1diot", + "1eccacu10", + "1eccacu1o", + "1eccacul0", + "1eccaculo", + "1mbec11e", + "1mbec1le", + "1mbeci1e", + "1mbecile", + "a11upat0", + "a11upato", + "a1lupat0", + "a1lupato", + "aand", + "ah01e", + "ah0le", + "aho1e", + "ahole", + "al1upat0", + "al1upato", + "allupat0", + "allupato", + "ana1", + "ana1e", + "anal", + "anale", + "anus", + "arrapat0", + "arrapato", + "arsch", + "arse", + "ass", + "b00b", + "b00be", + "b01ata", + "b0ceta", + "b0iata", + "b0ob", + "b0obe", + "b0sta", + "b1tch", + "b1te", + "b1tte", + "ba1atkar", + "balatkar", + "bastard0", + "bastardo", + "batt0na", + "battona", + "bitch", + "bite", + "bitte", + "bo0b", + "bo0be", + "bo1ata", + "boceta", + "boiata", + "boob", + "boobe", + "bosta", + "bran1age", + "bran1er", + "bran1ette", + "bran1eur", + "bran1euse", + "branlage", + "branler", + "branlette", + "branleur", + "branleuse", + "c0ck", + "c0g110ne", + "c0g11one", + "c0g1i0ne", + "c0g1ione", + "c0gl10ne", + "c0gl1one", + "c0gli0ne", + "c0glione", + "c0na", + "c0nnard", + "c0nnasse", + "c0nne", + "c0u111es", + "c0u11les", + "c0u1l1es", + "c0u1lles", + "c0ui11es", + "c0ui1les", + "c0uil1es", + "c0uilles", + "c11t", + "c11t0", + "c11to", + "c1it", + "c1it0", + "c1ito", + "cabr0n", + "cabra0", + "cabrao", + "cabron", + "caca", + "cacca", + "cacete", + "cagante", + "cagar", + "cagare", + "cagna", + "cara1h0", + "cara1ho", + "caracu10", + "caracu1o", + "caracul0", + "caraculo", + "caralh0", + "caralho", + "cazz0", + "cazz1mma", + "cazzata", + "cazzimma", + "cazzo", + "ch00t1a", + "ch00t1ya", + "ch00tia", + "ch00tiya", + "ch0d", + "ch0ot1a", + "ch0ot1ya", + "ch0otia", + "ch0otiya", + "ch1asse", + "ch1avata", + "ch1er", + "ch1ng0", + "ch1ngadaz0s", + "ch1ngadazos", + "ch1ngader1ta", + "ch1ngaderita", + "ch1ngar", + "ch1ngo", + "ch1ngues", + "ch1nk", + "chatte", + "chiasse", + "chiavata", + "chier", + "ching0", + "chingadaz0s", + "chingadazos", + "chingader1ta", + "chingaderita", + "chingar", + "chingo", + "chingues", + "chink", + "cho0t1a", + "cho0t1ya", + "cho0tia", + "cho0tiya", + "chod", + "choot1a", + "choot1ya", + "chootia", + "chootiya", + "cl1t", + "cl1t0", + "cl1to", + "clit", + "clit0", + "clito", + "cock", + "cog110ne", + "cog11one", + "cog1i0ne", + "cog1ione", + "cogl10ne", + "cogl1one", + "cogli0ne", + "coglione", + "cona", + "connard", + "connasse", + "conne", + "cou111es", + "cou11les", + "cou1l1es", + "cou1lles", + "coui11es", + "coui1les", + "couil1es", + "couilles", + "cracker", + "crap", + "cu10", + "cu1att0ne", + "cu1attone", + "cu1er0", + "cu1ero", + "cu1o", + "cul0", + "culatt0ne", + "culattone", + "culer0", + "culero", + "culo", + "cum", + "cunt", + "d11d0", + "d11do", + "d1ck", + "d1ld0", + "d1ldo", + "damn", + "de1ch", + "deich", + "depp", + "di1d0", + "di1do", + "dick", + "dild0", + "dildo", + "dyke", + "encu1e", + "encule", + "enema", + "enf01re", + "enf0ire", + "enfo1re", + "enfoire", + "estup1d0", + "estup1do", + "estupid0", + "estupido", + "etr0n", + "etron", + "f0da", + "f0der", + "f0ttere", + "f0tters1", + "f0ttersi", + "f0tze", + "f0utre", + "f1ca", + "f1cker", + "f1ga", + "fag", + "fica", + "ficker", + "figa", + "foda", + "foder", + "fottere", + "fotters1", + "fottersi", + "fotze", + "foutre", + "fr0c10", + "fr0c1o", + "fr0ci0", + "fr0cio", + "fr0sc10", + "fr0sc1o", + "fr0sci0", + "fr0scio", + "froc10", + "froc1o", + "froci0", + "frocio", + "frosc10", + "frosc1o", + "frosci0", + "froscio", + "fuck", + "g00", + "g0o", + "g0u1ne", + "g0uine", + "gandu", + "go0", + "goo", + "gou1ne", + "gouine", + "gr0gnasse", + "grognasse", + "haram1", + "harami", + "haramzade", + "hund1n", + "hundin", + "id10t", + "id1ot", + "idi0t", + "idiot", + "imbec11e", + "imbec1le", + "imbeci1e", + "imbecile", + "j1zz", + "jerk", + "jizz", + "k1ke", + "kam1ne", + "kamine", + "kike", + "leccacu10", + "leccacu1o", + "leccacul0", + "leccaculo", + "m1erda", + "m1gn0tta", + "m1gnotta", + "m1nch1a", + "m1nchia", + "m1st", + "mam0n", + "mamahuev0", + "mamahuevo", + "mamon", + "masturbat10n", + "masturbat1on", + "masturbate", + "masturbati0n", + "masturbation", + "merd0s0", + "merd0so", + "merda", + "merde", + "merdos0", + "merdoso", + "mierda", + "mign0tta", + "mignotta", + "minch1a", + "minchia", + "mist", + "musch1", + "muschi", + "n1gger", + "neger", + "negr0", + "negre", + "negro", + "nerch1a", + "nerchia", + "nigger", + "orgasm", + "p00p", + "p011a", + "p01la", + "p0l1a", + "p0lla", + "p0mp1n0", + "p0mp1no", + "p0mpin0", + "p0mpino", + "p0op", + "p0rca", + "p0rn", + "p0rra", + "p0uff1asse", + "p0uffiasse", + "p1p1", + "p1pi", + "p1r1a", + "p1rla", + "p1sc10", + "p1sc1o", + "p1sci0", + "p1scio", + "p1sser", + "pa11e", + "pa1le", + "pal1e", + "palle", + "pane1e1r0", + "pane1e1ro", + "pane1eir0", + "pane1eiro", + "panele1r0", + "panele1ro", + "paneleir0", + "paneleiro", + "patakha", + "pec0r1na", + "pec0rina", + "pecor1na", + "pecorina", + "pen1s", + "pendej0", + "pendejo", + "penis", + "pip1", + "pipi", + "pir1a", + "pirla", + "pisc10", + "pisc1o", + "pisci0", + "piscio", + "pisser", + "po0p", + "po11a", + "po1la", + "pol1a", + "polla", + "pomp1n0", + "pomp1no", + "pompin0", + "pompino", + "poop", + "porca", + "porn", + "porra", + "pouff1asse", + "pouffiasse", + "pr1ck", + "prick", + "pussy", + "put1za", + "puta", + "puta1n", + "putain", + "pute", + "putiza", + "puttana", + "queca", + "r0mp1ba11e", + "r0mp1ba1le", + "r0mp1bal1e", + "r0mp1balle", + "r0mpiba11e", + "r0mpiba1le", + "r0mpibal1e", + "r0mpiballe", + "rand1", + "randi", + "rape", + "recch10ne", + "recch1one", + "recchi0ne", + "recchione", + "retard", + "romp1ba11e", + "romp1ba1le", + "romp1bal1e", + "romp1balle", + "rompiba11e", + "rompiba1le", + "rompibal1e", + "rompiballe", + "ruff1an0", + "ruff1ano", + "ruffian0", + "ruffiano", + "s1ut", + "sa10pe", + "sa1aud", + "sa1ope", + "sacanagem", + "sal0pe", + "salaud", + "salope", + "saugnapf", + "sb0rr0ne", + "sb0rra", + "sb0rrone", + "sbattere", + "sbatters1", + "sbattersi", + "sborr0ne", + "sborra", + "sborrone", + "sc0pare", + "sc0pata", + "sch1ampe", + "sche1se", + "sche1sse", + "scheise", + "scheisse", + "schlampe", + "schwachs1nn1g", + "schwachs1nnig", + "schwachsinn1g", + "schwachsinnig", + "schwanz", + "scopare", + "scopata", + "sexy", + "sh1t", + "shit", + "slut", + "sp0mp1nare", + "sp0mpinare", + "spomp1nare", + "spompinare", + "str0nz0", + "str0nza", + "str0nzo", + "stronz0", + "stronza", + "stronzo", + "stup1d", + "stupid", + "succh1am1", + "succh1ami", + "succhiam1", + "succhiami", + "sucker", + "t0pa", + "tapette", + "test1c1e", + "test1cle", + "testic1e", + "testicle", + "tette", + "topa", + "tr01a", + "tr0ia", + "tr0mbare", + "tr1ng1er", + "tr1ngler", + "tring1er", + "tringler", + "tro1a", + "troia", + "trombare", + "turd", + "twat", + "vaffancu10", + "vaffancu1o", + "vaffancul0", + "vaffanculo", + "vag1na", + "vagina", + "verdammt", + "verga", + "w1chsen", + "wank", + "wichsen", + "x0ch0ta", + "x0chota", + "xana", + "xoch0ta", + "xochota", + "z0cc01a", + "z0cc0la", + "z0cco1a", + "z0ccola", + "z1z1", + "z1zi", + "ziz1", + "zizi", + "zocc01a", + "zocc0la", + "zocco1a", + "zoccola" +] diff --git a/src/deps.cljs b/src/deps.cljs deleted file mode 100644 index 9a421d9..0000000 --- a/src/deps.cljs +++ /dev/null @@ -1 +0,0 @@ -{:npm-deps {"sqids" "0.3.0"}} diff --git a/src/org/sqids/clojure.cljc b/src/org/sqids/clojure.cljc index 715682e..7da1e5e 100644 --- a/src/org/sqids/clojure.cljc +++ b/src/org/sqids/clojure.cljc @@ -1,83 +1,47 @@ (ns org.sqids.clojure (:require - [org.sqids.clojure.platform :as platform] - [org.sqids.clojure.spec :as spec])) + [org.sqids.clojure.decoding :as decoding] + [org.sqids.clojure.encoding :as encoding] + #?@(:clj + [[org.sqids.clojure.errors :as errors]]) + [org.sqids.clojure.init :as init] + [org.sqids.clojure.results :as results]) + #?(:cljs + (:require-macros + [org.sqids.clojure.errors :as errors]))) (def default-options - (spec/conform! ::spec/options - {:alphabet platform/default-alphabet - :min-length platform/default-min-length - :block-list (set platform/default-block-list)})) + "Default Sqids options after initialization." + (::results/value (init/sqids init/default-options))) (defn sqids - "Builds a sqids map. Supported options in `options`: + "Builds an immutable Sqids configuration map. - | key | description | - |---------------|-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------| - | `:alphabet` | A string. The alphabet to which a vector of numbers will be encoded to a Sqid and from which a Sqid will be decoded to a vector of numbers. Minimum length is `org.sqids.Sqids$MIN_ALPHABET_LENGTH`. Must not contain multi-byte characters. Must consistent of unique characters. Default is `org.sqids.Sqids$Builder/DEFAULT_ALPHABET`. | - | `:min-length` | An int. The minimum length of an Sqid. Must be in [0, `org.sqids.Sqids$MIN_LENGTH_LIMIT`]. Default is `org.sqids.Sqids$Builder/DEFAULT_MIN_LENGTH`. | - | `:block-list` | A set of strings. Any words that should be excluded from an encoded Sqid. Any words shorter than `org.sqids.Sqids/MIN_BLOCK_LIST_WORD_LENGTH` will be excluded. | " + Supported options: + - `:alphabet` String with unique single-byte chars and length >= 3. + - `:min-length` Integer in [0, 255]. + - `:block-list` Set of words to exclude from encoded IDs. + + If `:block-list` is omitted, the default Sqids blocklist is used. + If `:block-list` is an empty set, blocklist filtering is disabled." ([] (sqids {})) ([options] - (let [complete-options - (->> options - (spec/conform! ::spec/options) - (merge default-options)) - - instance - (platform/sqids complete-options)] - - (->> instance - (assoc complete-options :instance) - (spec/conform! ::spec/sqids))))) + (-> options + init/sqids + errors/unwrap-or-throw!))) -;; NOTE: Generative testing is disabled for encode because it may throw a -;; RuntimeException. (defn encode - "Encodes numbers into a Sqid string. Arguments: - - | name | description | - |------------|-------------------------------------------------------------------------------| - | `s` | A map returned by `org.sqids.clojure/sqids`. | - | `nat-ints` | A sequential collection of natural ints that will be encoded into a Sqid. | - - Returns an empty string if `nat-ints` is empty. Throws a `RuntimeException` if - any value in `nat-ints` is negative. May throw a `RuntimeException` if a Sqid - cannot be generated due to too many attempts." - [s nat-ints] - (let [instance - (spec/conform! ::spec/instance (:instance s)) - - numbers - (->> nat-ints - (spec/conform! ::spec/nat-ints) - (mapv long)) - - result - (platform/encode instance numbers)] - - (spec/conform! ::spec/sqid result))) + "Encodes a sequence of non-negative integers into a Sqid string." + [sqids-config numbers] + (-> (encoding/encode sqids-config numbers) + errors/unwrap-or-throw!)) (defn decode - "Decodes a Sqid string into numbers. Arguments: - - | name | description | - |--------|----------------------------------------------| - | `s` | A map returned by `org.sqids.clojure/sqids`. | - | `sqid` | A Sqid string. | - - Returns an empty vector if `sqid` is empty. For particularly long Sqids, - results may be negative due to long overflow; these results should be - considered invalid." - [s sqid] - (let [instance - (spec/conform! ::spec/instance (:instance s)) - - id - (spec/conform! ::spec/sqid sqid) - - numbers - (vec (platform/decode instance id))] + "Decodes a Sqid string back into a vector of integers. - (spec/conform! ::spec/ints numbers))) + Returns `[]` when the input contains characters outside the configured + alphabet." + [sqids-config sqid] + (-> (decoding/decode sqids-config sqid) + errors/unwrap-or-throw!)) diff --git a/src/org/sqids/clojure/alphabet.cljc b/src/org/sqids/clojure/alphabet.cljc new file mode 100644 index 0000000..3fbf5d1 --- /dev/null +++ b/src/org/sqids/clojure/alphabet.cljc @@ -0,0 +1,66 @@ +(ns org.sqids.clojure.alphabet + (:require + [clojure.spec.alpha :as s] + [org.sqids.clojure.generators.alphabet :as alphabet-generators] + [org.sqids.clojure.platform :as platform])) + +(def default + "Default Sqids alphabet." + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") + +(def min-length + "Minimum allowed alphabet size." + 3) + +(def max-char-code + "Highest single-byte character code accepted in Sqids alphabets." + 127) + +(defn rotate-left + "Returns `alphabet` rotated left by `offset` characters." + [alphabet offset] + (str (subs alphabet offset) (subs alphabet 0 offset))) + +(defn reverse-str + "Returns `s` with characters reversed." + [s] + (apply str (reverse s))) + +(defn consistent-shuffle + "Applies the deterministic Sqids alphabet shuffle." + [alphabet] + (let [size (count alphabet)] + (loop [alphabet-chars (vec alphabet) + left-index 0 + right-index (dec size)] + (if (<= right-index 0) + (apply str alphabet-chars) + (let [swap-index (mod (+ (* left-index right-index) + (platform/char-code (nth alphabet-chars left-index)) + (platform/char-code (nth alphabet-chars right-index))) + size) + left-char (nth alphabet-chars left-index) + swap-char (nth alphabet-chars swap-index)] + (recur (assoc alphabet-chars left-index swap-char swap-index left-char) + (inc left-index) + (dec right-index))))))) + +(s/def ::alphabet-string + string?) + +(s/def ::alphabet-distinct + #(apply distinct? %)) + +(s/def ::alphabet-min-length + #(>= (count %) min-length)) + +(s/def ::alphabet-no-multibyte + #(every? (fn [character] (<= (platform/char-code character) max-char-code)) %)) + +(s/def ::alphabet + (s/with-gen + (s/and ::alphabet-string + ::alphabet-distinct + ::alphabet-min-length + ::alphabet-no-multibyte) + #(alphabet-generators/alphabet default min-length))) diff --git a/src/org/sqids/clojure/block_list.cljc b/src/org/sqids/clojure/block_list.cljc new file mode 100644 index 0000000..7052e0c --- /dev/null +++ b/src/org/sqids/clojure/block_list.cljc @@ -0,0 +1,103 @@ +(ns org.sqids.clojure.block-list + (:require + #?@(:clj + [[clojure.edn :as edn] + [clojure.java.io :as io]]) + [clojure.set :as set] + [clojure.spec.alpha :as s] + [clojure.string :as str] + [org.sqids.clojure.alphabet :as alphabet] + [org.sqids.clojure.generators.block-list :as block-list-generators]) + #?(:cljs + (:require-macros + [org.sqids.clojure.block-list :as block-list-macros]))) + +(def min-word-length + "Minimum blocklist word length considered for matching." + 3) + +(def block-list-word-characters + "Characters used for generated block-list words." + (vec "abcdefghijklmnopqrstuvwxyz0123456789")) + +#?(:clj + (defmacro read-default + "Loads and returns the bundled default blocklist words at macro expansion time." + [] + (let [resource (io/resource "org/sqids/clojure/blocklist.json")] + (if-not resource + #{} + (-> resource + slurp + edn/read-string + set))))) + +(def default-words + "Default Sqids blocklist words loaded from the bundled resource." + #?(:clj + (read-default) + :cljs + (block-list-macros/read-default))) + +(defn remove-invalid-words + "Normalizes and filters blocklist words to lowercase alphabet-compatible entries." + [block-list alphabet] + (let [alphabet-set (set (str/lower-case alphabet))] + ;; Normalize blocklist words into the same lowercase alphabet domain used + ;; by encoding/decoding, and drop words that cannot ever match. + (into #{} + (comp (map str/lower-case) + (filter #(>= (count %) min-word-length)) + (filter #(set/subset? (set %) alphabet-set))) + block-list))) + +(defn- index-bucket + "Classifies a blocklist word by Sqids matching behavior." + [word] + (cond + (<= (count word) min-word-length) + :exact + + ;; Words that contain digits only match at boundaries per Sqids rules. + (re-find #"\d" word) + :prefix-suffix + + :else + :contains)) + +(defn build-index + "Builds blocklist match buckets for efficient blocked-id checks." + [block-list] + (reduce + (fn [idx word] + (update idx (index-bucket word) conj word)) + {:exact #{} + :prefix-suffix #{} + :contains #{}} + block-list)) + +(defn blocked-id? + "Returns true when `id` matches any indexed blocklist word." + [idx id] + (let [normalized-id (str/lower-case id) + id-length (count normalized-id)] + (cond + (< id-length min-word-length) + false + + :else + (or (contains? (:exact idx) normalized-id) + (when (> id-length min-word-length) + (or (some #(or (str/starts-with? normalized-id %) + (str/ends-with? normalized-id %)) + (:prefix-suffix idx)) + (some #(str/includes? normalized-id %) + (:contains idx)))))))) + +(s/def ::block-list + (s/with-gen + (s/coll-of string? :kind set?) + #(block-list-generators/block-list + {:alphabet-option alphabet/default + :word-characters block-list-word-characters + :min-word-length min-word-length}))) diff --git a/src/org/sqids/clojure/decoding.cljc b/src/org/sqids/clojure/decoding.cljc new file mode 100644 index 0000000..0730446 --- /dev/null +++ b/src/org/sqids/clojure/decoding.cljc @@ -0,0 +1,114 @@ +(ns org.sqids.clojure.decoding + (:require + [clojure.set :as set] + [clojure.spec.alpha :as s] + [clojure.string :as str] + [org.sqids.clojure.alphabet :as alphabet] + [org.sqids.clojure.encoding :as encoding] + [org.sqids.clojure.generators.decoding :as decoding-generators] + [org.sqids.clojure.init :as init] + [org.sqids.clojure.platform :as platform] + [org.sqids.clojure.results :as results])) + +(defn- to-number + "Decodes an ID chunk into a number for the provided alphabet." + [id alphabet] + (let [base (count alphabet)] + (loop [acc 0 + remaining-chars (seq id)] + (if (empty? remaining-chars) + acc + (when-some [idx (str/index-of alphabet (first remaining-chars))] + (when-some [next-value (platform/decode-step acc base idx)] + (recur next-value (next remaining-chars)))))))) + +(defn- parse-chunk-metadata + "Splits remaining input into the next chunk and decode state." + [remaining alphabet] + (let [separator (first alphabet) + separator-index (str/index-of remaining separator) + chunk-end (or separator-index (count remaining))] + ;; The first alphabet character is the per-round separator; the next round + ;; uses a deterministic shuffle only when another separator exists. + {:chunk (subs remaining 0 chunk-end) + :next-remaining (if separator-index + (subs remaining (inc chunk-end)) + "") + :next-alphabet (if separator-index + (alphabet/consistent-shuffle alphabet) + alphabet)})) + +(defn ^:private decode-raw + "Decodes a Sqid string into a vector of numbers for initialized inputs." + [{:keys [sqids sqid]}] + (let [source-alphabet (:alphabet sqids)] + (cond + (empty? sqid) + [] + + (not (set/subset? (set sqid) (set source-alphabet))) + [] + + :else + (let [prefix-char (first sqid) + prefix-offset (str/index-of source-alphabet prefix-char) + initial-alphabet (-> source-alphabet + (alphabet/rotate-left prefix-offset) + alphabet/reverse-str)] + (loop [remaining (subs sqid 1) + current-alphabet initial-alphabet + numbers []] + (if (empty? remaining) + numbers + (let [{decoded-chunk :chunk + next-remaining :next-remaining + next-alphabet :next-alphabet} + (parse-chunk-metadata remaining current-alphabet)] + (if (empty? decoded-chunk) + numbers + (if-some [decoded-number (to-number decoded-chunk (subs current-alphabet 1))] + (recur next-remaining next-alphabet (conj numbers decoded-number)) + []))))))))) + +(defn decode + "Decodes a Sqid and returns a non-throwing result envelope." + [sqids-config sqid] + (-> (results/attempt ::decode-init-stage + #(init/ensure-initialized sqids-config)) + (results/bind ::decode-args-stage + (fn [initialized-config] + (results/conform ::decode-args + [initialized-config sqid] + ::decode-args-stage))) + (results/bind ::decode-run-stage + (fn [conformed-args] + (results/ok (decode-raw conformed-args)))) + (results/bind ::decode-ret-stage + (fn [decoded-values] + (results/conform ::decoded-ints + decoded-values + ::decode-ret-stage))))) + +(s/def ::sqid + (s/with-gen + string? + decoding-generators/sqid)) + +(s/def ::decoded-ints + (s/coll-of ::encoding/nat-int :kind vector?)) + +(s/def ::decode-args + (s/with-gen + (s/cat :sqids ::init/sqids + :sqid ::sqid) + decoding-generators/decode-args)) + +(s/def ::decode-result + (s/or :ok (results/ok-result-for ::decoded-ints) + :error ::results/error-result)) + +(s/def ::decode-call-args + (s/with-gen + (s/cat :sqids-config any? + :sqid any?) + decoding-generators/decode-call-args)) diff --git a/src/org/sqids/clojure/encoding.cljc b/src/org/sqids/clojure/encoding.cljc new file mode 100644 index 0000000..8518f26 --- /dev/null +++ b/src/org/sqids/clojure/encoding.cljc @@ -0,0 +1,148 @@ +(ns org.sqids.clojure.encoding + (:require + [clojure.spec.alpha :as s] + [org.sqids.clojure.alphabet :as alphabet] + [org.sqids.clojure.block-list :as block-list] + [org.sqids.clojure.generators.encoding :as encoding-generators] + [org.sqids.clojure.init :as init] + [org.sqids.clojure.platform :as platform] + [org.sqids.clojure.results :as results])) + +(defn- to-id + "Encodes a non-negative integer into base-`alphabet` characters." + [number alphabet] + (let [base (count alphabet)] + (loop [n number + out ()] + (let [idx (int (mod n base)) + ;; `conj` on a list prepends, which builds base digits from least to + ;; most significant and yields the final order once joined. + out (conj out (nth alphabet idx)) + n (quot n base)] + (if (pos? n) + (recur n out) + (apply str out)))))) + +(defn- prefix-offset + "Computes the deterministic prefix offset for an encode attempt." + [alphabet numbers] + (let [alpha-len (count alphabet)] + ;; Spec-driven offset based on number positions and the selected alphabet + ;; character codes, before retry attempt adjustment. + (mod (reduce-kv (fn [acc index number] + (let [char-index (int (mod number alpha-len))] + (+ acc index (platform/char-code (nth alphabet char-index))))) + (count numbers) + numbers) + alpha-len))) + +(defn- encode-prefix + "Encodes numbers with prefix/separators and returns `[id alphabet]`." + [sqids numbers attempt] + (let [base-alphabet (:alphabet sqids) + alpha-len (count base-alphabet) + adjusted-offset (int (mod (+ (prefix-offset base-alphabet numbers) + attempt) + alpha-len)) + rotated-alphabet (alphabet/rotate-left base-alphabet adjusted-offset) + prefix (first rotated-alphabet) + initial-alphabet (alphabet/reverse-str rotated-alphabet) + number-count (count numbers)] + (loop [current-id (str prefix) + current-alphabet initial-alphabet + number-index 0] + (let [digit-alphabet (subs current-alphabet 1) + updated-id (str current-id + (to-id (nth numbers number-index) + digit-alphabet))] + (if (< number-index (dec number-count)) + (recur (str updated-id (first current-alphabet)) + (alphabet/consistent-shuffle current-alphabet) + (inc number-index)) + [updated-id current-alphabet]))))) + +(defn- pad-to-min-length + "Pads `id` to `min-length` via deterministic alphabet shuffles." + [id min-length alphabet] + (if (<= min-length (count id)) + id + (loop [current-id (str id (first alphabet)) + current-alphabet alphabet] + (if (<= min-length (count current-id)) + current-id + (let [shuffled-alphabet (alphabet/consistent-shuffle current-alphabet) + required-length (- min-length (count current-id)) + padded-id (str current-id + (subs shuffled-alphabet + 0 + (min required-length (count shuffled-alphabet))))] + (recur padded-id shuffled-alphabet)))))) + +(defn- encode-numbers + "Encodes numbers and retries with incremented attempts when blocked." + [sqids numbers attempt] + (if (> attempt (count (:alphabet sqids))) + (results/encode-max-attempts ::encode-run-stage + {:increment attempt + :numbers numbers}) + (let [[encoded-id current-alphabet] (encode-prefix sqids numbers attempt) + padded-id (pad-to-min-length encoded-id + (:min-length sqids) + current-alphabet)] + (if (block-list/blocked-id? (::block-list/index sqids) padded-id) + (recur sqids numbers (inc attempt)) + (results/ok padded-id))))) + +(defn ^:private encode* + "Encodes numbers using initialized Sqids state and returns a result envelope." + [{:keys [sqids numbers]}] + (if (empty? numbers) + (results/ok "") + (encode-numbers sqids (vec numbers) 0))) + +(defn encode + "Encodes numbers into a Sqid and returns a non-throwing result envelope." + [sqids-config numbers] + (-> (results/attempt ::encode-init-stage + #(init/ensure-initialized sqids-config)) + (results/bind ::encode-args-stage + (fn [initialized-config] + (results/conform ::encode-args + [initialized-config numbers] + ::encode-args-stage))) + (results/bind ::encode-run-stage + encode*) + (results/bind ::encode-ret-stage + (fn [sqid-value] + (results/conform ::sqid + sqid-value + ::encode-ret-stage))))) + +(s/def ::nat-int + (s/with-gen + (s/and integer? #(not (neg? %)) platform/in-range?) + encoding-generators/nat-int)) + +(s/def ::nat-ints + (s/coll-of ::nat-int :kind sequential?)) + +(s/def ::sqid + string?) + +(s/def ::encode-args + (s/cat :sqids ::init/sqids + :numbers ::nat-ints)) + +(s/def ::encode-result + (s/or :ok (results/ok-result-for ::sqid) + :error ::results/error-result)) + +(s/def ::sqids-input + (s/with-gen + any? + #(encoding-generators/sqids-input init/min-length-limit))) + +(s/def ::numbers-input + (s/with-gen + any? + encoding-generators/numbers-input)) diff --git a/src/org/sqids/clojure/errors.clj b/src/org/sqids/clojure/errors.clj new file mode 100644 index 0000000..977f6ec --- /dev/null +++ b/src/org/sqids/clojure/errors.clj @@ -0,0 +1,30 @@ +(ns org.sqids.clojure.errors + (:require + [org.sqids.clojure.results :as results])) + +(defmacro throw-edge-error! + "Throws an edge-facing exception from a non-throwing results envelope." + [result] + (let [result-sym (gensym "result__") + message-sym (gensym "message__") + details-sym (gensym "details__") + exception-sym (gensym "exception__") + ;; CLJS macro expansion provides `:ns` in `&env`; CLJ macro expansion does not. + edge-ex-info-form (if (contains? &env :ns) + `(ex-info ~message-sym (assoc ~details-sym :cause ~exception-sym)) + `(ex-info ~message-sym ~details-sym ~exception-sym))] + `(let [~result-sym ~result + ~message-sym (or (::results/message ~result-sym) "Sqids operation failed") + ~details-sym (or (::results/details ~result-sym) {}) + ~exception-sym (::results/exception ~result-sym)] + (throw (if ~exception-sym + ~edge-ex-info-form + (ex-info ~message-sym ~details-sym)))))) + +(defmacro unwrap-or-throw! + "Returns an ok value or throws the corresponding edge-facing exception." + [result] + `(let [result# ~result] + (if (= ::results/ok (::results/status result#)) + (::results/value result#) + (throw-edge-error! result#)))) diff --git a/src/org/sqids/clojure/generators/README.md b/src/org/sqids/clojure/generators/README.md new file mode 100644 index 0000000..630019c --- /dev/null +++ b/src/org/sqids/clojure/generators/README.md @@ -0,0 +1,22 @@ +# Generator Namespaces + +These namespaces hold `clojure.spec` generator helpers that are mirrored from +the runtime namespaces: + +- `alphabet.cljc` +- `block_list.cljc` +- `init.cljc` +- `encoding.cljc` +- `decoding.cljc` + +The owning runtime namespaces in `src/org/sqids/clojure/` still define the +actual specs and behavior. This directory exists to keep the runtime files +focused on algorithm and validation logic while giving generator-heavy code a +single place to live. + +When changing a spec generator: + +1. Update the mirrored generator namespace here. +2. Keep the owning runtime spec in sync. +3. Update any generator-focused tests, especially + `test/org/sqids/clojure/decoding_test.cljc`. diff --git a/src/org/sqids/clojure/generators/alphabet.cljc b/src/org/sqids/clojure/generators/alphabet.cljc new file mode 100644 index 0000000..2641e67 --- /dev/null +++ b/src/org/sqids/clojure/generators/alphabet.cljc @@ -0,0 +1,20 @@ +(ns org.sqids.clojure.generators.alphabet + (:require + [clojure.spec.gen.alpha :as gen])) + +(def printable-characters + "Printable ASCII characters used by alphabet-adjacent generators." + (mapv char (range 33 127))) + +(defn alphabet + "Generates valid, distinct alphabets from the provided alphabet domain." + [default-alphabet min-length] + (gen/frequency + [[2 (gen/return default-alphabet)] + [2 (gen/fmap (partial apply str) + (gen/shuffle (vec default-alphabet)))] + [6 (gen/fmap (partial apply str) + (gen/vector-distinct + (gen/elements printable-characters) + {:min-elements min-length + :max-elements (count printable-characters)}))]])) diff --git a/src/org/sqids/clojure/generators/block_list.cljc b/src/org/sqids/clojure/generators/block_list.cljc new file mode 100644 index 0000000..5a78809 --- /dev/null +++ b/src/org/sqids/clojure/generators/block_list.cljc @@ -0,0 +1,46 @@ +(ns org.sqids.clojure.generators.block-list + (:require + [clojure.spec.gen.alpha :as gen] + [clojure.string :as str])) + +(def block-list-word-characters + "Characters used for generated block-list words." + (vec "abcdefghijklmnopqrstuvwxyz0123456789")) + +(defn domain-characters + "Returns lowercase characters that survive block-list normalization." + [alphabet-option] + (or (->> alphabet-option + str/lower-case + distinct + vec + not-empty) + block-list-word-characters)) + +(defn ^:private word + "Generates a block-list word compatible with `alphabet-option` normalization." + [alphabet-option min-word-length] + (gen/fmap (partial apply str) + (gen/vector (gen/elements (domain-characters alphabet-option)) + min-word-length + 12))) + +(defn ^:private invalid-word + "Generates words likely to be filtered during block-list normalization." + [] + (gen/fmap (partial apply str) + (gen/vector (gen/elements block-list-word-characters) 0 12))) + +(defn block-list + "Builds a block-list generator for `alphabet-option` plus some invalid noise." + [{:keys [alphabet-option min-word-length]}] + (gen/frequency + [[2 (gen/return #{})] + [7 (gen/fmap set + (gen/vector-distinct + (word alphabet-option min-word-length) + {:min-elements 1 :max-elements 8}))] + [1 (gen/fmap set + (gen/vector-distinct + (invalid-word) + {:min-elements 1 :max-elements 4}))]])) diff --git a/src/org/sqids/clojure/generators/decoding.cljc b/src/org/sqids/clojure/generators/decoding.cljc new file mode 100644 index 0000000..825ca37 --- /dev/null +++ b/src/org/sqids/clojure/generators/decoding.cljc @@ -0,0 +1,104 @@ +(ns org.sqids.clojure.generators.decoding + (:require + [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as gen] + [org.sqids.clojure.block-list :as block-list] + [org.sqids.clojure.encoding :as encoding] + [org.sqids.clojure.generators.alphabet :as alphabet-generators] + [org.sqids.clojure.generators.init :as init-generators] + [org.sqids.clojure.init :as init] + [org.sqids.clojure.platform :as platform] + [org.sqids.clojure.results :as results])) + +(def init-sqids-spec-key + "Spec key used for generated initialized Sqids configs." + :org.sqids.clojure.init/sqids) + +(def encoding-nat-ints-spec-key + "Spec key used for generated natural integer vectors in decode roundtrips." + :org.sqids.clojure.encoding/nat-ints) + +(def invalid-character-sqid + "Sqid character guaranteed to be outside the supported alphabet domain." + "\u0100") + +(defn sqid + "Builds Sqid-like strings for decode argument coverage." + [] + (gen/frequency + [[2 (gen/return "")] + [4 (gen/string-alphanumeric)] + [4 (gen/fmap (partial apply str) + (gen/vector + (gen/elements alphabet-generators/printable-characters) + 0 + 24))]])) + +(defn decode-canonical-args + "Builds canonical decode args by round-tripping generated numbers through encode." + [] + (gen/bind (s/gen init-sqids-spec-key) + (fn [sqids-config] + (gen/fmap (fn [numbers] + (let [unblocked-config (assoc sqids-config + :block-list #{} + ::block-list/index (block-list/build-index #{})) + encode-result (encoding/encode unblocked-config numbers) + sqid-value (if (= ::results/ok (::results/status encode-result)) + (::results/value encode-result) + "")] + [unblocked-config sqid-value])) + (s/gen encoding-nat-ints-spec-key))))) + +(defn decode-invalid-char-args + "Builds decode args whose Sqid includes characters outside the alphabet." + [] + (gen/fmap (fn [sqids-config] + [sqids-config invalid-character-sqid]) + (s/gen init-sqids-spec-key))) + +(defn decode-overflow-args + "Builds known-overflow decode args for CLJS safe-integer behavior checks." + [] + (if (platform/decode-overflow-sqid-available?) + (let [default-sqids-result (init/sqids {})] + (if (= ::results/ok (::results/status default-sqids-result)) + (gen/return [(::results/value default-sqids-result) + platform/decode-overflow-sqid]) + (decode-invalid-char-args))) + (decode-invalid-char-args))) + +(defn decode-args + "Builds decode argument tuples with canonical, invalid-char, and overflow coverage." + [] + (let [core-generators [[8 (decode-canonical-args)] + [2 (decode-invalid-char-args)]] + generators (if (platform/decode-overflow-sqid-available?) + (conj core-generators [1 (decode-overflow-args)]) + core-generators)] + (gen/frequency generators))) + +(defn decode-invalid-input-args + "Builds decode arg tuples with invalid config or Sqid input types." + [] + (let [invalid-sqid-input (gen/one-of + [(gen/return nil) + (gen/large-integer* {}) + (gen/keyword) + (gen/vector (gen/large-integer* {})) + (gen/map (gen/keyword) (gen/large-integer* {}))]) + invalid-sqids-input (init-generators/invalid-sqids-input init/min-length-limit)] + (gen/one-of + [(gen/tuple invalid-sqids-input + invalid-sqid-input) + (gen/tuple (s/gen init-sqids-spec-key) + invalid-sqid-input) + (gen/tuple invalid-sqids-input + (sqid))]))) + +(defn decode-call-args + "Builds decode call args that mix canonical cases with invalid input coverage." + [] + (gen/frequency + [[8 (decode-args)] + [2 (decode-invalid-input-args)]])) diff --git a/src/org/sqids/clojure/generators/encoding.cljc b/src/org/sqids/clojure/generators/encoding.cljc new file mode 100644 index 0000000..4344493 --- /dev/null +++ b/src/org/sqids/clojure/generators/encoding.cljc @@ -0,0 +1,55 @@ +(ns org.sqids.clojure.generators.encoding + (:require + [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as gen] + [org.sqids.clojure.generators.init :as init-generators] + [org.sqids.clojure.platform :as platform])) + +(def nat-ints-spec-key + "Spec key used for generated natural integer collections." + :org.sqids.clojure.encoding/nat-ints) + +(def init-sqids-spec-key + "Spec key used for generated initialized Sqids configs." + :org.sqids.clojure.init/sqids) + +(defn nat-int + "Builds natural integers with weighted boundary coverage for encode specs." + [] + (gen/frequency + [[7 (gen/large-integer* {:min 0 :max platform/nat-int-random-max})] + [3 (gen/elements platform/nat-int-edge-values)]])) + +(defn ^:private invalid-number-value + "Builds values that fail the natural integer contract." + [] + (gen/one-of + [(gen/large-integer* {:max -1}) + (gen/double* {}) + (gen/return nil) + (gen/string-alphanumeric) + (gen/keyword)])) + +(defn invalid-numbers-input + "Builds invalid values for encode number collections." + [] + (gen/one-of + [(gen/return nil) + (gen/keyword) + (gen/string-alphanumeric) + (gen/map (gen/keyword) (gen/large-integer* {})) + (gen/vector (invalid-number-value) 1 8)])) + +(defn sqids-input + "Builds valid and invalid Sqids config inputs for encode call args." + [min-length-limit] + (gen/frequency + [[7 (s/gen init-sqids-spec-key)] + [3 (init-generators/invalid-sqids-input min-length-limit)]])) + +(defn numbers-input + "Builds valid and invalid numeric inputs for encode call args." + [] + (gen/frequency + [[7 (s/gen nat-ints-spec-key)] + [3 (invalid-numbers-input)]])) diff --git a/src/org/sqids/clojure/generators/init.cljc b/src/org/sqids/clojure/generators/init.cljc new file mode 100644 index 0000000..9751fdb --- /dev/null +++ b/src/org/sqids/clojure/generators/init.cljc @@ -0,0 +1,213 @@ +(ns org.sqids.clojure.generators.init + (:require + [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as gen] + [org.sqids.clojure.alphabet :as alphabet] + [org.sqids.clojure.block-list :as block-list] + [org.sqids.clojure.generators.alphabet :as alphabet-generators] + [org.sqids.clojure.generators.block-list :as block-list-generators])) + +(defn ^:private block-list-generator-config + "Returns shared block-list generator configuration for `alphabet-option`." + [alphabet-option] + {:alphabet-option alphabet-option + :word-characters block-list/block-list-word-characters + :min-word-length block-list/min-word-length}) + +(defn ^:private valid-min-length + "Builds valid min-length values for the public Sqids config contract." + [min-length-limit] + (gen/large-integer* {:min 0 :max min-length-limit})) + +(defn non-map-input + "Builds non-map values for invalid Sqids option inputs." + [] + (gen/one-of + [(gen/return nil) + (gen/large-integer* {}) + (gen/double* {}) + (gen/keyword) + (gen/string-alphanumeric) + (gen/vector (gen/large-integer* {})) + (gen/set (gen/large-integer* {}))])) + +(defn invalid-alphabet + "Builds alphabet values that fail alphabet validation." + [] + (gen/one-of + [(gen/fmap (partial apply str) + (gen/vector (gen/elements alphabet-generators/printable-characters) 0 2)) + (gen/fmap (fn [character] + (apply str (repeat 3 character))) + (gen/elements alphabet-generators/printable-characters)) + (gen/fmap (fn [suffix] + (str "abc" suffix)) + (gen/elements ["é" "€" "漢"]))])) + +(defn invalid-min-length + "Builds min-length values outside the supported range." + [min-length-limit] + (gen/one-of + [(gen/large-integer* {:max -1}) + (gen/large-integer* {:min (inc min-length-limit) + :max (+ min-length-limit 1024)}) + (gen/double* {})])) + +(defn invalid-block-list + "Builds block-list values that fail the public block-list contract." + [] + (gen/one-of + [(gen/vector (gen/string-alphanumeric)) + (gen/set (gen/large-integer* {})) + (gen/map (gen/keyword) (gen/string-alphanumeric)) + (gen/return nil)])) + +(defn ^:private invalid-options-map + "Builds map-shaped invalid Sqids options with one or more bad fields." + [min-length-limit] + (gen/one-of + [(gen/fmap (fn [alphabet-option] + {:alphabet alphabet-option}) + (invalid-alphabet)) + (gen/fmap (fn [minimum-length] + {:min-length minimum-length}) + (invalid-min-length min-length-limit)) + (gen/fmap (fn [block-list-option] + {:block-list block-list-option}) + (invalid-block-list)) + (gen/fmap (fn [[alphabet-option minimum-length block-list-option]] + {:alphabet alphabet-option + :min-length minimum-length + :block-list block-list-option}) + (gen/tuple (invalid-alphabet) + (valid-min-length min-length-limit) + (block-list-generators/block-list + (block-list-generator-config alphabet/default)))) + (gen/fmap (fn [[alphabet-option minimum-length block-list-option]] + {:alphabet alphabet-option + :min-length minimum-length + :block-list block-list-option}) + (gen/tuple (s/gen ::alphabet/alphabet) + (invalid-min-length min-length-limit) + (block-list-generators/block-list + (block-list-generator-config alphabet/default)))) + (gen/fmap (fn [[alphabet-option minimum-length block-list-option]] + {:alphabet alphabet-option + :min-length minimum-length + :block-list block-list-option}) + (gen/tuple (s/gen ::alphabet/alphabet) + (valid-min-length min-length-limit) + (invalid-block-list)))])) + +(defn invalid-options-input + "Builds invalid option inputs for public option-shaped arguments." + [min-length-limit] + (gen/frequency + [[3 (non-map-input)] + [7 (invalid-options-map min-length-limit)]])) + +(defn ^:private incomplete-sqids + "Builds initialized-config-shaped maps missing required public Sqids keys." + [min-length-limit] + (gen/one-of + [(gen/return {}) + (gen/fmap (fn [alphabet-option] + {:alphabet alphabet-option}) + (s/gen ::alphabet/alphabet)) + (gen/fmap (fn [minimum-length] + {:min-length minimum-length}) + (valid-min-length min-length-limit)) + (gen/fmap (fn [block-list-option] + {:block-list block-list-option}) + (block-list-generators/block-list + (block-list-generator-config alphabet/default)))])) + +(defn invalid-sqids-input + "Builds invalid inputs for initialized Sqids config arguments." + [min-length-limit] + (gen/frequency + [[3 (non-map-input)] + [2 (incomplete-sqids min-length-limit)] + [5 (invalid-options-map min-length-limit)]])) + +(defn ^:private options-block-list-only + "Builds options with only an explicit block-list override." + [] + (gen/fmap (fn [block-list-option] + {:block-list block-list-option}) + (block-list-generators/block-list + (block-list-generator-config alphabet/default)))) + +(defn ^:private options-min-length-and-block-list + "Builds options with min-length plus a default-alphabet block-list." + [min-length-limit] + (gen/fmap (fn [[minimum-length block-list-option]] + {:min-length minimum-length + :block-list block-list-option}) + (gen/tuple (valid-min-length min-length-limit) + (block-list-generators/block-list + (block-list-generator-config alphabet/default))))) + +(defn ^:private options-alphabet-and-block-list + "Builds options whose block-list matches a generated alphabet domain." + [] + (gen/bind (s/gen ::alphabet/alphabet) + (fn [alphabet-option] + (gen/fmap (fn [block-list-option] + {:alphabet alphabet-option + :block-list block-list-option}) + (block-list-generators/block-list + (block-list-generator-config alphabet-option)))))) + +(defn ^:private full-options + "Builds fully specified options with compatible alphabets and block-lists." + [min-length-limit] + (gen/bind (s/gen ::alphabet/alphabet) + (fn [alphabet-option] + (gen/fmap (fn [[minimum-length block-list-option]] + {:alphabet alphabet-option + :min-length minimum-length + :block-list block-list-option}) + (gen/tuple (valid-min-length min-length-limit) + (block-list-generators/block-list + (block-list-generator-config alphabet-option))))))) + +(defn options + "Builds Sqids option maps with low default-map noise and aligned block-lists." + [min-length-limit] + (gen/frequency + [[1 (gen/return {})] + [1 (gen/fmap (fn [alphabet-option] + {:alphabet alphabet-option}) + (s/gen ::alphabet/alphabet))] + [1 (options-block-list-only)] + [1 (options-min-length-and-block-list min-length-limit)] + [2 (options-alphabet-and-block-list)] + [8 (full-options min-length-limit)]])) + +(defn sqids + "Builds initialized Sqids option maps with all required public keys present." + [min-length-limit] + (gen/bind (s/gen ::alphabet/alphabet) + (fn [alphabet-option] + (gen/fmap (fn [[minimum-length block-list-option]] + {:alphabet alphabet-option + :min-length minimum-length + :block-list block-list-option}) + (gen/tuple (valid-min-length min-length-limit) + (block-list-generators/block-list + (block-list-generator-config alphabet-option))))))) + +(defn options-input + "Builds valid and invalid option-shaped API arguments." + [min-length-limit] + (gen/frequency + [[7 (options min-length-limit)] + [3 (invalid-options-input min-length-limit)]])) + +(defn sqids-input + "Builds valid and invalid initialized Sqids config arguments." + [min-length-limit] + (gen/frequency + [[7 (sqids min-length-limit)] + [3 (invalid-sqids-input min-length-limit)]])) diff --git a/src/org/sqids/clojure/init.cljc b/src/org/sqids/clojure/init.cljc new file mode 100644 index 0000000..6e90a7d --- /dev/null +++ b/src/org/sqids/clojure/init.cljc @@ -0,0 +1,104 @@ +(ns org.sqids.clojure.init + (:require + [clojure.spec.alpha :as s] + [org.sqids.clojure.alphabet :as alphabet] + [org.sqids.clojure.block-list :as block-list] + [org.sqids.clojure.generators.init :as init-generators] + [org.sqids.clojure.results :as results])) + +(def default-min-length + "Default minimum output ID length." + 0) + +(def min-length-limit + "Maximum supported minimum output ID length." + 255) + +(def default-options + "Default Sqids options before user overrides." + {:alphabet alphabet/default + :min-length default-min-length + :block-list block-list/default-words}) + +(defn ^:private build-sqids-config + "Builds initialized Sqids configuration from already-conformed options." + [options] + (let [merged-options (merge default-options options) + alphabet-option (:alphabet merged-options) + cleaned-options {:alphabet alphabet-option + :min-length (:min-length merged-options) + :block-list (block-list/remove-invalid-words + (:block-list merged-options) + alphabet-option)} + initialized-options (update cleaned-options :alphabet alphabet/consistent-shuffle)] + (assoc initialized-options + ;; Internal cache for fast blocklist checks; not a public option key. + ::block-list/index + (block-list/build-index (:block-list initialized-options))))) + +(defn sqids + "Builds an initialized Sqids configuration and returns a result envelope." + ([] + (sqids {})) + ([options] + (-> (results/conform ::options options ::sqids-options-stage) + (results/bind ::sqids-init-stage + (fn [conformed-options] + (results/ok (build-sqids-config conformed-options)))) + (results/bind ::sqids-ret-stage + (fn [sqids-config] + (results/conform ::sqids + sqids-config + ::sqids-ret-stage)))))) + +(defn ensure-initialized + "Returns initialized Sqids configuration as a result envelope." + [config] + (if (and (map? config) + (contains? config ::block-list/index)) + (results/conform ::sqids config ::ensure-initialized-ret-stage) + (-> (results/conform ::options config ::ensure-initialized-options-stage) + (results/bind ::ensure-initialized-stage + (fn [conformed-options] + (results/ok (build-sqids-config conformed-options)))) + (results/bind ::ensure-initialized-ret-stage + (fn [sqids-config] + (results/conform ::sqids + sqids-config + ::ensure-initialized-ret-stage)))))) + +(s/def ::options + (s/with-gen + (s/keys :opt-un [::alphabet/alphabet ::min-length ::block-list/block-list]) + #(init-generators/options min-length-limit))) + +(s/def ::sqids + (s/with-gen + (s/keys :req-un [::alphabet/alphabet ::min-length ::block-list/block-list]) + #(init-generators/sqids min-length-limit))) + +(s/def ::min-length + (s/int-in 0 (inc min-length-limit))) + +(s/def ::sqids-result + (s/or :ok (results/ok-result-for ::sqids) + :error ::results/error-result)) + +(s/def ::options-input + (s/with-gen + any? + #(init-generators/options-input min-length-limit))) + +(s/def ::sqids-input + (s/with-gen + any? + #(init-generators/sqids-input min-length-limit))) + +(s/fdef sqids + :args (s/alt :nullary (s/cat) + :unary (s/cat :options ::options-input)) + :ret ::sqids-result) + +(s/fdef ensure-initialized + :args (s/cat :config ::sqids-input) + :ret ::sqids-result) diff --git a/src/org/sqids/clojure/invariants.cljc b/src/org/sqids/clojure/invariants.cljc new file mode 100644 index 0000000..968b2ba --- /dev/null +++ b/src/org/sqids/clojure/invariants.cljc @@ -0,0 +1,88 @@ +(ns org.sqids.clojure.invariants + (:require + [clojure.set :as set] + [clojure.spec.alpha :as s] + [org.sqids.clojure.block-list :as block-list] + [org.sqids.clojure.decoding :as decoding] + [org.sqids.clojure.encoding :as encoding] + [org.sqids.clojure.init :as init] + [org.sqids.clojure.results :as results])) + +(defn ^:private valid-alphabet-characters? + "Returns true when every Sqid character exists in the Sqids alphabet." + [sqids-config sqid] + (set/subset? (set sqid) (set (:alphabet sqids-config)))) + +(defn ^:private encode-roundtrip? + "Returns true when decoding `sqid` reproduces the original `numbers`." + [sqids numbers sqid] + (let [decode-result (decoding/decode sqids sqid)] + (and (results/ok? decode-result) + (= (vec numbers) (::results/value decode-result))))) + +(defn encode-result-consistent? + "Checks semantic invariants for `encoding/encode` args and results." + [sqids-config numbers ret] + (boolean + (let [initialized-result (init/ensure-initialized sqids-config) + initialized? (results/ok? initialized-result) + valid-numbers? (s/valid? ::encoding/nat-ints numbers)] + (if (results/ok? ret) + (and initialized? + valid-numbers? + (let [sqids (::results/value initialized-result) + sqid-value (::results/value ret) + alphabet-set (set (:alphabet sqids))] + (if (empty? numbers) + (= "" sqid-value) + (and (not (empty? sqid-value)) + (<= (:min-length sqids) (count sqid-value)) + (every? alphabet-set sqid-value) + (not (block-list/blocked-id? (::block-list/index sqids) + sqid-value)) + (encode-roundtrip? sqids numbers sqid-value))))) + (or (not initialized?) + (not valid-numbers?) + (not= ::results/invalid-input (::results/code ret))))))) + +(defn decode-result-consistent? + "Checks semantic invariants for `decoding/decode` args and results. + + This stays one-way on purpose so decode fdef checks do not recursively invoke + encode fdef checks while `encode` is validating its stronger round-trip + property." + [sqids-config sqid ret] + (boolean + (let [initialized-result (init/ensure-initialized sqids-config) + initialized? (results/ok? initialized-result)] + (if (results/ok? ret) + (and initialized? + (string? sqid) + (let [sqids (::results/value initialized-result) + decoded-values (::results/value ret)] + (if (valid-alphabet-characters? sqids sqid) + (if (empty? sqid) + (empty? decoded-values) + true) + (empty? decoded-values)))) + (or (not initialized?) + (not (string? sqid))))))) + +(s/fdef encoding/encode + :args (s/cat :sqids-config ::encoding/sqids-input + :numbers ::encoding/numbers-input) + :ret ::encoding/encode-result + :fn (fn [{:keys [args ret]}] + (let [{:keys [sqids-config numbers]} args] + (encode-result-consistent? sqids-config + numbers + (s/unform ::encoding/encode-result ret))))) + +(s/fdef decoding/decode + :args ::decoding/decode-call-args + :ret ::decoding/decode-result + :fn (fn [{:keys [args ret]}] + (let [{:keys [sqids-config sqid]} args] + (decode-result-consistent? sqids-config + sqid + (s/unform ::decoding/decode-result ret))))) diff --git a/src/org/sqids/clojure/platform.clj b/src/org/sqids/clojure/platform.clj index 68a8bd6..c7e281d 100644 --- a/src/org/sqids/clojure/platform.clj +++ b/src/org/sqids/clojure/platform.clj @@ -1,49 +1,74 @@ -(ns org.sqids.clojure.platform - (:refer-clojure :exclude [class]) - (:require - [clojure.spec.alpha :as s]) - (:import - (org.sqids - Sqids - Sqids$Builder))) - -(def default-alphabet - Sqids$Builder/DEFAULT_ALPHABET) - -(def default-min-length - Sqids$Builder/DEFAULT_MIN_LENGTH) - -(def default-block-list - Sqids$Builder/DEFAULT_BLOCK_LIST) - -(def class - Sqids) - -(defn sqids - [{:keys [alphabet min-length block-list]}] - (.. (Sqids/builder) - (alphabet alphabet) - (minLength min-length) - (blockList block-list) - build)) - -(defn encode - [^org.sqids.Sqids instance numbers] - (.encode instance numbers)) - -(defn decode - [^org.sqids.Sqids instance sqid] - (.decode instance sqid)) - -(defn byte-count - [^String s] - (count (.getBytes s))) +(ns org.sqids.clojure.platform) + +(defn char-code + "Returns the integer character code for a JVM char." + [c] + (int c)) (def max-value - Long/MAX_VALUE) + "Upper-bound sentinel for JVM integer range checks." + ##Inf) + +(defn in-range? + "Returns true on JVM, where integer values are effectively unbounded." + [_] + true) + +(def +-safe + "Overflow-safe addition for JVM integers." + +') + +(def *-safe + "Overflow-safe multiplication for JVM integers." + *') + +(def nat-int-random-max + "Upper bound used for random natural integer generators." + 1000000000) + +(def nat-int-edge-values + "Boundary values used by natural integer generators." + [0N + 1N + 2N + 10N + 255N + 1024N + 9007199254740991N + 9007199254740992N + 18446744073709551616N + 340282366920938463463374607431768211455N]) + +(def decode-overflow-sqid + "Known overflow Sqid for CLJS safe-integer decoding checks." + nil) + +(defn decode-overflow-sqid-available? + "Returns true when this runtime provides a known decode-overflow Sqid." + [] + (some? decode-overflow-sqid)) + +(defn decode-overflow-sqid? + "Returns true when `sqid` matches the runtime decode-overflow fixture." + [sqid] + (and (decode-overflow-sqid-available?) + (= decode-overflow-sqid sqid))) + +(defn decode-step + "Advances decode arithmetic by one digit step." + [acc base idx] + (+-safe (*-safe acc base) idx)) -(def max-value+1 - (inc' max-value)) +(defn exception-message + "Extracts a stable string message from an exception-like value." + [cause] + (or (ex-message cause) + (str cause))) -(s/def ::ints-elem - int?) +(defn try-call + "Evaluates `thunk`, delegating caught exceptions to `on-error`." + [thunk on-error] + (try + (thunk) + (catch Exception cause + (on-error cause)))) diff --git a/src/org/sqids/clojure/platform.cljs b/src/org/sqids/clojure/platform.cljs index d61e513..41b12b1 100644 --- a/src/org/sqids/clojure/platform.cljs +++ b/src/org/sqids/clojure/platform.cljs @@ -1,44 +1,77 @@ -(ns org.sqids.clojure.platform - (:require - ["sqids" :as sqids] - ["sqids$default" :as Sqids] - [clojure.spec.alpha :as s])) +(ns org.sqids.clojure.platform) -(def default-alphabet - sqids/defaultOptions.alphabet) +(defn char-code + "Returns the UTF-16 code unit for a JS character." + [^js c] + (.charCodeAt c 0)) -(def default-min-length - sqids/defaultOptions.minLength) +(def max-value + "Maximum non-negative safe integer representable in JavaScript." + js/Number.MAX_SAFE_INTEGER) -(def default-block-list - (js->clj sqids/defaultOptions.blocklist)) +(defn in-range? + "Checks whether `n` is a non-negative JavaScript safe integer." + [n] + (and (number? n) + (js/Number.isSafeInteger n) + (<= 0 n max-value))) -(def class - Sqids) +(def +-safe + "Addition function used by decode arithmetic on CLJS." + +) -(defn sqids - [{:keys [alphabet min-length block-list]}] - (Sqids. (clj->js {:alphabet alphabet - :minLength min-length - :blocklist block-list}))) +(def *-safe + "Multiplication function used by decode arithmetic on CLJS." + *) -(defn encode - [^js instance numbers] - (js->clj (.encode instance (clj->js numbers)))) +(def nat-int-random-max + "Upper bound used for random natural integer generators." + max-value) -(defn decode - [^js instance sqid] - (js->clj (.decode instance (clj->js sqid)))) +(def nat-int-edge-values + "Boundary values used by natural integer generators." + [0 + 1 + 2 + 10 + 255 + 1024 + 9007199254740990 + 9007199254740991]) -(defn byte-count - [s] - (.-size (js/Blob. [s]))) +(def decode-overflow-sqid + "Known overflow Sqid for CLJS safe-integer decoding checks." + "pup591lWlB") -(def max-value - js/Number.MAX_SAFE_INTEGER) +(defn decode-overflow-sqid-available? + "Returns true when this runtime provides a known decode-overflow Sqid." + [] + (some? decode-overflow-sqid)) + +(defn decode-overflow-sqid? + "Returns true when `sqid` matches the runtime decode-overflow fixture." + [sqid] + (and (decode-overflow-sqid-available?) + (= decode-overflow-sqid sqid))) + +(defn decode-step + "Advances decode arithmetic by one digit step, returning nil on overflow." + [acc base idx] + (let [next-value (+-safe (*-safe acc base) idx)] + (when (in-range? next-value) + next-value))) -(def max-value+1 - (inc max-value)) +(defn exception-message + "Extracts a stable string message from an exception-like value." + [cause] + (or (.-message cause) + (ex-message cause) + (str cause))) -(s/def ::ints-elem - (s/and number? #(= % (long %)))) +(defn try-call + "Evaluates `thunk`, delegating caught exceptions to `on-error`." + [thunk on-error] + (try + (thunk) + (catch :default cause + (on-error cause)))) diff --git a/src/org/sqids/clojure/results.cljc b/src/org/sqids/clojure/results.cljc new file mode 100644 index 0000000..14a36a8 --- /dev/null +++ b/src/org/sqids/clojure/results.cljc @@ -0,0 +1,264 @@ +(ns org.sqids.clojure.results + (:require + [clojure.spec.alpha :as s] + [clojure.string :as str] + [org.sqids.clojure.platform :as platform])) + +(def result-key-namespace + "Namespace expected for top-level keys in result envelopes." + (namespace ::_)) + +(defn namespaced-results-keys? + "Returns true when all top-level keys in `result` are results-namespace keywords." + [result] + (and (map? result) + (every? qualified-keyword? (keys result)) + (every? #(= result-key-namespace (namespace %)) (keys result)))) + +(defn ^:private normalize-details + "Normalizes error details into a map payload." + [details] + (cond + (map? details) + details + + (nil? details) + {} + + :else + {:value details})) + +(defn ^:private trimmed-message + "Returns `message` without surrounding whitespace when it is non-blank." + [message] + (let [trimmed (some-> message str/trim)] + (when (seq trimmed) + trimmed))) + +(defn ^:private spec-explain-message + "Builds a human-readable spec explanation when `details` includes spec context." + [details] + (when-let [spec-key (::s/spec details)] + (trimmed-message (s/explain-str spec-key (::s/value details))))) + +(defn ^:private invalid-input-message + "Selects the richest invalid-input message available from `details` and `cause`." + [details cause] + (or (spec-explain-message details) + (some-> cause platform/exception-message trimmed-message) + "Invalid input")) + +(defn ok + "Builds a successful result envelope." + [value] + {::status ::ok + ::value value}) + +(defn error + "Builds an error result envelope." + [code stage message details] + {::status ::error + ::code code + ::stage stage + ::message message + ::details (normalize-details details)}) + +(defn ok? + "Returns true when `result` is a successful envelope." + [result] + (= ::ok (::status result))) + +(defn invalid-input + "Builds an invalid-input error result from explain-data or an exception." + ([cause] + (let [details (normalize-details (ex-data cause))] + (invalid-input ::validation + (::s/value details) + details + (invalid-input-message details cause)))) + ([stage input explain-data] + (invalid-input stage input explain-data nil)) + ([stage input explain-data message] + (let [details (normalize-details explain-data)] + (assoc (error ::invalid-input + stage + (or (trimmed-message message) + (invalid-input-message details nil)) + details) + ::input input + ::problems (vec (::s/problems details)))))) + +(defn encode-max-attempts + "Builds an encode max-attempts error result from details or an exception." + ([cause] + (encode-max-attempts ::encode-run-stage (ex-data cause))) + ([stage details] + (let [normalized-details (normalize-details details)] + (assoc (error ::encode-max-attempts + stage + "Reached max attempts to re-generate the ID" + normalized-details) + ::increment (:increment normalized-details) + ::numbers (:numbers normalized-details))))) + +(defn unexpected + "Builds an unexpected-exception result and preserves the original exception." + ([cause] + (unexpected ::unexpected cause)) + ([stage cause] + (assoc (error ::unexpected-exception + stage + (platform/exception-message cause) + (ex-data cause)) + ::exception cause))) + +(defn attempt + "Evaluates `thunk`, converting unexpected exceptions into error envelopes." + [stage thunk] + (platform/try-call thunk + (fn [cause] + (unexpected stage cause)))) + +(defn bind + "Invokes `f` for successful results and passes through error results unchanged." + ([result f] + (bind result ::bind f)) + ([result stage f] + (if (ok? result) + (attempt stage #(f (::value result))) + result))) + +(defn conform + "Conforms `input` with `spec-key` and returns either ::ok or ::invalid-input." + [spec-key input stage] + (attempt stage + #(let [conformed (s/conform spec-key input)] + (if (s/invalid? conformed) + (invalid-input stage input (s/explain-data spec-key input)) + (ok conformed))))) + +(defn ok-result-for + "Returns a spec matching ::ok result envelopes with values conforming to `value-spec`." + [value-spec] + (s/and ::ok-result + #(s/valid? value-spec (::value %)))) + +(s/def ::status + #{::ok ::error}) + +(s/def ::value + any?) + +(s/def ::code + #{::invalid-input ::encode-max-attempts ::unexpected-exception}) + +(s/def ::stage + keyword?) + +(s/def ::message + string?) + +(s/def ::details + map?) + +(s/def ::exception + some?) + +(s/def ::input + any?) + +(s/def ::problems + vector?) + +(s/def ::increment + integer?) + +(s/def ::numbers + sequential?) + +(def ok-result-keys + "Allowed top-level keys for successful result envelopes." + #{::status ::value}) + +(def error-result-keys + "Allowed top-level keys for error result envelopes." + #{::status + ::code + ::stage + ::message + ::details + ::exception + ::input + ::problems + ::increment + ::numbers}) + +(defn ^:private allowed-result-keys? + "Returns true when `result` only contains `allowed-keys`." + [allowed-keys result] + (every? allowed-keys (keys result))) + +(s/def ::result-map + (s/and map? + namespaced-results-keys?)) + +(s/def ::ok-result-shape + (s/and (s/keys :req [::status ::value]) + #(= ::ok (::status %)) + #(allowed-result-keys? ok-result-keys %))) + +(s/def ::error-base-shape + (s/and (s/keys :req [::status ::code ::stage ::message ::details] + :opt [::exception + ::input + ::problems + ::increment + ::numbers]) + #(= ::error (::status %)) + #(allowed-result-keys? error-result-keys %))) + +(defmulti error-shape-spec + "Dispatches error envelope shape specs by `::code`." + ::code) + +(defmethod error-shape-spec ::invalid-input + [_] + (s/and ::error-base-shape + (s/keys :req [::input ::problems]))) + +(defmethod error-shape-spec ::encode-max-attempts + [_] + (s/and ::error-base-shape + (s/keys :req [::increment ::numbers]))) + +(defmethod error-shape-spec ::unexpected-exception + [_] + (s/and ::error-base-shape + (s/keys :req [::exception]))) + +(s/def ::error-result-shape + (s/multi-spec error-shape-spec ::code)) + +(defmulti result-shape-spec + "Dispatches result envelope shape specs by `::status`." + ::status) + +(defmethod result-shape-spec ::ok + [_] + ::ok-result-shape) + +(defmethod result-shape-spec ::error + [_] + ::error-result-shape) + +(s/def ::result + (s/and ::result-map + (s/multi-spec result-shape-spec ::status))) + +(s/def ::ok-result + (s/and ::result + #(= ::ok (::status %)))) + +(s/def ::error-result + (s/and ::result + #(= ::error (::status %)))) diff --git a/src/org/sqids/clojure/spec.cljc b/src/org/sqids/clojure/spec.cljc deleted file mode 100644 index 3b65a67..0000000 --- a/src/org/sqids/clojure/spec.cljc +++ /dev/null @@ -1,134 +0,0 @@ -(ns org.sqids.clojure.spec - (:require - [borkdude.dynaload :refer [dynaload]] - [clojure.set :as set] - [clojure.spec.alpha :as s] - [clojure.spec.gen.alpha :as gen] - [clojure.string :as string] - [org.sqids.clojure.platform :as platform])) - -(defn conform! - [spec input] - (let [conformed (s/conform spec input)] - (when (s/invalid? conformed) - (throw (ex-info "Invalid input" (s/explain-data spec input)))) - conformed)) - -;; TODO: Replace with constants from sqids-java once -;; https://github.com/sqids/sqids-java/pull/7 is merged -(def min-alphabet-length - 3) - -(def min-length-limit - 255) - -(defn ^:private sqids - [& args] - (apply (dynaload 'org.sqids.clojure/sqids) args)) - -(defn ^:private decode - [& args] - (apply (dynaload 'org.sqids.clojure/decode) args)) - -(defn ^:private encode - [& args] - (apply (dynaload 'org.sqids.clojure/encode) args)) - -(s/def ::alphabet-string - string?) - -(s/def ::alphabet-distinct - #(apply distinct? %)) - -(s/def ::alphabet-min-length - #(>= (count %) min-alphabet-length)) - -(s/def ::alphabet-no-multibyte - #(= (count %) (platform/byte-count %))) - -(s/def ::alphabet - (s/with-gen - (s/and ::alphabet-string - ::alphabet-distinct - ::alphabet-min-length - ::alphabet-no-multibyte) - #(->> {:min-elements min-alphabet-length} - ;; TODO: Once https://github.com/sqids/sqids-java/pull/10 is merged, - ;; change to: - ;; - ;; (gen/set (gen/fmap char (gen/choose 0 127))) - ;; - ;; because regex chars are currently treated improperly - (gen/set (gen/char-alphanumeric)) - (gen/fmap string/join)))) - -(s/def ::min-length - (s/int-in 0 (inc min-length-limit))) - -(s/def ::block-list - (s/coll-of string? :kind set?)) - -(s/def ::options - (s/keys :opt-un [::alphabet ::min-length ::block-list])) - -(s/def ::instance - #(instance? platform/class %)) - -(s/def ::sqids - (s/with-gen - (s/keys :req-un [::instance ::alphabet ::min-length ::block-list]) - #(gen/fmap sqids (s/gen ::options)))) - -(s/def ::nat-ints - (s/coll-of (s/int-in 0 platform/max-value+1) - :kind sequential?)) - -(s/def ::ints - (s/coll-of ::platform/ints-elem :kind vector?)) - -(s/def ::sqid - (s/with-gen - string? - (fn [] - (->> (gen/tuple (s/gen ::sqids) (s/gen ::nat-ints)) - (gen/fmap - (fn [[s nat-ints]] - (try - (encode s nat-ints) - (catch #?(:cljs :default :clj RuntimeException) _ - ;; TODO: Catch a more specific exception from sqids-java once - ;; present. - nil)))) - (gen/such-that some?))))) - -(s/fdef org.sqids.clojure/sqids - :args (s/alt :nullary (s/cat) - :unary (s/cat :options ::options)) - :ret ::sqids) - -(s/fdef org.sqids.clojure/encode - :args (s/cat :s ::sqids :nat-ints ::nat-ints) - :ret ::sqid - :fn (fn [info] - (let [{:keys [ret args]} info - {:keys [s nat-ints]} args] - (= nat-ints (decode s ret))))) - -(s/fdef org.sqids.clojure/decode - :args (s/cat :s ::sqids :sqid ::sqid) - :ret ::ints - :fn (fn [info] - (let [{:keys [ret args]} info] - (or - (not (s/valid? ::nat-ints ret)) - (let [{:keys [s sqid]} - args - - expected - (if (set/subset? (set sqid) (-> s :alphabet set)) - (->> ret - (encode s) - (decode s)) - [])] - - (= ret expected)))))) diff --git a/test-resources/org/sqids/clojure/sqids_spec_runner.mjs b/test-resources/org/sqids/clojure/sqids_spec_runner.mjs new file mode 100644 index 0000000..589e6db --- /dev/null +++ b/test-resources/org/sqids/clojure/sqids_spec_runner.mjs @@ -0,0 +1,79 @@ +import { readFileSync } from "node:fs"; +import { pathToFileURL } from "node:url"; + +const [requestFilePath, specDir] = process.argv.slice(2); + +if (!requestFilePath || !specDir) { + throw new Error("Expected request JSON path and sqids-spec checkout path"); +} + +const { default: Sqids } = await import( + pathToFileURL(`${specDir}/src/index.ts`).href +); + +const requests = JSON.parse(readFileSync(requestFilePath, "utf8")); + +const wireToOptions = (wireOptions = {}) => { + const options = {}; + + if ("alphabet" in wireOptions) { + options.alphabet = wireOptions.alphabet; + } + + if ("min-length" in wireOptions) { + options.minLength = wireOptions["min-length"]; + } + + if ("block-list" in wireOptions) { + options.blocklist = new Set(wireOptions["block-list"]); + } + + return options; +}; + +const responseFor = (request, value) => ({ + id: request.id, + op: request.op, + status: "ok", + value, +}); + +const errorFor = (request, error) => ({ + id: request.id, + op: request.op, + status: "error", + message: error?.message ?? String(error), +}); + +const evaluate = (request) => { + try { + const sqids = new Sqids(wireToOptions(request.options)); + + switch (request.op) { + case "roundtrip": { + const sqid = sqids.encode(request.numbers); + + return responseFor(request, { + sqid, + numbers: sqids.decode(sqid), + }); + } + + case "decode": + return responseFor(request, sqids.decode(request.sqid)); + + case "encode": + return responseFor(request, sqids.encode(request.numbers)); + + case "sqids": + return responseFor(request, "initialized"); + + default: + throw new Error(`Unknown parity op: ${request.op}`); + } + } catch (error) { + return errorFor(request, error); + } +}; + +console.log(JSON.stringify(requests.map(evaluate))); diff --git a/test/org/sqids/clojure/alphabet_test.cljc b/test/org/sqids/clojure/alphabet_test.cljc index 82420a0..f616572 100644 --- a/test/org/sqids/clojure/alphabet_test.cljc +++ b/test/org/sqids/clojure/alphabet_test.cljc @@ -1,50 +1,60 @@ (ns org.sqids.clojure.alphabet-test (:require [clojure.spec.alpha :as s] - [clojure.test :as t :refer [deftest is]] + [clojure.test :as t] [org.sqids.clojure :as sut] - [org.sqids.clojure.spec :as spec]) + [org.sqids.clojure.alphabet :as alphabet]) #?(:clj (:import (clojure.lang ExceptionInfo)))) (defn make + "Builds a Sqids config for a custom alphabet." [alphabet] (sut/sqids {:alphabet alphabet})) (defn alphabet-spec-fails + "Asserts alphabet initialization fails with the expected root spec." [alphabet root-spec] (let [e - (is (thrown? ExceptionInfo (make alphabet))) + (t/is (thrown? ExceptionInfo (make alphabet))) {::s/keys [problems]} (ex-data e)] - (is (= 1 (count problems))) - (let [{:keys [via val]} (first problems)] - (is (= alphabet val)) - (is (= root-spec (last via)))))) + (t/is (seq problems)) + (t/is (some (fn [{:keys [via] value :val}] + (and (= alphabet value) + (= root-spec (last via)))) + problems)))) -(deftest simple-alphabet-test +(t/deftest simple-alphabet-test (let [sqids (make "0123456789abcdef") numbers [1 2 3] id "489158"] - (is (= id (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids id))))) + (t/is (= id (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids id))))) -(deftest short-alphabet-test +(t/deftest short-alphabet-test (let [sqids (make "abc") numbers [1 2 3]] - (is (= numbers (->> numbers - (sut/encode sqids) - (sut/decode sqids)))))) + (t/is (= numbers (->> numbers + (sut/encode sqids) + (sut/decode sqids)))))) -(deftest multibyte-tests - (alphabet-spec-fails "ë1092" ::spec/alphabet-no-multibyte)) +(t/deftest long-alphabet-test + (let [sqids (make "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!@#$%^&*()-_+|{}[];:'\"/?.>,<`~") + numbers [1 2 3]] + (t/is (= numbers (->> numbers + (sut/encode sqids) + (sut/decode sqids)))))) + +(t/deftest multibyte-tests + (alphabet-spec-fails "ë1092" ::alphabet/alphabet-no-multibyte)) -(deftest repeating-alphabet-characters - (alphabet-spec-fails "aabcdefg" ::spec/alphabet-distinct)) +(t/deftest repeating-alphabet-characters + (alphabet-spec-fails "aabcdefg" ::alphabet/alphabet-distinct)) -(deftest too-short-of-an-alphabet - (alphabet-spec-fails "ab" ::spec/alphabet-min-length)) +(t/deftest too-short-of-an-alphabet + (alphabet-spec-fails "ab" ::alphabet/alphabet-min-length)) diff --git a/test/org/sqids/clojure/block_list_test.cljc b/test/org/sqids/clojure/block_list_test.cljc index c52dd0b..7b82a02 100644 --- a/test/org/sqids/clojure/block_list_test.cljc +++ b/test/org/sqids/clojure/block_list_test.cljc @@ -1,71 +1,128 @@ (ns org.sqids.clojure.block-list-test (:require - [clojure.test :as t :refer [deftest is]] + #?@(:clj + [[clojure.java.io] + [org.sqids.clojure.block-list]]) + [clojure.test :as t] [org.sqids.clojure :as sut])) (defn make + "Builds a Sqids config with a custom block list." [block-list] (sut/sqids {:block-list block-list})) -(deftest block-list-test +(t/deftest default-block-list-test (let [sqids (sut/sqids) numbers [4572721]] - (is (= numbers (sut/decode sqids "aho1e"))) - (is (= "JExTR" (sut/encode sqids numbers))))) + (t/is (= numbers (sut/decode sqids "aho1e"))) + (t/is (= "JExTR" (sut/encode sqids numbers))))) -(deftest empty-block-list-test +(t/deftest empty-block-list-test (let [sqids (make #{}) numbers [4572721]] - (is (= numbers (sut/decode sqids "aho1e"))) - (is (= "aho1e" (sut/encode sqids numbers))))) + (t/is (= numbers (sut/decode sqids "aho1e"))) + (t/is (= "aho1e" (sut/encode sqids numbers))))) -(deftest non-empty-block-list-test +(t/deftest non-empty-block-list-test (let [sqids (make #{"ArUO"})] (let [numbers [4572721]] - (is (= numbers (sut/decode sqids "aho1e")) - (= "aho1e" (sut/encode sqids numbers)))) + (t/is (= numbers (sut/decode sqids "aho1e"))) + (t/is (= "aho1e" (sut/encode sqids numbers)))) (let [numbers [100000]] - (is (= numbers (sut/decode sqids "ArUO"))) - (is (= "QyG4" (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids "QyG4")))))) + (t/is (= numbers (sut/decode sqids "ArUO"))) + (t/is (= "QyG4" (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids "QyG4")))))) -(deftest encode-block-list - (let [sqids (make #{"JSwXFaosAN" ; normal result of 1st encoding, let's block that word on purpose +(t/deftest encode-block-list-test + (let [sqids (make #{"JSwXFaosAN" ; normal result of 1st encoding, block explicitly "OCjV9JK64o" ; result of 2nd encoding - "rBHf" ; result of 3rd encoding is `4rBHfOiqd3`, let's block a substring - "79SM" ; result of 4th encoding is `dyhgw479SM`, let's block the postfix - "7tE6" ; result of 4th encoding is `7tE6jdAHLe`, let's block the prefix + "rBHf" ; result of 3rd encoding is `4rBHfOiqd3`, block substring + "79SM" ; result of 4th encoding is `dyhgw479SM`, block postfix + "7tE6" ; result of 4th encoding is `7tE6jdAHLe`, block prefix }) numbers [1000000 2000000]] - (is (= "1aYeB7bRUt" (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids "1aYeB7bRUt"))))) + (t/is (= "1aYeB7bRUt" (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids "1aYeB7bRUt"))))) -(deftest decode-block-list +(t/deftest decode-block-list-test (let [sqids (make #{"86Rf07" "se8ojk" "ARsz1p" "Q8AI49" "5sQRZO"}) numbers [1 2 3]] - (is (= numbers (sut/decode sqids "86Rf07"))) - (is (= numbers (sut/decode sqids "se8ojk"))) - (is (= numbers (sut/decode sqids "ARsz1p"))) - (is (= numbers (sut/decode sqids "Q8AI49"))) - (is (= numbers (sut/decode sqids "5sQRZO"))))) + (t/is (= numbers (sut/decode sqids "86Rf07"))) + (t/is (= numbers (sut/decode sqids "se8ojk"))) + (t/is (= numbers (sut/decode sqids "ARsz1p"))) + (t/is (= numbers (sut/decode sqids "Q8AI49"))) + (t/is (= numbers (sut/decode sqids "5sQRZO"))))) -(deftest short-block-list +(t/deftest short-block-list-test (let [sqids (make #{"pnd"}) numbers [1000]] - (is (= numbers (->> numbers - (sut/encode sqids) - (sut/decode sqids)))))) + (t/is (= numbers (->> numbers + (sut/encode sqids) + (sut/decode sqids)))))) -(deftest lowercase-block-list +(t/deftest lowercase-block-list-test (let [sqids (sut/sqids {:alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ" :block-list #{"sxnzkl"}}) numbers [1 2 3]] - (is (= "IBSHOZ" (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids "IBSHOZ"))))) + (t/is (= "IBSHOZ" (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids "IBSHOZ"))))) -(deftest max-block-list +(t/deftest block-list-normalization-test + (let [sqids (sut/sqids {:alphabet "abc123" + :block-list #{"AB1" "xy" "ab!" "B2C" "12a"}})] + (t/is (= #{"ab1" "b2c" "12a"} (:block-list sqids))))) + +(t/deftest raw-config-map-initialization-test + (let [raw-config {:alphabet "abc" + :min-length 3 + :block-list #{"cab"}}] + (t/is (= "abc" (sut/encode raw-config [0]))) + (t/is (= [0] (sut/decode raw-config "abc"))))) + +(t/deftest max-block-list-test (let [sqids (sut/sqids {:alphabet "abc" :min-length 3 :block-list #{"cab" "abc" "bca"}})] - (is (thrown? #?(:cljs js/Error :clj RuntimeException) - (sut/encode sqids [0]))))) + #?(:clj + (t/is (thrown-with-msg? clojure.lang.ExceptionInfo + #"Reached max attempts to re-generate the ID" + (sut/encode sqids [0]))) + :cljs + (t/is (thrown-with-msg? js/Error + #"Reached max attempts to re-generate the ID" + (sut/encode sqids [0])))))) + +(t/deftest specific-is-blocked-id-scenarios-test + ;; id or word <= 3 chars should match exactly + (let [sqids (make #{"hey"})] + (t/is (= "86u" (sut/encode sqids [100])))) + + ;; id or word <= 3 chars should match exactly (blocked) + (let [sqids (make #{"86u"})] + (t/is (= "sec" (sut/encode sqids [100])))) + + ;; short block-list words should not match inside longer ids + (let [sqids (make #{"vFo"})] + (t/is (= "gMvFo" (sut/encode sqids [1000000])))) + + ;; word with digits should match prefix + (let [sqids (make #{"lP3i"})] + (t/is (= "oDqljxrokxRt" (sut/encode sqids [100 202 303 404])))) + + ;; word with digits should match suffix + (let [sqids (make #{"1HkYs"})] + (t/is (= "oDqljxrokxRt" (sut/encode sqids [100 202 303 404])))) + + ;; word with digits should not match in the middle + (let [sqids (make #{"0hfxX"})] + (t/is (= "862REt0hfxXVdsLG8vGWD" (sut/encode sqids [101 202 303 404 505 606 707])))) + + ;; word without digits should match in the middle + (let [sqids (make #{"hfxX"})] + (t/is (= "seu8n1jO9C4KQQDxdOxsK" (sut/encode sqids [101 202 303 404 505 606 707]))))) + +#?(:clj + (t/deftest read-default-missing-resource-test + (with-redefs [clojure.java.io/resource (constantly nil)] + (t/is (= #{} + (#'org.sqids.clojure.block-list/read-default nil nil)))))) diff --git a/test/org/sqids/clojure/decoding_test.cljc b/test/org/sqids/clojure/decoding_test.cljc new file mode 100644 index 0000000..09eaa8f --- /dev/null +++ b/test/org/sqids/clojure/decoding_test.cljc @@ -0,0 +1,86 @@ +(ns org.sqids.clojure.decoding-test + (:require + #?(:clj [clojure.spec.alpha :as s]) + #?(:clj [clojure.spec.gen.alpha :as gen]) + [clojure.test :as t] + [org.sqids.clojure.alphabet :as alphabet] + [org.sqids.clojure.decoding :as decoding] + #?(:clj [org.sqids.clojure.encoding :as encoding]) + #?(:clj [org.sqids.clojure.generators.decoding :as decoding-generators]) + #?(:clj [org.sqids.clojure.init :as init]) + [org.sqids.clojure.platform :as platform] + #?(:clj [org.sqids.clojure.results :as results]))) + +(t/deftest to-number-empty-input-test + (t/is (= 0 (#'decoding/to-number "" "abc")))) + +(t/deftest to-number-invalid-character-test + (t/is (nil? (#'decoding/to-number "z" "abc")))) + +(t/deftest to-number-valid-input-test + (t/is (= 0 (#'decoding/to-number "a" "abc"))) + (t/is (= 2 (#'decoding/to-number "c" "abc"))) + (t/is (= 5 (#'decoding/to-number "bc" "abc")))) + +#?(:cljs + (t/deftest to-number-out-of-range-test + (with-redefs [platform/in-range? (constantly false)] + (t/is (nil? (#'decoding/to-number "a" "abc")))))) + +(t/deftest parse-chunk-metadata-with-separator-test + (let [alphabet "abcd"] + (t/is (= {:chunk "bc" + :next-remaining "d" + :next-alphabet (alphabet/consistent-shuffle alphabet)} + (#'decoding/parse-chunk-metadata "bcad" alphabet))))) + +(t/deftest parse-chunk-metadata-without-separator-test + (let [alphabet "abcd"] + (t/is (= {:chunk "bcd" + :next-remaining "" + :next-alphabet alphabet} + (#'decoding/parse-chunk-metadata "bcd" alphabet))))) + +#?(:clj + (do + (t/deftest decode-overflow-args-gen-branches-test + (with-redefs [platform/decode-overflow-sqid-available? (constantly true) + platform/decode-overflow-sqid "overflow" + init/sqids (fn [_] + (results/ok {:alphabet "abc" + :min-length 0 + :block-list #{}}))] + (t/is (= [{:alphabet "abc" + :min-length 0 + :block-list #{}} + "overflow"] + (gen/generate (decoding-generators/decode-overflow-args))))) + (with-redefs [platform/decode-overflow-sqid-available? (constantly true) + init/sqids (fn [_] + (results/error ::error + ::stage + "failed" + {}))] + (let [[sqids-config sqid] (gen/generate (decoding-generators/decode-overflow-args))] + (t/is (s/valid? :org.sqids.clojure.init/sqids sqids-config)) + (t/is (= decoding-generators/invalid-character-sqid sqid)))) + (with-redefs [platform/decode-overflow-sqid-available? (constantly false)] + (let [[_ sqid] (gen/generate (decoding-generators/decode-overflow-args))] + (t/is (= decoding-generators/invalid-character-sqid sqid))))) + + (t/deftest decode-args-gen-includes-overflow-generator-when-available-test + (with-redefs [platform/decode-overflow-sqid-available? (constantly true)] + (t/is (some? (decoding-generators/decode-args))))) + + (t/deftest to-number-step-overflow-branch-test + (with-redefs [platform/decode-step (fn [_ _ _] nil)] + (t/is (nil? (#'decoding/to-number "a" "abc"))))) + + (t/deftest decode-canonical-args-gen-encode-error-fallback-test + (with-redefs [encoding/encode (fn [_ _] + (results/error ::error + ::stage + "failed" + {}))] + (let [[_ sqid] (gen/generate (decoding-generators/decode-canonical-args))] + (t/is (= "" sqid))))))) diff --git a/test/org/sqids/clojure/encoding_test.cljc b/test/org/sqids/clojure/encoding_test.cljc index 6b57ef8..3576de7 100644 --- a/test/org/sqids/clojure/encoding_test.cljc +++ b/test/org/sqids/clojure/encoding_test.cljc @@ -1,71 +1,105 @@ (ns org.sqids.clojure.encoding-test (:require [clojure.spec.alpha :as s] - [clojure.test :as t :refer [deftest is]] + [clojure.test :as t] [org.sqids.clojure :as sut] - [org.sqids.clojure.platform :as platform] - [org.sqids.clojure.spec :as spec]) + #?@(:clj [[org.sqids.clojure.decoding :as decoding]]) + [org.sqids.clojure.encoding :as encoding] + #?(:cljs [org.sqids.clojure.platform :as platform])) #?(:clj (:import (clojure.lang ExceptionInfo)))) (def sqids + "Default Sqids instance used by encoding tests." (sut/sqids)) -(deftest simple-test +(t/deftest simple-test (let [numbers [1 2 3] id "86Rf07"] - (is (= id (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids id))))) + (t/is (= id (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids id))))) -(deftest different-inputs-test - (let [numbers [0 0 0 1 2 3 100 1000 100000 1000000 platform/max-value]] - (is (= numbers (->> numbers - (sut/encode sqids) - (sut/decode sqids)))))) +(t/deftest different-inputs-test + (let [numbers [0 0 0 1 2 3 100 1000 100000 1000000 #?(:clj 9007199254740991N :cljs js/Number.MAX_SAFE_INTEGER)]] + (t/is (= numbers (->> numbers + (sut/encode sqids) + (sut/decode sqids)))))) -(deftest incremental-number-test +(t/deftest incremental-number-test (doseq [[id & numbers] [["bM" 0] ["Uk" 1] ["gb" 2] ["Ef" 3] ["Vq" 4] ["uw" 5] ["OI" 6] ["AX" 7] ["p6" 8] ["nJ" 9]]] - (is (= id (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids id))))) + (t/is (= id (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids id))))) -(deftest incremental-numbers-test +(t/deftest incremental-numbers-same-index-0-test (doseq [[id & numbers] [["SvIz" 0 0] ["n3qa" 0 1] ["tryF" 0 2] ["eg6q" 0 3] ["rSCF" 0 4] ["sR8x" 0 5] ["uY2M" 0 6] ["74dI" 0 7] ["30WX" 0 8] ["moxr" 0 9]]] - (is (= id (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids id))))) + (t/is (= id (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids id))))) -(deftest multi-input-test +(t/deftest incremental-numbers-same-index-1-test + (doseq [[id & numbers] + [["SvIz" 0 0] ["nWqP" 1 0] ["tSyw" 2 0] ["eX68" 3 0] ["rxCY" 4 0] + ["sV8a" 5 0] ["uf2K" 6 0] ["7Cdk" 7 0] ["3aWP" 8 0] ["m2xn" 9 0]]] + (t/is (= id (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids id))))) + +(t/deftest multi-input-test (let [numbers (range 0 100)] - (is (= numbers (->> numbers - (sut/encode sqids) - (sut/decode sqids)))))) + (t/is (= numbers (->> numbers + (sut/encode sqids) + (sut/decode sqids)))))) + +(t/deftest encode-no-numbers-test + (t/is (= "" (sut/encode sqids [])))) -(deftest encode-no-numbers-test - (is (= "" (sut/encode sqids [])))) +(t/deftest decode-empty-string-test + (t/is (= [] (sut/decode sqids "")))) -(deftest decode-empty-string-test - (is (= [] (sut/decode sqids "")))) +(t/deftest decode-invalid-character-test + (t/is (= [] (sut/decode sqids "*")))) -(deftest decode-invalid-character-test - (is (= [] (sut/decode sqids "*")))) +#?(:clj + (t/deftest decode-defensive-nil-branch-test + ;; Force internal number parsing failure to exercise the defensive [] + ;; branch in decoding/decode. + (with-redefs [decoding/to-number (constantly nil)] + (t/is (= [] (sut/decode sqids "86Rf07")))))) + +#?(:cljs + (t/deftest decode-overflow-safe-integer-test + ;; Encoded on CLJ from [9007199254740992N], which exceeds JS MAX_SAFE_INTEGER. + (t/is (= [] (sut/decode sqids "pup591lWlB"))))) (defn nat-ints-spec-fails + "Asserts `encode` fails spec validation for an invalid integer." [number] (let [e - (is (thrown? ExceptionInfo (sut/encode sqids [number]))) + (t/is (thrown? ExceptionInfo (sut/encode sqids [number]))) {::s/keys [problems]} (ex-data e)] - (is (= 1 (count problems))) - (let [{:keys [via val]} (first problems)] - (is (= number val)) - (is (= ::spec/nat-ints (last via)))))) + (t/is (seq problems)) + (t/is (some (fn [{:keys [via] value :val}] + (and (= number value) + (contains? #{::encoding/nat-ints ::encoding/nat-int} (last via)))) + problems)))) -(deftest encode-out-of-range-numbers-test +(t/deftest encode-out-of-range-numbers-test (nat-ints-spec-fails -1) - (nat-ints-spec-fails platform/max-value+1)) + #?(:cljs (nat-ints-spec-fails (inc platform/max-value)))) + +#?(:clj + (t/deftest big-integer-roundtrip-test + (let [numbers [0N + 1N + 18446744073709551616N + 340282366920938463463374607431768211455N + 12345678901234567890123456789012345678901234567890N] + id (sut/encode sqids numbers)] + (t/is (string? id)) + (t/is (= numbers (sut/decode sqids id)))))) diff --git a/test/org/sqids/clojure/generators/block_list_test.clj b/test/org/sqids/clojure/generators/block_list_test.clj new file mode 100644 index 0000000..b2edd3d --- /dev/null +++ b/test/org/sqids/clojure/generators/block_list_test.clj @@ -0,0 +1,11 @@ +(ns org.sqids.clojure.generators.block-list-test + (:require + [clojure.test :as t])) + +(t/deftest domain-characters-fallback-test + (let [block-list-word-characters + (var-get (requiring-resolve 'org.sqids.clojure.generators.block-list/block-list-word-characters)) + domain-characters + (requiring-resolve 'org.sqids.clojure.generators.block-list/domain-characters)] + (t/is (= block-list-word-characters + (domain-characters ""))))) diff --git a/test/org/sqids/clojure/invariants_test.cljc b/test/org/sqids/clojure/invariants_test.cljc new file mode 100644 index 0000000..dbd2b9e --- /dev/null +++ b/test/org/sqids/clojure/invariants_test.cljc @@ -0,0 +1,160 @@ +(ns org.sqids.clojure.invariants-test + (:require + [clojure.spec.alpha :as s] + [clojure.test :as t] + [org.sqids.clojure.decoding :as decoding] + [org.sqids.clojure.encoding :as encoding] + [org.sqids.clojure.init :as init] + [org.sqids.clojure.invariants :as invariants] + [org.sqids.clojure.results :as results])) + +(t/deftest encode-result-consistent-empty-numbers-test + (t/is (true? (invariants/encode-result-consistent? {:alphabet "abcde" + :min-length 5 + :block-list #{}} + [] + (results/ok ""))))) + +(t/deftest encode-result-consistent-valid-encode-test + (let [config (::results/value (init/sqids {:alphabet "abcde"})) + encode-result (encoding/encode config [1 2 3])] + (t/is (true? (invariants/encode-result-consistent? config + [1 2 3] + encode-result))))) + +(t/deftest encode-result-consistent-rejects-invalid-config-test + (t/is (false? (invariants/encode-result-consistent? {:alphabet "aa"} + [1] + (results/ok "abc"))))) + +(t/deftest encode-result-consistent-rejects-invalid-numbers-test + (t/is (false? (invariants/encode-result-consistent? {:alphabet "abcde" + :min-length 0 + :block-list #{}} + [:bad] + (results/ok "abc"))))) + +(t/deftest encode-result-consistent-rejects-invalid-sqid-test + (let [config (::results/value (init/sqids {:alphabet "abcde" + :block-list #{"cab"}}))] + (t/is (false? (invariants/encode-result-consistent? config + [0] + (results/ok "cab")))))) + +(t/deftest encode-result-consistent-rejects-empty-sqid-for-non-empty-input-test + (t/is (false? (invariants/encode-result-consistent? {:alphabet "abcde" + :min-length 0 + :block-list #{}} + [1] + (results/ok ""))))) + +(t/deftest encode-result-consistent-rejects-out-of-alphabet-sqid-test + (t/is (false? (invariants/encode-result-consistent? {:alphabet "abcde" + :min-length 0 + :block-list #{}} + [1] + (results/ok "zzz"))))) + +(t/deftest encode-result-consistent-rejects-too-short-sqid-test + (t/is (false? (invariants/encode-result-consistent? {:alphabet "abcde" + :min-length 4 + :block-list #{}} + [1] + (results/ok "abc"))))) + +(t/deftest encode-result-consistent-rejects-failed-roundtrip-test + (let [config (::results/value (init/sqids {:alphabet "abcde"}))] + (with-redefs [decoding/decode (fn [_ _] + (results/error ::results/unexpected-exception + :stage + "boom" + {}))] + (t/is (false? (invariants/encode-result-consistent? config + [1] + (results/ok "abc"))))))) + +(t/deftest encode-result-consistent-rejects-invalid-input-errors-for-valid-args-test + (let [config (::results/value (init/sqids {:alphabet "abcde"}))] + (t/is (false? (invariants/encode-result-consistent? config + [1] + (results/invalid-input :stage + [1] + {::s/problems []})))))) + +(t/deftest encode-result-consistent-allows-non-input-errors-for-valid-args-test + (let [config (::results/value (init/sqids {:alphabet "abcde"}))] + (t/is (true? (invariants/encode-result-consistent? config + [1] + (results/encode-max-attempts :stage + {:increment 1 + :numbers [1]})))))) + +(t/deftest encode-result-consistent-allows-invalid-input-errors-for-invalid-args-test + (t/is (true? (invariants/encode-result-consistent? {:alphabet "abcde" + :min-length 0 + :block-list #{}} + [:bad] + (results/invalid-input :stage + [:bad] + {::s/problems []}))))) + +(t/deftest decode-result-consistent-valid-decode-test + (let [config (::results/value (init/sqids {:alphabet "abcde"})) + encode-result (encoding/encode config [1 2 3]) + sqid (::results/value encode-result) + decode-result (decoding/decode config sqid)] + (t/is (true? (invariants/decode-result-consistent? config + sqid + decode-result))))) + +(t/deftest decode-result-consistent-empty-and-invalid-character-sqids-test + (let [config (::results/value (init/sqids {:alphabet "abcde"}))] + (t/is (true? (invariants/decode-result-consistent? config + "" + (results/ok [])))) + (t/is (true? (invariants/decode-result-consistent? config + "zzz" + (results/ok [])))) + (t/is (false? (invariants/decode-result-consistent? config + "zzz" + (results/ok [1])))))) + +(t/deftest decode-result-consistent-allows-non-canonical-sqids-test + (let [config (::results/value (init/sqids {}))] + (t/is (true? (invariants/decode-result-consistent? config + "0" + (results/ok [])))) + (t/is (true? (invariants/decode-result-consistent? config + "00" + (results/ok [60])))))) + +(t/deftest decode-result-consistent-rejects-invalid-config-and-non-string-successes-test + (t/is (false? (invariants/decode-result-consistent? {:alphabet "aa"} + "abc" + (results/ok [])))) + (t/is (false? (invariants/decode-result-consistent? {:alphabet "abcde" + :min-length 0 + :block-list #{}} + :not-a-string + (results/ok []))))) + +(t/deftest decode-result-consistent-error-shape-test + (let [config (::results/value (init/sqids {:alphabet "abcde"}))] + (t/is (false? (invariants/decode-result-consistent? config + "abc" + (results/error ::results/unexpected-exception + :stage + "boom" + {})))) + (t/is (true? (invariants/decode-result-consistent? {:alphabet "aa"} + "abc" + (results/error ::results/unexpected-exception + :stage + "boom" + {})))) + (t/is (true? (invariants/decode-result-consistent? config + :not-a-string + (results/error ::results/unexpected-exception + :stage + "boom" + {})))))) diff --git a/test/org/sqids/clojure/min_length_test.cljc b/test/org/sqids/clojure/min_length_test.cljc index 45cf8da..1662f2c 100644 --- a/test/org/sqids/clojure/min_length_test.cljc +++ b/test/org/sqids/clojure/min_length_test.cljc @@ -1,27 +1,36 @@ (ns org.sqids.clojure.min-length-test (:require - [clojure.test :as t :refer [deftest is]] - [org.sqids.clojure :as sut])) + [clojure.spec.alpha :as s] + [clojure.test :as t] + [org.sqids.clojure :as sut] + [org.sqids.clojure.init :as init]) + #?(:clj + (:import + (clojure.lang + ExceptionInfo)))) (def min-length + "Maximum alphabet size used in min-length boundary tests." (count "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")) (defn make - [min-length] - (sut/sqids {:min-length min-length})) + "Builds a Sqids config for a specific minimum output length." + [minimum-length] + (sut/sqids {:min-length minimum-length})) (def sqids + "Sqids instance configured with the maximum tested minimum length." (make min-length)) -(deftest simple-test +(t/deftest simple-test (let [numbers [1 2 3] id "86Rf07xd4zBmiJXQG6otHEbew02c3PWsUOLZxADhCpKj7aVFv9I8RquYrNlSTM"] - (is (= id (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids id))))) + (t/is (= id (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids id))))) -(deftest incremental-test +(t/deftest incremental-test (let [numbers [1 2 3]] - (doseq [[min-length id] + (doseq [[target-min-length expected-id] [[6 "86Rf07"] [7 "86Rf07x"] [8 "86Rf07xd"] @@ -31,14 +40,14 @@ [12 "86Rf07xd4zBm"] [13 "86Rf07xd4zBmi"] [(+ min-length 0) "86Rf07xd4zBmiJXQG6otHEbew02c3PWsUOLZxADhCpKj7aVFv9I8RquYrNlSTM"] - [(+ min-length 1) "86Rf07xd4zBmiJXQG6otHEbew02c3PWsUOLZxADhCpKj7aVFv9I8RquYrNlSTMy"] + [(inc min-length) "86Rf07xd4zBmiJXQG6otHEbew02c3PWsUOLZxADhCpKj7aVFv9I8RquYrNlSTMy"] [(+ min-length 2) "86Rf07xd4zBmiJXQG6otHEbew02c3PWsUOLZxADhCpKj7aVFv9I8RquYrNlSTMyf"] [(+ min-length 3) "86Rf07xd4zBmiJXQG6otHEbew02c3PWsUOLZxADhCpKj7aVFv9I8RquYrNlSTMyf1"]]] - (let [sqids (make min-length)] - (is (= id (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids id))))))) + (let [sqids-config (make target-min-length)] + (t/is (= expected-id (sut/encode sqids-config numbers))) + (t/is (= numbers (sut/decode sqids-config expected-id))))))) -(deftest incremental-numbers-test +(t/deftest incremental-numbers-test (doseq [[id & numbers] [["SvIzsqYMyQwI3GWgJAe17URxX8V924Co0DaTZLtFjHriEn5bPhcSkfmvOslpBu" 0 0] ["n3qafPOLKdfHpuNw3M61r95svbeJGk7aAEgYn4WlSjXURmF8IDqZBy0CT2VxQc" 0 1] @@ -50,19 +59,37 @@ ["74dID7X28VLQhBlnGmjZrec5wTA1fqpWtK4YkaoEIM9SRNiC3gUJH0OFvsPDdy" 0 7] ["30WXpesPhgKiEI5RHTY7xbB1GnytJvXOl2p0AcUjdF6waZDo9Qk8VLzMuWrqCS" 0 8] ["moxr3HqLAK0GsTND6jowfZz3SUx7cQ8aC54Pl1RbIvFXmEJuBMYVeW9yrdOtin" 0 9]]] - (is (= id (sut/encode sqids numbers))) - (is (= numbers (sut/decode sqids id))))) + (t/is (= id (sut/encode sqids numbers))) + (t/is (= numbers (sut/decode sqids id))))) -(deftest min-lengths-test - (doseq [min-length [0 1 5 10 min-length]] - (let [sqids (make min-length)] +(t/deftest min-lengths-test + (doseq [target-min-length [0 1 5 10 min-length]] + (let [sqids-config (make target-min-length)] (doseq [numbers [[0] [0 0 0 0 0] [1 2 3 4 5 6 7 8 9 10] [100 200 300] - [1000 2000 30000] - [(long #?(:clj Integer/MAX_VALUE + [1000 2000 3000] + [1000000] + [(long #?(:clj Long/MAX_VALUE :cljs js/Number.MAX_SAFE_INTEGER))]]] - (let [id (sut/encode sqids numbers)] - (is (<= min-length (count id))) - (is (= numbers (sut/decode sqids id)))))))) + (let [id (sut/encode sqids-config numbers)] + (t/is (<= target-min-length (count id))) + (t/is (= numbers (sut/decode sqids-config id)))))))) + +(defn min-length-spec-fails + "Asserts Sqids initialization fails for an invalid `:min-length` value." + [value] + (let [e + (t/is (thrown? #?(:clj ExceptionInfo :cljs cljs.core/ExceptionInfo) + (sut/sqids {:min-length value}))) + + {::s/keys [problems]} + (ex-data e)] + + (t/is (seq problems)) + (t/is (some #(= ::init/min-length (last (:via %))) problems)))) + +(t/deftest invalid-min-length-test + (min-length-spec-fails -1) + (min-length-spec-fails 256)) diff --git a/test/org/sqids/clojure/parity.clj b/test/org/sqids/clojure/parity.clj new file mode 100644 index 0000000..da917e1 --- /dev/null +++ b/test/org/sqids/clojure/parity.clj @@ -0,0 +1,350 @@ +(ns org.sqids.clojure.parity + (:require + [clojure.data.json :as json] + [clojure.java.io :as io] + [clojure.java.shell :as shell] + [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as gen] + [clojure.test :as t] + [clojure.test.check.generators :as tcgen] + [org.sqids.clojure :as sut] + [org.sqids.clojure.init :as init])) + +(set! *warn-on-reflection* true) + +(def js-safe-int-max + "Largest non-negative integer shared by the JS reference implementation." + 9007199254740991) + +(def generated-roundtrip-case-count + "Number of spec-generated shared-domain roundtrip parity cases." + 48) + +(def generated-invalid-decode-case-count + "Number of spec-generated invalid-character decode parity cases." + 16) + +(def invalid-reference-sqid + "Sqid character sequence guaranteed to be invalid for generated alphabets." + "\u0100") + +(def reference-runner-path + "Checked-in Node helper that evaluates requests with the sqids-spec reference implementation." + (.getAbsolutePath + (io/file "test-resources" "org" "sqids" "clojure" "sqids_spec_runner.mjs"))) + +(s/def ::id + string?) + +(s/def ::op + #{"roundtrip" "decode" "encode" "sqids"}) + +(s/def ::alphabet + string?) + +(s/def ::min-length + integer?) + +(s/def ::block-list + (s/coll-of string? :kind vector?)) + +(s/def ::options + (s/keys :opt-un [::alphabet ::min-length ::block-list])) + +(s/def ::numbers + (s/coll-of integer? :kind vector?)) + +(defn options->wire + "Converts public Clojure options to a JSON-friendly wire map." + [options] + (cond-> {} + (contains? options :alphabet) + (assoc :alphabet (:alphabet options)) + + (contains? options :min-length) + (assoc :min-length (:min-length options)) + + (contains? options :block-list) + (assoc :block-list (vec (sort (:block-list options)))))) + +(defn wire->options + "Converts a wire map back into public Clojure Sqids options." + [wire-options] + (cond-> {} + (contains? wire-options :alphabet) + (assoc :alphabet (:alphabet wire-options)) + + (contains? wire-options :min-length) + (assoc :min-length (:min-length wire-options)) + + (contains? wire-options :block-list) + (assoc :block-list (set (:block-list wire-options))))) + +(defn valid-wire-options? + "Returns true when `wire-options` conform to the public Sqids options spec." + [wire-options] + (s/valid? ::init/options (wire->options wire-options))) + +(s/def ::wire-options + (s/with-gen + valid-wire-options? + #(gen/fmap options->wire (s/gen ::init/options)))) + +(s/def ::shared-number + (s/with-gen + (s/and integer? #(<= 0 % js-safe-int-max)) + #(gen/large-integer* {:min 0 :max js-safe-int-max}))) + +(s/def ::shared-numbers + (s/with-gen + (s/coll-of ::shared-number :kind vector?) + #(gen/vector (s/gen ::shared-number) 0 8))) + +(s/def ::sqid + string?) + +(defmulti request-shape + "Dispatches parity request specs by operation." + :op) + +(defmethod request-shape "roundtrip" + [_] + (s/keys :req-un [::id ::op ::options ::numbers])) + +(defmethod request-shape "decode" + [_] + (s/keys :req-un [::id ::op ::options ::sqid])) + +(defmethod request-shape "encode" + [_] + (s/keys :req-un [::id ::op ::options ::numbers])) + +(defmethod request-shape "sqids" + [_] + (s/keys :req-un [::id ::op ::options])) + +(s/def ::request + (s/multi-spec request-shape :op)) + +(s/def ::status + #{"ok" "error"}) + +(s/def ::message + string?) + +(defn roundtrip-value? + "Returns true when `value` has the shared-domain roundtrip parity shape." + [value] + (and (map? value) + (s/valid? ::sqid (:sqid value)) + (s/valid? ::shared-numbers (:numbers value)))) + +(defn ok-response-value? + "Returns true when an ok response value matches the request operation." + [{:keys [op value]}] + (case op + "roundtrip" (roundtrip-value? value) + "decode" (s/valid? ::shared-numbers value) + "encode" (s/valid? ::sqid value) + "sqids" (= "initialized" value) + false)) + +(s/def ::ok-response + (s/and + (s/keys :req-un [::id ::op ::status]) + #(contains? % :value) + #(= "ok" (:status %)) + ok-response-value?)) + +(s/def ::error-response + (s/and + (s/keys :req-un [::id ::op ::status ::message]) + #(= "error" (:status %)))) + +(s/def ::response + (s/or :ok ::ok-response + :error ::error-response)) + +(defn sqids-spec-dir + "Returns the checked-out sqids-spec directory required for parity tests." + [] + (or (System/getenv "SQIDS_SPEC_DIR") + (throw (ex-info "SQIDS_SPEC_DIR must point to a checked-out sqids-spec repository" + {})))) + +(defn generate-samples + "Generates deterministic `sample-count` values from `generator` using `seed`." + [generator sample-count seed] + (mapv (fn [offset] + (tcgen/generate generator + 12 + (+ seed offset))) + (range sample-count))) + +(defn fixed-requests + "Returns curated parity requests for the shared successful spec surface." + [] + [{:id "default-simple" + :op "roundtrip" + :options {} + :numbers [1 2 3]} + {:id "default-blocklist" + :op "roundtrip" + :options {} + :numbers [4572721]} + {:id "custom-alphabet" + :op "roundtrip" + :options {:alphabet "0123456789abcdef"} + :numbers [1 2 3]} + {:id "custom-min-length" + :op "roundtrip" + :options {:min-length 10} + :numbers [1 2 3]} + {:id "custom-block-list" + :op "roundtrip" + :options {:block-list ["ArUO"]} + :numbers [100000]} + {:id "invalid-character" + :op "decode" + :options {} + :sqid "*"}]) + +(defn generated-roundtrip-requests + "Returns spec-generated roundtrip requests in the shared JS-safe domain." + [] + (->> (generate-samples (gen/tuple (s/gen ::wire-options) + (s/gen ::shared-numbers)) + generated-roundtrip-case-count + 42000) + (map-indexed (fn [index [wire-options shared-numbers]] + {:id (format "generated-roundtrip-%02d" index) + :op "roundtrip" + :options wire-options + :numbers shared-numbers})) + vec)) + +(defn generated-invalid-decode-requests + "Returns spec-generated invalid-character decode requests." + [] + (->> (generate-samples (s/gen ::wire-options) + generated-invalid-decode-case-count + 43000) + (map-indexed (fn [index wire-options] + {:id (format "generated-invalid-decode-%02d" index) + :op "decode" + :options wire-options + :sqid invalid-reference-sqid})) + vec)) + +(defn request->wire + "Normalizes internal request maps to the JSON wire shape used by the Node helper." + [request] + (cond-> {:id (:id request) + :op (:op request) + :options (:options request)} + (:numbers request) + (assoc :numbers (:numbers request)) + + (:sqid request) + (assoc :sqid (:sqid request)))) + +(defn local-response + "Evaluates a single parity request against this Clojure implementation." + [request] + (let [wire-request (request->wire request) + options (wire->options (:options wire-request))] + (try + (case (:op wire-request) + "roundtrip" + (let [sqids-config (sut/sqids options) + sqid (sut/encode sqids-config (:numbers wire-request))] + {:id (:id wire-request) + :op (:op wire-request) + :status "ok" + :value {:sqid sqid + :numbers (vec (sut/decode sqids-config sqid))}}) + + "decode" + (let [sqids-config (sut/sqids options)] + {:id (:id wire-request) + :op (:op wire-request) + :status "ok" + :value (vec (sut/decode sqids-config (:sqid wire-request)))}) + + "encode" + (let [sqids-config (sut/sqids options)] + {:id (:id wire-request) + :op (:op wire-request) + :status "ok" + :value (sut/encode sqids-config (:numbers wire-request))}) + + "sqids" + (do + (sut/sqids options) + {:id (:id wire-request) + :op (:op wire-request) + :status "ok" + :value "initialized"})) + (catch Exception error + {:id (:id wire-request) + :op (:op wire-request) + :status "error" + :message (.getMessage error)})))) + +(defn parse-reference-responses + "Parses the JSON emitted by the sqids-spec Node helper." + [json-output] + (json/read-str json-output :key-fn keyword)) + +(defn reference-responses + "Evaluates `requests` with the checked-out sqids-spec reference implementation." + [requests] + (let [spec-dir (sqids-spec-dir) + request-file (java.io.File/createTempFile "sqids-spec-parity" ".json") + wire-requests (mapv request->wire requests)] + (try + (spit request-file (json/write-str wire-requests)) + (let [{:keys [exit out err]} (shell/sh "npx" + "vite-node" + "--script" + reference-runner-path + (.getAbsolutePath request-file) + spec-dir + :dir spec-dir)] + (when-not (zero? exit) + (throw (ex-info "sqids-spec reference runner failed" + {:exit exit + :out out + :err err}))) + (parse-reference-responses out)) + (finally + (.delete request-file))))) + +(defn assert-valid! + "Asserts that `value` conforms to `spec`." + [spec value] + (t/is (s/valid? spec value) + (with-out-str (s/explain spec value)))) + +(defn assert-parity! + "Runs `requests` through both implementations and asserts matching results." + [requests] + (doseq [request requests] + (assert-valid! ::request (request->wire request))) + (let [expected (mapv local-response requests) + actual (reference-responses requests)] + (t/is (= (count expected) (count actual))) + (doseq [response expected] + (assert-valid! ::response response)) + (doseq [response actual] + (assert-valid! ::response response)) + (doseq [[request expected-response actual-response] (map vector requests expected actual)] + (t/testing (:id request) + (t/is (= expected-response actual-response)))))) + +(t/deftest sqids-spec-parity-test + (assert-parity! (into [] + cat + [(fixed-requests) + (generated-roundtrip-requests) + (generated-invalid-decode-requests)]))) diff --git a/test/org/sqids/clojure/parity_runner.clj b/test/org/sqids/clojure/parity_runner.clj new file mode 100644 index 0000000..590be0c --- /dev/null +++ b/test/org/sqids/clojure/parity_runner.clj @@ -0,0 +1,15 @@ +(ns org.sqids.clojure.parity-runner + (:gen-class) + (:require + [clojure.test :as t] + [org.sqids.clojure.parity])) + +(set! *warn-on-reflection* true) + +(defn -main + "Runs the sqids-spec parity test namespace and exits nonzero on failure." + [& _] + (let [result (t/run-tests 'org.sqids.clojure.parity)] + (shutdown-agents) + (when (pos? (+ (:fail result) (:error result))) + (System/exit 1)))) diff --git a/test/org/sqids/clojure/platform_test.cljc b/test/org/sqids/clojure/platform_test.cljc new file mode 100644 index 0000000..9158569 --- /dev/null +++ b/test/org/sqids/clojure/platform_test.cljc @@ -0,0 +1,13 @@ +(ns org.sqids.clojure.platform-test + (:require + [clojure.test :as t] + [org.sqids.clojure.platform :as platform])) + +(t/deftest decode-overflow-sqid-predicate-test + (t/is (= (some? platform/decode-overflow-sqid) + (platform/decode-overflow-sqid-available?))) + (t/is (false? (platform/decode-overflow-sqid? "not-overflow"))) + (with-redefs [platform/decode-overflow-sqid "fixture"] + (t/is (true? (platform/decode-overflow-sqid-available?))) + (t/is (true? (platform/decode-overflow-sqid? "fixture"))) + (t/is (false? (platform/decode-overflow-sqid? "other"))))) diff --git a/test/org/sqids/clojure/results_test.cljc b/test/org/sqids/clojure/results_test.cljc new file mode 100644 index 0000000..a523aeb --- /dev/null +++ b/test/org/sqids/clojure/results_test.cljc @@ -0,0 +1,379 @@ +(ns org.sqids.clojure.results-test + (:require + [clojure.spec.alpha :as s] + [clojure.test :as t] + [org.sqids.clojure :as sut] + [org.sqids.clojure.decoding :as decoding] + [org.sqids.clojure.encoding :as encoding] + [org.sqids.clojure.init :as init] + [org.sqids.clojure.results :as results])) + +(defn namespaced-results-keys? + "Returns true when all top-level keys in `result` use the results namespace." + [result] + (and (map? result) + (every? qualified-keyword? (keys result)) + (every? #(= results/result-key-namespace (namespace %)) (keys result)))) + +(defn assert-results-map-shape + "Asserts common structural guarantees for all result maps." + [result] + (t/is (map? result)) + (t/is (contains? result ::results/status)) + (t/is (namespaced-results-keys? result))) + +(defn assert-error-shape + "Asserts common structural guarantees for error result maps." + [result expected-code] + (assert-results-map-shape result) + (t/is (= ::results/error (::results/status result))) + (t/is (= expected-code (::results/code result))) + (t/is (keyword? (::results/stage result))) + (t/is (string? (::results/message result))) + (t/is (map? (::results/details result)))) + +(defn thrown-message + "Returns the platform-specific exception message string." + [error] + #?(:clj (.getMessage error) + :cljs (ex-message error))) + +(t/deftest namespaced-results-keys-rejects-non-map-test + (t/is (false? (results/namespaced-results-keys? :not-a-map))) + (t/is (false? (results/namespaced-results-keys? {:plain :key}))) + (t/is (false? (results/namespaced-results-keys? {:other.ns/key :value}))) + (t/is (true? (results/namespaced-results-keys? {::results/status ::results/ok})))) + +(t/deftest result-shape-multispec-branches-test + (let [exception (ex-info "cause" {:source :shape-test}) + valid-ok {::results/status ::results/ok + ::results/value 1} + valid-unexpected {::results/status ::results/error + ::results/code ::results/unexpected-exception + ::results/stage ::results/test-stage + ::results/message "boom" + ::results/details {} + ::results/exception exception} + valid-invalid-input {::results/status ::results/error + ::results/code ::results/invalid-input + ::results/stage ::results/test-stage + ::results/message "bad args" + ::results/details {} + ::results/input :value + ::results/problems []} + valid-max-attempts {::results/status ::results/error + ::results/code ::results/encode-max-attempts + ::results/stage ::results/test-stage + ::results/message "retry" + ::results/details {} + ::results/increment 1 + ::results/numbers [1]}] + (t/is (false? (s/valid? ::results/ok-result-shape :not-a-map))) + (t/is (false? (s/valid? ::results/ok-result-shape {:plain :key}))) + (t/is (false? (s/valid? ::results/ok-result-shape + {::results/status ::results/error ::results/value 1}))) + (t/is (false? (s/valid? ::results/ok-result-shape {::results/status ::results/ok}))) + (t/is (false? (s/valid? ::results/ok-result-shape + {::results/status ::results/ok + ::results/value 1 + ::results/extra true}))) + (t/is (true? (s/valid? ::results/ok-result-shape valid-ok))) + + (t/is (false? (s/valid? ::results/error-result-shape :not-a-map))) + (t/is (false? (s/valid? ::results/error-result-shape {:plain :key}))) + (t/is (false? (s/valid? ::results/error-result-shape + (assoc valid-unexpected ::results/status ::results/ok)))) + (t/is (false? (s/valid? ::results/error-result-shape + (dissoc valid-unexpected ::results/code)))) + (t/is (false? (s/valid? ::results/error-result-shape + (dissoc valid-unexpected ::results/stage)))) + (t/is (false? (s/valid? ::results/error-result-shape + (dissoc valid-unexpected ::results/message)))) + (t/is (false? (s/valid? ::results/error-result-shape + (dissoc valid-unexpected ::results/details)))) + (t/is (false? (s/valid? ::results/error-result-shape + (dissoc valid-unexpected ::results/exception)))) + (t/is (false? (s/valid? ::results/error-result-shape + (assoc valid-unexpected ::results/code ::results/invalid-input)))) + (t/is (false? (s/valid? ::results/error-result-shape + (assoc valid-unexpected ::results/code ::results/encode-max-attempts)))) + (t/is (false? (s/valid? ::results/error-result-shape + (assoc valid-unexpected ::results/code ::results/unknown-code)))) + (t/is (true? (s/valid? ::results/error-result-shape valid-unexpected))) + (t/is (true? (s/valid? ::results/error-result-shape valid-invalid-input))) + (t/is (true? (s/valid? ::results/error-result-shape valid-max-attempts))) + (t/is (false? (s/valid? ::results/error-base-shape + (assoc valid-unexpected ::results/stage "not-a-keyword")))) + (t/is (false? (s/valid? ::results/error-base-shape + (assoc valid-unexpected ::results/message :not-a-string)))) + (t/is (false? (s/valid? ::results/error-base-shape + (assoc valid-unexpected ::results/details :not-a-map)))) + (t/is (false? (s/valid? ::results/error-base-shape + (assoc valid-unexpected ::results/exception nil)))) + (t/is (false? (s/valid? ::results/error-base-shape + (assoc valid-invalid-input ::results/problems :not-a-vector)))) + (t/is (false? (s/valid? ::results/error-base-shape + (assoc valid-max-attempts ::results/increment "not-an-int")))) + (t/is (false? (s/valid? ::results/error-base-shape + (assoc valid-max-attempts ::results/numbers 42)))) + (t/is (true? (s/valid? ::results/error-base-shape valid-unexpected))) + (t/is (true? (s/valid? ::results/error-base-shape valid-invalid-input))) + (t/is (true? (s/valid? ::results/error-base-shape valid-max-attempts))) + + (t/is (false? (s/valid? ::results/result :not-a-map))) + (t/is (false? (s/valid? ::results/result {::results/value 1}))) + (t/is (false? (s/valid? ::results/result + {::results/status ::results/unknown-status + ::results/value 1}))) + (t/is (false? (s/valid? ::results/result + {:other.ns/status ::results/ok + ::results/value 1}))) + (t/is (true? (s/valid? ::results/result valid-ok))) + (t/is (true? (s/valid? ::results/result valid-unexpected))))) + +(t/deftest invalid-input-helper-shape-test + (let [input {:fn :encode :args [nil [1 2 3]]} + explain {::s/problems [{:path [:args 0] :pred `map? :val nil}] + ::s/value input} + cause (ex-info "Invalid input" explain) + from-cause (results/invalid-input cause) + explicit (results/invalid-input ::results/validation input explain)] + (doseq [result [from-cause explicit]] + (assert-error-shape result ::results/invalid-input) + (t/is (= input (::results/input result))) + (t/is (vector? (::results/problems result)))))) + +(t/deftest conform-invalid-input-uses-spec-explain-message-test + (let [result (results/conform ::init/options + {:alphabet "ab"} + ::results/test-stage)] + (assert-error-shape result ::results/invalid-input) + (t/is (not= "Invalid input" (::results/message result))) + (t/is (re-find #"ab" (::results/message result))))) + +(t/deftest encode-max-attempts-helper-shape-test + (let [cause (ex-info "Reached max attempts to re-generate the ID" + {:increment 63 + :numbers [0 1 2]}) + result (results/encode-max-attempts cause)] + (assert-error-shape result ::results/encode-max-attempts) + (t/is (= 63 (::results/increment result))) + (t/is (= [0 1 2] (::results/numbers result))))) + +(t/deftest unexpected-captures-original-exception-test + (let [cause (ex-info "unexpected" {:source :results-test}) + result (results/unexpected cause)] + (assert-error-shape result ::results/unexpected-exception) + (t/is (identical? cause (::results/exception result))))) + +(t/deftest error-normalizes-non-map-details-test + (let [result (results/error ::results/invalid-input + ::results/test-stage + "Invalid input" + 42)] + (assert-error-shape result ::results/invalid-input) + (t/is (= {:value 42} (::results/details result))))) + +(t/deftest unexpected-with-nil-message-falls-back-to-string-test + (let [cause #?(:clj (Exception.) :cljs (js/Error.)) + result (results/unexpected cause)] + (assert-error-shape result ::results/unexpected-exception))) + +(t/deftest bind-first-arity-test + (let [result (results/bind (results/ok 1) + (fn [value] + (results/ok (inc value))))] + (assert-results-map-shape result) + (t/is (= ::results/ok (::results/status result))) + (t/is (= 2 (::results/value result))))) + +(t/deftest bind-catches-exceptions-test + (let [cause (ex-info "bind failure" {:source :bind-test}) + result (results/bind (results/ok :x) + ::results/test-stage + (fn [_] + (throw cause)))] + (assert-error-shape result ::results/unexpected-exception) + (t/is (identical? cause (::results/exception result))))) + +(t/deftest conform-catches-spec-resolution-errors-test + (let [result (results/conform ::results/missing-spec + :value + ::results/test-stage)] + (assert-error-shape result ::results/unexpected-exception))) + +(t/deftest init-sqids-invalid-input-does-not-throw-test + (let [result (init/sqids {:alphabet "ab"})] + (assert-error-shape result ::results/invalid-input) + (t/is (seq (::results/problems result))))) + +(t/deftest encoding-encode-max-attempts-does-not-throw-test + (let [sqids-config (sut/sqids {:alphabet "abc" + :min-length 3 + :block-list #{"cab" "abc" "bca"}}) + result (encoding/encode sqids-config [0])] + (assert-error-shape result ::results/encode-max-attempts) + (t/is (= 4 (::results/increment result))) + (t/is (= [0] (::results/numbers result))))) + +(t/deftest encoding-unexpected-path-preserves-exception-test + (let [cause (ex-info "boom" {:source :with-redefs})] + (with-redefs [init/ensure-initialized (fn [_] (throw cause))] + (let [result (encoding/encode {:alphabet "abc"} [1])] + (assert-error-shape result ::results/unexpected-exception) + (t/is (identical? cause (::results/exception result))))))) + +(t/deftest internal-success-shape-test + (let [sqids-result (init/sqids {}) + sqids-value (::results/value sqids-result) + encode-result (encoding/encode sqids-value [1 2 3]) + decode-result (decoding/decode sqids-value (::results/value encode-result))] + (doseq [result [sqids-result encode-result decode-result]] + (assert-results-map-shape result) + (t/is (= ::results/ok (::results/status result)))) + (t/is (= [1 2 3] (::results/value decode-result))))) + +(t/deftest public-api-still-throws-at-edge-test + (let [sqids-config (sut/sqids {:alphabet "abc" + :min-length 3 + :block-list #{"cab" "abc" "bca"}})] + #?(:clj + (t/is (thrown-with-msg? + clojure.lang.ExceptionInfo + #"Reached max attempts to re-generate the ID" + (sut/encode sqids-config [0]))) + :cljs + (t/is (thrown-with-msg? + js/Error + #"Reached max attempts to re-generate the ID" + (sut/encode sqids-config [0])))))) + +(t/deftest public-sqids-invalid-input-throws-at-edge-test + (let [result (init/sqids {:alphabet "ab"}) + expected-message (::results/message result)] + (assert-error-shape result ::results/invalid-input) + (t/is (not= "Invalid input" expected-message)) + (try + (sut/sqids {:alphabet "ab"}) + (t/is false "Expected sut/sqids to throw") + (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) error + (t/is (= expected-message (thrown-message error))))))) + +(t/deftest public-decode-invalid-config-throws-at-edge-test + (let [result (decoding/decode {:alphabet "ab"} "abc") + expected-message (::results/message result)] + (assert-error-shape result ::results/invalid-input) + (t/is (not= "Invalid input" expected-message)) + (try + (sut/decode {:alphabet "ab"} "abc") + (t/is false "Expected sut/decode to throw") + (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) error + (t/is (= expected-message (thrown-message error))))))) + +#?(:clj + (t/deftest public-edge-throw-preserves-cause-test + (let [cause (Exception. "underlying failure")] + (with-redefs [encoding/encode (fn [_ _] + {::results/status ::results/error + ::results/code ::results/unexpected-exception + ::results/stage ::results/test-stage + ::results/message "wrapper failure" + ::results/details {:source :wrapper-test} + ::results/exception cause})] + (try + (sut/encode {} [1]) + (t/is false "Expected sut/encode to throw") + (catch clojure.lang.ExceptionInfo error + (t/is (= "wrapper failure" (.getMessage error))) + (t/is (= {:source :wrapper-test} (ex-data error))) + (t/is (identical? cause (.getCause error))))))))) + +#?(:clj + (t/deftest public-sqids-edge-throw-preserves-cause-test + (let [cause (Exception. "sqids failure")] + (with-redefs [init/sqids (fn [_] + {::results/status ::results/error + ::results/code ::results/unexpected-exception + ::results/stage ::results/test-stage + ::results/message "sqids failure" + ::results/details {:source :sqids-wrapper-test} + ::results/exception cause})] + (try + (sut/sqids {}) + (t/is false "Expected sut/sqids to throw") + (catch clojure.lang.ExceptionInfo error + (t/is (= "sqids failure" (.getMessage error))) + (t/is (= {:source :sqids-wrapper-test} (ex-data error))) + (t/is (identical? cause (.getCause error))))))))) + +#?(:clj + (t/deftest public-decode-edge-throw-preserves-cause-test + (let [cause (Exception. "decode failure")] + (with-redefs [decoding/decode (fn [_ _] + {::results/status ::results/error + ::results/code ::results/unexpected-exception + ::results/stage ::results/test-stage + ::results/message "decode failure" + ::results/details {:source :decode-wrapper-test} + ::results/exception cause})] + (try + (sut/decode {} "abc") + (t/is false "Expected sut/decode to throw") + (catch clojure.lang.ExceptionInfo error + (t/is (= "decode failure" (.getMessage error))) + (t/is (= {:source :decode-wrapper-test} (ex-data error))) + (t/is (identical? cause (.getCause error))))))))) + +(t/deftest public-edge-throw-defaults-message-and-details-test + (with-redefs [encoding/encode (fn [_ _] + {::results/status ::results/error + ::results/code ::results/unexpected-exception + ::results/stage ::results/test-stage})] + (try + (sut/encode {} [1]) + (t/is false "Expected sut/encode to throw") + (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) error + #?(:clj + (do + (t/is (= "Sqids operation failed" (thrown-message error))) + (t/is (= {} (ex-data error)))) + :cljs + (do + (t/is (= "Sqids operation failed" (thrown-message error))) + (t/is (= {} (ex-data error))))))))) + +(t/deftest public-sqids-edge-throw-defaults-message-and-details-test + (with-redefs [init/sqids (fn [_] + {::results/status ::results/error + ::results/code ::results/unexpected-exception + ::results/stage ::results/test-stage})] + (try + (sut/sqids {}) + (t/is false "Expected sut/sqids to throw") + (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) error + #?(:clj + (do + (t/is (= "Sqids operation failed" (thrown-message error))) + (t/is (= {} (ex-data error)))) + :cljs + (do + (t/is (= "Sqids operation failed" (thrown-message error))) + (t/is (= {} (ex-data error))))))))) + +(t/deftest public-decode-edge-throw-defaults-message-and-details-test + (with-redefs [decoding/decode (fn [_ _] + {::results/status ::results/error + ::results/code ::results/unexpected-exception + ::results/stage ::results/test-stage})] + (try + (sut/decode {} "abc") + (t/is false "Expected sut/decode to throw") + (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) error + #?(:clj + (do + (t/is (= "Sqids operation failed" (thrown-message error))) + (t/is (= {} (ex-data error)))) + :cljs + (do + (t/is (= "Sqids operation failed" (thrown-message error))) + (t/is (= {} (ex-data error))))))))) diff --git a/test/org/sqids/clojure/spec_test.cljc b/test/org/sqids/clojure/spec_test.cljc deleted file mode 100644 index ef6fad6..0000000 --- a/test/org/sqids/clojure/spec_test.cljc +++ /dev/null @@ -1,39 +0,0 @@ -(ns org.sqids.clojure.spec-test - (:require - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as stest] - [clojure.test :as t :refer [deftest]] - [clojure.test.check] - [clojure.test.check.properties] - [expound.alpha :as expound] - [org.sqids.clojure] - [org.sqids.clojure.spec])) - -(defn check - [results] - (doseq [result results] - (let [{:keys [failure] :as abbrev} - (stest/abbrev-result result) - - message - (binding [s/*explain-out* expound/printer] - (expound/explain-result-str result)) - - expected - (->> abbrev :spec rest (apply hash-map) :ret) - - actual - (if (instance? #?(:cljs js/Error :clj Throwable) failure) - failure - (::stest/val failure))] - - (t/do-report {:type (if failure :fail :pass) - :message message - :expected expected - :actual actual})))) - -(deftest sqids-test - (check (stest/check `org.sqids.clojure/sqids))) - -(deftest decode-test - (check (stest/check `org.sqids.clojure/decode))) diff --git a/tests.edn b/tests.edn new file mode 100644 index 0000000..03a1fbc --- /dev/null +++ b/tests.edn @@ -0,0 +1,46 @@ +#kaocha/v1 +{:plugins + [:kaocha.plugin/cloverage + :kaocha.plugin/junit-xml] + + :reporter + [kaocha.report/documentation] + + :tests + [{:id :unit + :source-paths ["src"] + :test-paths ["test"] + :ns-patterns [".*-test$"]} + + {:id :cljs + :type :kaocha.type/cljs + :source-paths ["src"] + :test-paths ["test"] + :ns-patterns [".*-test$"] + :cljs/repl-env cljs.repl.node/repl-env + :cljs/timeout 30000} + + {:id :generative-fdef-checks + :type :kaocha.type/spec.test.check + :source-paths ["src"] + :clojure.spec.test.check/instrument? true}] + + ;; Default cloverage output for `bin/kaocha`. + :cloverage/opts + {:output "target/coverage" + :exclude-call [clojure.spec.alpha/def + clojure.spec.alpha/and + clojure.spec.alpha/or + clojure.spec.alpha/keys + clojure.spec.alpha/multi-spec + clojure.core/loop + clojure.core/when-some] + :fail-threshold 100 + :codecov? true + :lcov? true + :summary? true + :html? true + :text? false} + + :kaocha.plugin.junit-xml/target-file + "target/test-results/junit.xml"}