diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,51 @@ +# Changelog + +All notable changes to hurl-workbench are recorded here. + +The format follows [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and +this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +## [0.1.0.0] - 2026-11-12 + +### Added + +- Versioned Dhall workspaces with compatible record completion, upward discovery, accumulated + semantic validation, and category-specific names. +- Byte-preserving fragment composition, source-mapped Hurlfmt validation, and inspectable rendering. +- Secure Hurl 8.x execution with separate plain/secret files, filtered ambient configuration, + exact child statuses, and typed Hurl option passthrough. +- Read-only/mutating recipes, bounded matrices, isolated client artifacts, managed services, suite + preflight, and isolated JUnit, HTML, JSON, and TAP reports. +- Revision-aware version output and generated Bash, Zsh, and Fish completions. +- Local vendor-exploration and managed integration-service examples. +- Per-execution UUID4, UUID7, TypeID, UTC timestamp, and alphanumeric generated parameters with + reproducible runtime overrides. +- Caller-owned Hurl file roots for file bodies, validated before subprocess work and protected from + output preparation. +- Ordered multi-service suites with bounded setup/teardown commands and named Stop/Start/Restart + barriers between Hurl batches; compatible old manifests and redacted ordered lifecycle results. +- Executable checks as ordered suite barriers, with workspace-contained executables, Plain argv + templates, bounded process groups, and private captures; checks-only suites with no Hurl cases. +- Process-group cleanup for Hurl and managed commands, including bounded capture cancellation, + plus production Rei/Hinagata command/read and lease-release acceptance drivers. +- Compatible suite isolation declarations, with a shared-state default and early refusal of + parallel mutation or unclassified suite runs; standalone mutating matrices require serial jobs. +- Private versioned per-scenario runtime inputs for caller-owned independent suites, with unique + fixture/origin assignments, channel/conflict validation, and individually resolved bindings. +- Safe isolation/scenario summaries for success, refusal, setup failure, and cancellation, plus + real two-database Hinagata acceptance covering fail-fast and caller-owned cleanup. +- Explicit inherited or clean environment policies for managed service and readiness commands, + with required-name preflight, compatible old manifests, and a caller-owned lease check driver. +- Local CLI/API parity examples and real application acceptance using executable checks. + +### Security + +- Secrets never enter child argv; temporary inputs and output artifacts use owner-only permissions. +- Managed services are cleaned up as POSIX process groups, including on timeout and interruption. + +### Compatibility + +- Hurl and Hurlfmt 8.0 or newer are required. Later major versions are reported as untested by + `doctor` rather than rejected automatically. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2026 Nadeem Bitar + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Nadeem Bitar nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,113 @@ +# hurl-workbench + +`hurl-workbench` composes complete Hurl entries into reusable workflows, supplies plain and secret +parameters securely, and executes recipes, matrices, and integration suites through the official +Hurl binary. Suites can manage several services, generate fresh scenario inputs, read caller-owned +body files, and run application-owned executable assertions between Hurl batches. Hurl remains +responsible for HTTP, captures, assertions, cookies, retries, and reports. + +Suites default to shared application state: parallel Hurl runs require ReadOnly recipes, and shared +writes require `--jobs 1 --allow-mutating`. Independent suites validate caller-provisioned +fixture/endpoint assignments through `--scenario-inputs`; the caller establishes actual isolation. +See the [integration guide](docs/guides/integration-testing.md). + +## Five-minute quick start + +Enter the pinned development environment and inspect the interface: + +```bash +nix develop +cabal run hurl-workbench -- --help +cabal run hurl-workbench -- doctor +``` + +The small workspace in [`examples/quick-start/`](examples/quick-start/) defines one `health` +fragment and workflow against the bundled Dhall schema. Its token is a secret parameter sourced +from `QUICKSTART_TOKEN`; no credential is committed. Inspect, validate, and render it: + +```bash +sed -n '1,240p' examples/quick-start/hurl-workbench.dhall +cabal run hurl-workbench -- --workspace examples/quick-start/hurl-workbench.dhall validate +cabal run hurl-workbench -- --workspace examples/quick-start/hurl-workbench.dhall render workflow health +``` + +Start the local fixture API in one terminal: + +```bash +cabal run hurl-workbench-fixture-server -- --port 18080 +``` + +Run the workflow from another terminal with an environment-backed fixture secret: + +```bash +QUICKSTART_TOKEN=fixture-secret cabal run hurl-workbench -- \ + --workspace examples/quick-start/hurl-workbench.dhall \ + test workflow health +``` + +The expected result is a passing Hurl test summary. For full workflows, continue with: + +- [`examples/vendor-odata/`](examples/vendor-odata/) — one OAuth capture reused by OData-shaped + recipes and a bounded matrix, plus bespoke capture and raw-response investigations; +- [`examples/integration-service/`](examples/integration-service/) — managed fixture-service + lifecycle, safe and mutating suites, clean command environments, and isolated reports; +- [`examples/multi-service/`](examples/multi-service/) — ordered stub/API/worker startup, + setup/teardown, and worker restart barriers; +- [`examples/generated-parameters/`](examples/generated-parameters/) — fresh UUID, TypeID, + timestamp, and random inputs with reproducible overrides; +- [`examples/file-body/`](examples/file-body/) — caller-generated UTF-8/CRLF request bodies + passed unchanged through `--file-root`; +- [`examples/executable-checks/`](examples/executable-checks/) — CLI/API parity assertions + between Hurl runs, including a deliberately failing comparison. + +## Core model + +A `hurl-workbench.dhall` manifest imports [`schema/package.dhall`](schema/package.dhall). Fragments +are ordinary `.hurl` files containing one or more complete entries. A workflow names fragments in +order; rendering preserves their bytes and inserts only the line feeds needed between them. +Recipes add committed plain bindings and an explicit safety class. Matrices layer named cases over +a recipe. Suites execute bounded Hurl batches separated by executable checks or named service +Stop/Start/Restart barriers. Services become ready in declaration order and stop in reverse +acquisition order before bounded teardown, including on failure and cancellation. + +Plain, Secret, and Generated parameters have separate binding rules. Generated values resolve +once per prepared Hurl execution; explicit runtime values reproduce a prior run. Use Plain inputs +when setup, checks, and several Hurl runs must share an identity. Command environments can inherit +ambient variables or explicitly select names through `EnvironmentPolicy.Clean`. + +Execution commands accept `--file-root DIR`; suites can also name a Plain `fileRootParameter`. +The caller keeps body files alive until execution ends. Keep report and output trees outside an +explicit body root. A suite with executable checks requires `--report-dir`; captured check output +stays in private files while the summary records named outcomes and relative paths. + +Without `--workspace`, discovery starts at the current directory and walks upward looking for +`hurl-workbench.dhall`. See the [workspace reference](docs/reference/workspace.md), [CLI +reference](docs/reference/cli.md), [architecture](docs/architecture.md), and [security +model](docs/security.md). The [guide index](docs/guides/index.md) maps tasks to examples, and the +[OKF capability catalog](docs/capabilities/index.md) records implemented contracts, evidence, and +limits with stable `CAP-N` handles. These capabilities are currently unreleased and experimental. + +## Development + +The repository contains `hurl-workbench-core` and `hurl-workbench-cli`, targets GHC 9.12.4, and +uses a Nix flake for the complete toolchain. + +```bash +nix develop +just check +``` + +`just check` initializes Cabal's Hackage index, whose solver view is pinned by +`cabal.project`, then runs formatting, builds, tests, local examples, source-distribution +checks, and the Nix flake gate. On a Mac with Apple `container` installed and its system +service running, `just linux-check` runs that same gate in a disposable ARM64 Linux VM. +Local examples include multi-service orchestration, file-body byte preservation, generated-input +overrides, and matching/failing executable checks. Real application and database lease acceptance +uses opt-in caller harnesses documented in the integration guide. + +Release source archives use `bash scripts/build-sdist.sh`; this wrapper preserves executable modes +for the declared check helpers. `just sdist` verifies the unpacked archives and their examples. + +## License + +[BSD-3-Clause](LICENSE) — © 2026 Nadeem Bitar. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import HurlWorkbench.Cli (runCli) + +main :: IO () +main = runCli diff --git a/examples/executable-checks/README.md b/examples/executable-checks/README.md new file mode 100644 --- /dev/null +++ b/examples/executable-checks/README.md @@ -0,0 +1,43 @@ +# Executable check barriers + +`parity` runs a read-only Hurl recipe, the application-owned `parity.py` assertion, +and another read-only recipe. The assertion invokes the example application's +supported CLI and HTTP facts interfaces against separately provisioned fixtures. +Plain inputs identify the fixtures; a Secret parameter reaches the helper only as +`PARITY_TOKEN`. Its Clean policy selects PATH and excludes ambient database and +service settings. `parity-mismatch` changes only the HTTP fixture through its +supported API, then proves that the same assertion fails. + +From the repository root, inside `nix develop`, run: + +```bash +cabal build all +HURL_WORKBENCH_EXECUTABLE="$(cabal list-bin hurl-workbench)" \ + python3 scripts/check-command-parity-local.py +``` + +The caller creates two private fixture directories, starts their HTTP service, +runs the matching suite at jobs=2 and the mutating mismatch suite serially, verifies +named summary outcomes and a secret sentinel, then stops the service and removes +the fixtures. This also runs under `just examples`. + +For manual use, provision separate CLI and HTTP fixture roots containing +`facts.json` arrays of `{ "key": "...", "value": "..." }` facts. Start the API +with `PARITY_TOKEN` supplied privately in its environment: + +```bash +python3 examples/executable-checks/app.py serve /private/http-fixture 18081 +hurl-workbench --workspace examples/executable-checks/hurl-workbench.dhall \ + test suite parity --jobs 2 --report-dir /private/new-reports \ + --variable cliFixture=/private/cli-fixture --variable apiUrl=http://127.0.0.1:18081 \ + --variable cliFixtureId=cli-scope --variable apiFixtureId=http-scope +``` + +The workbench invocation needs the same private `PARITY_TOKEN` environment source. +It refuses an existing suite report tree unless overwrite is explicit. Private +stdout/stderr live at `REPORT/SUITE/checks/parity/`; they may contain credentials +printed by a helper. Only logical status, timing, exit codes and relative paths +enter the summary. Checks-only suites are also supported. + +The [Rei consumer](rei/README.md) supplies actual application evidence beyond this +small local example. Neither check replaces package/schema/client release gates. diff --git a/examples/executable-checks/after.hurl b/examples/executable-checks/after.hurl new file mode 100644 --- /dev/null +++ b/examples/executable-checks/after.hurl @@ -0,0 +1,3 @@ +GET {{apiUrl}}/facts +Authorization: Bearer {{token}} +HTTP 200 diff --git a/examples/executable-checks/app.py b/examples/executable-checks/app.py new file mode 100644 --- /dev/null +++ b/examples/executable-checks/app.py @@ -0,0 +1,61 @@ +#!/usr/bin/env python3 +"""Disposable example application's supported CLI and HTTP facts interface.""" +import json +import os +from pathlib import Path +import sys +from http.server import BaseHTTPRequestHandler, ThreadingHTTPServer + + +def facts(root): + return json.loads((Path(root) / "facts.json").read_text()) + + +def put(root, value): + path = Path(root) / "facts.json" + path.write_text(json.dumps(value)) + path.chmod(0o600) + + +def serve(root, port): + class Handler(BaseHTTPRequestHandler): + def log_message(self, *_): + pass + + def do_GET(self): + if self.path == "/health": + self.send_response(200) + self.end_headers() + return + if self.headers.get("Authorization") != "Bearer " + os.environ["PARITY_TOKEN"]: + self.send_error(401) + return + if self.path != "/facts": + self.send_error(404) + return + data = json.dumps(facts(root)).encode() + self.send_response(200) + self.send_header("Content-Type", "application/json") + self.send_header("Content-Length", str(len(data))) + self.end_headers() + self.wfile.write(data) + + def do_POST(self): + if self.path != "/facts" or self.headers.get("Authorization") != "Bearer " + os.environ["PARITY_TOKEN"]: + self.send_error(403) + return + value = json.loads(self.rfile.read(int(self.headers["Content-Length"]))) + put(root, value) + self.send_response(204) + self.end_headers() + + ThreadingHTTPServer(("127.0.0.1", int(port)), Handler).serve_forever() + + +if __name__ == "__main__": + if sys.argv[1] == "observe": + print(json.dumps(facts(sys.argv[2]))) + elif sys.argv[1] == "serve": + serve(*sys.argv[2:4]) + else: + raise SystemExit("expected observe FIXTURE or serve FIXTURE PORT") diff --git a/examples/executable-checks/before.hurl b/examples/executable-checks/before.hurl new file mode 100644 --- /dev/null +++ b/examples/executable-checks/before.hurl @@ -0,0 +1,2 @@ +GET {{apiUrl}}/health +HTTP 200 diff --git a/examples/executable-checks/hurl-workbench.dhall b/examples/executable-checks/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/executable-checks/hurl-workbench.dhall @@ -0,0 +1,11 @@ +let S = ../../schema/package.dhall +let p = \(name : Text) -> S.Parameter::{ name = name } +let binding = \(variable : Text) -> \(parameter : Text) -> S.EnvironmentBinding::{ variable = variable, parameter = parameter } +in S.Workspace::{ schemaVersion = 1 +, parameters = [ p "cliFixture", p "apiUrl", p "cliFixtureId", p "apiFixtureId", S.Parameter::{ name = "token", kind = S.ParameterKind.Secret, environment = Some "PARITY_TOKEN" } ] +, fragments = [ S.Fragment::{ name = "before", path = "before.hurl" }, S.Fragment::{ name = "after", path = "after.hurl" }, S.Fragment::{ name = "mismatch", path = "mismatch.hurl" } ] +, workflows = [ S.Workflow::{ name = "before", fragments = [ "before" ], parameters = [ "apiUrl" ] }, S.Workflow::{ name = "after", fragments = [ "after" ], parameters = [ "apiUrl", "token" ] }, S.Workflow::{ name = "mismatch", fragments = [ "mismatch" ], parameters = [ "apiUrl", "token" ] } ] +, recipes = [ S.Recipe::{ name = "before", workflow = "before", safety = S.Safety.ReadOnly }, S.Recipe::{ name = "after", workflow = "after", safety = S.Safety.ReadOnly }, S.Recipe::{ name = "mismatch", workflow = "mismatch", safety = S.Safety.Mutating } ] +, checks = [ S.Check::{ name = "parity", command = S.CommandSpec::{ executable = "parity.py", arguments = [ "{{cliFixture}}", "{{apiUrl}}", "{{cliFixtureId}}", "{{apiFixtureId}}" ], environmentPolicy = S.EnvironmentPolicy.Clean [ "PATH" ], environment = [ binding "PARITY_TOKEN" "token" ] } } ] +, suites = [ S.Suite::{ name = "parity", runs = [ S.RunReference.Recipe "before", S.RunReference.Check "parity", S.RunReference.Recipe "after" ] }, S.Suite::{ name = "parity-mismatch", runs = [ S.RunReference.Recipe "mismatch", S.RunReference.Check "parity" ] } ] +} diff --git a/examples/executable-checks/mismatch.hurl b/examples/executable-checks/mismatch.hurl new file mode 100644 --- /dev/null +++ b/examples/executable-checks/mismatch.hurl @@ -0,0 +1,7 @@ +POST {{apiUrl}}/facts +Authorization: Bearer {{token}} +Content-Type: application/json +[ + {"key": "parity", "value": "deliberately different"} +] +HTTP 204 diff --git a/examples/executable-checks/parity.py b/examples/executable-checks/parity.py new file mode 100644 --- /dev/null +++ b/examples/executable-checks/parity.py @@ -0,0 +1,21 @@ +#!/usr/bin/env python3 +"""Application-owned comparison of independent supported CLI/HTTP observations.""" +import json +import os +from pathlib import Path +import subprocess +import sys +from urllib.request import Request, urlopen + +cli_fixture, api_url, cli_id, api_id = sys.argv[1:] +if not cli_id or not api_id or cli_id == api_id: + raise SystemExit("independent logical fixture identities are required") +assert not any(name in os.environ for name in ("REI_PG_CONNECTION_STRING", "MORI_API_URL", "PGHOST")) +cli = json.loads(subprocess.check_output([sys.executable, str(Path(__file__).with_name("app.py")), "observe", cli_fixture])) +request = Request(api_url + "/facts", headers={"Authorization": "Bearer " + os.environ["PARITY_TOKEN"]}) +with urlopen(request, timeout=5) as response: + api = json.load(response) +normalize = lambda values: sorted((item["key"], item["value"]) for item in values) +if normalize(cli) != normalize(api): + raise SystemExit("CLI/API persisted facts differ") +print("CLI/API persisted facts match") diff --git a/examples/executable-checks/rei/README.md b/examples/executable-checks/rei/README.md new file mode 100644 --- /dev/null +++ b/examples/executable-checks/rei/README.md @@ -0,0 +1,48 @@ +# Real Rei CLI/API category parity + +This consumer-specific assertion exercises the supported category CLI and paged +HTTP interfaces from `mori://shinzui/rei`, as requested by +`mori://shinzui/rei/masterplans/29-close-rei-cli-and-http-api-gaps-on-the-haskell-jitsurei-contract`. +`parity.py` compares slug, name, status, description and context, omitting generated +identities, timestamps and stream metadata. It neither reads internal tables nor +implements framework persistence. The helper belongs to this application fixture +workspace; workbench knows only its declared executable and process result. + +`scripts/check-rei-command-parity.py` is the separate caller. It starts a disposable +SCRAM-authenticated PostgreSQL cluster, uses Hinagata's supported prepare/acquire +commands to obtain two distinct clones, and starts one Rei API per clone. It +creates equivalent categories through the real CLI and HTTP POST, then invokes +`scripts/check-command-parity.sh` inside those independently provisioned scopes. +The mismatch suite creates one extra category only through the HTTP twin's API. +The named `parity` check must then fail with status 1. Two API processes stop before +either caller-owned lease is released. No production configuration or database is +used or modified. + +Discover the consumer and provider with Mori and build a matching API/CLI/schema +hook cohort in their repositories. From this repository, with absolute executable +paths in the named variables, run: + +```bash +export hinagata_postgres_datadir="$(mori path mori://shinzui/hinagata)/hinagata-postgres" +nix develop -c python3 scripts/check-rei-command-parity.py \ + --api "$REI_API_EXECUTABLE" --rei "$REI_CLI_EXECUTABLE" \ + --schema-hook "$REI_LIVE_TEST_EXECUTABLE" --hinagata "$HINAGATA_EXECUTABLE" \ + --workbench "$HURL_WORKBENCH_EXECUTABLE" --evidence-root /tmp/new-rei-parity-evidence +``` + +The evidence directory must be new. It contains private logs, binary SHA-256 +identities, match/mismatch summaries and caller release observations. Acceptance +used Rei 8.0.0.0, CLI revision +`mori://shinzui/rei/commits/8c5e11258f97b66600ce53269bd9675d9459db52`, with the +same built cohort as the existing multi-service consumer. This is no claim about +a newer consumer cohort. API tokens and database connection inputs use declared +Secret environment bindings; argv and ordinary summaries contain none of them. + +The generic driver takes `HURL_WORKBENCH_CONSUMER_WORKSPACE` and +`HURL_WORKBENCH_CONSUMER_SUITE`, plus distinct `HURL_WORKBENCH_CLI_FIXTURE_ID` / +`HURL_WORKBENCH_API_FIXTURE_ID`, `HURL_WORKBENCH_CLI_FIXTURE`, +`HURL_WORKBENCH_API_URL`, and a new `HURL_WORKBENCH_CONSUMER_EVIDENCE_ROOT`. +It runs the named matching suite with jobs=2 and the `SUITE-mismatch` suite with +jobs=1 and explicit mutation authorization. Set +`HURL_WORKBENCH_CONSUMER_MISMATCH_SUITE` to override that name. The application +owns the mismatch operation; the driver provisions or releases no fixtures. diff --git a/examples/executable-checks/rei/after.hurl b/examples/executable-checks/rei/after.hurl new file mode 100644 --- /dev/null +++ b/examples/executable-checks/rei/after.hurl @@ -0,0 +1,5 @@ +GET {{apiUrl}}/api/v2/categories?first=100&status=all +Authorization: Bearer {{token}} +HTTP 200 +[Asserts] +jsonpath "$.edges" count >= 1 diff --git a/examples/executable-checks/rei/before.hurl b/examples/executable-checks/rei/before.hurl new file mode 100644 --- /dev/null +++ b/examples/executable-checks/rei/before.hurl @@ -0,0 +1,2 @@ +GET {{apiUrl}}/health/ready +HTTP 200 diff --git a/examples/executable-checks/rei/hurl-workbench.dhall b/examples/executable-checks/rei/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/executable-checks/rei/hurl-workbench.dhall @@ -0,0 +1,11 @@ +let S = ../../../schema/package.dhall +let p = \(name : Text) -> S.Parameter::{ name = name } +let b = \(variable : Text) -> \(parameter : Text) -> S.EnvironmentBinding::{ variable = variable, parameter = parameter } +in S.Workspace::{ schemaVersion = 1 +, parameters = [ p "cliFixture", p "apiUrl", p "cliFixtureId", p "apiFixtureId", S.Parameter::{ name = "rei", environment = Some "HURL_WORKBENCH_PARITY_REI" }, S.Parameter::{ name = "token", kind = S.ParameterKind.Secret, environment = Some "PARITY_TOKEN" }, S.Parameter::{ name = "cliDatabase", kind = S.ParameterKind.Secret, environment = Some "REI_PARITY_CLI_DATABASE" } ] +, fragments = [ S.Fragment::{ name = "before", path = "before.hurl" }, S.Fragment::{ name = "after", path = "after.hurl" }, S.Fragment::{ name = "mismatch", path = "mismatch.hurl" } ] +, workflows = [ S.Workflow::{ name = "before", fragments = [ "before" ], parameters = [ "apiUrl" ] }, S.Workflow::{ name = "after", fragments = [ "after" ], parameters = [ "apiUrl", "token" ] }, S.Workflow::{ name = "mismatch", fragments = [ "mismatch" ], parameters = [ "apiUrl", "token" ] } ] +, recipes = [ S.Recipe::{ name = "before", workflow = "before", safety = S.Safety.ReadOnly }, S.Recipe::{ name = "after", workflow = "after", safety = S.Safety.ReadOnly }, S.Recipe::{ name = "mismatch", workflow = "mismatch", safety = S.Safety.Mutating } ] +, checks = [ S.Check::{ name = "parity", timeoutSeconds = Some 30, command = S.CommandSpec::{ executable = "parity.py", arguments = [ "{{cliFixture}}", "{{apiUrl}}", "{{cliFixtureId}}", "{{apiFixtureId}}" ], environmentPolicy = S.EnvironmentPolicy.Clean [ "PATH" ], environment = [ b "REI_CLI" "rei", b "PARITY_TOKEN" "token", b "CLI_DATABASE" "cliDatabase" ] } } ] +, suites = [ S.Suite::{ name = "parity", runs = [ S.RunReference.Recipe "before", S.RunReference.Check "parity", S.RunReference.Recipe "after" ] }, S.Suite::{ name = "parity-mismatch", runs = [ S.RunReference.Recipe "mismatch", S.RunReference.Check "parity" ] } ] +} diff --git a/examples/executable-checks/rei/mismatch.hurl b/examples/executable-checks/rei/mismatch.hurl new file mode 100644 --- /dev/null +++ b/examples/executable-checks/rei/mismatch.hurl @@ -0,0 +1,8 @@ +POST {{apiUrl}}/api/v2/categories +Authorization: Bearer {{token}} +Content-Type: application/json +{ + "name": "Workbench deliberate mismatch", + "description": "Present only in the independent HTTP fixture" +} +HTTP 201 diff --git a/examples/executable-checks/rei/parity.py b/examples/executable-checks/rei/parity.py new file mode 100644 --- /dev/null +++ b/examples/executable-checks/rei/parity.py @@ -0,0 +1,54 @@ +#!/usr/bin/env python3 +"""Rei-owned assertion over supported category CLI/HTTP contracts (MP29).""" +import json +import os +from pathlib import Path +import subprocess +import sys +from urllib.parse import urlencode, urlsplit +from urllib.request import Request, urlopen + +cli_root, api_url, cli_id, api_id = sys.argv[1:] +cli_root = Path(cli_root) +cli_url = (cli_root / 'endpoint').read_text().strip() +assert cli_id and api_id and cli_id != api_id, 'fixture identities must differ' +assert urlsplit(cli_url).netloc != urlsplit(api_url).netloc, 'fixture endpoints must differ' +assert not any(key in os.environ for key in ('REI_PG_CONNECTION_STRING', 'MORI_API_URL', 'PGHOST')), 'ambient settings crossed Clean boundary' +env = dict(PATH=os.environ['PATH'], HOME=str(cli_root / 'home'), + REI_CONFIG=str(cli_root / 'rei.yaml'), REI_API_URL=cli_url, + REI_API_TOKEN=os.environ['PARITY_TOKEN'], REI_PG_CONNECTION_STRING=os.environ['CLI_DATABASE'], + OTEL_SDK_DISABLED='true') +cli = subprocess.run([os.environ['REI_CLI'], 'category', 'list', '--all', '--json'], + env=env, stdin=subprocess.DEVNULL, capture_output=True, timeout=20) +assert cli.returncode == 0, 'supported category CLI failed' +cli_rows = json.loads(cli.stdout) +api_rows = [] +after = None +# Complete bounded pages; a fixture accidentally larger than this is a refusal. +for _ in range(100): + query = dict(first=100, status='all') + if after is not None: + query['after'] = after + request = Request(api_url + '/api/v2/categories?' + urlencode(query), headers={'Authorization': 'Bearer ' + os.environ['PARITY_TOKEN']}) + with urlopen(request, timeout=10) as response: + page = json.load(response) + api_rows.extend(edge['node'] for edge in page['edges']) + if not page['pageInfo']['hasNextPage']: + break + next_cursor = page['pageInfo']['endCursor'] + assert next_cursor and next_cursor != after, 'category paging did not advance' + after = next_cursor +else: + raise SystemExit('fixture exceeds bounded parity scope') + + +def normalize(rows): + # Only generated identity/time/stream metadata is omitted. Compare persisted + # domain meaning and discoverability, preserving None versus empty text. + return sorted((row['slug'], row['name'], row['status'].lower(), row.get('description'), row.get('context')) for row in rows) + + +if normalize(cli_rows) != normalize(api_rows): + raise SystemExit(f'persisted category parity differs: CLI {len(cli_rows)}, HTTP {len(api_rows)}') +assert cli_rows, 'empty fixture is not parity evidence' +print(f'persisted category parity matches: {len(cli_rows)} categories') diff --git a/examples/file-body/README.md b/examples/file-body/README.md new file mode 100644 --- /dev/null +++ b/examples/file-body/README.md @@ -0,0 +1,38 @@ +# Caller-owned request body files + +`request.hurl` reads `file,request.json;` without generating files in the workspace. +Start the repository fixture server on loopback port 18080, then run from the repository root: + +```bash +payload_root="$(mktemp -d)" +trap 'rm -rf "$payload_root"' EXIT +printf '{"message":"雪"}\r\n' > "$payload_root/request.json" +hurl-workbench --workspace examples/file-body/hurl-workbench.dhall \ + run workflow send-body --file-root "$payload_root" > "$payload_root.response" +cmp "$payload_root/request.json" "$payload_root.response" +hurl-workbench --workspace examples/file-body/hurl-workbench.dhall \ + test workflow send-body --file-root "$payload_root" +rm "$payload_root.response" +``` + +The echo endpoint returns the raw bytes, so `cmp` verifies UTF-8, CRLF, and the final newline. +`nix develop -c just examples` starts the fixture automatically and runs this comparison. + +The caller creates, keeps readable/searchable, and eventually deletes the body directory. +Keep it alive until workbench and its Hurl children exit. Workbench never creates, changes +permissions on, or removes these inputs, including after failure or interruption. Separate +invocations can use the same filename with different bytes in separate roots. + +`--file-root DIR` is relative to the invocation directory and overrides any suite setting. +For a suite alternative, run `test suite parameter --allow-mutating --variable +payloadRoot=/absolute/payload/directory`. Its `fileRootParameter = Some "payloadRoot"` +resolves a declared Plain parameter once from suite-wide CLI values, variable files, +environment, or defaults. Relative parameter values use the workspace directory. +Inspection requires no runtime value. The CLI override also works without supplying the +shadowed parameter. + +Explicit roots and response/report/curl output trees must be disjoint, including aliases. +Keep reports outside the body root. Explicitly selecting the workspace itself applies this +stronger rule; omitting the option preserves ordinary workspace-local reports. +Fragment sources still resolve inside the workspace. This option changes Hurl's body-file +base and does not confine arbitrary paths authored in Hurl. diff --git a/examples/file-body/hurl-workbench.dhall b/examples/file-body/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/file-body/hurl-workbench.dhall @@ -0,0 +1,13 @@ +let S = ../../schema/package.dhall +in S.Workspace::{ + , schemaVersion = S.schemaVersion + , parameters = [ S.Parameter::{ name = "baseUrl", defaultValue = Some "http://127.0.0.1:18080" }, S.Parameter::{ name = "payloadRoot" } ] + , fragments = [ S.Fragment::{ name = "request", path = "request.hurl" } ] + , workflows = [ S.Workflow::{ name = "send-body", fragments = [ "request" ], parameters = [ "baseUrl" ] } ] + , recipes = [ S.Recipe::{ name = "send-body", workflow = "send-body", safety = S.Safety.Mutating } ] + , matrices = [ S.Matrix::{ name = "bodies", recipe = "send-body", cases = [ S.MatrixCase::{ name = "one" }, S.MatrixCase::{ name = "two" } ] } ] + , suites = + [ S.Suite::{ name = "bodies", runs = [ S.RunReference.Recipe "send-body" ] } + , S.Suite::{ name = "parameter", fileRootParameter = Some "payloadRoot", runs = [ S.RunReference.Recipe "send-body" ] } + ] + } diff --git a/examples/file-body/request.hurl b/examples/file-body/request.hurl new file mode 100644 --- /dev/null +++ b/examples/file-body/request.hurl @@ -0,0 +1,4 @@ +POST {{baseUrl}}/mutating +Content-Type: application/json +file,request.json; +HTTP 201 diff --git a/examples/generated-parameters/README.md b/examples/generated-parameters/README.md new file mode 100644 --- /dev/null +++ b/examples/generated-parameters/README.md @@ -0,0 +1,15 @@ +# Generated parameters + +With the fixture server on port 18080, run from the repository root: + +```bash +hurl-workbench --workspace examples/generated-parameters/hurl-workbench.dhall test recipe recipient +hurl-workbench --workspace examples/generated-parameters/hurl-workbench.dhall test recipe recipient --variable recipientId=rcp_01h2xcejqtf2nbrexx3vqjhp41 +hurl-workbench --workspace examples/generated-parameters/hurl-workbench.dhall render recipe recipient --explain +``` + +The manifest shows all five generators. Each execution resolves its own values; +its two fragments share the same recipient ID. Runtime variables and variable +files override generation. Generated inputs cannot have committed defaults, +recipe bindings, or matrix bindings. Matrix `recipients` and suite `recipients` +can run with `--jobs 2` against the read-only echo endpoint. diff --git a/examples/generated-parameters/first.hurl b/examples/generated-parameters/first.hurl new file mode 100644 --- /dev/null +++ b/examples/generated-parameters/first.hurl @@ -0,0 +1,6 @@ +GET {{baseUrl}}/odata/echo?id={{recipientId}} +HTTP 200 +[Captures] +firstId: jsonpath "$.query" +[Asserts] +jsonpath "$.query" == "id={{recipientId}}" diff --git a/examples/generated-parameters/hurl-workbench.dhall b/examples/generated-parameters/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/generated-parameters/hurl-workbench.dhall @@ -0,0 +1,19 @@ +let S = ../../schema/package.dhall +let workflow = S.Workflow::{ name = "recipient", fragments = [ "first", "second" ], parameters = [ "baseUrl", "recipientId", "uuid4", "uuid7", "now", "random" ] } +let recipe = S.Recipe::{ name = "recipient", workflow = "recipient", safety = S.Safety.ReadOnly } +in S.Workspace::{ + , schemaVersion = S.schemaVersion + , parameters = + [ S.Parameter::{ name = "baseUrl", defaultValue = Some "http://127.0.0.1:18080" } + , S.Parameter::{ name = "recipientId", kind = S.ParameterKind.Generated (S.Generator.TypeId { prefix = "rcp" }) } + , S.Parameter::{ name = "uuid4", kind = S.ParameterKind.Generated S.Generator.Uuid4 } + , S.Parameter::{ name = "uuid7", kind = S.ParameterKind.Generated S.Generator.Uuid7 } + , S.Parameter::{ name = "now", kind = S.ParameterKind.Generated S.Generator.Rfc3339Now } + , S.Parameter::{ name = "random", kind = S.ParameterKind.Generated (S.Generator.RandomAlphanumeric { length = 24 }) } + ] + , fragments = [ S.Fragment::{ name = "first", path = "first.hurl" }, S.Fragment::{ name = "second", path = "second.hurl" } ] + , workflows = [ workflow ] + , recipes = [ recipe, recipe // { name = "recipient-second" } ] + , matrices = [ S.Matrix::{ name = "recipients", recipe = "recipient", cases = [ S.MatrixCase::{ name = "one" }, S.MatrixCase::{ name = "two" } ] } ] + , suites = [ S.Suite::{ name = "recipients", runs = [ S.RunReference.Recipe "recipient", S.RunReference.Recipe "recipient-second" ] } ] + } diff --git a/examples/generated-parameters/second.hurl b/examples/generated-parameters/second.hurl new file mode 100644 --- /dev/null +++ b/examples/generated-parameters/second.hurl @@ -0,0 +1,5 @@ +GET {{baseUrl}}/odata/echo?id={{recipientId}} +HTTP 200 +[Asserts] +jsonpath "$.query" == "{{firstId}}" +jsonpath "$.query" == "id={{recipientId}}" diff --git a/examples/integration-service/README.md b/examples/integration-service/README.md new file mode 100644 --- /dev/null +++ b/examples/integration-service/README.md @@ -0,0 +1,103 @@ +# Managed integration-service example + + +This workspace uses the repository fixture API to demonstrate the complete suite lifecycle. The +`default` suite contains only explicit read-only recipes, `writes` contains the opt-in mutating +recipe, and `perimeter` keeps a negative boundary check separate from ordinary functional tests. + +From the repository root: + +```bash +cabal run hurl-workbench -- \ + --workspace examples/integration-service/hurl-workbench.dhall \ + test suite default --report junit --report json --report-dir build/reports +``` + +The workbench starts the fixture server through Cabal, waits for `/health`, runs both safe recipes, +writes isolated reports plus `summary.json`, and terminates the service process group. The write +suite is refused unless authorization is explicit: + +The stderr result has this shape (durations and absolute paths vary): + +```text +PASS health +PASS read-echo +SERVICE stopped +SUMMARY .../build/reports/default/summary.json +``` + +```bash +cabal run hurl-workbench -- \ + --workspace examples/integration-service/hurl-workbench.dhall test suite writes + +cabal run hurl-workbench -- \ + --workspace examples/integration-service/hurl-workbench.dhall \ + test suite writes --allow-mutating +``` + +To use an already-running fixture server, start `hurl-workbench-fixture-server` separately and add +`--external-service`. See [the integration-testing guide](../../docs/guides/integration-testing.md) +for report layout, generated variable files, and troubleshooting. + +The `perimeter` suite is deliberately separate from normal functional checks: + +```bash +cabal run hurl-workbench -- \ + --workspace examples/integration-service/hurl-workbench.dhall \ + test suite perimeter +``` + +The `clean` suite opts into explicit environment selection. Build the workbench and fixture, +then run: + +```bash +export HURL_WORKBENCH_FIXTURE_EXECUTABLE="$(cabal list-bin hurl-workbench-fixture-server)" +export HURL_WORKBENCH_CURL_EXECUTABLE="$(command -v curl)" +PORT=1 cabal run hurl-workbench -- \ + --workspace examples/integration-service/hurl-workbench.dhall test suite clean +``` + +The service selects PORT and overrides it through the `service_port` binding; the fixture +asserts PORT is its only inherited variable. Readiness has its own empty clean policy. Neither +command implicitly receives PATH or HOME. Use absolute executable paths; select any additional +names explicitly. Missing selected names fail before service startup, even if overridden by a +binding. Other suites retain default inheritance. Child output and Hurl artifacts can still +contain data intentionally emitted by those programs. + +For a caller-owned database lease, explicitly select its PG variables and protected PGPASSFILE +when needed; keep the password file until consumer cleanup and lease release finish. + +## Independent scenarios + +Shared-state writes use `--jobs 1 --allow-mutating`; requesting more jobs is refused even +with one expanded run. The read-only default suite can use `--jobs 2`. + +`independent.dhall` declares an `IndependentState` suite with two mutating cases. A trusted +caller must provision one ready service and fixture per scenario, hold both until workbench +returns, and generate a private version-1 JSON handoff. Each assignment names `writes/first` +or `writes/second`, a distinct fixture ID, a distinct HTTP(S) endpoint origin, `baseUrl` as the +endpoint parameter, a plain `marker` binding, and a `token` secret-environment reference. +All channels are required, including empty lists when unused. See the +[integration guide](../../docs/guides/integration-testing.md#independent-scenario-handoff) for the full JSON contract. + +After provisioning and generating `scenario-inputs.json` with mode `0600` in a private directory: + +```bash +cabal run hurl-workbench -- \ + --workspace examples/integration-service/independent.dhall \ + test suite independent-writes --external-service \ + --scenario-inputs scenario-inputs.json --allow-mutating --jobs 2 \ + --report json --report-dir build/independent-reports +``` + +This fixture expects a POST/GET `/markers` service. The acceptance driver provisions two +fresh real Hinagata databases and one such service per database, then proves concurrent writes, +read isolation, refusal, fail-fast, cancellation, and caller-owned release: + +```bash +bash scripts/check-scenario-isolation.sh +``` + +Run it in a development shell with PostgreSQL tools, built workbench and Hinagata executables, +and the provider's packaged SQL resources. The [integration guide](../../docs/guides/integration-testing.md#real-provider-acceptance) +gives the complete setup. Workbench never acquires or releases the databases. diff --git a/examples/integration-service/hurl-workbench.dhall b/examples/integration-service/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/integration-service/hurl-workbench.dhall @@ -0,0 +1,117 @@ +let Schema = ../../schema/package.dhall + +in Schema.Workspace::{ + , schemaVersion = Schema.schemaVersion + , parameters = + [ Schema.Parameter::{ name = "base_url", defaultValue = Some "http://127.0.0.1:18080" } + , Schema.Parameter::{ name = "service_port", defaultValue = Some "18080" } + ] + , fragments = + [ Schema.Fragment::{ name = "health", path = "hurl/health.hurl" } + , Schema.Fragment::{ name = "read-echo", path = "hurl/read-echo.hurl" } + , Schema.Fragment::{ name = "create", path = "hurl/create.hurl" } + , Schema.Fragment::{ name = "perimeter", path = "hurl/perimeter.hurl" } + ] + , workflows = + [ Schema.Workflow::{ + , name = "health" + , fragments = [ "health" ] + , parameters = [ "base_url" ] + } + , Schema.Workflow::{ + , name = "read-echo" + , fragments = [ "read-echo" ] + , parameters = [ "base_url" ] + } + , Schema.Workflow::{ + , name = "create" + , fragments = [ "create" ] + , parameters = [ "base_url" ] + } + , Schema.Workflow::{ + , name = "perimeter" + , fragments = [ "perimeter" ] + , parameters = [ "base_url" ] + } + ] + , recipes = + [ Schema.Recipe::{ + , name = "health" + , workflow = "health" + , safety = Schema.Safety.ReadOnly + } + , Schema.Recipe::{ + , name = "read-echo" + , workflow = "read-echo" + , safety = Schema.Safety.ReadOnly + } + , Schema.Recipe::{ + , name = "create" + , workflow = "create" + , safety = Schema.Safety.Mutating + } + , Schema.Recipe::{ + , name = "perimeter" + , workflow = "perimeter" + , safety = Schema.Safety.ReadOnly + } + ] + , services = + [ Schema.Service::{ + , name = "fixture-api" + , command = Schema.CommandSpec::{ + , executable = "cabal" + , arguments = [ "--project-dir=../..", "run", "hurl-workbench-fixture-server" ] + , environment = + [ Schema.EnvironmentBinding::{ variable = "PORT", parameter = "service_port" } ] + } + , readiness = + Schema.Readiness.Http + Schema.HttpReadiness::{ url = "http://127.0.0.1:{{service_port}}/health" } + } + , Schema.Service::{ + , name = "clean-fixture-api" + , command = Schema.CommandSpec::{ + , executable = env:HURL_WORKBENCH_FIXTURE_EXECUTABLE as Text ? "hurl-workbench-fixture-server" + , arguments = [ "--assert-clean" ] + , environmentPolicy = Schema.EnvironmentPolicy.Clean [ "PORT" ] + , environment = [ Schema.EnvironmentBinding::{ variable = "PORT", parameter = "service_port" } ] + } + , readiness = Schema.Readiness.Command Schema.CommandReadiness::{ + , command = Schema.CommandSpec::{ + , executable = env:HURL_WORKBENCH_CURL_EXECUTABLE as Text ? "curl" + , arguments = [ "--fail", "--silent", "http://127.0.0.1:18080/health" ] + , environmentPolicy = Schema.EnvironmentPolicy.Clean ([] : List Text) + } + } + } + + ] + , suites = + [ Schema.Suite::{ + , name = "default" + , isolation = Schema.IsolationPolicy.SharedState + , runs = + [ Schema.RunReference.Recipe "health" + , Schema.RunReference.Recipe "read-echo" + ] + , service = Some "fixture-api" + , failFast = True + } + , Schema.Suite::{ + , name = "writes" + , isolation = Schema.IsolationPolicy.SharedState + , runs = [ Schema.RunReference.Recipe "create" ] + , service = Some "fixture-api" + , failFast = True + } + , Schema.Suite::{ + , name = "perimeter" + , runs = [ Schema.RunReference.Recipe "perimeter" ] + , service = Some "fixture-api" + , failFast = True + } + , Schema.Suite::{ name = "clean", runs = [ Schema.RunReference.Recipe "health" ], service = Some "clean-fixture-api" } + + ] + } diff --git a/examples/integration-service/hurl/create.hurl b/examples/integration-service/hurl/create.hurl new file mode 100644 --- /dev/null +++ b/examples/integration-service/hurl/create.hurl @@ -0,0 +1,9 @@ +POST {{base_url}}/mutating +Content-Type: application/json +{ + "fixture": "write" +} +HTTP 201 +[Asserts] +header "Content-Type" contains "application/octet-stream" +body contains "\"fixture\": \"write\"" diff --git a/examples/integration-service/hurl/health.hurl b/examples/integration-service/hurl/health.hurl new file mode 100644 --- /dev/null +++ b/examples/integration-service/hurl/health.hurl @@ -0,0 +1,5 @@ +GET {{base_url}}/health +HTTP 200 +[Asserts] +header "Content-Type" contains "text/plain" +body contains "ok" diff --git a/examples/integration-service/hurl/isolated-write.hurl b/examples/integration-service/hurl/isolated-write.hurl new file mode 100644 --- /dev/null +++ b/examples/integration-service/hurl/isolated-write.hurl @@ -0,0 +1,14 @@ +POST {{baseUrl}}/markers +Content-Type: application/json +X-Test-Token: {{token}} +{ + "marker": "{{marker}}" +} +HTTP 201 + +GET {{baseUrl}}/markers +HTTP 200 +[Asserts] +header "Content-Type" contains "application/json" +jsonpath "$.marker" == "{{marker}}" +jsonpath "$.count" == 1 diff --git a/examples/integration-service/hurl/perimeter.hurl b/examples/integration-service/hurl/perimeter.hurl new file mode 100644 --- /dev/null +++ b/examples/integration-service/hurl/perimeter.hurl @@ -0,0 +1,5 @@ +GET {{base_url}}/not-found +HTTP 404 +[Asserts] +header "Content-Type" contains "text/plain" +body contains "not found" diff --git a/examples/integration-service/hurl/read-echo.hurl b/examples/integration-service/hurl/read-echo.hurl new file mode 100644 --- /dev/null +++ b/examples/integration-service/hurl/read-echo.hurl @@ -0,0 +1,5 @@ +GET {{base_url}}/odata/echo?scope=default-safe +HTTP 200 +[Asserts] +header "Content-Type" contains "application/json" +jsonpath "$.query" == "scope=default-safe" diff --git a/examples/integration-service/independent.dhall b/examples/integration-service/independent.dhall new file mode 100644 --- /dev/null +++ b/examples/integration-service/independent.dhall @@ -0,0 +1,19 @@ +let S = ../../schema/package.dhall + +in S.Workspace::{ + , schemaVersion = 1 + , parameters = + [ S.Parameter::{ name = "baseUrl" } + , S.Parameter::{ name = "marker" } + , S.Parameter::{ name = "token", kind = S.ParameterKind.Secret } + ] + , fragments = [ S.Fragment::{ name = "write", path = "hurl/isolated-write.hurl" } ] + , workflows = + [ S.Workflow::{ name = "write", fragments = [ "write" ], parameters = [ "baseUrl", "marker", "token" ] } ] + , recipes = + [ S.Recipe::{ name = "write", workflow = "write", safety = S.Safety.Mutating } ] + , matrices = + [ S.Matrix::{ name = "writes", recipe = "write", cases = [ S.MatrixCase::{ name = "first" }, S.MatrixCase::{ name = "second" } ] } ] + , suites = + [ S.Suite::{ name = "independent-writes", runs = [ S.RunReference.Matrix "writes" ], isolation = S.IsolationPolicy.IndependentState } ] + } diff --git a/examples/multi-service/README.md b/examples/multi-service/README.md new file mode 100644 --- /dev/null +++ b/examples/multi-service/README.md @@ -0,0 +1,52 @@ +# Ordered services and worker restart + +Run `nix develop -c just examples` from the repository root. The multi-service +check uses the built fixture executable, private temporary state, and three +available loopback ports. It starts a stub, API, and projection worker, waiting +for each readiness check before starting the next service. + +The `command-read` suite runs at jobs=1 with `--allow-mutating`. It submits exactly +one POST, polls GET until the worker has made that command visible, restarts the +worker, then observes the second worker generation through GET. The POST has no +retry option. The separate `read-barriers` suite uses pre-existing accepted state +and jobs=2; its two read-only batches are separated by the restart barrier. +Parallel mutation is refused even with mutation permission. + +`launch.py` passes suite-level environment bindings to the fixture executable; +it also implements setup/teardown markers. Teardown checks every recorded PID is +gone. The caller owns temporary state. Workbench owns child process groups and +stops services in reverse acquisition order before teardown. A restarted service +gets the latest acquisition position. Commands and readiness use explicit Clean +environments. The summary contains logical names, statuses, durations and relative +artifact references; phase stdout/stderr remain sensitive, owner-only files. + +These roles prove orchestration without a database. They do not prove actual +application projection behavior or lease release. The lease provider is +`mori://shinzui/hinagata`; the production consumer requirement is +`mori://shinzui/rei/masterplans/29-close-rei-cli-and-http-api-gaps-on-the-haskell-jitsurei-contract`. +Rei exposes `rei worker query-projections` for its production Note/assignment/ +definition owners, alongside the production `rei-api` executable. Its live-test +executable has `--hinagata-schema` and `--hinagata-verify` hooks for isolated +baselines. The optional [production Rei consumer](rei/README.md) and its separate caller harness provide real application/lease acceptance. + +The opt-in `scripts/check-multi-service-lease.sh` runs **inside an already active +caller lease**. Supply absolute `HURL_WORKBENCH_CONSUMER_WORKSPACE`, the +`HURL_WORKBENCH_CONSUMER_SUITE` name, built `HURL_WORKBENCH_EXECUTABLE`, and a new +absolute `HURL_WORKBENCH_CONSUMER_EVIDENCE_ROOT`. An optional +`HURL_WORKBENCH_CONSUMER_VARIABLES_FILE` carries ordinary runtime bindings; secret +bindings use declared environment channels. The driver never acquires or releases +a database. + +The consumer manifest must consume `HURL_WORKBENCH_CONSUMER_VARIANT` (`success`, +`readiness-failure`, `unexpected-exit`, `cancellation`) and the private +`HURL_WORKBENCH_CONSUMER_EVIDENCE_DIR`. Each variant writes `pids.json` as an array +of all owned leader/descendant PIDs and appends complete JSON lines to +`events.jsonl`. Success records one `{"event":"mutation"}`, one or more +`{"event":"observation","owner":"LOGICAL-PRODUCTION-OWNER"}`, and a successful +worker restart in the workbench summary. Cancellation records +`{"event":"cancel-ready"}` only while execution is active. Teardown's last event +is `{"event":"consumers-stopped"}` after confirming the real API/stub/owner have +stopped. The driver rejects jobs=2 mutation before setup, checks every PID and preserves private reports. The caller +then releases its lease and records provider evidence proving release followed +consumer shutdown. Use fresh isolated fixtures for each retry; teardown must +handle partially completed setup. diff --git a/examples/multi-service/hurl-workbench.dhall b/examples/multi-service/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/multi-service/hurl-workbench.dhall @@ -0,0 +1,26 @@ +let S = ../../schema/package.dhall +let parameter = \(name : Text) -> \(environment : Text) -> S.Parameter::{ name = name, environment = Some environment } +let binding = \(variable : Text) -> \(parameter : Text) -> S.EnvironmentBinding::{ variable = variable, parameter = parameter } +let command = \(role : Text) -> \(port : Text) -> S.CommandSpec::{ + executable = "/usr/bin/env" + , arguments = [ "python3", "launch.py", role ] + , workingDirectory = None Text + , environmentPolicy = S.EnvironmentPolicy.Clean [ "PATH" ] + , environment = [ binding "FIXTURE_EXECUTABLE" "fixtureExecutable", binding "STATE_DIR" "stateDir", binding "ROLE_PORT" port ] + } +let service = \(role : Text) -> \(port : Text) -> \(url : Text) -> S.Service::{ + name = role + , command = command role port + , readiness = S.Readiness.Http S.HttpReadiness::{ url = url, intervalMilliseconds = 10, timeoutSeconds = 5 } + , shutdownTimeoutSeconds = 2 + } +let recipe = \(name : Text) -> \(workflow : Text) -> S.Recipe::{ name = name, workflow = workflow, safety = S.Safety.ReadOnly } +in S.Workspace::{ + schemaVersion = S.schemaVersion + , parameters = [ parameter "fixtureExecutable" "HURL_WORKBENCH_FIXTURE_EXECUTABLE", parameter "stateDir" "HURL_WORKBENCH_STATE_DIR", parameter "apiPort" "HURL_WORKBENCH_API_PORT", parameter "stubPort" "HURL_WORKBENCH_STUB_PORT", parameter "workerPort" "HURL_WORKBENCH_WORKER_PORT" ] + , fragments = [ S.Fragment::{ name = "command", path = "hurl/command.hurl" }, S.Fragment::{ name = "before", path = "hurl/before.hurl" }, S.Fragment::{ name = "after", path = "hurl/after.hurl" } ] + , workflows = [ S.Workflow::{ name = "command", fragments = [ "command" ], parameters = [ "apiPort" ] }, S.Workflow::{ name = "before", fragments = [ "before" ], parameters = [ "apiPort" ] }, S.Workflow::{ name = "after", fragments = [ "after" ], parameters = [ "apiPort" ] } ] + , recipes = [ S.Recipe::{ name = "submit", workflow = "command", safety = S.Safety.Mutating }, recipe "before" "before", recipe "after" "after", recipe "read1" "before", recipe "read2" "before", recipe "read3" "after", recipe "read4" "after" ] + , services = [ service "stub" "stubPort" "http://127.0.0.1:{{stubPort}}/health", service "api" "apiPort" "http://127.0.0.1:{{apiPort}}/health", service "worker" "workerPort" "http://127.0.0.1:{{workerPort}}/health" ] + , suites = [ S.Suite::{ name = "command-read", services = [ "stub", "api", "worker" ], setup = [ command "setup" "apiPort" ], teardown = [ command "teardown" "apiPort" ], runs = [ S.RunReference.Recipe "submit", S.RunReference.Recipe "before", S.RunReference.Service (S.ServiceStep.Restart "worker"), S.RunReference.Recipe "after" ] }, S.Suite::{ name = "read-barriers", services = [ "stub", "api", "worker" ], setup = [ command "setup" "apiPort" ], teardown = [ command "teardown" "apiPort" ], runs = [ S.RunReference.Recipe "read1", S.RunReference.Recipe "read2", S.RunReference.Service (S.ServiceStep.Restart "worker"), S.RunReference.Recipe "read3", S.RunReference.Recipe "read4" ] } ] + } diff --git a/examples/multi-service/hurl/after.hurl b/examples/multi-service/hurl/after.hurl new file mode 100644 --- /dev/null +++ b/examples/multi-service/hurl/after.hurl @@ -0,0 +1,7 @@ +GET http://127.0.0.1:{{apiPort}}/read +[Options] +retry: 100 +retry-interval: 10ms +HTTP 200 +[Asserts] +body == "visible:2" diff --git a/examples/multi-service/hurl/before.hurl b/examples/multi-service/hurl/before.hurl new file mode 100644 --- /dev/null +++ b/examples/multi-service/hurl/before.hurl @@ -0,0 +1,7 @@ +GET http://127.0.0.1:{{apiPort}}/read +[Options] +retry: 100 +retry-interval: 10ms +HTTP 200 +[Asserts] +body == "visible:1" diff --git a/examples/multi-service/hurl/command.hurl b/examples/multi-service/hurl/command.hurl new file mode 100644 --- /dev/null +++ b/examples/multi-service/hurl/command.hurl @@ -0,0 +1,4 @@ +POST http://127.0.0.1:{{apiPort}}/command +HTTP 201 +[Asserts] +body == "accepted" diff --git a/examples/multi-service/launch.py b/examples/multi-service/launch.py new file mode 100644 --- /dev/null +++ b/examples/multi-service/launch.py @@ -0,0 +1,21 @@ +#!/usr/bin/env python3 +"""Pass resolved environment values to the test fixture executable.""" +import os +import sys + +role = sys.argv[1] +if role in ("setup", "teardown"): + from pathlib import Path + root = Path(os.environ["STATE_DIR"]) + if role == "teardown" and (root / "pids").exists(): + for pid in map(int, (root / "pids").read_text().splitlines()): + try: + os.kill(pid, 0) + except ProcessLookupError: + continue + raise RuntimeError("owned consumer survived before teardown") + with (root / "events").open("a") as events: + events.write(role + "\n") + raise SystemExit(0) + +os.execv(os.environ["FIXTURE_EXECUTABLE"], [os.environ["FIXTURE_EXECUTABLE"], "--role", sys.argv[1], "--port", os.environ["ROLE_PORT"], "--state-dir", os.environ["STATE_DIR"]]) diff --git a/examples/multi-service/rei/README.md b/examples/multi-service/rei/README.md new file mode 100644 --- /dev/null +++ b/examples/multi-service/rei/README.md @@ -0,0 +1,47 @@ +# Production Rei consumer inside a Hinagata lease + +This opt-in fixture uses the actual `rei-api` application and +`rei worker query-projections` Note owner from `mori://shinzui/rei`, with a local +HTTP stub/proxy for deterministic request recording. It implements the contract of +`scripts/check-multi-service-lease.sh`. The generic driver accepts an already +leased fixture and never allocates or releases a database. + +The separate caller `scripts/check-rei-multi-service.py` starts its own disposable +SCRAM-authenticated PostgreSQL cluster, asks `mori://shinzui/hinagata` to prepare a +baseline using Rei's existing `rei-api-live-test --hinagata-schema` and +`--hinagata-verify` hooks, then acquires one clone. A static Topic read row is an +independent anchor fixture. The Note under observation is created only by one +production POST and appears only through the production asynchronous query owner; +no Note projection rows or runtime tables are seeded by this harness. + +Success polls GET on the Note tag, restarts the production worker and observes it +again. Other variants fail worker readiness, terminate the worker during active +HTTP work, and interrupt a held request. Every adapter and child PID is recorded, +reverse cleanup precedes teardown, and the caller verifies Hinagata reports +`Released` only after all four consumer scopes have stopped. Private timestamps +corroborate that order. Parallel mutation is refused before setup, and every +adapter asserts Clean policy excluded ambient database/service configuration. + +Build matching API, CLI and schema-hook executables from the same Rei cohort. +Discover repositories with Mori; do not point these hooks at a developer database. +From the workbench repository, after building the workbench and provider, run: + +```bash +export hinagata_postgres_datadir="$(mori path mori://shinzui/hinagata)/hinagata-postgres" +nix develop -c python3 scripts/check-rei-multi-service.py \ + --api "$REI_API_EXECUTABLE" --rei "$REI_CLI_EXECUTABLE" \ + --schema-hook "$REI_LIVE_TEST_EXECUTABLE" --hinagata "$HINAGATA_EXECUTABLE" \ + --workbench "$HURL_WORKBENCH_EXECUTABLE" --evidence-root /tmp/new-rei-lifecycle-evidence +``` + +Each option is an absolute built executable path. `cabal list-bin` in the owning +repository's development shell supplies those paths (`rei-api:exe:rei-api`, +`rei-cli:exe:rei`, `rei-api:test:rei-api-live-test`, and `hinagata`). The evidence root +must be new. Reports, capture files and caller diagnostics are private; retain +only sanitized aggregate evidence in durable documents. + +Acceptance was exercised with the Rei 8.0.0.0 binary cohort (CLI build revision +`8c5e112`), discovered under `mori://shinzui/rei`. The current 9.0.0.0 checkout's live +schema hook has a generated Note-symbol linker failure (FRIC-7 in the workbench +friction log); this fixture makes no Rei 9 acceptance claim. No consumer source, +production database or lease configuration is modified. diff --git a/examples/multi-service/rei/after.hurl b/examples/multi-service/rei/after.hurl new file mode 100644 --- /dev/null +++ b/examples/multi-service/rei/after.hurl @@ -0,0 +1,7 @@ +GET http://127.0.0.1:{{stubPort}}/after +[Options] +retry: 100 +retry-interval: 50ms +HTTP 200 +[Asserts] +jsonpath "$.edges" count == 1 diff --git a/examples/multi-service/rei/hurl-workbench.dhall b/examples/multi-service/rei/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/multi-service/rei/hurl-workbench.dhall @@ -0,0 +1,12 @@ +let S = ../../../schema/package.dhall +let p = \(name : Text) -> \(env : Text) -> S.Parameter::{ name = name, environment = Some env } +let b = \(variable : Text) -> \(parameter : Text) -> S.EnvironmentBinding::{ variable = variable, parameter = parameter } +let command = \(role : Text) -> S.CommandSpec::{ executable = "/usr/bin/env", arguments = [ "python3", "launch.py", role ], environmentPolicy = S.EnvironmentPolicy.Clean [ "PATH" ], environment = [ b "EVIDENCE" "evidence", b "VARIANT" "variant", b "DB" "database", b "TOKEN" "token", b "API" "api", b "REI" "rei", b "API_PORT" "apiPort", b "STUB_PORT" "stubPort" ] } +let http = \(url : Text) -> S.Readiness.Http S.HttpReadiness::{ url = url, intervalMilliseconds = 20, timeoutSeconds = 20 } +in S.Workspace::{ schemaVersion = 1 +, parameters = [ p "evidence" "HURL_WORKBENCH_CONSUMER_EVIDENCE_DIR", p "variant" "HURL_WORKBENCH_CONSUMER_VARIANT", p "api" "REI_LIFECYCLE_API", p "rei" "REI_LIFECYCLE_CLI", p "apiPort" "REI_LIFECYCLE_API_PORT", p "stubPort" "REI_LIFECYCLE_STUB_PORT", p "topic" "REI_LIFECYCLE_TOPIC", S.Parameter::{ name = "database", kind = S.ParameterKind.Secret, environment = Some "REI_LIFECYCLE_DB" }, S.Parameter::{ name = "token", kind = S.ParameterKind.Secret, environment = Some "REI_LIFECYCLE_TOKEN" } ] +, fragments = [ S.Fragment::{ name = "submit", path = "submit.hurl" }, S.Fragment::{ name = "after", path = "after.hurl" } ] +, workflows = [ S.Workflow::{ name = "submit", fragments = [ "submit" ], parameters = [ "stubPort", "topic", "variant", "token" ] }, S.Workflow::{ name = "after", fragments = [ "after" ], parameters = [ "stubPort" ] } ] +, recipes = [ S.Recipe::{ name = "submit", workflow = "submit", safety = S.Safety.Mutating }, S.Recipe::{ name = "after", workflow = "after", safety = S.Safety.ReadOnly } ] +, services = [ S.Service::{ name = "stub", command = command "stub", readiness = http "http://127.0.0.1:{{stubPort}}/health", shutdownTimeoutSeconds = 8 }, S.Service::{ name = "api", command = command "api", readiness = http "http://127.0.0.1:{{apiPort}}/health/ready", shutdownTimeoutSeconds = 8 }, S.Service::{ name = "worker", command = command "worker", readiness = S.Readiness.Command S.CommandReadiness::{ command = command "probe-worker", intervalMilliseconds = 20, timeoutSeconds = 3 }, shutdownTimeoutSeconds = 8 } ] +, suites = [ S.Suite::{ name = "production", services = [ "stub", "api", "worker" ], setup = [ command "setup" ], teardown = [ command "teardown" ], runs = [ S.RunReference.Recipe "submit", S.RunReference.Service (S.ServiceStep.Restart "worker"), S.RunReference.Recipe "after" ] } ] } diff --git a/examples/multi-service/rei/launch.py b/examples/multi-service/rei/launch.py new file mode 100644 --- /dev/null +++ b/examples/multi-service/rei/launch.py @@ -0,0 +1,169 @@ +#!/usr/bin/env python3 +"""Adapters for real Rei executables; database allocation belongs to the caller.""" +import http.client +from http.server import BaseHTTPRequestHandler, ThreadingHTTPServer +import json +import os +from pathlib import Path +import pty +import select +import signal +import subprocess +import sys +import time + +assert not any(name in os.environ for name in ["REI_PG_CONNECTION_STRING", "MORI_API_URL", "PGHOST", "PGDATABASE", "PGPASSFILE"]), "managed command inherited ambient database configuration" +root = Path(os.environ["EVIDENCE"]) +variant = os.environ["VARIANT"] +role = sys.argv[1] + + +def event(name, **fields): + data = (json.dumps(dict(event=name, at=time.time_ns(), **fields)) + "\n").encode() + fd = os.open(root / "events.jsonl", os.O_WRONLY | os.O_CREAT | os.O_APPEND, 0o600) + try: + os.write(fd, data) + finally: + os.close(fd) + + +def pid(value): + path = root / "pids.json" + values = json.loads(path.read_text()) if path.exists() else [] + path.write_text(json.dumps(values + [value])) + path.chmod(0o600) + + +def environment(): + return {"PATH": os.environ["PATH"], "HOME": str(root / "home"), + "REI_CONFIG": str(root / "rei.yaml"), "REI_PG_CONNECTION_STRING": os.environ["DB"], + "REI_API_PORT": os.environ["API_PORT"], "REI_API_TOKENS": os.environ["TOKEN"] + "=human", + "MORI_API_URL": "http://127.0.0.1:" + os.environ["STUB_PORT"], "OTEL_SDK_DISABLED": "true"} + + +if role == "setup": + (root / "home").mkdir(mode=0o700) + (root / "workspace").mkdir(mode=0o700) + (root / "rei.yaml").write_text("workspace:\n path: " + str(root / "workspace") + "\n") + (root / "rei.yaml").chmod(0o600) + event("setup") + raise SystemExit(0) +if role == "teardown": + for value in json.loads((root / "pids.json").read_text()) if (root / "pids.json").exists() else []: + try: + os.kill(value, 0) + except ProcessLookupError: + continue + raise RuntimeError("owned process survived cleanup") + event("consumers-stopped") + raise SystemExit(0) +if role == "probe-worker": + raise SystemExit(0 if variant != "readiness-failure" and (root / "worker-ready").exists() else 1) + +pid(os.getpid()) +event("start", service=role) +if role == "stub": + class Proxy(BaseHTTPRequestHandler): + def log_message(self, *_): + pass + + def request(self): + if self.path == "/health": + self.send_response(200) + self.end_headers() + self.wfile.write(b"ok") + return + if self.path == "/after" and variant == "unexpected-exit": + time.sleep(2) + if self.path == "/after" and variant == "cancellation": + event("cancel-ready") + time.sleep(60) + return + if self.path == "/after": + self.path = "/api/v2/notes?tag=workbench-" + variant + "&first=10" + body = self.rfile.read(int(self.headers.get("Content-Length", "0"))) + connection = http.client.HTTPConnection("127.0.0.1", int(os.environ["API_PORT"]), timeout=15) + headers = {key: value for key, value in self.headers.items() if key.lower() not in ("host", "content-length")} + connection.request(self.command, self.path, body=body, headers=headers) + response = connection.getresponse() + data = response.read() + if self.command == "POST" and response.status == 201: + event("mutation") + if self.command == "GET" and response.status == 200: + parsed = json.loads(data) + if parsed.get("edges"): + event("observation", owner="rei-note-query-projection") + if variant == "unexpected-exit": + (root / "worker-exit").touch() + self.send_response(response.status) + self.send_header("Content-Type", "application/json") + self.send_header("Content-Length", str(len(data))) + self.end_headers() + self.wfile.write(data) + connection.close() + + do_GET = request + do_POST = request + + server = ThreadingHTTPServer(("127.0.0.1", int(os.environ["STUB_PORT"])), Proxy) + server.daemon_threads = True + signal.signal(signal.SIGTERM, lambda *_: sys.exit(0)) + try: + server.serve_forever(poll_interval=0.02) + finally: + server.server_close() + event("stop", service=role) + raise SystemExit(0) + +argv = [os.environ["API"]] if role == "api" else [os.environ["REI"], "worker", "query-projections"] +master = slave = None +with (root / (role + ".log")).open("wb") as output: + (root / (role + ".log")).chmod(0o600) + if role == "worker": + master, slave = pty.openpty() + child = subprocess.Popen(argv, env=environment(), stdin=subprocess.DEVNULL, + stdout=slave if slave is not None else output, stderr=subprocess.STDOUT) + pid(child.pid) + if slave is not None: + os.close(slave) + stopping = False + + def stop(*_): + global stopping + stopping = True + if child.poll() is None: + child.terminate() + + signal.signal(signal.SIGTERM, stop) + try: + buffer = b"" + death_at = None + while child.poll() is None: + if master is not None and select.select([master], [], [], 0.02)[0]: + try: + data = os.read(master, 65536) + except OSError: + data = b"" + output.write(data) + output.flush() + buffer = (buffer + data)[-65536:] + if b"Starting Note, assignment and definition query projection workers." in buffer: + (root / "worker-ready").touch() + else: + time.sleep(0.02) + if role == "worker" and (root / "worker-exit").exists(): + death_at = death_at or time.monotonic() + 0.15 + if time.monotonic() >= death_at: + child.terminate() + child.wait(timeout=4) + raise SystemExit(9) + raise SystemExit(0 if stopping else child.returncode) + finally: + if child.poll() is None: + child.terminate() + child.wait(timeout=4) + if master is not None: + os.close(master) + if role == "worker": + (root / "worker-ready").unlink(missing_ok=True) + event("stop", service=role) diff --git a/examples/multi-service/rei/submit.hurl b/examples/multi-service/rei/submit.hurl new file mode 100644 --- /dev/null +++ b/examples/multi-service/rei/submit.hurl @@ -0,0 +1,12 @@ +POST http://127.0.0.1:{{stubPort}}/api/v2/notes +Authorization: Bearer {{token}} +{"anchor":{"target":{"type":"topic","id":"{{topic}}"},"parent":null},"format":"markdown","content":"# Workbench lifecycle\n","tags":["workbench-{{variant}}"]} +HTTP 201 + +GET http://127.0.0.1:{{stubPort}}/api/v2/notes?tag=workbench-{{variant}}&first=10 +[Options] +retry: 100 +retry-interval: 50ms +HTTP 200 +[Asserts] +jsonpath "$.edges" count == 1 diff --git a/examples/quick-start/health.hurl b/examples/quick-start/health.hurl new file mode 100644 --- /dev/null +++ b/examples/quick-start/health.hurl @@ -0,0 +1,6 @@ +GET {{base_url}}/health +Authorization: Bearer {{token}} +HTTP 200 +[Asserts] +header "Content-Type" contains "text/plain" +body contains "ok" diff --git a/examples/quick-start/hurl-workbench.dhall b/examples/quick-start/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/quick-start/hurl-workbench.dhall @@ -0,0 +1,21 @@ +let Schema = ../../schema/package.dhall + +in Schema.Workspace::{ + , schemaVersion = Schema.schemaVersion + , parameters = + [ Schema.Parameter::{ name = "base_url", defaultValue = Some "http://127.0.0.1:18080" } + , Schema.Parameter::{ + , name = "token" + , kind = Schema.ParameterKind.Secret + , environment = Some "QUICKSTART_TOKEN" + } + ] + , fragments = [ Schema.Fragment::{ name = "health", path = "health.hurl" } ] + , workflows = + [ Schema.Workflow::{ + , name = "health" + , fragments = [ "health" ] + , parameters = [ "base_url", "token" ] + } + ] + } diff --git a/examples/vendor-odata/README.md b/examples/vendor-odata/README.md new file mode 100644 --- /dev/null +++ b/examples/vendor-odata/README.md @@ -0,0 +1,53 @@ +# Vendor OData exploration example + +This workspace mirrors a common third-party API investigation without containing vendor +credentials, hostnames, schemas, or response data. One OAuth client-credentials fragment feeds one +reusable OData-shaped query workflow. Recipes hold resource-family defaults, and the +`property-by-mls` matrix changes only market-specific data. The MLSPIN case intentionally uses a +sold-status filter instead of the generic closed-status filter. + +The example targets the repository's local fixture server. From the repository root, start it: + +```bash +cabal run hurl-workbench-fixture-server -- --port 18080 +``` + +In another shell, inspect and execute the workspace: + +```bash +cabal run hurl-workbench -- --workspace examples/vendor-odata/hurl-workbench.dhall validate +cabal run hurl-workbench -- --workspace examples/vendor-odata/hurl-workbench.dhall render recipe properties --explain +VENDOR_ODATA_CLIENT_SECRET=fixture-secret cabal run hurl-workbench -- \ + --workspace examples/vendor-odata/hurl-workbench.dhall \ + matrix property-by-mls --mode run --jobs 2 --output-dir build/vendor-odata \ + --variable baseUrl=http://127.0.0.1:18080 +``` + +Responses are written beneath `build/vendor-odata/property-by-mls/` with owner-only permissions. +They are not guaranteed to be redacted; a remote service can echo secrets in a response body. +The matrix prints ordered summaries like: + +```text +PASS property-by-mls/northwest -> .../property-by-mls/northwest.response +PASS property-by-mls/metro -> .../property-by-mls/metro.response +PASS property-by-mls/mlspin-sold -> .../property-by-mls/mlspin-sold.response +``` + +`co-buyer-investigation` retains a custom capture/assertion chain, while +`raw-decoding-investigation` preserves an opaque response used to diagnose below a typed client. +They remain ordinary native Hurl workflows because turning one-off diagnostic semantics into schema +would make both the workbench and the investigation harder to review. + +Run those special workflows directly against the same fixture service: + +```bash +VENDOR_ODATA_CLIENT_SECRET=fixture-secret cabal run hurl-workbench -- \ + --workspace examples/vendor-odata/hurl-workbench.dhall \ + test workflow co-buyer-investigation \ + --variable baseUrl=http://127.0.0.1:18080 --variable clientId=fixture-client + +cabal run hurl-workbench -- \ + --workspace examples/vendor-odata/hurl-workbench.dhall \ + test workflow raw-decoding-investigation \ + --variable baseUrl=http://127.0.0.1:18080 +``` diff --git a/examples/vendor-odata/fragments/co-buyer-capture.hurl b/examples/vendor-odata/fragments/co-buyer-capture.hurl new file mode 100644 --- /dev/null +++ b/examples/vendor-odata/fragments/co-buyer-capture.hurl @@ -0,0 +1,14 @@ +# A bespoke two-entry investigation is clearer as native Hurl than as matrix data. +GET {{baseUrl}}/capture +Authorization: Bearer {{accessToken}} +HTTP 200 +[Captures] +captureMarker: header "X-Fixture-Capture" +[Asserts] +body contains "capture-body" + +GET {{baseUrl}}/odata/echo?scenario=co-buyer&marker={{captureMarker}} +Authorization: Bearer {{accessToken}} +HTTP 200 +[Asserts] +jsonpath "$.query" contains "marker=captured-value" diff --git a/examples/vendor-odata/fragments/oauth-client-credentials.hurl b/examples/vendor-odata/fragments/oauth-client-credentials.hurl new file mode 100644 --- /dev/null +++ b/examples/vendor-odata/fragments/oauth-client-credentials.hurl @@ -0,0 +1,12 @@ +# Shared authentication entry. The captured token remains in this Hurl session. +POST {{baseUrl}}/oauth/token +[FormParams] +grant_type: client_credentials +client_id: {{clientId}} +client_secret: {{clientSecret}} +HTTP 200 +[Captures] +accessToken: jsonpath "$.access_token" +[Asserts] +header "Content-Type" contains "application/json" +jsonpath "$.token_type" == "Bearer" diff --git a/examples/vendor-odata/fragments/odata-query.hurl b/examples/vendor-odata/fragments/odata-query.hurl new file mode 100644 --- /dev/null +++ b/examples/vendor-odata/fragments/odata-query.hurl @@ -0,0 +1,8 @@ +# One reusable OData-shaped query entry. Query values come from recipes and cases. +GET {{baseUrl}}/odata/echo?mls={{mls}}&resource={{resource}}&filter={{filter}}&select={{select}}&orderby={{orderby}}&top={{top}} +Authorization: Bearer {{accessToken}} +HTTP 200 +[Asserts] +header "Content-Type" contains "application/json" +jsonpath "$.query" contains "mls=" +jsonpath "$.query" contains "resource=" diff --git a/examples/vendor-odata/fragments/raw-decoding-response.hurl b/examples/vendor-odata/fragments/raw-decoding-response.hurl new file mode 100644 --- /dev/null +++ b/examples/vendor-odata/fragments/raw-decoding-response.hurl @@ -0,0 +1,6 @@ +# Preserve a response whose bytes deliberately do not fit a typed JSON model. +GET {{baseUrl}}/raw-response +HTTP 200 +[Asserts] +header "Content-Type" contains "application/octet-stream" +header "X-Raw" == "yes" diff --git a/examples/vendor-odata/hurl-workbench.dhall b/examples/vendor-odata/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/examples/vendor-odata/hurl-workbench.dhall @@ -0,0 +1,111 @@ +let Schema = ../../schema/package.dhall + +let authParameters = [ "baseUrl", "clientId", "clientSecret" ] + +let queryParameters = [ "mls", "resource", "filter", "select", "orderby", "top" ] + +in Schema.Workspace::{ + , schemaVersion = Schema.schemaVersion + , parameters = + [ Schema.Parameter::{ name = "baseUrl" } + , Schema.Parameter::{ name = "clientId", defaultValue = Some "fixture-client" } + , Schema.Parameter::{ + , name = "clientSecret" + , kind = Schema.ParameterKind.Secret + , environment = Some "VENDOR_ODATA_CLIENT_SECRET" + } + , Schema.Parameter::{ name = "mls" } + , Schema.Parameter::{ name = "resource" } + , Schema.Parameter::{ name = "filter" } + , Schema.Parameter::{ name = "select" } + , Schema.Parameter::{ name = "orderby" } + , Schema.Parameter::{ name = "top", defaultValue = Some "10" } + ] + , fragments = + [ Schema.Fragment::{ + , name = "oauth-client-credentials" + , path = "fragments/oauth-client-credentials.hurl" + } + , Schema.Fragment::{ name = "odata-query", path = "fragments/odata-query.hurl" } + , Schema.Fragment::{ name = "co-buyer-capture", path = "fragments/co-buyer-capture.hurl" } + , Schema.Fragment::{ name = "raw-decoding-response", path = "fragments/raw-decoding-response.hurl" } + ] + , workflows = + [ Schema.Workflow::{ + , name = "odata-query" + , fragments = [ "oauth-client-credentials", "odata-query" ] + , parameters = authParameters # queryParameters + } + , Schema.Workflow::{ + , name = "co-buyer-investigation" + , fragments = [ "oauth-client-credentials", "co-buyer-capture" ] + , parameters = authParameters + } + , Schema.Workflow::{ + , name = "raw-decoding-investigation" + , fragments = [ "raw-decoding-response" ] + , parameters = [ "baseUrl" ] + } + ] + , recipes = + [ Schema.Recipe::{ + , name = "properties" + , workflow = "odata-query" + , bindings = + [ Schema.Binding::{ parameter = "mls", value = "NORTHWEST" } + , Schema.Binding::{ parameter = "resource", value = "Property" } + , Schema.Binding::{ parameter = "filter", value = "Status%20eq%20Closed" } + , Schema.Binding::{ parameter = "select", value = "ListingKey,ListPrice,Status" } + , Schema.Binding::{ parameter = "orderby", value = "ModificationTimestamp%20desc" } + ] + , safety = Schema.Safety.ReadOnly + } + , Schema.Recipe::{ + , name = "members" + , workflow = "odata-query" + , bindings = + [ Schema.Binding::{ parameter = "mls", value = "NORTHWEST" } + , Schema.Binding::{ parameter = "resource", value = "Member" } + , Schema.Binding::{ parameter = "filter", value = "MemberStatus%20eq%20Active" } + , Schema.Binding::{ parameter = "select", value = "MemberKey,MemberFullName" } + , Schema.Binding::{ parameter = "orderby", value = "MemberFullName" } + ] + , safety = Schema.Safety.ReadOnly + } + , Schema.Recipe::{ + , name = "offices" + , workflow = "odata-query" + , bindings = + [ Schema.Binding::{ parameter = "mls", value = "NORTHWEST" } + , Schema.Binding::{ parameter = "resource", value = "Office" } + , Schema.Binding::{ parameter = "filter", value = "OfficeStatus%20eq%20Active" } + , Schema.Binding::{ parameter = "select", value = "OfficeKey,OfficeName" } + , Schema.Binding::{ parameter = "orderby", value = "OfficeName" } + ] + , safety = Schema.Safety.ReadOnly + } + ] + , matrices = + [ Schema.Matrix::{ + , name = "property-by-mls" + , recipe = "properties" + , cases = + [ Schema.MatrixCase::{ + , name = "northwest" + , bindings = [ Schema.Binding::{ parameter = "mls", value = "NORTHWEST" } ] + } + , Schema.MatrixCase::{ + , name = "metro" + , bindings = [ Schema.Binding::{ parameter = "mls", value = "METRO" } ] + } + , Schema.MatrixCase::{ + , name = "mlspin-sold" + , bindings = + [ Schema.Binding::{ parameter = "mls", value = "MLSPIN" } + , Schema.Binding::{ parameter = "filter", value = "Status%20eq%20Sold" } + ] + } + ] + } + ] + } diff --git a/hurl-workbench-cli.cabal b/hurl-workbench-cli.cabal new file mode 100644 --- /dev/null +++ b/hurl-workbench-cli.cabal @@ -0,0 +1,163 @@ +cabal-version: 3.4 +name: hurl-workbench-cli +version: 0.1.0.0 +synopsis: Command-line interface for hurl-workbench +description: + A Haskell-powered Hurl workbench for composing, exploring, executing, and + testing reusable API workflows without duplicating request templates. + . + This package provides the @hurl-workbench@ executable (validate, list, + render, run, test, matrix, doctor, and shell completions) for recipes, + matrices, and integration suites, built on @hurl-workbench-core@, together + with runnable example workspaces. + +category: Web, Testing +license: BSD-3-Clause +license-file: LICENSE +author: Nadeem Bitar +maintainer: nadeem@gmail.com +copyright: (c) 2026 Nadeem Bitar +build-type: Simple +extra-doc-files: + CHANGELOG.md + README.md + +extra-source-files: + examples/**/*.dhall + examples/**/*.hurl + examples/**/*.md + examples/**/*.py + schema/*.dhall + test/fixtures/scenario-isolation/*.dhall + test/fixtures/scenario-isolation/*.py + test/fixtures/scenario-isolation/hurl/*.hurl + test/golden/top-level-help.txt + test/golden/unknown-workflow.txt + +common common-options + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + -fhide-source-paths + -Wmissing-export-lists + -Wpartial-fields + -Wmissing-deriving-strategies + + default-language: GHC2024 + default-extensions: + DeriveAnyClass + DuplicateRecordFields + OverloadedLabels + OverloadedStrings + +library + import: common-options + hs-source-dirs: src + autogen-modules: Paths_hurl_workbench_cli + other-modules: Paths_hurl_workbench_cli + exposed-modules: + HurlWorkbench.Cli + HurlWorkbench.Cli.Command.Doctor + HurlWorkbench.Cli.Command.List + HurlWorkbench.Cli.Command.Matrix + HurlWorkbench.Cli.Command.Render + HurlWorkbench.Cli.Command.Run + HurlWorkbench.Cli.Command.Suite + HurlWorkbench.Cli.Command.Validate + HurlWorkbench.Cli.Error + HurlWorkbench.Cli.Help + HurlWorkbench.Cli.Options + HurlWorkbench.Cli.Output + HurlWorkbench.Cli.Version + HurlWorkbench.Cli.Workspace + + build-depends: + base >=4.20 && <5, + bytestring >=0.11 && <0.13, + containers >=0.6 && <0.8, + directory ^>=1.3, + filepath >=1.4 && <1.6, + generic-lens ^>=2.3, + githash >=0.1.7 && <0.2, + hurl-workbench-core ^>=0.1.0.0, + lens ^>=5.3, + optparse-applicative >=0.19 && <0.20, + temporary ^>=1.3, + terminal-size >=0.3.4 && <0.4, + text ^>=2.1, + +executable hurl-workbench + import: common-options + main-is: Main.hs + hs-source-dirs: app + ghc-options: + -threaded + -rtsopts + -with-rtsopts=-N + + build-depends: + base >=4.20 && <5, + hurl-workbench-cli, + +executable hurl-workbench-fixture-server + import: common-options + main-is: Main.hs + hs-source-dirs: test/fixture-server + other-modules: + FixtureServer + + ghc-options: + -threaded + -rtsopts + -with-rtsopts=-N + + build-depends: + base >=4.20 && <5, + bytestring >=0.11 && <0.13, + directory ^>=1.3, + filepath >=1.4 && <1.6, + http-types >=0.12 && <0.13, + unix >=2.8.8 && <2.9, + wai >=3.2.5 && <3.3, + warp >=3.4.16 && <3.5, + +test-suite hurl-workbench-cli-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: + test + test/fixture-server + + main-is: Main.hs + other-modules: + CheckTest + FileRootTest + FixtureServer + + ghc-options: + -threaded + + build-depends: + async, + base >=4.20 && <5, + bytestring, + containers, + directory, + filepath, + generic-lens, + http-types, + hurl-workbench-cli, + hurl-workbench-core ^>=0.1.0.0, + lens, + optparse-applicative, + tasty ^>=1.5, + tasty-hunit ^>=0.10, + temporary, + text, + unix, + wai, + warp, diff --git a/schema/Binding.dhall b/schema/Binding.dhall new file mode 100644 --- /dev/null +++ b/schema/Binding.dhall @@ -0,0 +1,2 @@ +{- A plain value bound to a parameter declared by the selected workflow. -} +{ Type = { parameter : Text, value : Text }, default = {=} } diff --git a/schema/Check.dhall b/schema/Check.dhall new file mode 100644 --- /dev/null +++ b/schema/Check.dhall @@ -0,0 +1,16 @@ +{- A single application-owned executable assertion, run as a suite barrier. -} +let CommandSpec = ./CommandSpec.dhall + +in { Type = + { name : Text + , command : CommandSpec.Type + , expectedStatus : Natural + , timeoutSeconds : Optional Natural + , description : Optional Text + } + , default = + { expectedStatus = 0 + , timeoutSeconds = None Natural + , description = None Text + } + } diff --git a/schema/CommandReadiness.dhall b/schema/CommandReadiness.dhall new file mode 100644 --- /dev/null +++ b/schema/CommandReadiness.dhall @@ -0,0 +1,10 @@ +{- Run `command` until it exits successfully. -} +let CommandSpec = ./CommandSpec.dhall + +in { Type = + { command : CommandSpec.Type + , intervalMilliseconds : Natural + , timeoutSeconds : Natural + } + , default = { intervalMilliseconds = 500, timeoutSeconds = 30 } + } diff --git a/schema/CommandSpec.dhall b/schema/CommandSpec.dhall new file mode 100644 --- /dev/null +++ b/schema/CommandSpec.dhall @@ -0,0 +1,21 @@ +{- A process invocation as an executable plus argv; there is no shell-string form. + `workingDirectory` is relative to the workspace root. +-} +let EnvironmentBinding = ./EnvironmentBinding.dhall + +let EnvironmentPolicy = ./EnvironmentPolicy.dhall + +in { Type = + { executable : Text + , arguments : List Text + , workingDirectory : Optional Text + , environmentPolicy : EnvironmentPolicy + , environment : List EnvironmentBinding.Type + } + , default = + { arguments = [] : List Text + , workingDirectory = None Text + , environmentPolicy = EnvironmentPolicy.Inherit + , environment = [] : List EnvironmentBinding.Type + } + } diff --git a/schema/EnvironmentBinding.dhall b/schema/EnvironmentBinding.dhall new file mode 100644 --- /dev/null +++ b/schema/EnvironmentBinding.dhall @@ -0,0 +1,2 @@ +{- Export the workspace parameter `parameter` to a child process as `variable`. -} +{ Type = { variable : Text, parameter : Text }, default = {=} } diff --git a/schema/EnvironmentPolicy.dhall b/schema/EnvironmentPolicy.dhall new file mode 100644 --- /dev/null +++ b/schema/EnvironmentPolicy.dhall @@ -0,0 +1,1 @@ +< Inherit | Clean : List Text > diff --git a/schema/Fragment.dhall b/schema/Fragment.dhall new file mode 100644 --- /dev/null +++ b/schema/Fragment.dhall @@ -0,0 +1,6 @@ +{- A file of one or more complete Hurl entries. + `path` is relative to the directory containing `hurl-workbench.dhall`. +-} +{ Type = { name : Text, path : Text, description : Optional Text } +, default.description = None Text +} diff --git a/schema/Generator.dhall b/schema/Generator.dhall new file mode 100644 --- /dev/null +++ b/schema/Generator.dhall @@ -0,0 +1,1 @@ +< Uuid4 | Uuid7 | TypeId : { prefix : Text } | Rfc3339Now | RandomAlphanumeric : { length : Natural } > diff --git a/schema/HttpReadiness.dhall b/schema/HttpReadiness.dhall new file mode 100644 --- /dev/null +++ b/schema/HttpReadiness.dhall @@ -0,0 +1,9 @@ +{- Poll `url` until it answers with `expectedStatus`. -} +{ Type = + { url : Text + , expectedStatus : Natural + , intervalMilliseconds : Natural + , timeoutSeconds : Natural + } +, default = { expectedStatus = 200, intervalMilliseconds = 500, timeoutSeconds = 30 } +} diff --git a/schema/IsolationPolicy.dhall b/schema/IsolationPolicy.dhall new file mode 100644 --- /dev/null +++ b/schema/IsolationPolicy.dhall @@ -0,0 +1,2 @@ +{- Whether expanded scenarios share application state. -} +< SharedState | IndependentState > diff --git a/schema/Matrix.dhall b/schema/Matrix.dhall new file mode 100644 --- /dev/null +++ b/schema/Matrix.dhall @@ -0,0 +1,12 @@ +{- A recipe applied to a non-empty list of uniquely named cases. -} +let MatrixCase = ./MatrixCase.dhall + +in { Type = + { name : Text + , recipe : Text + , cases : List MatrixCase.Type + , failFast : Bool + , description : Optional Text + } + , default = { failFast = False, description = None Text } + } diff --git a/schema/MatrixCase.dhall b/schema/MatrixCase.dhall new file mode 100644 --- /dev/null +++ b/schema/MatrixCase.dhall @@ -0,0 +1,6 @@ +{- One named set of bindings layered over a matrix's recipe. -} +let Binding = ./Binding.dhall + +in { Type = { name : Text, bindings : List Binding.Type } + , default.bindings = [] : List Binding.Type + } diff --git a/schema/Parameter.dhall b/schema/Parameter.dhall new file mode 100644 --- /dev/null +++ b/schema/Parameter.dhall @@ -0,0 +1,21 @@ +{- An externally injected Hurl variable. + + `defaultValue` is a committed plain value and is rejected for secrets. + `environment` names an environment variable that supplies the value at run time. +-} +let ParameterKind = ./ParameterKind.dhall + +in { Type = + { name : Text + , description : Optional Text + , kind : ParameterKind + , defaultValue : Optional Text + , environment : Optional Text + } + , default = + { description = None Text + , kind = ParameterKind.Plain + , defaultValue = None Text + , environment = None Text + } + } diff --git a/schema/ParameterKind.dhall b/schema/ParameterKind.dhall new file mode 100644 --- /dev/null +++ b/schema/ParameterKind.dhall @@ -0,0 +1,2 @@ +let Generator = ./Generator.dhall +in < Plain | Secret | Generated : Generator > diff --git a/schema/Readiness.dhall b/schema/Readiness.dhall new file mode 100644 --- /dev/null +++ b/schema/Readiness.dhall @@ -0,0 +1,6 @@ +{- How to decide that a service is ready, for example + `Schema.Readiness.Http Schema.HttpReadiness::{ url = "http://127.0.0.1:8080/health" }`. +-} +< Http : (./HttpReadiness.dhall).Type +| Command : (./CommandReadiness.dhall).Type +> diff --git a/schema/Recipe.dhall b/schema/Recipe.dhall new file mode 100644 --- /dev/null +++ b/schema/Recipe.dhall @@ -0,0 +1,16 @@ +{- A workflow plus committed plain bindings and an explicit safety class. + `safety` has no default so that a mutating recipe is never silently read-only. +-} +let Binding = ./Binding.dhall + +let Safety = ./Safety.dhall + +in { Type = + { name : Text + , workflow : Text + , bindings : List Binding.Type + , safety : Safety + , description : Optional Text + } + , default = { bindings = [] : List Binding.Type, description = None Text } + } diff --git a/schema/RunReference.dhall b/schema/RunReference.dhall new file mode 100644 --- /dev/null +++ b/schema/RunReference.dhall @@ -0,0 +1,4 @@ +{- Hurl runs and named service lifecycle barriers. -} +let ServiceStep = ./ServiceStep.dhall + +in < Workflow : Text | Recipe : Text | Matrix : Text | Check : Text | Service : ServiceStep > diff --git a/schema/Safety.dhall b/schema/Safety.dhall new file mode 100644 --- /dev/null +++ b/schema/Safety.dhall @@ -0,0 +1,4 @@ +{- Whether running a recipe may change remote state. + `Mutating` recipes only run when explicitly allowed at execution time. +-} +< ReadOnly | Mutating > diff --git a/schema/Service.dhall b/schema/Service.dhall new file mode 100644 --- /dev/null +++ b/schema/Service.dhall @@ -0,0 +1,14 @@ +{- A managed process that suites can start, wait for, and stop. -} +let CommandSpec = ./CommandSpec.dhall + +let Readiness = ./Readiness.dhall + +in { Type = + { name : Text + , command : CommandSpec.Type + , readiness : Readiness + , shutdownTimeoutSeconds : Natural + , description : Optional Text + } + , default = { shutdownTimeoutSeconds = 10, description = None Text } + } diff --git a/schema/ServiceStep.dhall b/schema/ServiceStep.dhall new file mode 100644 --- /dev/null +++ b/schema/ServiceStep.dhall @@ -0,0 +1,2 @@ +{- An ordered lifecycle barrier for a service belonging to this suite. -} +< Stop : Text | Start : Text | Restart : Text > diff --git a/schema/Suite.dhall b/schema/Suite.dhall new file mode 100644 --- /dev/null +++ b/schema/Suite.dhall @@ -0,0 +1,34 @@ +{- A non-empty collection of runs, optionally against a managed service. -} +let RunReference = ./RunReference.dhall + +let CommandSpec = ./CommandSpec.dhall + +let IsolationPolicy = ./IsolationPolicy.dhall + +in { Type = + { name : Text + , runs : List RunReference + , fileRootParameter : Optional Text + , service : Optional Text + , services : List Text + , setup : List CommandSpec.Type + , teardown : List CommandSpec.Type + , commandTimeoutSeconds : Natural + , cleanupTimeoutSeconds : Natural + , isolation : IsolationPolicy + , failFast : Bool + , description : Optional Text + } + , default = + { fileRootParameter = None Text + , service = None Text + , services = [] : List Text + , setup = [] : List CommandSpec.Type + , teardown = [] : List CommandSpec.Type + , commandTimeoutSeconds = 60 + , cleanupTimeoutSeconds = 30 + , isolation = IsolationPolicy.SharedState + , failFast = False + , description = None Text + } + } diff --git a/schema/Workflow.dhall b/schema/Workflow.dhall new file mode 100644 --- /dev/null +++ b/schema/Workflow.dhall @@ -0,0 +1,9 @@ +{- An ordered, non-empty list of fragment names and the parameters they consume. -} +{ Type = + { name : Text + , fragments : List Text + , parameters : List Text + , description : Optional Text + } +, default = { parameters = [] : List Text, description = None Text } +} diff --git a/schema/Workspace.dhall b/schema/Workspace.dhall new file mode 100644 --- /dev/null +++ b/schema/Workspace.dhall @@ -0,0 +1,44 @@ +{- The top-level value of `hurl-workbench.dhall`. + + `schemaVersion` is required and has no default: a manifest states the schema + version it was written for, and the workbench rejects versions it does not know. + Every list defaults to empty so new categories never break existing manifests. +-} +let Parameter = ./Parameter.dhall + +let Fragment = ./Fragment.dhall + +let Workflow = ./Workflow.dhall + +let Recipe = ./Recipe.dhall + +let Matrix = ./Matrix.dhall + +let Check = ./Check.dhall + +let Service = ./Service.dhall + +let Suite = ./Suite.dhall + +in { Type = + { schemaVersion : Natural + , parameters : List Parameter.Type + , fragments : List Fragment.Type + , workflows : List Workflow.Type + , recipes : List Recipe.Type + , matrices : List Matrix.Type + , checks : List Check.Type + , services : List Service.Type + , suites : List Suite.Type + } + , default = + { parameters = [] : List Parameter.Type + , fragments = [] : List Fragment.Type + , workflows = [] : List Workflow.Type + , recipes = [] : List Recipe.Type + , matrices = [] : List Matrix.Type + , checks = [] : List Check.Type + , services = [] : List Service.Type + , suites = [] : List Suite.Type + } + } diff --git a/schema/package.dhall b/schema/package.dhall new file mode 100644 --- /dev/null +++ b/schema/package.dhall @@ -0,0 +1,36 @@ +{- The hurl-workbench workspace schema, version 1. + + Import it by relative path from a workspace manifest: + + let Schema = ../schema/package.dhall + in Schema.Workspace::{ schemaVersion = Schema.schemaVersion, ... } + + Record modules expose `Type` and `default` for record completion (`::`). + Union modules (`ParameterKind`, `Safety`, `Readiness`, `RunReference`) are the + union types themselves. +-} +{ schemaVersion = 1 +, Workspace = ./Workspace.dhall +, Parameter = ./Parameter.dhall +, Generator = ./Generator.dhall +, ParameterKind = ./ParameterKind.dhall +, Fragment = ./Fragment.dhall +, Workflow = ./Workflow.dhall +, Binding = ./Binding.dhall +, Safety = ./Safety.dhall +, Recipe = ./Recipe.dhall +, MatrixCase = ./MatrixCase.dhall +, Matrix = ./Matrix.dhall +, EnvironmentBinding = ./EnvironmentBinding.dhall +, EnvironmentPolicy = ./EnvironmentPolicy.dhall +, CommandSpec = ./CommandSpec.dhall +, HttpReadiness = ./HttpReadiness.dhall +, CommandReadiness = ./CommandReadiness.dhall +, Readiness = ./Readiness.dhall +, Check = ./Check.dhall +, Service = ./Service.dhall +, ServiceStep = ./ServiceStep.dhall +, RunReference = ./RunReference.dhall +, IsolationPolicy = ./IsolationPolicy.dhall +, Suite = ./Suite.dhall +} diff --git a/src/HurlWorkbench/Cli.hs b/src/HurlWorkbench/Cli.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli.hs @@ -0,0 +1,109 @@ +-- | Top-level CLI entry point: parse argv and dispatch to a command. +module HurlWorkbench.Cli + ( runCli, + runCommand, + runCommandWithHurlfmt, + runCommandWithDependencies, + ) +where + +import Data.Text qualified as Text +import HurlWorkbench.Cli.Command.Doctor (runDoctorWith) +import HurlWorkbench.Cli.Command.List (runList) +import HurlWorkbench.Cli.Command.Matrix (runMatrixWith) +import HurlWorkbench.Cli.Command.Render (runRenderWith) +import HurlWorkbench.Cli.Command.Run (runExecuteWith) +import HurlWorkbench.Cli.Command.Suite (runSuiteCommandWith) +import HurlWorkbench.Cli.Command.Validate (runValidateWith) +import HurlWorkbench.Cli.Help (helpPreferences, resolveHelpColumns) +import HurlWorkbench.Cli.Options (Command (..), CompletionShell (..), GlobalOptions, Options (..), parserInfo) +import HurlWorkbench.Cli.Output (CommandResult, emitResult, success) +import HurlWorkbench.Hurl.Capabilities (HurlCapabilities, detectHurlCapabilities) +import HurlWorkbench.Hurl.Format + ( DependencyError, + HurlfmtCapabilities, + HurlfmtError, + WorkflowSyntaxError, + detectHurlfmtCapabilities, + validateRenderedWorkflow, + validateWorkspaceSyntax, + ) +import HurlWorkbench.Hurl.Run (HurlRunMode (..)) +import HurlWorkbench.Prelude (Text) +import HurlWorkbench.Workflow.Render (RenderedWorkflow) +import HurlWorkbench.Workspace.Context (ValidatedWorkspace) +import Options.Applicative (customExecParser) +import Options.Applicative.BashCompletion + ( bashCompletionScript, + fishCompletionScript, + zshCompletionScript, + ) +import System.Directory (getCurrentDirectory) + +-- | Parse argv, run the command from the current directory, print its +-- output, and exit with its status. +runCli :: IO () +runCli = do + helpColumns <- resolveHelpColumns + Options {global, cmd} <- customExecParser (helpPreferences helpColumns) parserInfo + currentDirectory <- getCurrentDirectory + runCommand global currentDirectory cmd >>= emitResult + +-- | Run a parsed command as if started in the given directory. +runCommand :: GlobalOptions -> FilePath -> Command -> IO CommandResult +runCommand = + runCommandWithDependencies + detectHurlfmtCapabilities + detectHurlCapabilities + validateRenderedWorkflow + validateWorkspaceSyntax + +-- | Test seam for supplying a deterministic Hurlfmt capability probe. +runCommandWithHurlfmt :: + IO (Either DependencyError HurlfmtCapabilities) -> + (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> + (HurlfmtCapabilities -> ValidatedWorkspace -> IO (Either DependencyError [WorkflowSyntaxError])) -> + GlobalOptions -> + FilePath -> + Command -> + IO CommandResult +runCommandWithHurlfmt detectCapabilities validateRendered validateSyntax global currentDirectory = \case + command -> + runCommandWithDependencies + detectCapabilities + detectHurlCapabilities + validateRendered + validateSyntax + global + currentDirectory + command + +runCommandWithDependencies :: + IO (Either DependencyError HurlfmtCapabilities) -> + IO (Either DependencyError HurlCapabilities) -> + (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> + (HurlfmtCapabilities -> ValidatedWorkspace -> IO (Either DependencyError [WorkflowSyntaxError])) -> + GlobalOptions -> + FilePath -> + Command -> + IO CommandResult +runCommandWithDependencies detectHurlfmt detectHurl validateRendered validateSyntax global currentDirectory = \case + ValidateCommand -> runValidateWith detectHurlfmt validateSyntax global currentDirectory + ListCommand category -> runList global currentDirectory category + RenderCommand options -> runRenderWith detectHurlfmt validateRendered global currentDirectory options + RunCommand options -> runExecuteWith detectHurl validateRendered global currentDirectory ClientMode options + TestCommand options -> runExecuteWith detectHurl validateRendered global currentDirectory TestMode options + MatrixCommand options -> runMatrixWith detectHurl validateRendered global currentDirectory options + SuiteCommand options -> runSuiteCommandWith detectHurl validateRendered global currentDirectory options + CompletionsCommand shell -> pure (success (completionLines shell)) + DoctorCommand -> runDoctorWith detectHurl + +completionLines :: CompletionShell -> [Text] +completionLines shell = + Text.lines . Text.pack $ + case shell of + Bash -> bashCompletionScript commandName commandName + Zsh -> zshCompletionScript commandName commandName + Fish -> fishCompletionScript commandName commandName + where + commandName = "hurl-workbench" diff --git a/src/HurlWorkbench/Cli/Command/Doctor.hs b/src/HurlWorkbench/Cli/Command/Doctor.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Command/Doctor.hs @@ -0,0 +1,44 @@ +module HurlWorkbench.Cli.Command.Doctor + ( runDoctor, + runDoctorWith, + ) +where + +import Data.Generics.Labels () +import Data.Text qualified as Text +import Data.Version (showVersion) +import HurlWorkbench.Cli.Output (CommandResult (..)) +import HurlWorkbench.Hurl.Capabilities +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Prelude +import System.Exit (ExitCode (..)) + +runDoctor :: IO CommandResult +runDoctor = runDoctorWith detectHurlCapabilities + +runDoctorWith :: IO (Either DependencyError HurlCapabilities) -> IO CommandResult +runDoctorWith detectCapabilities = + detectCapabilities <&> \case + Left err -> + CommandResult + { stdoutLines = [], + stderrLines = ["error: " <> renderDependencyError err], + exitCode = ExitFailure 3 + } + Right capabilities -> + CommandResult + { stdoutLines = + [ "hurl: " + <> Text.pack (capabilities ^. #hurlExecutable) + <> " (" + <> Text.pack (showVersion (capabilities ^. #hurlVersion)) + <> ", supported)", + "hurlfmt: " + <> Text.pack (capabilities ^. #hurlfmt . #executable . #unHurlfmtExecutable) + <> " (" + <> Text.pack (showVersion (capabilities ^. #hurlfmt . #version)) + <> ", supported)" + ], + stderrLines = hurlCapabilityWarnings capabilities, + exitCode = ExitSuccess + } diff --git a/src/HurlWorkbench/Cli/Command/List.hs b/src/HurlWorkbench/Cli/Command/List.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Command/List.hs @@ -0,0 +1,178 @@ +-- | @hurl-workbench list@: print workspace entities and their relationships +-- as aligned, line-oriented tables in declaration order. +-- +-- Listing never reads parameter environments and never prints secret +-- values; an @ENVIRONMENT@ column names the variable, not its value. +module HurlWorkbench.Cli.Command.List + ( runList, + listLines, + ) +where + +import Data.Generics.Labels () +import Data.Text qualified as Text +import HurlWorkbench.Cli.Options (GlobalOptions, ListCategory (..)) +import HurlWorkbench.Cli.Output (CommandResult, renderTable, success) +import HurlWorkbench.Cli.Workspace (withValidatedWorkspace) +import HurlWorkbench.Prelude +import HurlWorkbench.Workspace.Context (ValidatedWorkspace, lookupMatrix, lookupRecipe, validatedWorkspace) +import HurlWorkbench.Workspace.Types + +runList :: GlobalOptions -> FilePath -> ListCategory -> IO CommandResult +runList options currentDirectory category = + withValidatedWorkspace options currentDirectory (success . listLines category) + +listLines :: ListCategory -> ValidatedWorkspace -> [Text] +listLines category vw = case category of + AllCategories -> + intercalateBlank + [ heading title : section c + | c <- [ParametersCategory .. SuitesCategory], + let title = categoryTitle c + ] + single -> section single + where + ws = validatedWorkspace vw + heading title = title <> ":" + intercalateBlank = concat . zipWith (\i block -> [Text.empty | i > (0 :: Int)] <> block) [0 ..] + section = \case + AllCategories -> [] + ParametersCategory -> table ["NAME", "KIND", "DEFAULT", "ENVIRONMENT", "DESCRIPTION"] (map parameterRow (ws ^. #parameters)) + FragmentsCategory -> table ["NAME", "PATH", "DESCRIPTION"] (map fragmentRow (ws ^. #fragments)) + WorkflowsCategory -> table ["NAME", "FRAGMENTS", "PARAMETERS", "DESCRIPTION"] (map workflowRow (ws ^. #workflows)) + RecipesCategory -> table ["NAME", "WORKFLOW", "SAFETY", "BINDINGS", "DESCRIPTION"] (map recipeRow (ws ^. #recipes)) + MatricesCategory -> table ["NAME", "RECIPE", "CASES", "FAIL-FAST", "DESCRIPTION"] (map matrixRow (ws ^. #matrices)) + ChecksCategory -> table ["NAME", "EXPECTED-STATUS", "TIMEOUT", "DESCRIPTION"] (map checkRow (ws ^. #checks)) + ServicesCategory -> table ["NAME", "COMMAND", "READINESS", "DESCRIPTION"] (map serviceRow (ws ^. #services)) + SuitesCategory -> table ["NAME", "RUNS", "SERVICE", "SAFETY", "FAIL-FAST", "DESCRIPTION"] (map (suiteRow vw) (ws ^. #suites)) + +table :: [Text] -> [[Text]] -> [Text] +table _ [] = ["(none)"] +table headings rows = renderTable headings rows + +categoryTitle :: ListCategory -> Text +categoryTitle = \case + AllCategories -> "All" + ParametersCategory -> "Parameters" + FragmentsCategory -> "Fragments" + WorkflowsCategory -> "Workflows" + RecipesCategory -> "Recipes" + MatricesCategory -> "Matrices" + ChecksCategory -> "Checks" + ServicesCategory -> "Services" + SuitesCategory -> "Suites" + +parameterRow :: Parameter -> [Text] +parameterRow p = + [ unParameterName (p ^. #name), + case p ^. #kind of + Generated generator -> "generated " <> Text.pack (show generator) + Plain -> "plain" + Secret -> "secret", + maybe "" (displayLiteral . hurlValueLiteralText) (p ^. #defaultValue), + fromMaybe "" (p ^. #environment), + describe (p ^. #description) + ] + +fragmentRow :: Fragment -> [Text] +fragmentRow f = [unFragmentName (f ^. #name), Text.pack (f ^. #path), describe (f ^. #description)] + +workflowRow :: Workflow -> [Text] +workflowRow w = + [ unWorkflowName (w ^. #name), + commaList (map unFragmentName (w ^. #fragments)), + commaList (map unParameterName (w ^. #parameters)), + describe (w ^. #description) + ] + +recipeRow :: Recipe -> [Text] +recipeRow r = + [ unRecipeName (r ^. #name), + unWorkflowName (r ^. #workflow), + case r ^. #safety of + ReadOnly -> "read-only" + Mutating -> "mutating", + bindingList (r ^. #bindings), + describe (r ^. #description) + ] + +matrixRow :: Matrix -> [Text] +matrixRow m = + [ unMatrixName (m ^. #name), + unRecipeName (m ^. #recipe), + commaList (map (unMatrixCaseName . view #name) (m ^. #cases)), + yesNo (m ^. #failFast), + describe (m ^. #description) + ] + +checkRow :: Check -> [Text] +checkRow check = [unCheckName (check ^. #name), Text.pack (show (check ^. #expectedStatus)), maybe "60" (Text.pack . show) (check ^. #timeoutSeconds), describe (check ^. #description)] + +serviceRow :: Service -> [Text] +serviceRow s = + [ unServiceName (s ^. #name), + s ^. #command . #executable, + case s ^. #readiness of + HttpReadinessCheck http -> "http " <> http ^. #url + CommandReadinessCheck check -> "command " <> check ^. #command . #executable, + describe (s ^. #description) + ] + +suiteRow :: ValidatedWorkspace -> Suite -> [Text] +suiteRow validated s = + [ unSuiteName (s ^. #name), + commaList (map runLabel (s ^. #runs)), + commaList (map unServiceName (suiteServices s)), + suiteSafety validated s, + yesNo (s ^. #failFast), + describe (s ^. #description) + ] + where + runLabel = \case + WorkflowRun w -> "workflow:" <> unWorkflowName w + RecipeRun r -> "recipe:" <> unRecipeName r + MatrixRun m -> "matrix:" <> unMatrixName m + CheckRun c -> "check:" <> unCheckName c + ServiceRun step -> "service:" <> Text.pack (show step) + +suiteSafety :: ValidatedWorkspace -> Suite -> Text +suiteSafety validated suite = + case (any (== MutatingRun) dispositions, any (== UnclassifiedRun) dispositions) of + (False, False) -> "read-only" + (True, False) -> "mutating" + (False, True) -> "unclassified" + (True, True) -> "mutating, unclassified" + where + dispositions = map disposition (suite ^. #runs) + disposition = \case + CheckRun _ -> ReadOnlyRun + ServiceRun _ -> ReadOnlyRun + WorkflowRun _ -> UnclassifiedRun + RecipeRun name -> maybe UnclassifiedRun recipeDisposition (lookupRecipe name validated) + MatrixRun name -> case lookupMatrix name validated >>= (\matrix -> lookupRecipe (matrix ^. #recipe) validated) of + Nothing -> UnclassifiedRun + Just recipe -> recipeDisposition recipe + recipeDisposition recipe = case recipe ^. #safety of + ReadOnly -> ReadOnlyRun + Mutating -> MutatingRun + +data ListedSafety = ReadOnlyRun | MutatingRun | UnclassifiedRun + deriving stock (Eq) + +-- | Committed plain bindings are part of the workspace source, so they are +-- safe to display. +bindingList :: [Binding] -> Text +bindingList bindings = + commaList [unParameterName (b ^. #parameter) <> "=" <> displayLiteral (hurlValueLiteralText (b ^. #value)) | b <- bindings] + +displayLiteral :: Text -> Text +displayLiteral value = if Text.null value then "\"\"" else value + +commaList :: [Text] -> Text +commaList = Text.intercalate ", " + +describe :: Maybe Text -> Text +describe = fromMaybe "" + +yesNo :: Bool -> Text +yesNo b = if b then "yes" else "no" diff --git a/src/HurlWorkbench/Cli/Command/Matrix.hs b/src/HurlWorkbench/Cli/Command/Matrix.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Command/Matrix.hs @@ -0,0 +1,204 @@ +module HurlWorkbench.Cli.Command.Matrix + ( runMatrix, + runMatrixWith, + replayCaptured, + renderCaseSummary, + ) +where + +import Data.Generics.Labels () +import Data.IORef (atomicModifyIORef', newIORef) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text.Encoding +import Data.Text.Encoding.Error (lenientDecode) +import Data.Text.IO qualified as Text.IO +import HurlWorkbench.Cli.Command.Run (buildExecutionInputs) +import HurlWorkbench.Cli.Error (cliErrors, cliFailure) +import HurlWorkbench.Cli.Options +import HurlWorkbench.Cli.Output (CommandResult (..)) +import HurlWorkbench.Cli.Workspace (loadValidatedWorkspace) +import HurlWorkbench.Hurl.Capabilities +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Hurl.Run +import HurlWorkbench.Parameter.Resolve (BindingInput) +import HurlWorkbench.Prelude +import HurlWorkbench.Run.Artifact +import HurlWorkbench.Run.Batch +import HurlWorkbench.Run.FileRoot +import HurlWorkbench.Run.Prepare +import HurlWorkbench.Run.Selection +import HurlWorkbench.Suite.Isolation +import HurlWorkbench.Workflow.Render (RenderedWorkflow) +import HurlWorkbench.Workspace.Context (lookupMatrix, validatedRoot) +import HurlWorkbench.Workspace.Types (IsolationPolicy (..), MatrixName (..), Safety (..), WorkspaceRoot (..)) +import System.Exit (ExitCode (..)) +import System.FilePath (isAbsolute, ()) +import System.IO qualified as IO + +runMatrix :: GlobalOptions -> FilePath -> MatrixOptions -> IO CommandResult +runMatrix = runMatrixWith detectHurlCapabilities validateRenderedWorkflow + +runMatrixWith :: + IO (Either DependencyError HurlCapabilities) -> + (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> + GlobalOptions -> + FilePath -> + MatrixOptions -> + IO CommandResult +runMatrixWith detectCapabilities validateRendered global currentDirectory matrixOptions = + loadValidatedWorkspace global currentDirectory >>= \case + Left errors -> pure (cliFailure 2 errors) + Right validated -> case lookupMatrix (matrixOptions ^. #matrix) validated of + Nothing -> pure (cliFailure 2 ["unknown matrix \"" <> unMatrixName (matrixOptions ^. #matrix) <> "\""]) + Just matrixDefinition -> case validateMatrixOptions matrixOptions of + Just problem -> pure (cliFailure 2 [problem]) + Nothing + | Right expanded <- resolveSelection validated (SelectMatrix (matrixOptions ^. #matrix)), + problems@(_ : _) <- checkIsolation SharedState (matrixOptions ^. #jobs) (toList expanded) -> + pure (cliErrors 2 (map renderIsolationIssue problems)) + Nothing -> case buildInputs matrixOptions of + Left errors -> pure (cliErrors 2 errors) + Right (bindingInput, hurlOptions) -> + let requested = matrixOptions ^. #hurl . #fileRoot + base = maybe (unWorkspaceRoot (validatedRoot validated)) (const currentDirectory) requested + in validateFileRoot base requested >>= \case + Left err -> pure (cliFailure 2 [renderFileRootError err]) + Right root -> + checkFileRootOutputs root (maybe [] pure (matrixOptions ^. #outputDirectory) <> maybe [] pure (hurlOptions ^. #curlExportPath)) >>= \case + Left err -> pure (cliFailure 2 [renderFileRootError err]) + Right () -> + detectCapabilities >>= \case + Left err -> pure (cliFailure 3 [renderDependencyError err]) + Right capabilities -> + prepareSelectionAtFileRootWith + root + validateRendered + (capabilities ^. #hurlfmt) + validated + bindingInput + hurlOptions + (SelectMatrix (matrixOptions ^. #matrix)) + >>= \case + Left errors -> + pure + ( cliErrors + (preparationExitCode errors) + (map (("preflight: " <>) . renderPreparationError) (toList errors)) + ) + Right prepared + | any (mutatingDenied (matrixOptions ^. #allowMutating) . view #safety) prepared -> + pure (cliFailure 2 ["mutating matrix requires --allow-mutating"]) + | isJust (matrixOptions ^. #hurl . #curlExportPath) && length prepared > 1 -> + pure (cliFailure 2 ["--curl has one path and cannot be shared by multiple matrix cases"]) + | otherwise -> do + built <- buildCases currentDirectory matrixOptions prepared + case built of + Left errors -> pure (cliErrors 2 (map renderArtifactError (toList errors))) + Right batchCases -> do + let failFast = fromMaybe (matrixDefinition ^. #failFast) (matrixOptions ^. #failFastOverride) + batchOptions = BatchOptions (matrixOptions ^. #jobs) failFast + runner = mkHurlRunner capabilities + selectedRunner <- + if usesInheritedOutput matrixOptions + then labelSequentialRunner (map (view #name) (toList batchCases)) runner + else pure runner + result <- runBatch selectedRunner batchOptions batchCases + pure + CommandResult + { stdoutLines = [], + stderrLines = + hurlCapabilityWarnings capabilities + <> replayCaptured (result ^. #cases) + <> map renderCaseSummary (toList (result ^. #cases)), + exitCode = result ^. #selectedExitCode + } + +buildInputs :: MatrixOptions -> Either [Text] (BindingInput, HurlOptions) +buildInputs matrixOptions = + buildExecutionInputs + ExecuteOptions + { selection = SelectMatrix (matrixOptions ^. #matrix), + bindings = matrixOptions ^. #bindings, + hurl = matrixOptions ^. #hurl, + allowMutating = matrixOptions ^. #allowMutating + } + +validateMatrixOptions :: MatrixOptions -> Maybe Text +validateMatrixOptions options + | options ^. #overwrite && isNothing (options ^. #outputDirectory) = Just "--overwrite requires --output-dir" + | options ^. #mode == ClientMode && positiveIntValue (options ^. #jobs) > 1 && isNothing (options ^. #outputDirectory) = + Just "client matrices with --jobs greater than 1 require --output-dir" + | options ^. #mode == TestMode && isJust (options ^. #outputDirectory) = Just "--output-dir is available only with --mode run" + | otherwise = Nothing + +buildCases :: FilePath -> MatrixOptions -> NonEmpty PreparedRun -> IO (Either (NonEmpty ArtifactError) (NonEmpty BatchCase)) +buildCases currentDirectory options prepared = case (options ^. #mode, options ^. #outputDirectory) of + (ClientMode, Just requestedDirectory) -> do + let outputDirectory = if isAbsolute requestedDirectory then requestedDirectory else currentDirectory requestedDirectory + prepareResponseArtifacts outputDirectory (options ^. #overwrite) prepared <&> \case + Left errors -> Left errors + Right paths -> Right (NonEmpty.zipWith (\ready path -> buildBatchCase ClientMode (ResponseFile path) [] ready) prepared paths) + (ClientMode, Nothing) -> pure (Right (fmap (buildBatchCase ClientMode InheritRunOutput []) prepared)) + (TestMode, Nothing) -> pure (Right (fmap (buildBatchCase TestMode CaptureRunOutput []) prepared)) + (TestMode, Just _) -> error "buildCases: output directory rejected by validation" + +usesInheritedOutput :: MatrixOptions -> Bool +usesInheritedOutput options = options ^. #mode == ClientMode && isNothing (options ^. #outputDirectory) + +labelSequentialRunner :: [Text] -> HurlRunner -> IO HurlRunner +labelSequentialRunner names runner = do + remaining <- newIORef names + pure $ HurlRunner $ \request -> do + caseName <- atomicModifyIORef' remaining $ \case + [] -> ([], "unknown") + name : rest -> (rest, name) + Text.IO.hPutStrLn IO.stderr ("==> " <> caseName) + result <- runHurl runner request + Text.IO.hPutStrLn IO.stderr ("<== " <> caseName <> " (" <> resultLabel result <> ")") + pure result + where + resultLabel = \case + Left _ -> "start failed" + Right result -> case result ^. #exitCode of + ExitSuccess -> "passed" + ExitFailure status -> "Hurl exit " <> Text.pack (show status) + +replayCaptured :: (Foldable f) => f CaseResult -> [Text] +replayCaptured = concatMap replayOne . toList + where + replayOne result = case result ^. #capturedOutput of + Nothing -> [] + Just captured -> + let stdoutText = decode (captured ^. #stdout) + stderrText = decode (captured ^. #stderr) + lines_ = Text.lines stdoutText <> Text.lines stderrText + in ["--- " <> result ^. #name <> " diagnostics ---" | not (null lines_)] <> lines_ + decode = Text.Encoding.decodeUtf8With lenientDecode + +renderCaseSummary :: CaseResult -> Text +renderCaseSummary result = + summary <> maybe "" ((" -> " <>) . Text.pack) (result ^. #outputPath) + where + summary = case result ^. #outcome of + CasePassed -> "PASS " <> result ^. #name + CaseFailed (ExitFailure status) -> "FAIL " <> result ^. #name <> " (Hurl exit " <> Text.pack (show status) <> ")" + CaseFailed ExitSuccess -> "FAIL " <> result ^. #name <> " (invalid successful failure status)" + CaseStartFailed err -> "ERROR " <> result ^. #name <> " (" <> renderRunStartError err <> ")" + CaseSkipped reason -> "SKIP " <> result ^. #name <> " (" <> skipReason reason <> ")" + skipReason FailFastTriggered = "fail-fast" + skipReason BatchPrerequisiteFailed = "batch prerequisite failed" + skipReason BatchCancelled = "cancelled" + +preparationExitCode :: NonEmpty PreparationError -> Int +preparationExitCode errors = maximum (map one (toList errors)) + where + one = \case + RunFormatFailed _ InvalidHurl {} -> 2 + RunFormatFailed {} -> 3 + _ -> 2 + +mutatingDenied :: Bool -> SafetyDisposition -> Bool +mutatingDenied allowed = \case + Classified Mutating -> not allowed + _ -> False diff --git a/src/HurlWorkbench/Cli/Command/Render.hs b/src/HurlWorkbench/Cli/Command/Render.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Command/Render.hs @@ -0,0 +1,140 @@ +-- | @hurl-workbench render workflow@: exact, syntax-checked Hurl output. +module HurlWorkbench.Cli.Command.Render + ( runRender, + runRenderWith, + ) +where + +import Control.Exception (IOException, displayException, mask, onException, try) +import Data.ByteString qualified as ByteString +import Data.Generics.Labels () +import Data.List.NonEmpty qualified as NonEmpty +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text.Encoding +import HurlWorkbench.Cli.Options (GlobalOptions, RenderOptions) +import HurlWorkbench.Cli.Output (CommandResult (..), failure) +import HurlWorkbench.Cli.Workspace (loadValidatedWorkspace) +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Parameter.Generate (generatorName) +import HurlWorkbench.Parameter.Resolve (BindingSource (..)) +import HurlWorkbench.Prelude +import HurlWorkbench.Run.Selection +import HurlWorkbench.Workflow.Render +import HurlWorkbench.Workspace.Context +import HurlWorkbench.Workspace.Types +import System.Directory (canonicalizePath, removeFile, renameFile) +import System.Exit (ExitCode (..)) +import System.FilePath (isAbsolute, takeDirectory, takeFileName, ()) +import System.IO (hClose, hFlush) +import System.IO.Temp (openBinaryTempFile) + +runRender :: GlobalOptions -> FilePath -> RenderOptions -> IO CommandResult +runRender = runRenderWith detectHurlfmtCapabilities validateRenderedWorkflow + +runRenderWith :: + IO (Either DependencyError HurlfmtCapabilities) -> + (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> + GlobalOptions -> + FilePath -> + RenderOptions -> + IO CommandResult +runRenderWith detectCapabilities validateRendered global currentDirectory options = + loadValidatedWorkspace global currentDirectory >>= \case + Left errors -> pure (failure errors) + Right validated -> case resolveSelection validated (options ^. #selection) of + Left err -> pure (failure ["error: " <> renderSelectionError err]) + Right (expanded :| []) -> + renderWorkflow (expanded ^. #workflow) >>= \case + Left err -> pure (failure ["error: " <> renderRenderError err]) + Right rendered -> + detectCapabilities >>= \case + Left err -> pure (failure ["error: " <> renderDependencyError err]) + Right capabilities -> + validateRendered capabilities rendered >>= \case + Left err -> pure (failure ["error: " <> renderHurlfmtError err]) + Right () -> emitRendered currentDirectory options (explanation options expanded <> generatedExplanation validated options expanded) rendered + Right _ -> pure (failure ["error: render accepts one workflow or recipe, not a matrix"]) + +emitRendered :: FilePath -> RenderOptions -> [Text] -> RenderedWorkflow -> IO CommandResult +emitRendered currentDirectory options explanationLines rendered = + case options ^. #output of + Nothing -> + pure + CommandResult + { stdoutLines = Text.lines (rendered ^. #contents), + stderrLines = explanationLines, + exitCode = ExitSuccess + } + Just requested -> do + let requestedPath = if isAbsolute requested then requested else currentDirectory requested + canonicalOutputResult <- try (canonicalizePath requestedPath) + case canonicalOutputResult of + Left (err :: IOException) -> pure (failure ["error: " <> Text.pack (displayException err)]) + Right canonicalOutput + | canonicalOutput `elem` sourcePaths rendered -> + pure + ( failure + [ "error: refusing to overwrite source fragment " + <> Text.pack canonicalOutput + ] + ) + | otherwise -> + atomicWrite canonicalOutput (Text.Encoding.encodeUtf8 (rendered ^. #contents)) >>= \case + Left err -> pure (failure ["error: " <> Text.pack (displayException err)]) + Right () -> + pure + CommandResult + { stdoutLines = [], + stderrLines = Text.pack canonicalOutput : explanationLines, + exitCode = ExitSuccess + } + where + sourcePaths = map (view #fragmentPath) . NonEmpty.toList . view #sourceFragments + +explanation :: RenderOptions -> ExpandedRun -> [Text] +explanation options expanded + | not (options ^. #explain) = [] + | null (expanded ^. #bindingLayers) = ["Binding sources: none (direct workflow; safety unclassified)"] + | otherwise = + "Binding sources (values redacted):" + : [ " " + <> renderSource (layer ^. #source) + <> " (" + <> Text.pack (show (length (layer ^. #values))) + <> " plain bindings)" + | layer <- expanded ^. #bindingLayers + ] + where + renderSource = \case + CommittedBinding label -> label + source -> Text.pack (show source) + +atomicWrite :: FilePath -> ByteString.ByteString -> IO (Either IOException ()) +atomicWrite target bytes = + mask $ \restore -> do + let directory = takeDirectory target + template = takeFileName target <> ".tmp" + opened <- try (openBinaryTempFile directory template) + case opened of + Left err -> pure (Left err) + Right (temporaryPath, handle) -> do + let cleanup = do + _ <- try @IOException (hClose handle) + _ <- try @IOException (removeFile temporaryPath) + pure () + writeAndRename = do + ByteString.hPut handle bytes + hFlush handle + hClose handle + renameFile temporaryPath target + try (restore writeAndRename `onException` cleanup) + +-- Inspection reads declarations only; it has no generator dependency. +generatedExplanation :: ValidatedWorkspace -> RenderOptions -> ExpandedRun -> [Text] +generatedExplanation validated options expanded = + [ " " <> unParameterName name <> ": generated (" <> generatorName generator <> ")" + | options ^. #explain, + name <- expanded ^. #workflow . #workflow . #parameters, + Just parameter <- [lookupParameter name validated], + Generated generator <- [parameter ^. #kind] + ] diff --git a/src/HurlWorkbench/Cli/Command/Run.hs b/src/HurlWorkbench/Cli/Command/Run.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Command/Run.hs @@ -0,0 +1,213 @@ +module HurlWorkbench.Cli.Command.Run + ( runExecute, + runExecuteWith, + buildExecutionInputs, + buildRuntimeInputs, + ) +where + +import Data.Bifunctor (first) +import Data.Generics.Labels () +import Data.List (sort) +import Data.Map.Strict qualified as Map +import Data.Text qualified as Text +import HurlWorkbench.Cli.Error (cliErrors, cliFailure) +import HurlWorkbench.Cli.Options +import HurlWorkbench.Cli.Output (CommandResult (..)) +import HurlWorkbench.Cli.Workspace (loadValidatedWorkspace) +import HurlWorkbench.Hurl.Capabilities +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Hurl.Run +import HurlWorkbench.Parameter.Resolve +import HurlWorkbench.Prelude +import HurlWorkbench.Run.FileRoot +import HurlWorkbench.Run.Prepare +import HurlWorkbench.Run.Selection +import HurlWorkbench.Workflow.Render +import HurlWorkbench.Workspace.Context (validatedRoot) +import HurlWorkbench.Workspace.Types +import HurlWorkbench.Workspace.Validate (isValidEnvironmentName, isValidParameterName) + +runExecute :: GlobalOptions -> FilePath -> HurlRunMode -> ExecuteOptions -> IO CommandResult +runExecute = runExecuteWith detectHurlCapabilities validateRenderedWorkflow + +runExecuteWith :: + IO (Either DependencyError HurlCapabilities) -> + (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> + GlobalOptions -> + FilePath -> + HurlRunMode -> + ExecuteOptions -> + IO CommandResult +runExecuteWith detectCapabilities validateRendered global currentDirectory mode executeOptions = + loadValidatedWorkspace global currentDirectory >>= \case + Left errors -> pure (cliFailure 2 errors) + Right validated -> case buildExecutionInputs executeOptions of + Left errors -> pure (cliErrors 2 errors) + Right (bindingInput, hurlOptions) -> + let requested = executeOptions ^. #hurl . #fileRoot + base = maybe (unWorkspaceRoot (validatedRoot validated)) (const currentDirectory) requested + in validateFileRoot base requested >>= \case + Left err -> pure (cliFailure 2 [renderFileRootError err]) + Right root -> + checkFileRootOutputs root (maybe [] pure (hurlOptions ^. #curlExportPath)) >>= \case + Left err -> pure (cliFailure 2 [renderFileRootError err]) + Right () -> + detectCapabilities >>= \case + Left err -> pure (cliFailure 3 [renderDependencyError err]) + Right capabilities -> + prepareSelectionAtFileRootWith + root + validateRendered + (capabilities ^. #hurlfmt) + validated + bindingInput + hurlOptions + (executeOptions ^. #selection) + >>= \case + Left errors -> + pure + ( cliErrors + (preparationExitCode errors) + (map (("preflight: " <>) . renderPreparationError) (toList errors)) + ) + Right (prepared :| []) + | mutatingDenied (executeOptions ^. #allowMutating) (prepared ^. #safety) -> + pure (cliFailure 2 ["mutating recipe requires --allow-mutating"]) + | otherwise -> do + executed <- + runHurl + (mkHurlRunner capabilities) + RunRequest + { renderedWorkflow = prepared ^. #renderedWorkflow, + fileRoot = root, + mode, + bindings = prepared ^. #bindings, + options = prepared ^. #options, + outputPolicy = InheritRunOutput, + reportTargets = [] + } + pure $ case executed of + Left err -> + cliFailure + (runStartExitCode err) + [renderRunStartError err] + Right result -> + CommandResult + { stdoutLines = [], + stderrLines = hurlCapabilityWarnings capabilities, + exitCode = result ^. #exitCode + } + Right _ -> pure (cliFailure 2 ["run and test accept one workflow or recipe, not a matrix"]) + +buildExecutionInputs :: ExecuteOptions -> Either [Text] (BindingInput, HurlOptions) +buildExecutionInputs executeOptions = buildRuntimeInputs (executeOptions ^. #bindings) (executeOptions ^. #hurl) + +buildRuntimeInputs :: BindingOptions -> CliHurlOptions -> Either [Text] (BindingInput, HurlOptions) +buildRuntimeInputs bindingOptions cli = do + plain <- parseUnique "--variable" parsePlain (bindingOptions ^. #variables) + secretEnvironments <- parseUnique "--secret-env" parseSecretEnvironment (bindingOptions ^. #secretEnvironments) + additional <- collect (map (first renderCliHurlOptionError . mkAllowedHurlArgument) (cli ^. #additionalArguments)) + pure + ( BindingInput + { plainOverrides = plain, + secretEnvironmentOverrides = secretEnvironments, + variableFiles = bindingOptions ^. #variableFiles, + secretFiles = bindingOptions ^. #secretFiles + }, + HurlOptions + { connectTimeoutSeconds = cli ^. #connectTimeoutSeconds, + maxTimeSeconds = cli ^. #maxTimeSeconds, + retryCount = cli ^. #retryCount, + retryIntervalMilliseconds = cli ^. #retryIntervalMilliseconds, + insecureTls = cli ^. #insecureTls, + includeHeaders = cli ^. #includeHeaders, + jsonOutput = cli ^. #jsonOutput, + verbosity = cli ^. #verbosity, + curlExportPath = cli ^. #curlExportPath, + additionalArguments = additional + } + ) + +parsePlain :: Text -> Either Text (ParameterName, HurlValueLiteral) +parsePlain raw = do + (name, value) <- splitAssignment "--variable" raw + validateParameterName "--variable" name + literal <- first (\err -> "--variable " <> name <> ": " <> renderHurlValueLiteralError err) (mkHurlValueLiteral value) + pure (ParameterName name, literal) + +parseSecretEnvironment :: Text -> Either Text (ParameterName, Text) +parseSecretEnvironment raw = do + (name, environment) <- splitAssignment "--secret-env" raw + validateParameterName "--secret-env" name + unlessEither (isValidEnvironmentName environment) ("--secret-env " <> name <> " names invalid environment variable " <> quote environment) + pure (ParameterName name, environment) + +splitAssignment :: Text -> Text -> Either Text (Text, Text) +splitAssignment option raw = case Text.breakOn "=" raw of + (name, rest) + | Text.null rest || Text.null name -> Left (option <> " expects NAME=VALUE") + | otherwise -> Right (name, Text.drop 1 rest) + +validateParameterName :: Text -> Text -> Either Text () +validateParameterName option name = + unlessEither (isValidParameterName name) (option <> " has invalid parameter name " <> quote name) + +parseUnique :: (Ord key) => Text -> (value -> Either Text (key, parsed)) -> [value] -> Either [Text] (Map key parsed) +parseUnique option parser values = do + parsed <- collect (map parser values) + let duplicateKeys = duplicates (map fst parsed) + case duplicateKeys of + [] -> Right (Map.fromList parsed) + _ -> Left [option <> " defines the same parameter more than once"] + +collect :: [Either Text value] -> Either [Text] [value] +collect values = case [err | Left err <- values] of + [] -> Right [value | Right value <- values] + errors -> Left errors + +duplicates :: (Ord value) => [value] -> [value] +duplicates values = [value | value : _duplicate : _rest <- groupSorted (sort values)] + where + groupSorted [] = [] + groupSorted (value : remaining) = + let (same, rest) = span (== value) remaining + in (value : same) : groupSorted rest + +unlessEither :: Bool -> err -> Either err () +unlessEither condition err = if condition then Right () else Left err + +hurlfmtExitCode :: HurlfmtError -> Int +hurlfmtExitCode = \case + InvalidHurl {} -> 2 + HurlfmtNotFound {} -> 3 + HurlfmtFailed {} -> 3 + +preparationExitCode :: NonEmpty PreparationError -> Int +preparationExitCode errors = + maximum (map one (toList errors)) + where + one = \case + RunFormatFailed _ err -> hurlfmtExitCode err + _ -> 2 + +mutatingDenied :: Bool -> SafetyDisposition -> Bool +mutatingDenied allowed = \case + Classified Mutating -> not allowed + _ -> False + +runStartExitCode :: RunStartError -> Int +runStartExitCode = \case + InvalidFileRootLayout {} -> 2 + HurlSpawnFailed {} -> 3 + InvalidRunOptions {} -> 2 + SecureRunFileError {} -> 2 + +quote :: Text -> Text +quote value = "\"" <> value <> "\"" + +renderCliHurlOptionError :: HurlOptionError -> Text +renderCliHurlOptionError = \case + UnsupportedHurlArgument rawArgument -> "unsupported --hurl-arg " <> rawArgument + NegativeOption name value -> name <> " must not be negative, got " <> Text.pack (show value) + DuplicateReportFormat format -> "duplicate " <> format <> " report target" diff --git a/src/HurlWorkbench/Cli/Command/Suite.hs b/src/HurlWorkbench/Cli/Command/Suite.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Command/Suite.hs @@ -0,0 +1,139 @@ +-- | @hurl-workbench test suite@: whole-suite preflight, optional managed +-- service ownership, bounded Hurl execution, and report summaries. +module HurlWorkbench.Cli.Command.Suite + ( runSuiteCommand, + runSuiteCommandWith, + ) +where + +import Data.Generics.Labels () +import Data.Set qualified as Set +import Data.Text qualified as Text +import HurlWorkbench.Check.Run (checkStatus) +import HurlWorkbench.Cli.Command.Matrix (renderCaseSummary, replayCaptured) +import HurlWorkbench.Cli.Command.Run (buildRuntimeInputs) +import HurlWorkbench.Cli.Error (cliErrors, cliFailure) +import HurlWorkbench.Cli.Options +import HurlWorkbench.Cli.Output (CommandResult (..)) +import HurlWorkbench.Cli.Workspace (loadValidatedWorkspace) +import HurlWorkbench.Hurl.Capabilities +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Hurl.Run (mkHurlRunner) +import HurlWorkbench.Prelude +import HurlWorkbench.Run.FileRoot +import HurlWorkbench.Run.Prepare (PreparationError (..)) +import HurlWorkbench.Service.Resolve (renderServiceError) +import HurlWorkbench.Suite.Resolve qualified as Suite +import HurlWorkbench.Suite.Run qualified as Suite +import HurlWorkbench.Suite.Scenario +import HurlWorkbench.Workflow.Render (RenderedWorkflow) +import HurlWorkbench.Workspace.Types (CheckName (..), ServiceName (..)) +import System.FilePath (isAbsolute, ()) + +runSuiteCommand :: GlobalOptions -> FilePath -> SuiteCommandOptions -> IO CommandResult +runSuiteCommand = runSuiteCommandWith detectHurlCapabilities validateRenderedWorkflow + +runSuiteCommandWith :: + IO (Either DependencyError HurlCapabilities) -> + (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> + GlobalOptions -> + FilePath -> + SuiteCommandOptions -> + IO CommandResult +runSuiteCommandWith detectCapabilities validateRendered global currentDirectory options = + loadValidatedWorkspace global currentDirectory >>= \case + Left errors -> pure (cliFailure 2 errors) + Right validated -> case validateOptions options of + Just problem -> pure (cliFailure 2 [problem]) + Nothing -> case buildRuntimeInputs (options ^. #bindings) (options ^. #hurl) of + Left errors -> pure (cliErrors 2 errors) + Right (bindingInput, hurlOptions) -> do + let request root scenarioInputs = + Suite.SuiteRequest + { suiteName = options ^. #suite, + fileRoot = root, + scenarioInputs, + bindingInput, + hurlOptions, + suiteOptions = + Suite.SuiteOptions + { jobs = options ^. #jobs, + failFastOverride = options ^. #failFastOverride, + allowMutating = options ^. #allowMutating, + manageService = not (options ^. #externalService), + reportFormats = Set.fromList (options ^. #reportFormats), + reportDirectory = fmap resolvePath (options ^. #reportDirectory), + overwriteReports = options ^. #overwrite + } + } + refusal root inputs err = preflightResult <$> Suite.finalizeSuitePreflight validated (request root inputs) err + cliRoot <- case options ^. #hurl . #fileRoot of + Nothing -> pure (Right Nothing) + Just path -> fmap Just <$> validateFileRoot currentDirectory (Just path) + case cliRoot of + Left err -> pure (cliFailure 2 [renderFileRootError err]) + Right selected -> + Suite.preflightFileRoot validated (request selected Nothing) >>= \case + Left err -> pure (preflightResult err) + Right root -> do + loaded <- case options ^. #scenarioInputsFile of + Nothing -> pure (Right Nothing) + Just path -> fmap Just <$> loadScenarioInputs (resolvePath path) + case loaded of + Left issue -> refusal (Just root) Nothing (Suite.SuitePreflightError (Suite.SuiteScenarioFailed issue :| [])) + Right inputs -> + Suite.preflightScenarioInputs validated (request (Just root) inputs) >>= \case + Left err -> refusal (Just root) inputs err + Right _ -> + detectCapabilities >>= \case + Left _ -> refusal (Just root) inputs (Suite.SuitePreflightError (Suite.SuiteDependencyUnavailable :| [])) + Right capabilities -> + Suite.runSuiteWith validateRendered (mkHurlRunner capabilities) (capabilities ^. #hurlfmt) validated (request (Just root) inputs) <&> \case + Left err -> preflightResult err + Right result -> + CommandResult + { stdoutLines = [], + stderrLines = + hurlCapabilityWarnings capabilities + <> replayCaptured (result ^. #cases) + <> map renderCaseSummary (toList (result ^. #cases)) + <> ["CHECK " <> unCheckName (event ^. #name) <> " " <> checkStatus event <> maybe "" ((" -> " <>) . Text.pack) (event ^. #stdoutPath) | Suite.CheckStep event <- result ^. #steps] + <> ["SERVICE " <> unServiceName (event ^. #name) <> " " <> event ^. #action <> " " <> event ^. #status | event <- result ^. #services] + <> ["PHASE " <> event ^. #phase <> " " <> Text.pack (show (event ^. #ordinal)) <> " " <> Text.pack (show (event ^. #status)) | event <- result ^. #phases] + <> renderServiceOutcome (result ^. #serviceOutcome) + <> maybe [] (pure . ("SUMMARY " <>) . Text.pack) (result ^. #summaryPath) + <> maybe [] (pure . ("ERROR " <>)) (result ^. #summaryError), + exitCode = result ^. #selectedExitCode + } + where + resolvePath path + | isAbsolute path = path + | otherwise = currentDirectory path + +preflightResult :: Suite.SuitePreflightError -> CommandResult +preflightResult err = cliErrors (preflightExitCode err) (map (("preflight: " <>) . Suite.renderSuitePreflightIssue) (toList (err ^. #issues))) + +validateOptions :: SuiteCommandOptions -> Maybe Text +validateOptions options + | options ^. #overwrite && isNothing (options ^. #reportDirectory) = Just "--overwrite requires --report-dir" + | Set.size (Set.fromList (options ^. #reportFormats)) /= length (options ^. #reportFormats) = Just "each --report format may be requested at most once" + | otherwise = Nothing + +preflightExitCode :: Suite.SuitePreflightError -> Int +preflightExitCode error_ = maximum (2 : map issueExitCode (toList (error_ ^. #issues))) + where + issueExitCode = \case + Suite.SuiteScenarioFailed ScenarioFileUnreadable -> 3 + Suite.SuiteDependencyUnavailable -> 3 + Suite.SuiteReportIoError {} -> 3 + Suite.SuiteRunPreparationFailed (RunFormatFailed _ HurlfmtNotFound {}) -> 3 + Suite.SuiteRunPreparationFailed (RunFormatFailed _ HurlfmtFailed {}) -> 3 + Suite.SuiteCheckFailed _ _ -> 3 + Suite.SuiteServiceResolutionFailed _ -> 4 + _ -> 2 + +renderServiceOutcome :: Maybe Suite.ServiceOutcome -> [Text] +renderServiceOutcome = \case + Nothing -> [] + Just Suite.ServiceStopped -> ["SERVICE stopped"] + Just (Suite.ServiceFailed err) -> ["SERVICE failed (" <> renderServiceError err <> ")"] diff --git a/src/HurlWorkbench/Cli/Command/Validate.hs b/src/HurlWorkbench/Cli/Command/Validate.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Command/Validate.hs @@ -0,0 +1,66 @@ +-- | @hurl-workbench validate@: report the manifest path and entity counts, +-- or every validation issue at once. +module HurlWorkbench.Cli.Command.Validate + ( runValidate, + runValidateWith, + validateSummary, + ) +where + +import Data.Generics.Labels () +import Data.Text qualified as Text +import HurlWorkbench.Cli.Options (GlobalOptions) +import HurlWorkbench.Cli.Output (CommandResult, failure, plural, success) +import HurlWorkbench.Cli.Workspace (loadValidatedWorkspace) +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Prelude +import HurlWorkbench.Workspace.Context (ValidatedWorkspace, validatedManifestPath, validatedWorkspace) + +runValidate :: GlobalOptions -> FilePath -> IO CommandResult +runValidate = runValidateWith detectHurlfmtCapabilities validateWorkspaceSyntax + +runValidateWith :: + IO (Either DependencyError HurlfmtCapabilities) -> + (HurlfmtCapabilities -> ValidatedWorkspace -> IO (Either DependencyError [WorkflowSyntaxError])) -> + GlobalOptions -> + FilePath -> + IO CommandResult +runValidateWith detectCapabilities validateSyntax options currentDirectory = + loadValidatedWorkspace options currentDirectory >>= \case + Left errors -> pure (failure errors) + Right validated -> + detectCapabilities >>= \case + Left err -> pure (failure ["error: " <> renderDependencyError err]) + Right capabilities -> + validateSyntax capabilities validated >>= \case + Left err -> pure (failure ["error: " <> renderDependencyError err]) + Right [] -> pure (success (validateSummary validated)) + Right issues -> + pure + ( failure + ( ["Invalid Hurl syntax: " <> Text.pack (validatedManifestPath validated)] + <> map ((" " <>) . indentMultiline . renderWorkflowSyntaxError) issues + <> [plural (length issues) "workflow issue" "workflow issues" <> " found"] + ) + ) + +indentMultiline :: Text -> Text +indentMultiline = Text.replace "\n" "\n " + +validateSummary :: ValidatedWorkspace -> [Text] +validateSummary vw = + [ "Valid workspace: " <> Text.pack (validatedManifestPath vw), + Text.intercalate + ", " + [ plural (length (ws ^. #parameters)) "parameter" "parameters", + plural (length (ws ^. #fragments)) "fragment" "fragments", + plural (length (ws ^. #workflows)) "workflow" "workflows", + plural (length (ws ^. #recipes)) "recipe" "recipes", + plural (length (ws ^. #matrices)) "matrix" "matrices", + plural (length (ws ^. #checks)) "check" "checks", + plural (length (ws ^. #services)) "service" "services", + plural (length (ws ^. #suites)) "suite" "suites" + ] + ] + where + ws = validatedWorkspace vw diff --git a/src/HurlWorkbench/Cli/Error.hs b/src/HurlWorkbench/Cli/Error.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Error.hs @@ -0,0 +1,34 @@ +-- | Consistent CLI failure rendering and exit construction. +module HurlWorkbench.Cli.Error + ( cliFailure, + cliErrors, + renderCliError, + ) +where + +import Data.Text qualified as Text +import HurlWorkbench.Cli.Output (CommandResult (..)) +import HurlWorkbench.Prelude +import System.Exit (ExitCode (..)) + +-- | Render one safe, already-domain-specific diagnostic. +renderCliError :: Text -> Text +renderCliError message + | "error:" `Text.isPrefixOf` Text.toLower message = message + | otherwise = "error: " <> message + +-- | Construct a failure whose first line introduces one possibly-multiline +-- diagnostic. Continuation lines retain their indentation and context. +cliFailure :: Int -> [Text] -> CommandResult +cliFailure status messages = + CommandResult + { stdoutLines = [], + stderrLines = case messages of + [] -> ["error: command failed"] + first : rest -> renderCliError first : rest, + exitCode = ExitFailure status + } + +-- | Construct a failure from several independent diagnostics. +cliErrors :: Int -> [Text] -> CommandResult +cliErrors status = cliFailure status . map renderCliError diff --git a/src/HurlWorkbench/Cli/Help.hs b/src/HurlWorkbench/Cli/Help.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Help.hs @@ -0,0 +1,37 @@ +-- | Terminal-aware parser preferences. +module HurlWorkbench.Cli.Help + ( helpPreferences, + resolveHelpColumns, + ) +where + +import Options.Applicative + ( ParserPrefs, + columns, + prefs, + showHelpOnEmpty, + showHelpOnError, + ) +import System.Console.Terminal.Size qualified as Terminal +import System.IO (hIsTerminalDevice, stdout) + +-- | Apply the public help behavior at a known output width. +helpPreferences :: Int -> ParserPrefs +helpPreferences width = + prefs (showHelpOnError <> showHelpOnEmpty <> columns (max 1 width)) + +-- | Use the actual terminal width when interactive, capped for readability. +-- Piped output uses a stable 80-column layout. +resolveHelpColumns :: IO Int +resolveHelpColumns = do + interactive <- hIsTerminalDevice stdout + if not interactive + then pure defaultColumns + else do + window <- Terminal.hSize stdout + pure $ case window of + Just size | Terminal.width size > 0 -> min maxColumns (Terminal.width size) + _ -> defaultColumns + where + defaultColumns = 80 + maxColumns = 140 diff --git a/src/HurlWorkbench/Cli/Options.hs b/src/HurlWorkbench/Cli/Options.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Options.hs @@ -0,0 +1,684 @@ +-- | Command-line grammar: +-- +-- > hurl-workbench [--workspace FILE] validate +-- > hurl-workbench [--workspace FILE] list [all|parameters|fragments|workflows|recipes|matrices|services|suites] +-- > hurl-workbench [--workspace FILE] render (workflow|recipe) NAME [--output FILE] +-- > hurl-workbench [--workspace FILE] run (workflow|recipe) NAME [OPTIONS] +-- > hurl-workbench [--workspace FILE] test (workflow|recipe) NAME [OPTIONS] +-- > hurl-workbench [--workspace FILE] test suite NAME [OPTIONS] +-- > hurl-workbench [--workspace FILE] matrix NAME [OPTIONS] +-- > hurl-workbench completions (bash|zsh|fish) +-- > hurl-workbench doctor +module HurlWorkbench.Cli.Options + ( Options (..), + GlobalOptions (..), + Command (..), + RenderOptions (..), + ExecuteOptions (..), + MatrixOptions (..), + SuiteCommandOptions (..), + BindingOptions (..), + emptyBindingOptions, + CliHurlOptions (..), + defaultCliHurlOptions, + ListCategory (..), + CompletionShell (..), + allListCategories, + listCategoryName, + parseListCategory, + parserInfo, + ) +where + +import Data.Text qualified as Text +import HurlWorkbench.Cli.Version (versionText) +import HurlWorkbench.Hurl.Run (HurlRunMode (..), HurlVerbosity (..)) +import HurlWorkbench.Prelude hiding (argument) +import HurlWorkbench.Run.Batch (PositiveInt, mkPositiveInt) +import HurlWorkbench.Run.Selection (RunSelection (..)) +import HurlWorkbench.Suite.Resolve (ReportFormat (..)) +import HurlWorkbench.Workspace.Types (MatrixName (..), RecipeName (..), SuiteName (..), WorkflowName (..)) +import Options.Applicative + ( Parser, + ParserInfo, + argument, + auto, + command, + completeWith, + eitherReader, + flag', + fullDesc, + header, + help, + helper, + hsubparser, + info, + infoOption, + long, + many, + metavar, + option, + optional, + parserOptionGroup, + progDesc, + strArgument, + strOption, + switch, + value, + (<**>), + (<|>), + ) +import Text.Read (readMaybe) + +-- | Parsed argv. +data Options = Options + { global :: !GlobalOptions, + cmd :: !Command + } + deriving stock (Generic, Eq, Show) + +-- | Options shared by every command. +data GlobalOptions = GlobalOptions + { -- | Explicit manifest; otherwise discovered from the current directory. + workspace :: !(Maybe FilePath) + } + deriving stock (Generic, Eq, Show) + +-- | A subcommand. +data Command + = ValidateCommand + | ListCommand !ListCategory + | RenderCommand !RenderOptions + | RunCommand !ExecuteOptions + | TestCommand !ExecuteOptions + | MatrixCommand !MatrixOptions + | SuiteCommand !SuiteCommandOptions + | CompletionsCommand !CompletionShell + | DoctorCommand + deriving stock (Generic, Eq, Show) + +-- | Options for rendering one named workflow. +data RenderOptions = RenderOptions + { selection :: !RunSelection, + output :: !(Maybe FilePath), + explain :: !Bool + } + deriving stock (Generic, Eq, Show) + +data ExecuteOptions = ExecuteOptions + { selection :: !RunSelection, + bindings :: !BindingOptions, + hurl :: !CliHurlOptions, + allowMutating :: !Bool + } + deriving stock (Generic, Eq, Show) + +data MatrixOptions = MatrixOptions + { matrix :: !MatrixName, + mode :: !HurlRunMode, + jobs :: !PositiveInt, + failFastOverride :: !(Maybe Bool), + allowMutating :: !Bool, + outputDirectory :: !(Maybe FilePath), + overwrite :: !Bool, + bindings :: !BindingOptions, + hurl :: !CliHurlOptions + } + deriving stock (Generic, Eq, Show) + +data SuiteCommandOptions = SuiteCommandOptions + { suite :: !SuiteName, + jobs :: !PositiveInt, + failFastOverride :: !(Maybe Bool), + allowMutating :: !Bool, + externalService :: !Bool, + scenarioInputsFile :: !(Maybe FilePath), + reportFormats :: ![ReportFormat], + reportDirectory :: !(Maybe FilePath), + overwrite :: !Bool, + bindings :: !BindingOptions, + hurl :: !CliHurlOptions + } + deriving stock (Generic, Eq, Show) + +data BindingOptions = BindingOptions + { variables :: ![Text], + variableFiles :: ![FilePath], + secretEnvironments :: ![Text], + secretFiles :: ![FilePath] + } + deriving stock (Generic, Eq, Show) + +emptyBindingOptions :: BindingOptions +emptyBindingOptions = BindingOptions [] [] [] [] + +data CliHurlOptions = CliHurlOptions + { connectTimeoutSeconds :: !(Maybe Int), + maxTimeSeconds :: !(Maybe Int), + retryCount :: !(Maybe Int), + retryIntervalMilliseconds :: !(Maybe Int), + insecureTls :: !Bool, + includeHeaders :: !Bool, + jsonOutput :: !Bool, + verbosity :: !(Maybe HurlVerbosity), + fileRoot :: !(Maybe FilePath), + curlExportPath :: !(Maybe FilePath), + additionalArguments :: ![Text] + } + deriving stock (Generic, Eq, Show) + +defaultCliHurlOptions :: CliHurlOptions +defaultCliHurlOptions = + CliHurlOptions + { connectTimeoutSeconds = Nothing, + maxTimeSeconds = Nothing, + retryCount = Nothing, + retryIntervalMilliseconds = Nothing, + insecureTls = False, + includeHeaders = False, + jsonOutput = False, + verbosity = Nothing, + fileRoot = Nothing, + curlExportPath = Nothing, + additionalArguments = [] + } + +data HttpRetryOptions = HttpRetryOptions !(Maybe Int) !(Maybe Int) !(Maybe Int) !(Maybe Int) !Bool + +data OutputDiagnosticOptions = OutputDiagnosticOptions !Bool !Bool !(Maybe HurlVerbosity) !(Maybe FilePath) + +data BatchControlOptions = BatchControlOptions !HurlRunMode !PositiveInt !(Maybe Bool) !Bool + +data MatrixOutputOptions = MatrixOutputOptions !(Maybe FilePath) !Bool !OutputDiagnosticOptions + +data SuiteControlOptions = SuiteControlOptions !PositiveInt !(Maybe Bool) !Bool + +data SuiteReportOptions = SuiteReportOptions ![ReportFormat] !(Maybe FilePath) !Bool + +-- | Which entities @list@ prints. +data ListCategory + = AllCategories + | ParametersCategory + | FragmentsCategory + | WorkflowsCategory + | RecipesCategory + | MatricesCategory + | ChecksCategory + | ServicesCategory + | SuitesCategory + deriving stock (Generic, Eq, Ord, Show, Enum, Bounded) + +-- | Supported public shell-completion formats. +data CompletionShell = Bash | Zsh | Fish + deriving stock (Generic, Eq, Ord, Show, Enum, Bounded) + +allListCategories :: [ListCategory] +allListCategories = [minBound .. maxBound] + +-- | The command-line spelling of a category. +listCategoryName :: ListCategory -> Text +listCategoryName = \case + AllCategories -> "all" + ParametersCategory -> "parameters" + FragmentsCategory -> "fragments" + WorkflowsCategory -> "workflows" + RecipesCategory -> "recipes" + MatricesCategory -> "matrices" + ChecksCategory -> "checks" + ServicesCategory -> "services" + SuitesCategory -> "suites" + +parseListCategory :: String -> Either String ListCategory +parseListCategory raw = + case filter ((== Text.pack raw) . listCategoryName) allListCategories of + [category] -> Right category + _ -> + Left + ( "unknown category " + <> show raw + <> "; expected one of: " + <> Text.unpack (Text.intercalate ", " (map listCategoryName allListCategories)) + ) + +parserInfo :: ParserInfo Options +parserInfo = + info + (optionsParser <**> helper <**> versionOption) + ( fullDesc + <> header "hurl-workbench - compose, explore, and test reusable Hurl workflows" + <> progDesc "Keep each Hurl entry once, combine entries into named workflows, and validate the workspace that describes them." + ) + where + versionOption = infoOption versionText (long "version" <> help "Show package version and build revision") + +optionsParser :: Parser Options +optionsParser = Options <$> globalOptionsParser <*> commandParser + +globalOptionsParser :: Parser GlobalOptions +globalOptionsParser = + parserOptionGroup "Workspace" $ + GlobalOptions + <$> optional + ( strOption + ( long "workspace" + <> metavar "FILE" + <> help "Workspace manifest to use instead of discovering hurl-workbench.dhall from the current directory upward" + ) + ) + +commandParser :: Parser Command +commandParser = + hsubparser + ( command + "validate" + ( info + (pure ValidateCommand) + (progDesc "Check the workspace and report every problem at once") + ) + <> command + "list" + ( info + (ListCommand <$> listCategoryParser) + (progDesc "List the named entities in the workspace") + ) + <> command + "render" + ( info + renderCommandParser + (progDesc "Compose and syntax-check inspectable Hurl source") + ) + <> command + "run" + ( info + (executeCommandParser RunCommand) + (progDesc "Execute one workflow in Hurl client mode") + ) + <> command + "test" + ( info + testCommandParser + (progDesc "Execute one workflow, recipe, or integration suite in Hurl test mode") + ) + <> command + "matrix" + ( info + (MatrixCommand <$> matrixOptionsParser) + (progDesc "Execute every declared case in one named matrix") + ) + <> command + "completions" + ( info + (CompletionsCommand <$> completionShellParser) + (progDesc "Generate a completion script for Bash, Zsh, or Fish") + ) + <> command + "doctor" + ( info + (pure DoctorCommand) + (progDesc "Report Hurl and Hurlfmt paths, versions, and support status") + ) + ) + +completionShellParser :: Parser CompletionShell +completionShellParser = + argument + (eitherReader parseShell) + (metavar "SHELL" <> completeWith ["bash", "zsh", "fish"] <> help "One of bash, zsh, or fish") + where + parseShell = \case + "bash" -> Right Bash + "zsh" -> Right Zsh + "fish" -> Right Fish + other -> Left ("unknown shell " <> show other <> "; expected bash, zsh, or fish") + +renderCommandParser :: Parser Command +renderCommandParser = + hsubparser + ( command + "workflow" + ( info + (RenderCommand <$> renderOptionsParser (SelectWorkflow . WorkflowName . Text.pack)) + (progDesc "Render one named workflow") + ) + <> command + "recipe" + ( info + (RenderCommand <$> renderOptionsParser (SelectRecipe . RecipeName . Text.pack)) + (progDesc "Render the workflow selected by one named recipe") + ) + ) + +renderOptionsParser :: (String -> RunSelection) -> Parser RenderOptions +renderOptionsParser selectionConstructor = + RenderOptions + <$> (selectionConstructor <$> strArgument (metavar "NAME" <> help "Workflow or recipe name")) + <*> parserOptionGroup + "Output" + ( optional + ( strOption + ( long "output" + <> metavar "FILE" + <> help "Atomically replace FILE instead of writing Hurl source to stdout" + ) + ) + ) + <*> switch (long "explain" <> help "Print the recipe's binding sources to stderr without values") + +executeCommandParser :: (ExecuteOptions -> Command) -> Parser Command +executeCommandParser constructor = + hsubparser + ( command + "workflow" + ( info + (constructor <$> executeOptionsParser (SelectWorkflow . WorkflowName . Text.pack)) + (progDesc "Execute one unclassified low-level workflow") + ) + <> command + "recipe" + ( info + (constructor <$> executeOptionsParser (SelectRecipe . RecipeName . Text.pack)) + (progDesc "Execute one safety-classified recipe") + ) + ) + +testCommandParser :: Parser Command +testCommandParser = + hsubparser + ( command + "workflow" + ( info + (TestCommand <$> executeOptionsParser (SelectWorkflow . WorkflowName . Text.pack)) + (progDesc "Execute one unclassified low-level workflow") + ) + <> command + "recipe" + ( info + (TestCommand <$> executeOptionsParser (SelectRecipe . RecipeName . Text.pack)) + (progDesc "Execute one safety-classified recipe") + ) + <> command + "suite" + ( info + (SuiteCommand <$> suiteCommandOptionsParser) + (progDesc "Execute every run in one integration suite") + ) + ) + +executeOptionsParser :: (String -> RunSelection) -> Parser ExecuteOptions +executeOptionsParser selectionConstructor = + ExecuteOptions + <$> (selectionConstructor <$> strArgument (metavar "NAME" <> help "Workflow or recipe name")) + <*> bindingOptionsParser + <*> cliHurlOptionsParser + <*> parserOptionGroup + "Execution safety" + (switch (long "allow-mutating" <> help "Authorize this invocation to run a mutating recipe")) + +matrixOptionsParser :: Parser MatrixOptions +matrixOptionsParser = + assemble + <$> (MatrixName . Text.pack <$> strArgument (metavar "NAME" <> help "Matrix name")) + <*> batchControlOptionsParser + <*> bindingOptionsParser + <*> httpRetryOptionsParser + <*> matrixOutputOptionsParser + <*> fileRootParser + <*> advancedArgumentsParser + where + assemble + matrix + (BatchControlOptions mode jobs failFastOverride allowMutating) + bindings + http + (MatrixOutputOptions outputDirectory overwrite diagnostics) + root + additionalArguments = + MatrixOptions + { matrix, + mode, + jobs, + failFastOverride, + allowMutating, + outputDirectory, + overwrite, + bindings, + hurl = assembleCliHurlOptions http diagnostics root additionalArguments + } + +suiteCommandOptionsParser :: Parser SuiteCommandOptions +suiteCommandOptionsParser = + assemble + <$> (SuiteName . Text.pack <$> strArgument (metavar "NAME" <> help "Suite name")) + <*> suiteControlOptionsParser + <*> parserOptionGroup + "Service lifecycle" + (switch (long "external-service" <> help "Skip setup, managed services, and teardown; suites with lifecycle steps are refused")) + <*> optional (strOption (long "scenario-inputs" <> metavar "FILE" <> help "Private per-scenario fixture and endpoint assignments")) + <*> suiteReportOptionsParser + <*> bindingOptionsParser + <*> httpRetryOptionsParser + <*> outputDiagnosticOptionsParser + <*> fileRootParser + <*> advancedArgumentsParser + where + assemble + suite + (SuiteControlOptions jobs failFastOverride allowMutating) + externalService + scenarioInputsFile + (SuiteReportOptions reportFormats reportDirectory overwrite) + bindings + http + diagnostics + root + additionalArguments = + SuiteCommandOptions + { suite, + jobs, + failFastOverride, + allowMutating, + externalService, + scenarioInputsFile, + reportFormats, + reportDirectory, + overwrite, + bindings, + hurl = assembleCliHurlOptions http diagnostics root additionalArguments + } + +suiteControlOptionsParser :: Parser SuiteControlOptions +suiteControlOptionsParser = + parserOptionGroup "Suite control" $ + SuiteControlOptions + <$> option + (eitherReader parsePositiveInt) + (long "jobs" <> metavar "N" <> value oneJob <> help "Maximum concurrent Hurl processes (default: 1)") + <*> optional + ( flag' True (long "fail-fast" <> help "Stop scheduling after the first observed failure") + <|> flag' False (long "keep-going" <> help "Run every case despite failures") + ) + <*> switch (long "allow-mutating" <> help "Authorize mutating and unclassified runs in this invocation") + +suiteReportOptionsParser :: Parser SuiteReportOptions +suiteReportOptionsParser = + parserOptionGroup "Reports" $ + SuiteReportOptions + <$> many + ( option + (eitherReader parseReportFormat) + (long "report" <> metavar "junit|html|json|tap" <> help "Emit one isolated report of this format per expanded run; repeat for several formats") + ) + <*> optional + (strOption (long "report-dir" <> metavar "DIR" <> help "Write reports and summary.json beneath DIR/SUITE (required for checks)")) + <*> switch (long "overwrite" <> help "Replace only the selected suite subtree beneath --report-dir") + +batchControlOptionsParser :: Parser BatchControlOptions +batchControlOptionsParser = + parserOptionGroup "Batch control" $ + BatchControlOptions + <$> option + (eitherReader parseMode) + (long "mode" <> metavar "run|test" <> value ClientMode <> help "Use Hurl client mode (run) or test mode") + <*> option + (eitherReader parsePositiveInt) + (long "jobs" <> metavar "N" <> value oneJob <> help "Maximum concurrent Hurl processes (default: 1)") + <*> optional + ( flag' True (long "fail-fast" <> help "Stop scheduling after the first observed failure") + <|> flag' False (long "keep-going" <> help "Run every case despite failures") + ) + <*> switch (long "allow-mutating" <> help "Authorize every mutating case in this invocation") + +matrixOutputOptionsParser :: Parser MatrixOutputOptions +matrixOutputOptionsParser = + parserOptionGroup "Output" $ + MatrixOutputOptions + <$> optional + ( strOption + (long "output-dir" <> metavar "DIR" <> help "Write one owner-only client response artifact per case") + ) + <*> switch (long "overwrite" <> help "Replace the exact response artifacts for this batch") + <*> outputDiagnosticOptionsFields + +bindingOptionsParser :: Parser BindingOptions +bindingOptionsParser = + parserOptionGroup "Bindings" $ + BindingOptions + <$> many + ( Text.pack + <$> strOption + ( long "variable" + <> metavar "NAME=VALUE" + <> help "Set one plain workflow parameter; repeat for several parameters" + ) + ) + <*> many + ( strOption + ( long "variables-file" + <> metavar "FILE" + <> help "Load plain parameters from a Hurl properties file; later files win" + ) + ) + <*> many + ( Text.pack + <$> strOption + ( long "secret-env" + <> metavar "NAME=ENVIRONMENT_NAME" + <> help "Read a secret parameter from the named environment variable" + ) + ) + <*> many + ( strOption + ( long "secrets-file" + <> metavar "FILE" + <> help "Load secret parameters from a Hurl secrets file; later files win" + ) + ) + +cliHurlOptionsParser :: Parser CliHurlOptions +cliHurlOptionsParser = assembleCliHurlOptions <$> httpRetryOptionsParser <*> outputDiagnosticOptionsParser <*> fileRootParser <*> advancedArgumentsParser + +assembleCliHurlOptions :: HttpRetryOptions -> OutputDiagnosticOptions -> Maybe FilePath -> [Text] -> CliHurlOptions +assembleCliHurlOptions + (HttpRetryOptions connectTimeout maxTime retries retryInterval insecure) + (OutputDiagnosticOptions include json verbosity curl) + root + additional = + CliHurlOptions + { connectTimeoutSeconds = connectTimeout, + maxTimeSeconds = maxTime, + retryCount = retries, + retryIntervalMilliseconds = retryInterval, + insecureTls = insecure, + includeHeaders = include, + jsonOutput = json, + verbosity, + fileRoot = root, + curlExportPath = curl, + additionalArguments = additional + } + +httpRetryOptionsParser :: Parser HttpRetryOptions +httpRetryOptionsParser = + parserOptionGroup "HTTP and retry" $ + HttpRetryOptions + <$> optional (integerOption "connect-timeout" "SECONDS" "Maximum connection time in seconds") + <*> optional (integerOption "max-time" "SECONDS" "Maximum transfer time in seconds") + <*> optional (integerOption "retry" "NUM" "Maximum retry count") + <*> optional (integerOption "retry-interval" "MILLISECONDS" "Delay between retries in milliseconds") + <*> switch (long "insecure" <> help "Allow insecure TLS connections") + +outputDiagnosticOptionsParser :: Parser OutputDiagnosticOptions +outputDiagnosticOptionsParser = + parserOptionGroup "Output and diagnostics" outputDiagnosticOptionsFields + +outputDiagnosticOptionsFields :: Parser OutputDiagnosticOptions +outputDiagnosticOptionsFields = + OutputDiagnosticOptions + <$> switch (long "include" <> help "Include response headers in client output") + <*> switch (long "json" <> help "Emit JSON output where Hurl supports it") + <*> optional + ( flag' Verbose (long "verbose" <> help "Enable Hurl verbose diagnostics") + <|> flag' VeryVerbose (long "very-verbose" <> help "Enable Hurl and libcurl debug diagnostics") + ) + <*> optional + ( strOption + ( long "curl" + <> metavar "FILE" + <> help "Export requests as curl commands to an owner-only file" + ) + ) + +advancedArgumentsParser :: Parser [Text] +advancedArgumentsParser = + parserOptionGroup "Advanced Hurl arguments" $ + many + ( Text.pack + <$> strOption + ( long "hurl-arg" + <> metavar "FLAG" + <> help "Pass one audited zero-argument Hurl flag" + ) + ) + +integerOption :: String -> String -> String -> Parser Int +integerOption name valueName description = + option auto (long name <> metavar valueName <> help description) + +parseMode :: String -> Either String HurlRunMode +parseMode = \case + "run" -> Right ClientMode + "test" -> Right TestMode + other -> Left ("unknown matrix mode " <> show other <> "; expected run or test") + +parsePositiveInt :: String -> Either String PositiveInt +parsePositiveInt raw = case readMaybe raw of + Nothing -> Left ("expected a positive integer, got " <> show raw) + Just parsedValue -> case mkPositiveInt parsedValue of + Left _ -> Left ("expected a positive integer, got " <> show raw) + Right positive -> Right positive + +parseReportFormat :: String -> Either String ReportFormat +parseReportFormat = \case + "junit" -> Right JUnit + "html" -> Right Html + "json" -> Right Json + "tap" -> Right Tap + other -> Left ("unknown report format " <> show other <> "; expected junit, html, json, or tap") + +oneJob :: PositiveInt +oneJob = case mkPositiveInt 1 of + Right positive -> positive + Left _ -> error "one is positive" + +listCategoryParser :: Parser ListCategory +listCategoryParser = + argument + (eitherReader parseListCategory) + ( metavar "CATEGORY" + <> value AllCategories + <> completeWith (map (Text.unpack . listCategoryName) allListCategories) + <> help "One of all, parameters, fragments, workflows, recipes, matrices, checks, services, suites (default: all)" + ) + +fileRootParser :: Parser (Maybe FilePath) +fileRootParser = parserOptionGroup "Request body files" $ optional (strOption (long "file-root" <> metavar "DIR" <> help "Read file request bodies from a caller-owned directory (relative to invocation)")) diff --git a/src/HurlWorkbench/Cli/Output.hs b/src/HurlWorkbench/Cli/Output.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Output.hs @@ -0,0 +1,51 @@ +-- | Command results as data, so commands can be tested without capturing +-- process handles, plus a small aligned-table renderer. +module HurlWorkbench.Cli.Output + ( CommandResult (..), + success, + failure, + emitResult, + renderTable, + plural, + ) +where + +import Data.Text qualified as Text +import Data.Text.IO qualified as Text.IO +import HurlWorkbench.Prelude +import System.Exit (ExitCode (..), exitWith) +import System.IO (stderr) + +-- | What a command prints and how the process exits. +data CommandResult = CommandResult + { stdoutLines :: ![Text], + stderrLines :: ![Text], + exitCode :: !ExitCode + } + deriving stock (Generic, Eq, Show) + +success :: [Text] -> CommandResult +success out = CommandResult {stdoutLines = out, stderrLines = [], exitCode = ExitSuccess} + +-- | Workbench failures (discovery, decoding, validation) exit with status 1. +failure :: [Text] -> CommandResult +failure err = CommandResult {stdoutLines = [], stderrLines = err, exitCode = ExitFailure 1} + +emitResult :: CommandResult -> IO () +emitResult CommandResult {stdoutLines, stderrLines, exitCode} = do + traverse_ Text.IO.putStrLn stdoutLines + traverse_ (Text.IO.hPutStrLn stderr) stderrLines + when (exitCode /= ExitSuccess) (exitWith exitCode) + +-- | Left-aligned columns separated by two spaces; empty cells print as @-@. +renderTable :: [Text] -> [[Text]] -> [Text] +renderTable headings rows = + map renderRow (headings : map (map orDash) rows) + where + orDash cell = if Text.null cell then "-" else cell + widths = foldr (zipWith max . map Text.length) (map (const 0) headings) (headings : map (map orDash) rows) + renderRow cells = Text.stripEnd (Text.intercalate " " (zipWith (`Text.justifyLeft` ' ') widths cells)) + +-- | @plural 2 "recipe" "recipes"@ is @2 recipes@. +plural :: Int -> Text -> Text -> Text +plural n one many = Text.pack (show n) <> " " <> (if n == 1 then one else many) diff --git a/src/HurlWorkbench/Cli/Version.hs b/src/HurlWorkbench/Cli/Version.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Version.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | Build identity shown by @--version@. +module HurlWorkbench.Cli.Version + ( versionText, + revisionText, + ) +where + +import Data.Version (showVersion) +import GitHash qualified +import Paths_hurl_workbench_cli qualified as Package + +-- | The package version followed by the short build revision. +versionText :: String +versionText = "hurl-workbench " <> showVersion Package.version <> " (" <> revisionText <> ")" + +-- | Prefer the reproducible revision injected by Nix. Local builds fall back +-- to the repository revision captured by Template Haskell; source archives +-- without either form of metadata remain buildable. +revisionText :: String +#ifdef GIT_HASH +revisionText = take 7 GIT_HASH +#else +revisionText = + revisionFromGitInfo $$(GitHash.tGitInfoCwdTry) + +revisionFromGitInfo :: Either String GitHash.GitInfo -> String +revisionFromGitInfo = \case + Right gitInfo -> take 7 (GitHash.giHash gitInfo) + Left _ -> "unknown" +#endif diff --git a/src/HurlWorkbench/Cli/Workspace.hs b/src/HurlWorkbench/Cli/Workspace.hs new file mode 100644 --- /dev/null +++ b/src/HurlWorkbench/Cli/Workspace.hs @@ -0,0 +1,43 @@ +-- | Load and validate the workspace once for every command. Command +-- handlers receive only a 'ValidatedWorkspace'. +module HurlWorkbench.Cli.Workspace + ( loadValidatedWorkspace, + withValidatedWorkspace, + renderIssueReport, + ) +where + +import Data.Generics.Labels () +import Data.Text qualified as Text +import HurlWorkbench.Cli.Options (GlobalOptions) +import HurlWorkbench.Cli.Output (CommandResult, failure, plural) +import HurlWorkbench.Prelude +import HurlWorkbench.Workspace.Context (ValidatedWorkspace, WorkspaceContext, loadWorkspaceContext) +import HurlWorkbench.Workspace.Discover (discoverWorkspace) +import HurlWorkbench.Workspace.Error (renderWorkspaceError) +import HurlWorkbench.Workspace.Validate (ValidationIssue, renderValidationIssue, validateWorkspace) + +-- | Discover, decode, and validate. The start directory is the process's +-- current directory, passed explicitly so tests can choose it. +loadValidatedWorkspace :: GlobalOptions -> FilePath -> IO (Either [Text] ValidatedWorkspace) +loadValidatedWorkspace options currentDirectory = do + discovered <- discoverWorkspace (options ^. #workspace) currentDirectory + case discovered of + Left err -> pure (Left ["error: " <> renderWorkspaceError err]) + Right source -> + loadWorkspaceContext source >>= \case + Left err -> pure (Left ["error: " <> renderWorkspaceError err]) + Right context -> + validateWorkspace context <&> \case + Left issues -> Left (renderIssueReport context issues) + Right validated -> Right validated + +withValidatedWorkspace :: GlobalOptions -> FilePath -> (ValidatedWorkspace -> CommandResult) -> IO CommandResult +withValidatedWorkspace options currentDirectory handler = + either failure handler <$> loadValidatedWorkspace options currentDirectory + +renderIssueReport :: WorkspaceContext -> NonEmpty ValidationIssue -> [Text] +renderIssueReport context issues = + ["Invalid workspace: " <> Text.pack (context ^. #manifestPath)] + <> map ((" " <>) . renderValidationIssue) (toList issues) + <> [plural (length issues) "issue" "issues" <> " found"] diff --git a/test/CheckTest.hs b/test/CheckTest.hs new file mode 100644 --- /dev/null +++ b/test/CheckTest.hs @@ -0,0 +1,208 @@ +module CheckTest (tests) where + +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (cancel, waitCatch, withAsync) +import Control.Concurrent.MVar (MVar, newMVar, withMVar) +import Data.Generics.Labels () +import Data.Text qualified as Text +import Data.Text.IO qualified as Text.IO +import HurlWorkbench.Cli (runCommandWithDependencies) +import HurlWorkbench.Cli.Options +import HurlWorkbench.Cli.Output +import HurlWorkbench.Hurl.Capabilities +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Prelude +import Network.HTTP.Types (status200) +import Network.Wai (Application, pathInfo, responseLBS) +import Network.Wai.Handler.Warp (testWithApplication) +import Options.Applicative (ParserResult (..), defaultPrefs, execParserPure) +import System.Directory (canonicalizePath, doesFileExist, removeFile) +import System.Exit (ExitCode (..)) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import System.Posix.Files (setFileMode) +import System.Timeout qualified as Timeout +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = + testGroup + "public executable checks" + [ testCase "jobs=2 drains both sides, lists checks and uses private artifacts" $ + fixture $ \root manifest -> do + result <- invoke root manifest "ordered" [] + result ^. #exitCode @?= ExitSuccess + events <- Text.lines <$> Text.IO.readFile (root "events") + let before = ["before1-end", "before2-end"] + after = ["after1-start", "after2-start"] + position label = length (takeWhile (/= label) events) + assertBool "barrier after both earlier ends" (all ((< position "check") . position) before) + assertBool "barrier before both later starts" (all ((> position "check") . position) after) + summary <- Text.IO.readFile (root "reports" "ordered" "summary.json") + for_ ["\"kind\":\"check\"", "\"name\":\"parity\"", "checks/parity/stdout"] $ \part -> assertBool "named summary" (part `Text.isInfixOf` summary) + let ordinary = Text.unlines (result ^. #stderrLines) <> summary + assertBool "sensitive output absent" (not ("secret-sentinel" `Text.isInfixOf` ordinary)) + Text.IO.readFile (root "reports" "ordered" "checks" "parity" "stdout") >>= (\captured -> assertBool "private output retained" ("secret-sentinel" `Text.isInfixOf` captured)) + listed <- command root manifest ["list", "checks"] + listed ^. #exitCode @?= ExitSuccess + assertBool "check category" ("parity" `Text.isInfixOf` Text.unlines (listed ^. #stdoutLines)) + repeated <- invoke root manifest "ordered" [] + repeated ^. #exitCode @?= ExitFailure 2, + testCase "status mismatch keeps going, fail-fast skips later Hurl and named checks" $ + fixture $ \root manifest -> do + mismatch <- invoke root manifest "mismatch" [] + mismatch ^. #exitCode @?= ExitFailure 7 + Text.lines <$> Text.IO.readFile (root "events") >>= (\events -> assertBool "keep-going" ("after1-end" `elem` events)) + writeFile (root "events") "" + stopped <- invoke root manifest "mismatch" ["--fail-fast", "--overwrite"] + stopped ^. #exitCode @?= ExitFailure 7 + events <- Text.lines <$> Text.IO.readFile (root "events") + assertBool "later Hurl skipped" (not ("after1-start" `elem` events)) + summary <- Text.IO.readFile (root "reports" "mismatch" "summary.json") + assertBool "explicit later check skip" ("skipped-fail-fast" `Text.isInfixOf` summary) + assertBool "named mismatch" ("\"actualStatus\":7" `Text.isInfixOf` summary), + testCase "ordinary failures use declaration order and a later spawn failure retains exit 3 priority" $ + fixture $ \root manifest -> do + firstHurl <- invoke root manifest "hurl-first" [] + firstHurl ^. #exitCode @?= ExitFailure 4 + firstCheck <- invoke root manifest "check-first" [] + firstCheck ^. #exitCode @?= ExitFailure 7 + spawnFailure <- invoke root manifest "spawn-race" [] + spawnFailure ^. #exitCode @?= ExitFailure 3, + testCase "checks-only supports expected nonzero and missing reports refuse before execution" $ + fixture $ \root manifest -> do + missing <- command root manifest ["test", "suite", "only", "--secrets-file", root "secrets"] + missing ^. #exitCode @?= ExitFailure 2 + doesFileExist (root "events") >>= (@?= False) + result <- invoke root manifest "only" [] + result ^. #exitCode @?= ExitSuccess, + testCase "late missing environment rejects whole suite before setup or Hurl" $ + fixture $ \root manifest -> do + result <- invoke root manifest "late" [] + result ^. #exitCode @?= ExitFailure 3 + doesFileExist (root "events") >>= (@?= False), + testCase "a check failure still tears down services before teardown" $ + fixture $ \root manifest -> do + result <- invoke root manifest "managed-failure" [] + result ^. #exitCode @?= ExitFailure 7 + events <- Text.lines <$> Text.IO.readFile (root "events") + drop (length events - 2) events @?= ["service-stop", "teardown"], + testCase "service death cancels a check, preserves both failures and tears down" $ + fixture $ \root manifest -> do + result <- bounded (invoke root manifest "service-death" []) + result ^. #exitCode @?= ExitFailure 4 + events <- Text.lines <$> Text.IO.readFile (root "events") + last events @?= "teardown" + summary <- Text.IO.readFile (root "reports" "service-death" "summary.json") + assertBool "check interruption retained" ("\"status\":\"cancelled\"" `Text.isInfixOf` summary) + assertBool "service failure retained" ("\"service\":\"failed\"" `Text.isInfixOf` summary), + testCase "timeout cleans the check before later Hurl; cancellation writes partial summary" $ + fixture $ \root manifest -> do + result <- bounded (invoke root manifest "timeout" []) + result ^. #exitCode @?= ExitFailure 124 + events <- Text.lines <$> Text.IO.readFile (root "events") + assertBool "keep-going after timeout" ("after1-end" `elem` events) + withAsync (invoke root manifest "cancel" []) $ \worker -> do + bounded (waitFor (root "cancel-started")) + bounded (cancel worker) + waitCatch worker >>= \case Left _ -> pure (); Right _ -> assertFailure "cancel swallowed" + summary <- Text.IO.readFile (root "reports" "cancel" "summary.json") + assertBool "cancelled summary" ("\"status\":\"cancelled\"" `Text.isInfixOf` summary) + ] + +command :: FilePath -> FilePath -> [String] -> IO CommandResult +command root manifest args = case execParserPure defaultPrefs parserInfo args of + Success options -> runCommandWithDependencies detectHurlfmtCapabilities detectHurlCapabilities validateRenderedWorkflow (\_ _ -> pure (Right [])) (GlobalOptions (Just manifest)) root (options ^. #cmd) + _ -> assertFailure ("parse failed: " <> show args) + +invoke :: FilePath -> FilePath -> String -> [String] -> IO CommandResult +invoke root manifest suite extra = command root manifest (["test", "suite", suite, "--jobs", "2", "--report-dir", root "reports", "--secrets-file", root "secrets"] <> extra) + +fixture :: (FilePath -> FilePath -> IO a) -> IO a +fixture action = withSystemTempDirectory "check-cli" $ \directory -> do + root <- canonicalizePath directory + schema <- canonicalizePath "schema/package.dhall" + Text.IO.writeFile (root "check.py") checkScript + Text.IO.writeFile (root "service.py") serviceScript + setFileMode (root "check.py") 0o700 + writeFile (root "secrets") "token=secret-sentinel\n" + setFileMode (root "secrets") 0o600 + lock <- newMVar () + testWithApplication (pure (application lock root)) $ \port -> do + for_ ["before1", "before2", "after1", "after2", "fail", "remove"] $ \name -> + Text.IO.writeFile (root name <> ".hurl") ("GET http://127.0.0.1:" <> Text.pack (show port) <> "/" <> Text.pack name <> (if name == "fail" then "\nHTTP 201\n" else "\nHTTP 200\n")) + let manifest = root "hurl-workbench.dhall" + Text.IO.writeFile manifest (source (Text.pack schema)) + action root manifest + +application :: MVar () -> FilePath -> Application +application lock root request respond = do + let label = Text.unpack (Text.intercalate "/" (pathInfo request)) + withMVar lock $ \_ -> appendFile (root "events") (label <> "-start\n") + when (label == "remove") (removeFile (root "check.py")) + threadDelay 60000 + withMVar lock $ \_ -> appendFile (root "events") (label <> "-end\n") + respond (responseLBS status200 [] "ok") + +source :: Text -> Text +source schema = + Text.unlines + [ "let S = " <> schema, + "let check = \\(name : Text) -> \\(mode : Text) -> S.Check::{name = name, command = S.CommandSpec::{executable = \"check.py\", arguments = [mode, \"{{value}}\"], environmentPolicy = S.EnvironmentPolicy.Clean [\"PATH\"], environment = [ {variable = \"TOKEN\", parameter = \"token\"} ] }}", + "let phase = S.CommandSpec::{executable = \"python3\", arguments = [\"-c\", \"open('events','a').write('teardown\\\\n')\"]}", + "let managed = \\(name : Text) -> \\(run : S.RunReference) -> S.Suite::{name = name, services = [\"server\"], teardown = [phase], runs = [run]}", + "in S.Workspace::{schemaVersion = 1,", + " parameters = [ S.Parameter::{name = \"value\", defaultValue = Some \"one argument\"}, S.Parameter::{name = \"token\", kind = S.ParameterKind.Secret} ],", + " fragments = [" <> Text.intercalate "," ["S.Fragment::{name = \"" <> n <> "\", path = \"" <> n <> ".hurl\"}" | n <- names] <> "],", + " workflows = [" <> Text.intercalate "," ["S.Workflow::{name = \"" <> n <> "\", fragments = [\"" <> n <> "\"]}" | n <- names] <> "],", + " recipes = [" <> Text.intercalate "," ["S.Recipe::{name = \"" <> n <> "\", workflow = \"" <> n <> "\", safety = S.Safety.ReadOnly}" | n <- names] <> "],", + " checks = [check \"parity\" \"0\", check \"mismatch\" \"7\", check \"expected\" \"7\" // {expectedStatus = 7}, check \"later\" \"0\", check \"death\" \"death\", check \"timeout\" \"timeout\" // {timeoutSeconds = Some 1}, check \"cancel\" \"cancel\", (check \"bad\" \"0\") with command.environmentPolicy = S.EnvironmentPolicy.Clean [\"HURL_WORKBENCH_ABSENT_CHECK_65182\"] ],", + " services = [ S.Service::{name = \"server\", command = S.CommandSpec::{executable = \"python3\", arguments = [\"service.py\"]}, readiness = S.Readiness.Command S.CommandReadiness::{command = S.CommandSpec::{executable = \"python3\", arguments = [\"-c\", \"import os; raise SystemExit(0 if os.path.exists('ready') else 1)\"]}}, shutdownTimeoutSeconds = 1} ],", + " suites = [ S.Suite::{name = \"ordered\", runs = [S.RunReference.Recipe \"before1\", S.RunReference.Recipe \"before2\", S.RunReference.Check \"parity\", S.RunReference.Recipe \"after1\", S.RunReference.Recipe \"after2\"]},", + " S.Suite::{name = \"mismatch\", runs = [S.RunReference.Recipe \"before1\", S.RunReference.Check \"mismatch\", S.RunReference.Recipe \"after1\", S.RunReference.Check \"later\"]},", + " S.Suite::{name = \"only\", runs = [S.RunReference.Check \"expected\"]},", + " S.Suite::{name = \"late\", runs = [S.RunReference.Recipe \"before1\", S.RunReference.Check \"bad\"]},", + " S.Suite::{name = \"hurl-first\", runs = [S.RunReference.Recipe \"fail\", S.RunReference.Check \"mismatch\"]},", + " S.Suite::{name = \"check-first\", runs = [S.RunReference.Check \"mismatch\", S.RunReference.Recipe \"fail\"]},", + " S.Suite::{name = \"spawn-race\", runs = [S.RunReference.Recipe \"fail\", S.RunReference.Recipe \"remove\", S.RunReference.Check \"mismatch\"]},", + " managed \"managed-failure\" (S.RunReference.Check \"mismatch\"), managed \"service-death\" (S.RunReference.Check \"death\"),", + " S.Suite::{name = \"timeout\", runs = [S.RunReference.Check \"timeout\", S.RunReference.Recipe \"after1\"]}, S.Suite::{name = \"cancel\", runs = [S.RunReference.Check \"cancel\"]} ] }" + ] + where + names = ["before1", "before2", "after1", "after2", "fail", "remove"] + +checkScript :: Text +checkScript = + Text.unlines + [ "#!/usr/bin/env python3", + "import os, sys, time", + "assert len(sys.argv) == 3 and sys.argv[2] == 'one argument'", + "assert not any(key.startswith(('REI_', 'MORI_', 'PG')) for key in os.environ)", + "assert os.environ['TOKEN'] == 'secret-sentinel'", + "print(os.environ['TOKEN'], flush=True)", + "with open('events','a') as f: f.write('check\\n')", + "if sys.argv[1] == 'death': open('die','w').close()", + "if sys.argv[1] == 'cancel': open('cancel-started','w').close()", + "if sys.argv[1] in ('death','cancel','timeout'): time.sleep(30)", + "raise SystemExit(int(sys.argv[1]))" + ] + +serviceScript :: Text +serviceScript = + Text.unlines + [ "import signal, os, time", + "def stop(*args):", + " with open('events','a') as f: f.write('service-stop\\n')", + " raise SystemExit(0)", + "signal.signal(signal.SIGTERM, stop)", + "open('ready','w').close()", + "while not os.path.exists('die'): time.sleep(0.01)", + "raise SystemExit(9)" + ] + +bounded :: IO a -> IO a +bounded action = Timeout.timeout 15000000 action >>= maybe (assertFailure "suite exceeded time bound") pure + +waitFor :: FilePath -> IO () +waitFor path = doesFileExist path >>= \exists -> unless exists (threadDelay 5000 >> waitFor path) diff --git a/test/FileRootTest.hs b/test/FileRootTest.hs new file mode 100644 --- /dev/null +++ b/test/FileRootTest.hs @@ -0,0 +1,177 @@ +module FileRootTest (tests) where + +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (cancel, concurrently, waitCatch, withAsync) +import Control.Exception (bracket_) +import Data.ByteString qualified as Bytes +import Data.ByteString.Lazy (fromStrict) +import Data.Generics.Labels () +import Data.IORef +import Data.Map.Strict qualified as Map +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Encoding +import Data.Text.IO qualified as Text.IO +import HurlWorkbench.Cli (runCommandWithDependencies) +import HurlWorkbench.Cli.Options +import HurlWorkbench.Cli.Output +import HurlWorkbench.Hurl.Capabilities +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Prelude +import Network.HTTP.Types (status201) +import Network.Wai (pathInfo, responseLBS, strictRequestBody) +import Network.Wai.Handler.Warp (testWithApplication) +import Options.Applicative (CompletionResult (..), ParserResult (..), defaultPrefs, execParserPure, renderFailure) +import System.Directory (canonicalizePath, copyFile, createDirectory, createDirectoryLink, listDirectory, removeDirectoryRecursive) +import System.Exit (ExitCode (..)) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import System.Posix.Files (fileMode, getFileStatus, setFileMode) +import System.Posix.User (getEffectiveUserID) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) + +parsed :: [String] -> IO Command +parsed args = case execParserPure defaultPrefs parserInfo args of + Success options -> pure (options ^. #cmd) + _ -> assertFailure ("parse failed: " <> show args) + +invoke :: FilePath -> FilePath -> IO (Either DependencyError HurlCapabilities) -> [String] -> IO CommandResult +invoke manifest cwd detect args = do + command <- parsed args + runCommandWithDependencies (fmap (fmap (view #hurlfmt)) detect) detect validateRenderedWorkflow (\_ _ -> pure (Right [])) (GlobalOptions (Just manifest)) cwd command + +createWorkspace :: FilePath -> IO FilePath +createWorkspace directory = do + schema <- canonicalizePath "schema/package.dhall" + source <- Text.IO.readFile "examples/file-body/hurl-workbench.dhall" + let manifest = directory "hurl-workbench.dhall" + Text.IO.writeFile manifest (Text.replace "../../schema/package.dhall" (Text.pack schema) source) + copyFile "examples/file-body/request.hurl" (directory "request.hurl") + pure manifest + +tests :: TestTree +tests = + testGroup + "caller-owned file roots" + [ testCase "option is execution-only, rejects duplicates, and appears in help/completion" $ do + for_ [["run", "workflow", "send-body"], ["test", "recipe", "send-body"], ["matrix", "bodies"], ["test", "suite", "bodies"]] $ \prefix -> do + void (parsed (prefix <> ["--file-root", "private"])) + case execParserPure defaultPrefs parserInfo (prefix <> ["--help"]) of + Failure failure -> assertBool "help describes file root" ("--file-root" `Text.isInfixOf` Text.pack (fst (renderFailure failure "workbench"))) + _ -> assertFailure "missing execution help" + case execParserPure defaultPrefs parserInfo (["--bash-completion-index", show (length prefix + 1), "--bash-completion-word", "hurl-workbench"] <> concatMap (\word -> ["--bash-completion-word", word]) prefix <> ["--bash-completion-word", "--file-"]) of + CompletionInvoked (CompletionResult complete) -> complete "hurl-workbench" >>= assertBool "offers file-root completion" . Text.isInfixOf "--file-root" . Text.pack + _ -> assertFailure "file-root completion protocol unavailable" + case execParserPure defaultPrefs parserInfo (prefix <> ["--file-root", "one", "--file-root", "two"]) of + Failure _ -> pure () + _ -> assertFailure "duplicate file root accepted" + for_ [["render", "workflow", "send-body"], ["validate"]] $ \prefix -> + case execParserPure defaultPrefs parserInfo (prefix <> ["--file-root", "private"]) of + Failure _ -> pure () + _ -> assertFailure "inspection accepted execution option", + testCase "invalid roots and overlaps refuse before injected dependency or formatter work" $ + withSystemTempDirectory "file-root-preflight" $ \directory -> do + manifest <- createWorkspace directory + let body = directory "body" + failProbe = assertFailure "dependency detection ran before file-root validation" + selections = [["run", "workflow", "send-body"], ["test", "workflow", "send-body"], ["run", "recipe", "send-body"], ["test", "recipe", "send-body"], ["matrix", "bodies"], ["test", "suite", "bodies"]] + writeFile (directory "regular") "payload" + createDirectory body + for_ ["missing", "regular", ""] $ \bad -> for_ selections $ \prefix -> do + result <- invoke manifest directory failProbe (prefix <> ["--file-root", if null bad then "" else directory bad]) + result ^. #exitCode @?= ExitFailure 2 + uid <- getEffectiveUserID + when (uid /= 0) $ for_ [0o300, 0o600] $ \mode -> bracket_ (setFileMode body mode) (setFileMode body 0o700) $ + for_ selections $ + \prefix -> invoke manifest directory failProbe (prefix <> ["--file-root", body]) >>= (\result -> result ^. #exitCode @?= ExitFailure 2) + for_ [["matrix", "bodies", "--output-dir", body "output", "--overwrite"], ["test", "suite", "bodies", "--report-dir", directory, "--overwrite"], ["test", "workflow", "send-body", "--curl", body "curl"]] $ \args -> do + result <- invoke manifest directory failProbe (args <> ["--file-root", body]) + result ^. #exitCode @?= ExitFailure 2, + testCase "static parameter validation rejects unknown, Secret, and Generated references even with CLI override" $ + withSystemTempDirectory "file-root-static" $ \directory -> do + manifest <- createWorkspace directory + source <- Text.IO.readFile manifest + for_ [Text.replace "Some \"payloadRoot\"" "Some \"unknown\"" source, Text.replace "name = \"payloadRoot\"" "name = \"payloadRoot\", kind = S.ParameterKind.Secret" source, Text.replace "name = \"payloadRoot\"" "name = \"payloadRoot\", kind = S.ParameterKind.Generated S.Generator.Uuid4" source] $ \bad -> do + Text.IO.writeFile manifest bad + result <- invoke manifest directory (assertFailure "invalid manifest started a probe") ["test", "suite", "parameter", "--file-root", directory] + result ^. #exitCode @?= ExitFailure 2, + testCase "real Hurl delivers exact bytes across execution paths, concurrent roots, failure, and cancellation" $ do + capabilities <- detectHurlCapabilities >>= either (assertFailure . Text.unpack . renderDependencyError) pure + received <- newIORef Map.empty + slowStarted <- newIORef False + let app request respond = do + bytes <- strictRequestBody request + atomicModifyIORef' received (\values -> (Map.insert (pathInfo request) bytes values, ())) + when ("slow" `elem` pathInfo request) $ writeIORef slowStarted True >> threadDelay 10000000 + respond (responseLBS status201 [] bytes) + testWithApplication (pure app) $ \port -> withSystemTempDirectory "file-root-live" $ \directory -> do + let ws = directory "workspace" + first = directory "root 雪 sentinel" + second = directory "second root" + nested = ws "nested" + one = "{\"payload-sentinel\":\"雪\"}\r\n" + two = "{\"payload-sentinel\":\"別\"}" + url label = "baseUrl=http://127.0.0.1:" <> show port <> "/" <> label + run args = invoke (ws "hurl-workbench.dhall") nested (pure (Right capabilities)) args + successful args = run args >>= \result -> assertBool (show (result ^. #stderrLines)) (result ^. #exitCode == ExitSuccess) + capture label expected = readIORef received >>= \values -> Map.lookup [Text.pack label, "mutating"] values @?= Just expected + snapshot root = do + names <- listDirectory root + files <- for names $ \name -> (name,,) <$> Bytes.readFile (root name) <*> (fileMode <$> getFileStatus (root name)) + mode <- fileMode <$> getFileStatus root + pure (mode, files) + traverse_ createDirectory [ws, first, second] + createDirectory nested + _ <- createWorkspace ws + Bytes.writeFile (first "request.json") (Encoding.encodeUtf8 one) + Bytes.writeFile (second "request.json") (Encoding.encodeUtf8 two) + Bytes.writeFile (ws "request.json") "workspace fallback\n" + createDirectoryLink first (directory "alias") + beforeSecond <- snapshot second + sourceBytes <- traverse (Bytes.readFile . (ws )) ["request.hurl", "hurl-workbench.dhall", "request.json"] + before <- snapshot first + rendered <- run ["render", "workflow", "send-body"] + rendered ^. #exitCode @?= ExitSuccess + original <- Text.IO.readFile (ws "request.hurl") + Text.unlines (rendered ^. #stdoutLines) @?= original + inspected <- run ["validate"] + inspected ^. #exitCode @?= ExitSuccess + let firstRoot = ["--file-root", "../../alias"] + for_ [["run", "workflow", "send-body"], ["test", "workflow", "send-body"], ["run", "recipe", "send-body", "--allow-mutating"], ["test", "recipe", "send-body", "--allow-mutating"], ["matrix", "bodies", "--allow-mutating", "--output-dir", directory "matrix"], ["test", "suite", "bodies", "--allow-mutating", "--report-dir", directory "reports"]] $ \prefix -> do + successful (prefix <> firstRoot <> ["--variable", url "one"]) + capture "one" (fromStrict (Encoding.encodeUtf8 one)) + let command root label = ["matrix", "bodies", "--allow-mutating", "--file-root", root, "--output-dir", directory label, "--variable", url label] + void (concurrently (successful (command first "a")) (successful (command second "b"))) + capture "a" (fromStrict (Encoding.encodeUtf8 one)) + capture "b" (fromStrict (Encoding.encodeUtf8 two)) + successful ["test", "workflow", "send-body", "--variable", url "fallback"] + capture "fallback" "workspace fallback\n" + successful ["test", "suite", "parameter", "--allow-mutating", "--variable", "payloadRoot=../root 雪 sentinel", "--variable", url "parameter"] + capture "parameter" (fromStrict (Encoding.encodeUtf8 one)) + successful (["test", "suite", "parameter", "--allow-mutating", "--variable", "payloadRoot=missing", "--variable", url "precedence"] <> firstRoot) + capture "precedence" (fromStrict (Encoding.encodeUtf8 one)) + -- A missing shadowed value must not be required. + successful (["test", "suite", "parameter", "--allow-mutating", "--variable", url "shadowed"] <> firstRoot) + summary <- Bytes.readFile (directory "reports/bodies/summary.json") + for_ ["sentinel", "payload-sentinel", Encoding.encodeUtf8 (Text.pack first)] $ \sentinel -> assertBool "summary omits root and payload" (not (sentinel `Bytes.isInfixOf` summary)) + source <- Text.IO.readFile (ws "request.hurl") + Text.IO.writeFile (ws "request.hurl") (Text.replace "HTTP 201" "HTTP 200" source) + failed <- run (["test", "workflow", "send-body", "--variable", url "failure"] <> firstRoot) + assertBool "Hurl assertion failed" (failed ^. #exitCode /= ExitSuccess) + Text.IO.writeFile (ws "request.hurl") source + withAsync (run (["test", "workflow", "send-body", "--variable", url "slow"] <> firstRoot)) $ \worker -> do + let awaitSlow remaining = readIORef slowStarted >>= \ready -> unless ready (if remaining == (0 :: Int) then assertFailure "slow request never arrived" else threadDelay 10000 >> awaitSlow (remaining - 1)) + awaitSlow 1000 + cancel worker + waitCatch worker >>= \case Left _ -> pure (); Right _ -> assertFailure "cancelled execution returned normally" + snapshot first >>= (@?= before) + snapshot second >>= (@?= beforeSecond) + traverse (Bytes.readFile . (ws )) ["request.hurl", "hurl-workbench.dhall", "request.json"] >>= (@?= sourceBytes) + -- Disappearance after validation is a normal Hurl failure; never recreate. + let gone = directory "gone" + createDirectory gone + Bytes.writeFile (gone "request.json") "gone" + cmd <- parsed ["test", "workflow", "send-body", "--file-root", gone, "--variable", url "gone"] + result <- runCommandWithDependencies (assertFailure "format probe") (removeDirectoryRecursive gone >> pure (Right capabilities)) validateRenderedWorkflow (\_ _ -> pure (Right [])) (GlobalOptions (Just (ws "hurl-workbench.dhall"))) nested cmd + assertBool "missing runtime root fails" (result ^. #exitCode /= ExitSuccess) + ] diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,704 @@ +module Main (main) where + +import CheckTest qualified +import Control.Monad (join) +import Data.Bits ((.&.)) +import Data.ByteString qualified as ByteString +import Data.Generics.Labels () +import Data.IORef +import Data.Map.Strict qualified as Map +import Data.Text qualified as Text +import Data.Text.IO qualified as Text.IO +import Data.Version (makeVersion) +import FileRootTest qualified +import FixtureServer qualified +import HurlWorkbench.Cli (runCommandWithDependencies, runCommandWithHurlfmt) +import HurlWorkbench.Cli.Command.Suite qualified as SuiteCommand +import HurlWorkbench.Cli.Help (helpPreferences) +import HurlWorkbench.Cli.Options +import HurlWorkbench.Cli.Output (CommandResult (..)) +import HurlWorkbench.Cli.Version (versionText) +import HurlWorkbench.Cli.Workspace (loadValidatedWorkspace) +import HurlWorkbench.Hurl.Capabilities +import HurlWorkbench.Hurl.Format +import HurlWorkbench.Hurl.Run +import HurlWorkbench.Parameter.Resolve +import HurlWorkbench.Prelude +import HurlWorkbench.Run.Batch +import HurlWorkbench.Run.FileRoot +import HurlWorkbench.Run.Prepare +import HurlWorkbench.Run.Selection +import HurlWorkbench.Suite.Resolve (ReportFormat (..)) +import HurlWorkbench.Workflow.Render (RenderedWorkflow, renderRenderError, renderWorkflow) +import HurlWorkbench.Workflow.Resolve (renderWorkflowError, resolveWorkflow) +import HurlWorkbench.Workspace.Context (lookupWorkflow) +import HurlWorkbench.Workspace.Types (MatrixName (..), ParameterName (..), RecipeName (..), SuiteName (..), WorkflowName (..), WorkspaceRoot (..), mkHurlValueLiteral) +import Network.Wai (queryString) +import Network.Wai.Handler.Warp (testWithApplication) +import Options.Applicative (CompletionResult (..), ParserResult (..), defaultPrefs, execParserPure, renderFailure) +import System.Directory (canonicalizePath, doesPathExist, getPermissions, setOwnerExecutable, setPermissions) +import System.Exit (ExitCode (..)) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import System.Posix.Files (setFileMode) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) + +main :: IO () +main = defaultMain (testGroup "hurl-workbench-cli" [CheckTest.tests, FileRootTest.tests, parserTests, commandTests, executionTests]) + +fixtureDir :: FilePath -> FilePath +fixtureDir name = "../hurl-workbench-core/test/fixtures/workspaces" name + +fixtureManifest :: FilePath -> FilePath +fixtureManifest name = fixtureDir name "hurl-workbench.dhall" + +parse :: [String] -> ParserResult Options +parse = execParserPure defaultPrefs parserInfo + +parsePublic :: [String] -> ParserResult Options +parsePublic = execParserPure (helpPreferences 80) parserInfo + +parserTests :: TestTree +parserTests = + testGroup + "parser" + [ testCase "external suite help explains phase bypass and lifecycle refusal" $ + case parsePublic ["test", "suite", "--help"] of + Failure failure -> do + let (message, _) = renderFailure failure "hurl-workbench" + for_ ["Skip setup", "teardown", "lifecycle steps are refused"] $ \phrase -> + assertBool "external lifecycle contract is visible" (Text.pack phrase `Text.isInfixOf` Text.unwords (Text.words (Text.pack message))) + _ -> assertFailure "expected suite help", + testCase "validate with an explicit workspace" $ + successOf (parse ["--workspace", "ws.dhall", "validate"]) + >>= (@?= Options (GlobalOptions (Just "ws.dhall")) ValidateCommand), + testCase "list defaults to all categories" $ + successOf (parse ["list"]) >>= (@?= Options (GlobalOptions Nothing) (ListCommand AllCategories)), + testCase "list accepts every category name" $ + for_ allListCategories $ \category -> + successOf (parse ["list", Text.unpack (listCategoryName category)]) + >>= (@?= Options (GlobalOptions Nothing) (ListCommand category)), + testCase "list rejects an unknown category" $ + case parse ["list", "widgets"] of + Failure _ -> pure () + _ -> assertFailure "expected a parse failure", + testCase "render parses a workflow and optional output" $ + successOf (parse ["render", "workflow", "oauth-property", "--output", "rendered.hurl"]) + >>= (@?= Options (GlobalOptions Nothing) (RenderCommand (RenderOptions (SelectWorkflow (WorkflowName "oauth-property")) (Just "rendered.hurl") False))), + testCase "run parses grouped binding and Hurl options" $ do + options <- + successOf + ( parse + [ "run", + "workflow", + "health", + "--variable", + "baseUrl=http://127.0.0.1", + "--retry", + "2", + "--include", + "--hurl-arg=--compressed" + ] + ) + case options ^. #cmd of + RunCommand execute -> do + execute ^. #selection @?= SelectWorkflow (WorkflowName "health") + execute ^. #bindings . #variables @?= ["baseUrl=http://127.0.0.1"] + execute ^. #hurl . #retryCount @?= Just 2 + execute ^. #hurl . #includeHeaders @?= True + execute ^. #hurl . #additionalArguments @?= ["--compressed"] + other -> assertFailure ("expected run command, got " <> show other), + testCase "run help groups options by intent" $ do + helpText <- case parse ["run", "workflow", "health", "--help"] of + Failure failure -> pure (fst (renderFailure failure "hurl-workbench")) + _ -> assertFailure "expected --help to produce help text" + for_ ["Bindings", "HTTP and retry", "Output and diagnostics", "Advanced Hurl arguments"] $ \heading -> + assertBool ("mentions " <> heading) (heading `isIn` helpText), + testCase "recipe and matrix selectors parse with grouped batch controls" $ do + rendered <- successOf (parse ["render", "recipe", "properties", "--explain"]) + rendered + @?= Options + (GlobalOptions Nothing) + (RenderCommand (RenderOptions (SelectRecipe (RecipeName "properties")) Nothing True)) + selected <- + successOf + ( parse + [ "matrix", + "property-by-mls", + "--mode", + "run", + "--jobs", + "2", + "--fail-fast", + "--allow-mutating", + "--output-dir", + "responses" + ] + ) + case selected ^. #cmd of + MatrixCommand options -> do + options ^. #matrix @?= MatrixName "property-by-mls" + options ^. #mode @?= ClientMode + positiveIntValue (options ^. #jobs) @?= 2 + options ^. #failFastOverride @?= Just True + options ^. #allowMutating @?= True + options ^. #outputDirectory @?= Just "responses" + other -> assertFailure ("expected matrix command, got " <> show other) + helpText <- case parse ["matrix", "property-by-mls", "--help"] of + Failure failure -> pure (fst (renderFailure failure "hurl-workbench")) + _ -> assertFailure "expected matrix --help to produce help text" + for_ ["Batch control", "Bindings", "HTTP and retry", "Output", "Advanced Hurl arguments"] $ \heading -> + assertBool ("mentions " <> heading) (heading `isIn` helpText), + testCase "suite test parses lifecycle, safety, and report controls" $ do + selected <- + successOf + ( parse + [ "test", + "suite", + "default", + "--jobs", + "3", + "--keep-going", + "--allow-mutating", + "--external-service", + "--report", + "junit", + "--report", + "json", + "--report-dir", + "reports", + "--overwrite" + ] + ) + case selected ^. #cmd of + SuiteCommand options -> do + options ^. #suite @?= SuiteName "default" + positiveIntValue (options ^. #jobs) @?= 3 + options ^. #failFastOverride @?= Just False + options ^. #allowMutating @?= True + options ^. #externalService @?= True + options ^. #reportFormats @?= [JUnit, Json] + options ^. #reportDirectory @?= Just "reports" + options ^. #overwrite @?= True + other -> assertFailure ("expected suite command, got " <> show other) + helpText <- case parse ["test", "suite", "default", "--help"] of + Failure failure -> pure (fst (renderFailure failure "hurl-workbench")) + _ -> assertFailure "expected suite --help to produce help text" + for_ ["Suite control", "Service lifecycle", "Reports", "Bindings", "Advanced Hurl arguments"] $ \heading -> + assertBool ("mentions " <> heading) (heading `isIn` helpText), + testCase "help lists every top-level command and no longer mentions hello" $ do + helpText <- case parsePublic ["--help"] of + Failure failure -> pure (fst (renderFailure failure "hurl-workbench")) + _ -> assertFailure "expected --help to produce help text" + assertBool "mentions validate" ("validate" `isIn` helpText) + assertBool "mentions list" ("list" `isIn` helpText) + assertBool "mentions render" ("render" `isIn` helpText) + assertBool "mentions run" ("run" `isIn` helpText) + assertBool "mentions test" ("test" `isIn` helpText) + assertBool "mentions matrix" ("matrix" `isIn` helpText) + assertBool "mentions doctor" ("doctor" `isIn` helpText) + assertBool "mentions completions" ("completions" `isIn` helpText) + assertBool "mentions --workspace" ("--workspace" `isIn` helpText) + assertBool "does not mention hello" (not ("hello" `isIn` helpText)) + assertGolden "test/golden/top-level-help.txt" (Text.pack helpText), + testCase "empty and invalid invocations include contextual help" $ do + for_ [[], ["unknown-command"]] $ \arguments -> + case parsePublic arguments of + Failure parserFailure -> do + let rendered = fst (renderFailure parserFailure "hurl-workbench") + assertBool "contains usage" ("Usage:" `isIn` rendered) + assertBool "contains commands" ("Available commands:" `isIn` rendered) + _ -> assertFailure "expected a help-bearing parse failure", + testCase "version includes package version and a build revision" $ + case parsePublic ["--version"] of + Failure parserFailure -> do + let rendered = fst (renderFailure parserFailure "hurl-workbench") + assertBool "matches the version module" (versionText `isIn` rendered) + assertBool "includes the package version" ("0.1.0.0" `isIn` rendered) + _ -> assertFailure "expected the version option to terminate parsing", + testCase "public completion commands generate scripts for every shell" $ do + for_ [("bash", "complete -o filenames"), ("zsh", "#compdef hurl-workbench"), ("fish", "complete --no-files")] $ \(shell, marker) -> do + options <- successOf (parse ["completions", shell]) + result <- runTestCommand (options ^. #global) "." (options ^. #cmd) + result ^. #exitCode @?= ExitSuccess + let script = Text.unlines (result ^. #stdoutLines) + assertBool (shell <> " script names the stable executable") ("hurl-workbench" `Text.isInfixOf` script) + assertBool (shell <> " script uses the completion protocol") ("--bash-completion-index" `Text.isInfixOf` script) + assertBool (shell <> " script has its native marker") (Text.pack marker `Text.isInfixOf` script), + testCase "hidden completion protocol follows the public parser" $ + case parsePublic ["--bash-completion-index", "1", "--bash-completion-word", "hurl-workbench", "--bash-completion-word", "c"] of + CompletionInvoked (CompletionResult complete) -> do + candidates <- complete "hurl-workbench" + assertBool "offers completions" ("completions" `isIn` candidates) + _ -> assertFailure "expected a completion query" + ] + where + isIn needle haystack = Text.pack needle `Text.isInfixOf` Text.pack haystack + +successOf :: ParserResult a -> IO a +successOf = \case + Success a -> pure a + _ -> assertFailure "expected the arguments to parse" + +commandTests :: TestTree +commandTests = + testGroup + "commands" + [ testCase "validate discovers a parent workspace and reports counts" $ do + result <- runTestCommand (GlobalOptions Nothing) (fixtureDir "full" "hurl") ValidateCommand + manifest <- canonicalizePath (fixtureManifest "full") + result + @?= CommandResult + { stdoutLines = + [ "Valid workspace: " <> Text.pack manifest, + "5 parameters, 3 fragments, 2 workflows, 1 recipe, 1 matrix, 0 checks, 1 service, 1 suite" + ], + stderrLines = [], + exitCode = ExitSuccess + }, + testCase "validate reports every invalid reference and exits non-zero" $ do + result <- runTestCommand (GlobalOptions (Just (fixtureManifest "missing-reference"))) "." ValidateCommand + result ^. #exitCode @?= ExitFailure 1 + result ^. #stdoutLines @?= [] + let err = result ^. #stderrLines + take 1 err @?= take 1 (filter ("Invalid workspace: " `Text.isPrefixOf`) err) + for_ ["missing-fragment", "missing_parameter", "missing-workflow", "missing-recipe", "missing-matrix", "missing-service"] $ \name -> + assertBool ("reports " <> Text.unpack name) (any (Text.isInfixOf name) err) + drop (length err - 1) err @?= ["8 issues found"], + testCase "a missing explicit workspace is a workbench error" $ do + result <- runTestCommand (GlobalOptions (Just "does-not-exist.dhall")) "." ValidateCommand + result ^. #exitCode @?= ExitFailure 1 + assertBool "names the missing manifest" (any (Text.isInfixOf "workspace manifest not found") (result ^. #stderrLines)), + testCase "list all groups every category and shows relationships" $ do + result <- runTestCommand (GlobalOptions (Just (fixtureManifest "full"))) "." (ListCommand AllCategories) + result ^. #exitCode @?= ExitSuccess + let out = result ^. #stdoutLines + for_ ["Parameters:", "Fragments:", "Workflows:", "Recipes:", "Matrices:", "Services:", "Suites:"] $ \title -> + assertBool ("has heading " <> Text.unpack title) (title `elem` out) + assertBool "workflow shares the oauth fragment" (any (Text.isInfixOf "list-properties oauth, properties") out) + assertBool "suite lists its runs" (any (Text.isInfixOf "workflow:list-members, recipe:top-properties, matrix:property-page-sizes") out) + assertBool "suite identifies unclassified safety" (any (Text.isInfixOf "unclassified") out), + testCase "list parameters names environment variables but never reads them" $ do + result <- runTestCommand (GlobalOptions (Just (fixtureManifest "full"))) "." (ListCommand ParametersCategory) + result ^. #stdoutLines + @?= [ "NAME KIND DEFAULT ENVIRONMENT DESCRIPTION", + "auth_url plain https://auth.example.test - -", + "base_url plain https://api.example.test - -", + "client_id plain - EXAMPLE_CLIENT_ID -", + "client_secret secret - EXAMPLE_CLIENT_SECRET OAuth client secret", + "top plain 5 - -" + ], + testCase "list of an empty category says so" $ do + result <- runTestCommand (GlobalOptions (Just (fixtureManifest "minimal"))) "." (ListCommand SuitesCategory) + result @?= CommandResult ["(none)"] [] ExitSuccess, + testCase "render writes only composed Hurl source to stdout" $ do + result <- + runTestCommand + (GlobalOptions (Just (fixtureManifest "full"))) + "." + (RenderCommand (RenderOptions (SelectWorkflow (WorkflowName "list-properties")) Nothing False)) + oauth <- Text.IO.readFile (fixtureDir "full" "hurl/oauth.hurl") + properties <- Text.IO.readFile (fixtureDir "full" "hurl/properties.hurl") + result ^. #exitCode @?= ExitSuccess + result ^. #stderrLines @?= [] + Text.unlines (result ^. #stdoutLines) @?= oauth <> "\n" <> properties, + testCase "render reports an unknown workflow on stderr" $ do + result <- + runTestCommand + (GlobalOptions (Just (fixtureManifest "full"))) + "." + (RenderCommand (RenderOptions (SelectWorkflow (WorkflowName "missing")) Nothing False)) + result ^. #exitCode @?= ExitFailure 1 + result ^. #stdoutLines @?= [] + assertBool "names the unknown workflow" (any (Text.isInfixOf "unknown workflow \"missing\"") (result ^. #stderrLines)) + assertGolden "test/golden/unknown-workflow.txt" (Text.unlines (result ^. #stderrLines)), + testCase "render recipe explains binding sources without values" $ do + result <- + runTestCommand + (GlobalOptions (Just (fixtureManifest "full"))) + "." + (RenderCommand (RenderOptions (SelectRecipe (RecipeName "top-properties")) Nothing True)) + result ^. #exitCode @?= ExitSuccess + result ^. #stderrLines + @?= ["Binding sources (values redacted):", " recipe \"top-properties\" (1 plain bindings)"] + assertBool "does not explain the bound value" (not (any (Text.isInfixOf "10") (result ^. #stderrLines))), + testCase "render atomically replaces an output file and reports its path" $ + withSystemTempDirectory "hurl-workbench-cli" $ \dir -> do + manifest <- canonicalizePath (fixtureManifest "full") + let output = dir "rendered.hurl" + Text.IO.writeFile output "old contents" + result <- + runTestCommand + (GlobalOptions (Just manifest)) + dir + (RenderCommand (RenderOptions (SelectWorkflow (WorkflowName "list-properties")) (Just "rendered.hurl") False)) + canonicalOutput <- canonicalizePath output + result ^. #exitCode @?= ExitSuccess + result ^. #stdoutLines @?= [] + result ^. #stderrLines @?= [Text.pack canonicalOutput] + rendered <- Text.IO.readFile output + assertBool "replaced the old file" ("POST {{auth_url}}/oauth/token" `Text.isInfixOf` rendered), + testCase "render refuses to overwrite an input fragment" $ do + manifest <- canonicalizePath (fixtureManifest "full") + source <- canonicalizePath (fixtureDir "full" "hurl/oauth.hurl") + before <- Text.IO.readFile source + result <- + runTestCommand + (GlobalOptions (Just manifest)) + "." + (RenderCommand (RenderOptions (SelectWorkflow (WorkflowName "list-properties")) (Just source) False)) + result ^. #exitCode @?= ExitFailure 1 + after <- Text.IO.readFile source + after @?= before + assertBool "explains the refusal" (any (Text.isInfixOf "refusing to overwrite source fragment") (result ^. #stderrLines)), + testCase "run propagates the exact Hurl exit status after spawn" $ + withSystemTempDirectory "hurl-workbench-cli-run" $ \dir -> do + executable <- writeExitHurl dir 17 + result <- + runExecutionCommand + (Right (testCapabilities executable)) + ( RunCommand + ExecuteOptions + { selection = SelectWorkflow (WorkflowName "health"), + bindings = BindingOptions ["baseUrl=http://127.0.0.1"] [] [] [], + hurl = defaultCliHurlOptions, + allowMutating = False + } + ) + result ^. #exitCode @?= ExitFailure 17, + testCase "run uses exit 2 for binding errors and exit 3 for dependency errors" $ + withSystemTempDirectory "hurl-workbench-cli-exits" $ \dir -> do + executable <- writeExitHurl dir 0 + let command = RunCommand (ExecuteOptions (SelectWorkflow (WorkflowName "health")) emptyBindingOptions defaultCliHurlOptions False) + bindingFailure <- runExecutionCommand (Right (testCapabilities executable)) command + bindingFailure ^. #exitCode @?= ExitFailure 2 + dependencyFailure <- runExecutionCommand (Left (DependencyNotFound "hurl" "hurl")) command + dependencyFailure ^. #exitCode @?= ExitFailure 3, + testCase "mutating recipes require an explicit invocation gate" $ + withSystemTempDirectory "hurl-workbench-cli-mutation" $ \dir -> do + executable <- writeExitHurl dir 0 + let recipeCommand allowed = + RunCommand + ExecuteOptions + { selection = SelectRecipe (RecipeName "dangerous-health"), + bindings = BindingOptions ["baseUrl=http://127.0.0.1"] [] [] [], + hurl = defaultCliHurlOptions, + allowMutating = allowed + } + denied <- runExecutionCommand (Right (testCapabilities executable)) (recipeCommand False) + denied ^. #exitCode @?= ExitFailure 2 + assertBool "explains the safety gate" (any (Text.isInfixOf "requires --allow-mutating") (denied ^. #stderrLines)) + allowed <- runExecutionCommand (Right (testCapabilities executable)) (recipeCommand True) + allowed ^. #exitCode @?= ExitSuccess, + testCase "parallel client matrices require and populate isolated artifacts" $ + withSystemTempDirectory "hurl-workbench-cli-matrix" $ \dir -> do + executable <- writeExitHurl dir 0 + let options outputDirectory = + MatrixOptions + { matrix = MatrixName "health-cases", + mode = ClientMode, + jobs = positiveJobs 2, + failFastOverride = Nothing, + allowMutating = False, + outputDirectory, + overwrite = False, + bindings = BindingOptions ["baseUrl=http://127.0.0.1"] [] [] [], + hurl = defaultCliHurlOptions + } + rejected <- runExecutionCommand (Right (testCapabilities executable)) (MatrixCommand (options Nothing)) + rejected ^. #exitCode @?= ExitFailure 2 + assertBool "requires output isolation" (any (Text.isInfixOf "require --output-dir") (rejected ^. #stderrLines)) + let output = dir "responses" + result <- runExecutionCommand (Right (testCapabilities executable)) (MatrixCommand (options (Just output))) + result ^. #exitCode @?= ExitSuccess + length (filter (Text.isPrefixOf "PASS") (result ^. #stderrLines)) @?= 3 + for_ ["first", "second", "third"] $ \caseName -> + ByteString.readFile (output "health-cases" caseName <> ".response") >>= (@?= ""), + testCase "suite and matrix refusal never probes capabilities or validates syntax" $ do + let run argv = do + parsed <- successOf (parse argv) + runCommandWithDependencies + (assertFailure "hurlfmt probe called") + (assertFailure "Hurl probe called") + (\_ _ -> assertFailure "syntax validation called") + (\_ _ -> assertFailure "workspace syntax called") + (GlobalOptions (Just (fixtureManifest "isolation"))) + "." + (parsed ^. #cmd) + for_ [False, True] $ \allow -> for_ [False, True] $ \external -> do + for_ ["mixed", "single-write", "independent"] $ \name -> do + result <- run (["test", "suite", name, "--jobs", "2"] <> ["--allow-mutating" | allow] <> ["--external-service" | external]) + result ^. #exitCode @?= ExitFailure 2 + for_ ["writes", "single-write"] $ \matrix -> do + result <- run (["matrix", matrix, "--mode", "test", "--jobs", "2"] <> ["--allow-mutating" | allow]) + result ^. #exitCode @?= ExitFailure 2 + for_ ["service-started", "readiness-started"] $ \marker -> + doesPathExist (fixtureDir "isolation" marker) >>= (@?= False), + testCase "invalid private scenario files fail before capability probes" $ + withSystemTempDirectory "scenario-cli" $ \directory -> do + let input = directory "inputs.json" + run = do + parsed <- successOf (parse ["test", "suite", "independent", "--external-service", "--scenario-inputs", input, "--report-dir", directory "reports", "--overwrite"]) + runCommandWithDependencies (assertFailure "format probe called") (assertFailure "Hurl probe called") (\_ _ -> assertFailure "format called") (\_ _ -> assertFailure "syntax called") (GlobalOptions (Just (fixtureManifest "isolation"))) "." (parsed ^. #cmd) + missing <- run + missing ^. #exitCode @?= ExitFailure 3 + ByteString.writeFile input "private-invalid-input" + setFileMode input 0o600 + invalid <- run + invalid ^. #exitCode @?= ExitFailure 2 + assertBool "raw input is redacted" (not (any (Text.isInfixOf "private-invalid-input") (invalid ^. #stderrLines))), + testCase "a verified handoff executes separate endpoints through the suite command" $ + testWithApplication (pure FixtureServer.application) $ \firstPort -> + testWithApplication (pure FixtureServer.application) $ \secondPort -> + withSystemTempDirectory "scenario-live-cli" $ \directory -> do + let input = directory "inputs.json" + entry name port = "{\"scenario\":\"writes/" <> name <> "\",\"fixtureId\":\"private-fixture-" <> name <> "\",\"endpoint\":\"http://127.0.0.1:" <> Text.pack (show port) <> "\",\"endpointParameter\":\"baseUrl\",\"bindings\":[],\"secretEnvironment\":[]}" + Text.IO.writeFile input ("{\"version\":1,\"scenarios\":[" <> entry "first" firstPort <> "," <> entry "second" secondPort <> "]}") + setFileMode input 0o600 + parsed <- successOf (parse ["test", "suite", "independent", "--external-service", "--scenario-inputs", input, "--allow-mutating", "--jobs", "2", "--report-dir", directory "reports"]) + case parsed ^. #cmd of + SuiteCommand options -> do + result <- SuiteCommand.runSuiteCommand (GlobalOptions (Just (fixtureManifest "isolation"))) "." options + result ^. #exitCode @?= ExitSuccess + length (filter (Text.isPrefixOf "PASS") (result ^. #stderrLines)) @?= 2 + summary <- ByteString.readFile (directory "reports" "independent" "summary.json") + assertBool "fixture identities are private" (not ("private-fixture" `ByteString.isInfixOf` summary)) + _ -> assertFailure "expected suite command", + testCase "read-only suites retain parallel execution" $ + withSystemTempDirectory "hurl-workbench-cli-read-suite" $ \dir -> do + executable <- writeExitHurl dir 0 + parsed <- successOf (parse ["test", "suite", "reads", "--jobs", "2", "--external-service", "--variable", "baseUrl=http://fixture.test"]) + result <- runExecutionCommandAt (fixtureManifest "isolation") (Right (testCapabilities executable)) (parsed ^. #cmd) + result ^. #exitCode @?= ExitSuccess + length (filter (Text.isPrefixOf "PASS") (result ^. #stderrLines)) @?= 3, + testCase "suite command gates unsafe runs and writes isolated reports" $ + withSystemTempDirectory "hurl-workbench-cli-suite" $ \dir -> do + executable <- writeExitHurl dir 0 + let secretFile = dir "secrets.env" + reportRoot = dir "reports" + options allowed reports = + SuiteCommandOptions + { suite = SuiteName "smoke", + jobs = positiveJobs 1, + failFastOverride = Nothing, + allowMutating = allowed, + externalService = True, + scenarioInputsFile = Nothing, + reportFormats = reports, + reportDirectory = if null reports then Nothing else Just reportRoot, + overwrite = False, + bindings = BindingOptions ["client_id=suite-client"] [] [] [secretFile], + hurl = defaultCliHurlOptions + } + ByteString.writeFile secretFile "client_secret=suite-secret\n" + denied <- runExecutionCommandAt (fixtureManifest "full") (Right (testCapabilities executable)) (SuiteCommand (options False [])) + denied ^. #exitCode @?= ExitFailure 2 + assertBool "explains suite safety" (any (Text.isInfixOf "requires --allow-mutating") (denied ^. #stderrLines)) + passed <- runExecutionCommandAt (fixtureManifest "full") (Right (testCapabilities executable)) (SuiteCommand (options True [JUnit, Json])) + passed ^. #exitCode @?= ExitSuccess + length (filter (Text.isPrefixOf "PASS") (passed ^. #stderrLines)) @?= 4 + assertBool "prints summary path" (any (Text.isPrefixOf "SUMMARY ") (passed ^. #stderrLines)) + for_ + [ reportRoot "smoke" "list-members" "junit.xml", + reportRoot "smoke" "list-members" "json", + reportRoot "smoke" "property-page-sizes" "small" "junit.xml", + reportRoot "smoke" "summary.json" + ] + $ \path -> doesPathExist path >>= assertBool ("missing suite artifact " <> path), + testCase "doctor reports both executable paths and versions without a workspace" $ do + let capabilities = testCapabilities "/tools/hurl" + result <- runExecutionCommand (Right capabilities) DoctorCommand + result ^. #exitCode @?= ExitSuccess + assertBool "reports Hurl" (any (Text.isInfixOf "/tools/hurl (8.0.1, supported)") (result ^. #stdoutLines)) + assertBool "reports Hurlfmt" (any (Text.isInfixOf "/tools/hurlfmt (8.0.1, supported)") (result ^. #stdoutLines)) + ] + +runTestCommand :: GlobalOptions -> FilePath -> Command -> IO CommandResult +runTestCommand = + runCommandWithHurlfmt + (pure (Right (HurlfmtCapabilities (HurlfmtExecutable "unused-in-tests") (makeVersion [8, 0, 1])))) + (\_capabilities _rendered -> pure (Right ())) + (\_capabilities _validated -> pure (Right [])) + +assertGolden :: FilePath -> Text -> IO () +assertGolden path actual = Text.IO.readFile path >>= (\expected -> Text.stripEnd actual @?= Text.stripEnd expected) + +runExecutionCommand :: Either DependencyError HurlCapabilities -> Command -> IO CommandResult +runExecutionCommand = runExecutionCommandAt (fixtureManifest "execution") + +runExecutionCommandAt :: FilePath -> Either DependencyError HurlCapabilities -> Command -> IO CommandResult +runExecutionCommandAt manifest detected = + runCommandWithDependencies + (pure (Right (HurlfmtCapabilities (HurlfmtExecutable "/tools/hurlfmt") (makeVersion [8, 0, 1])))) + (pure detected) + (\_capabilities _rendered -> pure (Right ())) + (\_capabilities _validated -> pure (Right [])) + (GlobalOptions (Just manifest)) + "." + +testCapabilities :: FilePath -> HurlCapabilities +testCapabilities executable = + HurlCapabilities + executable + (makeVersion [8, 0, 1]) + (HurlfmtCapabilities (HurlfmtExecutable "/tools/hurlfmt") (makeVersion [8, 0, 1])) + +writeExitHurl :: FilePath -> Int -> IO FilePath +writeExitHurl directory status = do + let executable = directory "fake-hurl" + Text.IO.writeFile executable ("#!/bin/sh\nexit " <> Text.pack (show status) <> "\n") + permissions <- getPermissions executable + setPermissions executable (setOwnerExecutable True permissions) + pure executable + +executionTests :: TestTree +executionTests = + testGroup + "live Hurl execution" + [ testCase "public validation rejects committed generated inputs before execution" $ + withSystemTempDirectory "generated-invalid" $ \directory -> do + schema <- canonicalizePath "schema/package.dhall" + source <- Text.IO.readFile "examples/generated-parameters/hurl-workbench.dhall" + for_ ["first.hurl", "second.hurl"] $ \file -> ByteString.readFile ("examples/generated-parameters" file) >>= ByteString.writeFile (directory file) + let manifest = directory "hurl-workbench.dhall" + local = Text.replace "../../schema/package.dhall" (Text.pack schema) source + for_ + [ Text.replace "name = \"recipientId\"" "name = \"recipientId\", defaultValue = Some \"fixed\"" local, + Text.replace "name = \"one\"" "name = \"one\", bindings = [ S.Binding::{ parameter = \"recipientId\", value = \"fixed\" } ]" local + ] + $ \invalid -> do + Text.IO.writeFile manifest invalid + result <- runTestCommand (GlobalOptions (Just manifest)) "." ValidateCommand + result ^. #exitCode @?= ExitFailure 1 + assertBool "explains generated constraint" (any (Text.isInfixOf "generated parameters") (result ^. #stderrLines)) + parsed <- successOf (parse ["test", "recipe", "recipient"]) + blocked <- runCommandWithDependencies (assertFailure "format probe") (assertFailure "Hurl probe") (\_ _ -> assertFailure "format") (\_ _ -> assertFailure "syntax") (GlobalOptions (Just manifest)) "." (parsed ^. #cmd) + blocked ^. #exitCode @?= ExitFailure 2, + testCase "generated CLI inputs are shared per execution and fresh across concurrent cases" $ do + capabilities <- detectHurlCapabilities >>= either (assertFailure . Text.unpack . renderDependencyError) pure + received <- newIORef ([] :: [ByteString.ByteString]) + let app request respond = do + for_ (join (lookup "id" (queryString request))) $ \value -> atomicModifyIORef' received (\values -> (value : values, ())) + FixtureServer.application request respond + testWithApplication (pure app) $ \port -> withSystemTempDirectory "generated-cli" $ \directory -> do + let manifest = "examples/generated-parameters/hurl-workbench.dhall" + base = "baseUrl=http://127.0.0.1:" <> show port + invoke args = do + parsed <- successOf (parse args) + result <- runExecutionCommandAt manifest (Right capabilities) (parsed ^. #cmd) + assertBool (show (result ^. #stderrLines)) (result ^. #exitCode == ExitSuccess) + pure result + reproduction = "rcp_01h2xcejqtf2nbrexx3vqjhp41" + inspected <- invoke ["render", "recipe", "recipient", "--explain"] + assertBool "explains generated input" (any (Text.isInfixOf "recipientId: generated (TypeId)") (inspected ^. #stderrLines)) + readIORef received >>= (@?= []) + for_ [1 :: Int, 2] $ \_ -> void (invoke ["test", "recipe", "recipient", "--variable", base]) + void (invoke ["test", "recipe", "recipient", "--variable", base, "--variable", "recipientId=" <> reproduction]) + void (invoke ["matrix", "recipients", "--jobs", "2", "--variable", base, "--output-dir", directory "matrix"]) + void (invoke ["test", "suite", "recipients", "--jobs", "2", "--variable", base, "--report", "json", "--report-dir", directory "suite"]) + values <- readIORef received + length values @?= 14 + let generated = filter (/= "rcp_01h2xcejqtf2nbrexx3vqjhp41") values + counts = Map.fromListWith (+) [(value, 1 :: Int) | value <- generated] + Map.size counts @?= 6 + Map.elems counts @?= replicate 6 2 + for_ (Map.keys counts) $ \value -> do + ByteString.take 4 value @?= "rcp_" + ByteString.length value @?= 30 + let alphabet = "0123456789abcdefghjkmnpqrstvwxyz" + decoded = foldl (\acc byte -> acc * 32 + fromIntegral (fromMaybe (-100) (ByteString.elemIndex byte alphabet))) (0 :: Integer) (ByteString.unpack (ByteString.drop 4 value)) + (decoded `div` 2 ^ (76 :: Int)) .&. 15 @?= 7 + (decoded `div` 2 ^ (62 :: Int)) .&. 3 @?= 2 + summary <- ByteString.readFile (directory "suite/recipients/summary.json") + for_ values $ \value -> assertBool "summary excludes generated and override values" (not (value `ByteString.isInfixOf` summary)), + testCase "client and test modes execute against the shared fixture service" $ do + detected <- detectHurlCapabilities + case detected of + Left DependencyNotFound {} -> putStrLn "SKIP: Hurl 8.x or Hurlfmt is not installed" + Left err -> assertFailure (Text.unpack (renderDependencyError err)) + Right capabilities -> + testWithApplication (pure FixtureServer.application) $ \port -> do + validated <- + loadValidatedWorkspace + (GlobalOptions (Just (fixtureManifest "execution"))) + "." + >>= either (assertFailure . Text.unpack . Text.unlines) pure + workflow <- maybe (assertFailure "health workflow missing") pure (lookupWorkflow (WorkflowName "health") validated) + resolved <- either (assertFailure . Text.unpack . renderWorkflowError) pure (resolveWorkflow validated (WorkflowName "health")) + rendered <- renderWorkflow resolved >>= either (assertFailure . Text.unpack . renderRenderError) pure + validateRenderedWorkflow (capabilities ^. #hurlfmt) rendered + >>= either (assertFailure . Text.unpack . renderHurlfmtError) pure + baseUrl <- + either + (assertFailure . show) + pure + (mkHurlValueLiteral ("http://127.0.0.1:" <> Text.pack (show port))) + bindings <- + resolveWorkflowBindings + validated + workflow + emptyBindingInput {plainOverrides = Map.singleton (ParameterName "baseUrl") baseUrl} + >>= either (assertFailure . Text.unpack . renderBindingError) pure + client <- runLive capabilities rendered bindings ClientMode + test <- runLive capabilities rendered bindings TestMode + client ^. #exitCode @?= ExitSuccess + test ^. #exitCode @?= ExitSuccess + assertBool "client prints fixture response" (maybe False (ByteString.isInfixOf "ok" . view #stdout) (client ^. #capturedOutput)) + assertBool + "test mode prints a Hurl result" + ( maybe + False + (\captured -> not (ByteString.null (captured ^. #stdout) && ByteString.null (captured ^. #stderr))) + (test ^. #capturedOutput) + ), + testCase "a real Hurl matrix runs with bounded captured output" $ do + detected <- detectHurlCapabilities + case detected of + Left DependencyNotFound {} -> putStrLn "SKIP: Hurl 8.x or Hurlfmt is not installed" + Left err -> assertFailure (Text.unpack (renderDependencyError err)) + Right capabilities -> + testWithApplication (pure FixtureServer.application) $ \port -> do + validated <- + loadValidatedWorkspace + (GlobalOptions (Just (fixtureManifest "execution"))) + "." + >>= either (assertFailure . Text.unpack . Text.unlines) pure + baseUrl <- + either + (assertFailure . show) + pure + (mkHurlValueLiteral ("http://127.0.0.1:" <> Text.pack (show port))) + prepared <- + prepareSelection + (capabilities ^. #hurlfmt) + validated + emptyBindingInput {plainOverrides = Map.singleton (ParameterName "baseUrl") baseUrl} + defaultHurlOptions + (SelectMatrix (MatrixName "health-cases")) + >>= either (assertFailure . Text.unpack . Text.unlines . map renderPreparationError . toList) pure + let cases = fmap (buildBatchCase TestMode CaptureRunOutput []) prepared + result <- runBatch (mkHurlRunner capabilities) (BatchOptions (positiveJobs 2) False) cases + result ^. #selectedExitCode @?= ExitSuccess + map (view #outcome) (toList (result ^. #cases)) @?= replicate 3 CasePassed + assertBool "all cases retain captured Hurl diagnostics" (all (isJust . view #capturedOutput) (result ^. #cases)) + ] + +positiveJobs :: Int -> PositiveInt +positiveJobs value = either (error . show) id (mkPositiveInt value) + +runLive :: HurlCapabilities -> RenderedWorkflow -> ResolvedBindings -> HurlRunMode -> IO RunResult +runLive capabilities rendered bindings mode = do + root <- validateFileRoot (unWorkspaceRoot (rendered ^. #workspaceRoot)) Nothing >>= either (assertFailure . show) pure + runHurl + (mkHurlRunner capabilities) + RunRequest + { renderedWorkflow = rendered, + fileRoot = root, + mode, + bindings, + options = defaultHurlOptions, + outputPolicy = CaptureRunOutput, + reportTargets = [] + } + >>= either (assertFailure . Text.unpack . renderRunStartError) pure diff --git a/test/fixture-server/FixtureServer.hs b/test/fixture-server/FixtureServer.hs new file mode 100644 --- /dev/null +++ b/test/fixture-server/FixtureServer.hs @@ -0,0 +1,133 @@ +module FixtureServer + ( application, + runFixtureServer, + runFixtureRole, + ) +where + +import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo) +import Control.Exception (AsyncException (UserInterrupt), bracket, bracket_) +import Control.Monad (forever, when) +import Data.ByteString qualified as ByteString +import Data.ByteString.Char8 qualified as Char8 +import Data.ByteString.Lazy qualified as LazyByteString +import Data.IORef (atomicModifyIORef', newIORef) +import Network.HTTP.Types + ( hContentType, + methodDelete, + methodGet, + methodPost, + status200, + status201, + status404, + status405, + status409, + status503, + ) +import Network.Wai + ( Application, + pathInfo, + queryString, + requestMethod, + responseLBS, + strictRequestBody, + ) +import Network.Wai.Handler.Warp (defaultSettings, runSettings, setHost, setPort) +import System.Directory (doesFileExist, renameFile) +import System.FilePath (()) +import System.Posix.Process (getProcessID) +import System.Posix.Signals (Handler (Catch), installHandler, sigTERM) + +runFixtureServer :: Int -> IO () +runFixtureServer port = + runSettings (setPort port (setHost "127.0.0.1" defaultSettings)) application + +-- | Deterministic roles for the public orchestration example. Only the worker +-- writes visibility; the API accepts one command and exposes read-only polling. +runFixtureRole :: String -> Int -> FilePath -> IO () +runFixtureRole role port root = do + mainThread <- myThreadId + _ <- installHandler sigTERM (Catch (throwTo mainThread UserInterrupt)) Nothing + pid <- getProcessID + appendFile (root "pids") (show pid <> "\n") + generation <- + if role == "worker" + then do + exists <- doesFileExist (root "generation") + previous <- if exists then read . Char8.unpack <$> ByteString.readFile (root "generation") else pure (0 :: Int) + writeFile (root "generation") (show (previous + 1)) + pure (previous + 1) + else pure 0 + firstHealth <- newIORef True + let event label = appendFile (root "events") (role <> "-" <> label <> "\n") + project = forever $ do + accepted <- doesFileExist (root "accepted") + when accepted $ do + writeFile (root "visible.tmp") ("visible:" <> show generation) + renameFile (root "visible.tmp") (root "visible") + threadDelay 10000 + serve request respond = case (requestMethod request, pathInfo request) of + (method, ["health"]) | method == methodGet -> do + first <- atomicModifyIORef' firstHealth (\value -> (False, value)) + when first (event "ready") + respond (responseLBS status200 [] "ok") + (method, ["command"]) + | role == "api", + method == methodPost -> do + exists <- doesFileExist (root "accepted") + if exists + then respond (responseLBS status409 [] "duplicate") + else do + _ <- strictRequestBody request + writeFile (root "accepted") "accepted" + event "mutation" + respond (responseLBS status201 [] "accepted") + (method, ["read"]) + | role == "api", + method == methodGet -> do + event "read" + exists <- doesFileExist (root "visible") + if exists + then do + visible <- ByteString.readFile (root "visible") + respond (responseLBS status200 [] (LazyByteString.fromStrict visible)) + else respond (responseLBS status503 [] "pending") + _ -> respond (responseLBS status404 [] "not found") + run = runSettings (setPort port (setHost "127.0.0.1" defaultSettings)) serve + bracket_ (event "start") (event "stop") $ + if role == "worker" then bracket (forkIO project) killThread (const run) else run + +application :: Application +application request respond = case (requestMethod request, pathInfo request) of + (method, ["health"]) + | method == methodGet -> + respond (text status200 "ok\n") + (method, ["oauth", "token"]) + | method == methodPost -> + respond (json status200 "{\"access_token\":\"fixture-token\",\"token_type\":\"Bearer\"}\n") + (method, ["odata", "echo"]) + | method == methodGet -> + respond (json status200 (LazyByteString.fromStrict (showQuery (queryString request)))) + (method, ["capture"]) + | method == methodGet -> + respond (responseLBS status200 [("Content-Type", "text/plain"), ("X-Fixture-Capture", "captured-value")] "capture-body\n") + (method, ["raw-response"]) + | method == methodGet -> + respond (responseLBS status200 [("Content-Type", "application/octet-stream"), ("X-Raw", "yes")] "raw\NULbytes\n") + (method, ["mutating"]) | method == methodPost || method == methodDelete -> do + body <- strictRequestBody request + respond (responseLBS status201 [(hContentType, "application/octet-stream")] body) + (_method, ["mutating"]) -> + respond (text status405 "method not allowed\n") + _ -> respond (text status404 "not found\n") + where + text status = responseLBS status [(hContentType, "text/plain; charset=utf-8")] + json status = responseLBS status [(hContentType, "application/json")] + +showQuery :: [(ByteString.ByteString, Maybe ByteString.ByteString)] -> ByteString.ByteString +showQuery query = + "{\"query\":\"" + <> ByteString.intercalate + "&" + [name <> maybe "" ("=" <>) value | (name, value) <- query] + <> "\"}\n" diff --git a/test/fixture-server/Main.hs b/test/fixture-server/Main.hs new file mode 100644 --- /dev/null +++ b/test/fixture-server/Main.hs @@ -0,0 +1,38 @@ +module Main (main) where + +import FixtureServer (runFixtureRole, runFixtureServer) +import System.Environment (getArgs, getEnvironment, lookupEnv) +import Text.Read (readMaybe) + +main :: IO () +main = do + arguments <- getArgs + case arguments of + ["--role", role, "--port", value, "--state-dir", root] | role `elem` ["api", "stub", "worker"] -> + case readMaybe value of + Just port | port > 0 && port <= 65535 -> runFixtureRole role port root + _ -> ioError (userError "invalid role port") + _ -> runDefault arguments + +runDefault :: [String] -> IO () +runDefault arguments = do + if arguments == ["--assert-clean"] + then do + environment <- getEnvironment + if filter (/= "__CF_USER_TEXT_ENCODING") (map fst environment) == ["PORT"] then pure () else ioError (userError "unexpected clean fixture environment names") + else pure () + environmentPort <- lookupEnv "PORT" + case parsePort arguments environmentPort of + Left message -> ioError (userError message) + Right port -> runFixtureServer port + +parsePort :: [String] -> Maybe String -> Either String Int +parsePort arguments environmentPort = case arguments of + ["--assert-clean"] -> maybe (Right 18080) readPort environmentPort + [] -> maybe (Right 18080) readPort environmentPort + ["--port", value] -> readPort value + _ -> Left "usage: hurl-workbench-fixture-server [--port PORT]" + where + readPort value = case readMaybe value of + Just port | port > 0 && port <= 65535 -> Right port + _ -> Left ("invalid port: " <> value) diff --git a/test/fixtures/scenario-isolation/hurl-workbench.dhall b/test/fixtures/scenario-isolation/hurl-workbench.dhall new file mode 100644 --- /dev/null +++ b/test/fixtures/scenario-isolation/hurl-workbench.dhall @@ -0,0 +1,19 @@ +let S = ../../../../schema/package.dhall + +in S.Workspace::{ + , schemaVersion = 1 + , parameters = + [ S.Parameter::{ name = "baseUrl" } + , S.Parameter::{ name = "marker" } + , S.Parameter::{ name = "token", kind = S.ParameterKind.Secret } + ] + , fragments = [ S.Fragment::{ name = "write", path = "hurl/write.hurl" } ] + , workflows = + [ S.Workflow::{ name = "write", fragments = [ "write" ], parameters = [ "baseUrl", "marker", "token" ] } ] + , recipes = + [ S.Recipe::{ name = "write", workflow = "write", safety = S.Safety.Mutating } ] + , matrices = + [ S.Matrix::{ name = "writes", recipe = "write", cases = [ S.MatrixCase::{ name = "first" }, S.MatrixCase::{ name = "second" } ] } ] + , suites = + [ S.Suite::{ name = "independent-writes", runs = [ S.RunReference.Matrix "writes" ], isolation = S.IsolationPolicy.IndependentState } ] + } diff --git a/test/fixtures/scenario-isolation/hurl/write.hurl b/test/fixtures/scenario-isolation/hurl/write.hurl new file mode 100644 --- /dev/null +++ b/test/fixtures/scenario-isolation/hurl/write.hurl @@ -0,0 +1,14 @@ +POST {{baseUrl}}/markers +Content-Type: application/json +X-Test-Token: {{token}} +{ + "marker": "{{marker}}" +} +HTTP 201 + +GET {{baseUrl}}/markers +HTTP 200 +[Asserts] +header "Content-Type" contains "application/json" +jsonpath "$.marker" == "{{marker}}" +jsonpath "$.count" == 1 diff --git a/test/fixtures/scenario-isolation/server.py b/test/fixtures/scenario-isolation/server.py new file mode 100644 --- /dev/null +++ b/test/fixtures/scenario-isolation/server.py @@ -0,0 +1,87 @@ +"""Disposable provider-owned HTTP fixture. Database mode requires real psql. + +Only --memory selects the local test fixture; real lease acceptance never falls +back to it. Credentials remain in the provider's environment/protected passfile. +""" +import argparse +import http.server +import json +import os +import pathlib +import subprocess +import threading +import time + +parser = argparse.ArgumentParser() +parser.add_argument("--directory", type=pathlib.Path, required=True) +parser.add_argument("--name", required=True, choices=("first", "second")) +parser.add_argument("--mode", default="success", choices=("success", "failure", "cancellation")) +parser.add_argument("--memory", action="store_true") +options = parser.parse_args() +markers = [] +lock = threading.Lock() + + +def sql(statement): + result = subprocess.run([os.environ["SCENARIO_PSQL"], "-X", "-w", "-Atq"], + input=statement.encode(), capture_output=True, timeout=10) + if result.returncode: + raise RuntimeError("private database operation failed") + return result.stdout.decode().strip().splitlines() + + +if not options.memory: + assert sql("SELECT current_database();") == [os.environ["PGDATABASE"]] + assert sql("SELECT current_user;") == [os.environ["PGUSER"]] + sql("CREATE TABLE scenario_markers (marker text NOT NULL);") + + +class Handler(http.server.BaseHTTPRequestHandler): + def log_message(self, *_args): + pass + + def reply(self, status, body): + data = json.dumps(body).encode() + self.send_response(status) + self.send_header("Content-Type", "application/json") + self.send_header("Content-Length", str(len(data))) + self.end_headers() + self.wfile.write(data) + + def do_GET(self): + if self.path == "/health": + self.reply(200, {}) + return + with lock: + values = list(markers) if options.memory else sql("SELECT marker FROM scenario_markers ORDER BY marker;") + self.reply(200, {"count": len(values), "marker": values[0] if len(values) == 1 else None}) + + def do_POST(self): + data = json.loads(self.rfile.read(int(self.headers["Content-Length"]))) + marker = data["marker"] + assert marker in ("private-first-marker", "private-second-marker") + with lock: + if options.memory: + markers.append(marker) + else: + sql("INSERT INTO scenario_markers VALUES ('" + marker + "');") + (options.directory / (options.name + ".posted")).touch() + if options.mode == "failure": + self.reply(500, {}) + return + deadline = time.monotonic() + 20 + while options.mode == "cancellation" or not all((options.directory / (name + ".posted")).exists() for name in ("first", "second")): + if time.monotonic() >= deadline: + self.reply(504, {}) + return + time.sleep(0.01) + self.reply(201, {}) + + +server = http.server.ThreadingHTTPServer(("127.0.0.1", 0), Handler) +ready = options.directory / (options.name + ".ready.json") +temporary = ready.with_suffix(".tmp") +temporary.touch(mode=0o600) +temporary.write_text(json.dumps({"endpoint": f"http://127.0.0.1:{server.server_port}", "pid": os.getpid()})) +temporary.replace(ready) +server.serve_forever() diff --git a/test/golden/top-level-help.txt b/test/golden/top-level-help.txt new file mode 100644 --- /dev/null +++ b/test/golden/top-level-help.txt @@ -0,0 +1,27 @@ +hurl-workbench - compose, explore, and test reusable Hurl workflows + +Usage: hurl-workbench [--workspace FILE] COMMAND [--version] + + Keep each Hurl entry once, combine entries into named workflows, and validate + the workspace that describes them. + +Workspace + --workspace FILE Workspace manifest to use instead of discovering + hurl-workbench.dhall from the current directory + upward + +Available options: + -h,--help Show this help text + --version Show package version and build revision + +Available commands: + validate Check the workspace and report every problem at once + list List the named entities in the workspace + render Compose and syntax-check inspectable Hurl source + run Execute one workflow in Hurl client mode + test Execute one workflow, recipe, or integration suite in + Hurl test mode + matrix Execute every declared case in one named matrix + completions Generate a completion script for Bash, Zsh, or Fish + doctor Report Hurl and Hurlfmt paths, versions, and support + status diff --git a/test/golden/unknown-workflow.txt b/test/golden/unknown-workflow.txt new file mode 100644 --- /dev/null +++ b/test/golden/unknown-workflow.txt @@ -0,0 +1,1 @@ +error: unknown workflow "missing"