packages feed

hurl-workbench-core (empty) → 0.1.0.0

raw patch · 118 files changed

+10727/−0 lines, 118 filesdep +aesondep +asyncdep +base

Dependencies added: aeson, async, base, bytestring, containers, dhall, directory, filepath, generic-lens, http-client, http-types, hurl-workbench-core, lens, process, stm, tasty, tasty-hunit, temporary, text, time, typed-process, unix

Files

+ CHANGELOG.md view
@@ -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.
+ LICENSE view
@@ -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.
+ README.md view
@@ -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.
+ hurl-workbench-core.cabal view
@@ -0,0 +1,157 @@+cabal-version: 3.4+name: hurl-workbench-core+version: 0.1.0.0+synopsis: Core library for composing and executing reusable Hurl API workflows+description:+  A Haskell-powered Hurl workbench for composing, exploring, executing, and+  testing reusable API workflows without duplicating request templates.+  .+  This library provides the engine behind the @hurl-workbench@ command: typed,+  versioned Dhall workspaces; byte-preserving Hurl fragment composition with+  source-mapped validation; secure Hurl 8.x execution that keeps secrets out+  of child argv; read-only and mutating recipes; bounded matrices; managed+  services cleaned up as POSIX process groups; and ordered integration suites+  with executable checks and isolated JUnit, HTML, JSON, and TAP reports.++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:+  schema/*.dhall+  test/fixtures/processes/*.c+  test/fixtures/workspaces/**/*.dhall+  test/fixtures/workspaces/**/*.hurl+  test/fixtures/workspaces/**/*.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+  exposed-modules:+    HurlWorkbench.Check.Resolve+    HurlWorkbench.Check.Run+    HurlWorkbench.Hurl.Capabilities+    HurlWorkbench.Hurl.Format+    HurlWorkbench.Hurl.Run+    HurlWorkbench.Parameter.Generate+    HurlWorkbench.Parameter.Properties+    HurlWorkbench.Parameter.Resolve+    HurlWorkbench.Prelude+    HurlWorkbench.Run.Artifact+    HurlWorkbench.Run.Batch+    HurlWorkbench.Run.FileRoot+    HurlWorkbench.Run.Prepare+    HurlWorkbench.Run.Selection+    HurlWorkbench.Service.Environment+    HurlWorkbench.Service.Group+    HurlWorkbench.Service.Resolve+    HurlWorkbench.Service.Run+    HurlWorkbench.Suite.Isolation+    HurlWorkbench.Suite.Resolve+    HurlWorkbench.Suite.Run+    HurlWorkbench.Suite.Scenario+    HurlWorkbench.Workflow.Render+    HurlWorkbench.Workflow.Resolve+    HurlWorkbench.Workspace.Context+    HurlWorkbench.Workspace.Decode+    HurlWorkbench.Workspace.Discover+    HurlWorkbench.Workspace.Error+    HurlWorkbench.Workspace.Types+    HurlWorkbench.Workspace.Validate++  other-modules:+    HurlWorkbench.Check.Template+    HurlWorkbench.Parameter.Resolve.Internal+    HurlWorkbench.Process.Run+    HurlWorkbench.Workspace.Context.Internal++  build-depends:+    aeson >=2.2.5.1 && <2.3,+    async ^>=2.2.6,+    base >=4.20 && <5,+    bytestring >=0.11 && <0.13,+    containers >=0.6 && <0.8,+    dhall ^>=1.42,+    directory ^>=1.3,+    filepath >=1.4 && <1.6,+    generic-lens ^>=2.3,+    http-client ^>=0.7.19,+    http-types >=0.12 && <0.13,+    lens ^>=5.3,+    process >=1.6.3 && <1.7,+    stm >=2.5 && <2.6,+    temporary ^>=1.3,+    text ^>=2.1,+    time >=1.14 && <1.17,+    typed-process ^>=0.2.13,+    unix >=2.8.8 && <2.9,++test-suite hurl-workbench-core-test+  import: common-options+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  other-modules:+    HurlWorkbench.Check.RunTest+    HurlWorkbench.Hurl.RunTest+    HurlWorkbench.Parameter.GenerateTest+    HurlWorkbench.Parameter.ParameterTest+    HurlWorkbench.Run.FileRootTest+    HurlWorkbench.Run.SelectionTest+    HurlWorkbench.Service.RunTest+    HurlWorkbench.Suite.LifecycleTest+    HurlWorkbench.Suite.RunTest+    HurlWorkbench.Suite.ScenarioTest+    HurlWorkbench.Workflow.WorkflowTest+    HurlWorkbench.Workspace.NameSafetyTest+    HurlWorkbench.Workspace.WorkspaceTest++  ghc-options:+    -threaded++  build-depends:+    aeson >=2.2.5.1 && <2.3,+    async,+    base >=4.20 && <5,+    bytestring,+    containers,+    directory,+    filepath,+    generic-lens,+    hurl-workbench-core,+    lens,+    stm,+    tasty ^>=1.5,+    tasty-hunit ^>=0.10,+    temporary ^>=1.3,+    text,+    time >=1.14 && <1.17,+    typed-process,+    unix,
+ schema/Binding.dhall view
@@ -0,0 +1,2 @@+{- A plain value bound to a parameter declared by the selected workflow. -}+{ Type = { parameter : Text, value : Text }, default = {=} }
+ schema/Check.dhall view
@@ -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+      }+    }
+ schema/CommandReadiness.dhall view
@@ -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 }+    }
+ schema/CommandSpec.dhall view
@@ -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+      }+    }
+ schema/EnvironmentBinding.dhall view
@@ -0,0 +1,2 @@+{- Export the workspace parameter `parameter` to a child process as `variable`. -}+{ Type = { variable : Text, parameter : Text }, default = {=} }
+ schema/EnvironmentPolicy.dhall view
@@ -0,0 +1,1 @@+< Inherit | Clean : List Text >
+ schema/Fragment.dhall view
@@ -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+}
+ schema/Generator.dhall view
@@ -0,0 +1,1 @@+< Uuid4 | Uuid7 | TypeId : { prefix : Text } | Rfc3339Now | RandomAlphanumeric : { length : Natural } >
+ schema/HttpReadiness.dhall view
@@ -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 }+}
+ schema/IsolationPolicy.dhall view
@@ -0,0 +1,2 @@+{- Whether expanded scenarios share application state. -}+< SharedState | IndependentState >
+ schema/Matrix.dhall view
@@ -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 }+    }
+ schema/MatrixCase.dhall view
@@ -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+    }
+ schema/Parameter.dhall view
@@ -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+      }+    }
+ schema/ParameterKind.dhall view
@@ -0,0 +1,2 @@+let Generator = ./Generator.dhall+in < Plain | Secret | Generated : Generator >
+ schema/Readiness.dhall view
@@ -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+>
+ schema/Recipe.dhall view
@@ -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 }+    }
+ schema/RunReference.dhall view
@@ -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 >
+ schema/Safety.dhall view
@@ -0,0 +1,4 @@+{- Whether running a recipe may change remote state.+   `Mutating` recipes only run when explicitly allowed at execution time.+-}+< ReadOnly | Mutating >
+ schema/Service.dhall view
@@ -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 }+    }
+ schema/ServiceStep.dhall view
@@ -0,0 +1,2 @@+{- An ordered lifecycle barrier for a service belonging to this suite. -}+< Stop : Text | Start : Text | Restart : Text >
+ schema/Suite.dhall view
@@ -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+        }+    }
+ schema/Workflow.dhall view
@@ -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 }+}
+ schema/Workspace.dhall view
@@ -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+      }+    }
+ schema/package.dhall view
@@ -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+}
+ src/HurlWorkbench/Check/Resolve.hs view
@@ -0,0 +1,54 @@+-- | Suite-wide inputs only; argv templates never accept Secret or Generated.+module HurlWorkbench.Check.Resolve (ResolvedCheck (..), CheckResolutionError (..), prepareCheck, renderCheckResolutionError) where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime)+import HurlWorkbench.Check.Template+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Service.Resolve+import HurlWorkbench.Service.Run (prepareCommand)+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types++-- The command's Show instance redacts all resolved values.+data ResolvedCheck = ResolvedCheck+  { name :: !CheckName,+    processConfig :: !ResolvedCommand,+    expectedStatus :: !Int,+    timeout :: !NominalDiffTime+  }+  deriving stock (Generic, Eq, Show)++data CheckResolutionError = CheckBindingFailed !BindingError | CheckCommandFailed !ServiceError | CheckTemplateInvalid | CheckDefinitionMissing+  deriving stock (Generic, Eq, Show)++prepareCheck :: [(String, String)] -> ValidatedWorkspace -> BindingInput -> CheckName -> IO (Either CheckResolutionError ResolvedCheck)+prepareCheck ambient workspace input name = case (lookupCheck name workspace, lookupCheckExecutable name workspace) of+  (Just check, Just executable) -> case traverse parseTemplate (check ^. #command . #arguments) of+    Left _ -> pure (Left CheckTemplateInvalid)+    Right templates -> do+      let required = Set.fromList ([p | templateParts <- templates, Placeholder p <- templateParts] <> map (view #parameter) (check ^. #command . #environment))+      resolveParameterSubsetInEnvironment ambient workspace required input <&> \case+        Left err -> Left (CheckBindingFailed err)+        Right bindings -> do+          let render (Literal value) = Right value+              render (Placeholder parameter) = case lookupParameter parameter workspace of+                Just definition | definition ^. #kind == Plain -> maybe (Left CheckTemplateInvalid) (Right . hurlValueLiteralText) (Map.lookup parameter (bindings ^. #variables))+                _ -> Left CheckTemplateInvalid+          arguments <- traverse (fmap Text.unpack . fmap Text.concat . traverse render) templates+          command <- either (Left . CheckCommandFailed) Right (resolveCommand workspace bindings (check ^. #command))+          frozen <- either (Left . CheckCommandFailed) Right (prepareCommand ambient (ServiceName (unCheckName name)) "check" (command & #executable .~ executable & #arguments .~ arguments))+          pure (ResolvedCheck name frozen (fromIntegral (check ^. #expectedStatus)) (maybe 60 fromIntegral (check ^. #timeoutSeconds)))+  _ -> pure (Left CheckDefinitionMissing)++renderCheckResolutionError :: CheckResolutionError -> Text+renderCheckResolutionError = \case+  CheckBindingFailed err -> renderBindingError err+  CheckCommandFailed (ServiceEnvironmentMissing _ _ names) -> "check requires missing environment variables: " <> Text.intercalate ", " names+  CheckCommandFailed _ -> "check command preparation failed"+  CheckTemplateInvalid -> "invalid check argument template"+  CheckDefinitionMissing -> "check definition unavailable"
+ src/HurlWorkbench/Check/Run.hs view
@@ -0,0 +1,148 @@+-- | One execution with file captures and bounded process-group cleanup.+module HurlWorkbench.Check.Run+  ( CheckOutcome (..),+    CheckResult (..),+    runCheck,+    runCheckObserved,+    runCheckObservedWith,+    checkPassed,+    checkExitCode,+    checkStatus,+    skippedCheck,+  )+where++import Control.Applicative ((<|>))+import Control.Concurrent.Async (async, wait)+import Control.Exception (IOException, SomeException, mask, throwIO, try, uninterruptibleMask_)+import Data.Generics.Labels ()+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)+import HurlWorkbench.Check.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Process.Run+import HurlWorkbench.Service.Resolve (ServiceError)+import HurlWorkbench.Workspace.Types (CheckName (..), ServiceName (..))+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO (hClose)+import System.Posix.Files (ownerReadMode, ownerWriteMode, setFileMode, unionFileModes)+import System.Posix.IO (OpenFileFlags (..), OpenMode (WriteOnly), defaultFileFlags, fdToHandle, openFd)+import System.Process qualified as Process+import System.Timeout qualified as Timeout++data CheckOutcome = CheckPassed | CheckMismatch | CheckTimedOut | CheckSignalled | CheckCancelled | CheckStartFailed | CheckSkipped !Text+  deriving stock (Generic, Eq, Show)++data CheckResult = CheckResult+  { name :: !CheckName,+    outcome :: !CheckOutcome,+    expectedStatus :: !Int,+    actualStatus :: !(Maybe Int),+    elapsed :: !(Maybe NominalDiffTime),+    stdoutPath :: !(Maybe FilePath),+    stderrPath :: !(Maybe FilePath),+    cleanupDiagnostics :: ![Text]+  }+  deriving stock (Generic, Eq, Show)++-- | Paths are suite-relative; no output, argv, environments or exception text.+skippedCheck :: Text -> ResolvedCheck -> CheckResult+skippedCheck reason check = CheckResult (check ^. #name) (CheckSkipped reason) (check ^. #expectedStatus) Nothing Nothing Nothing Nothing []++checkPassed :: CheckResult -> Bool+checkPassed result = result ^. #outcome == CheckPassed && null (result ^. #cleanupDiagnostics)++checkStatus :: CheckResult -> Text+checkStatus result = case result ^. #outcome of+  CheckPassed | not (null (result ^. #cleanupDiagnostics)) -> "cleanup-failed"+  CheckPassed -> "passed"+  CheckMismatch -> "failed"+  CheckTimedOut -> "timed-out"+  CheckSignalled -> "signalled"+  CheckCancelled -> "cancelled"+  CheckStartFailed -> "start-failed"+  CheckSkipped reason -> reason++checkExitCode :: CheckResult -> ExitCode+checkExitCode result = case result ^. #outcome of+  CheckPassed -> if null (result ^. #cleanupDiagnostics) then ExitSuccess else ExitFailure 3+  CheckMismatch -> ExitFailure (max 1 (fromMaybe 1 (result ^. #actualStatus)))+  CheckTimedOut -> ExitFailure 124+  CheckSignalled -> ExitFailure (128 + abs (fromMaybe 0 (result ^. #actualStatus)))+  CheckCancelled -> ExitFailure 130+  CheckStartFailed -> ExitFailure 3+  CheckSkipped _ -> ExitSuccess++runCheck :: FilePath -> ResolvedCheck -> IO CheckResult+runCheck root check = runCheckObserved root check (const (pure ()))++runCheckObserved :: FilePath -> ResolvedCheck -> (CheckResult -> IO ()) -> IO CheckResult+runCheckObserved root check = runCheckObservedWith (terminateGroup (ServiceName (unCheckName (check ^. #name))) 10) root check++-- | The cleanup action is injectable for fault tests. Production always uses+-- the common ten-second TERM/KILL/reap policy, also after normal leader exit.+runCheckObservedWith :: (OwnedProcess -> IO (Either ServiceError ())) -> FilePath -> ResolvedCheck -> (CheckResult -> IO ()) -> IO CheckResult+runCheckObservedWith cleanup root check observe = mask $ \restore -> do+  began <- getCurrentTime+  let relative = "checks" </> unpackName (check ^. #name)+      out = relative </> "stdout"+      err = relative </> "stderr"+      initial = (skippedCheck "cancelled" check) {outcome = CheckCancelled}+      finish outcome actual diagnostics artifacts = do+        ended <- getCurrentTime+        let result = initial {outcome, actualStatus = actual, elapsed = Just (diffUTCTime ended began), stdoutPath = if artifacts then Just out else Nothing, stderrPath = if artifacts then Just err else Nothing, cleanupDiagnostics = diagnostics}+        observe result+        pure result+  -- O_EXCL creates 0600 files atomically and refuses a replaced capture path.+  allocated <- try @IOException $ do+    stdout <- capture (root </> out)+    stderr <- capture (root </> err) `onIoFailure` hClose stdout+    pure (stdout, stderr)+  case allocated of+    Left _ -> finish CheckStartFailed Nothing [] False+    Right (stdout, stderr) -> do+      let close = hClose stdout >> hClose stderr+      spawnBegan <- getCurrentTime+      started <- spawnGroup (ServiceName (unCheckName (check ^. #name))) (commandConfig (check ^. #processConfig)) {Process.std_out = Process.UseHandle stdout, Process.std_err = Process.UseHandle stderr}+      case started of+        Left _ -> close >> finish CheckStartFailed Nothing [] True+        Right owned -> do+          now <- getCurrentTime+          let remaining = floor (((check ^. #timeout) - diffUTCTime now spawnBegan) * 1000000)+          executed <- try @SomeException (restore (if remaining <= 0 then pure Nothing else Timeout.timeout remaining (waitExitCode owned)))+          -- Cancellation can arrive after leader exit while TERM grace is+          -- running. Join the independently bounded cleanup task before allowing+          -- that exception to propagate; do not cancel the cleanup itself.+          cleaning <- async (try @SomeException (cleanup owned))+          joined <- try @SomeException (wait cleaning)+          (cleaned, interrupted) <- case joined of+            Right result -> pure (result, Nothing)+            Left exception -> (,Just exception) <$> uninterruptibleMask_ (wait cleaning)+          closed <- try @IOException close+          let diagnostics = (case cleaned of Right (Right ()) -> []; _ -> ["process-group-cleanup-failed"]) <> ["capture-close-failed" | Left _ <- [closed]]+              exception = either Just (const Nothing) executed <|> interrupted+          case exception of+            Just exception_ -> do+              _ <- finish CheckCancelled Nothing diagnostics True+              throwIO exception_+            Nothing -> case executed of+              Left exception_ -> throwIO exception_+              Right Nothing -> finish CheckTimedOut Nothing diagnostics True+              Right (Just status) ->+                let actual = case status of ExitSuccess -> 0; ExitFailure code -> code+                    outcome+                      | actual < 0 = CheckSignalled+                      | actual == check ^. #expectedStatus = CheckPassed+                      | otherwise = CheckMismatch+                 in finish outcome (Just actual) diagnostics True+  where+    unpackName = Text.unpack . unCheckName+    capture path = do+      fd <- openFd path WriteOnly defaultFileFlags {creat = Just (ownerReadMode `unionFileModes` ownerWriteMode), exclusive = True, nofollow = True}+      handle <- fdToHandle fd+      setFileMode path (ownerReadMode `unionFileModes` ownerWriteMode)+      pure handle+    onIoFailure action cleanupAction = do+      result <- try @IOException action+      case result of Left exception -> cleanupAction >> throwIO exception; Right value -> pure value
+ src/HurlWorkbench/Check/Template.hs view
@@ -0,0 +1,23 @@+-- | Exact {{parameter}} placeholders. Substitution preserves argv boundaries.+module HurlWorkbench.Check.Template (TemplatePart (..), parseTemplate) where++import Data.Text qualified as Text+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Types (ParameterName (..))++data TemplatePart = Literal !Text | Placeholder !ParameterName+  deriving stock (Eq, Show)++parseTemplate :: Text -> Either Text [TemplatePart]+parseTemplate = go+  where+    go remaining = case Text.breakOn "{{" remaining of+      (prefix, rest)+        | "}}" `Text.isInfixOf` prefix -> malformed+        | Text.null rest -> Right [Literal prefix]+        | otherwise ->+            let (name, close) = Text.breakOn "}}" (Text.drop 2 rest)+             in if Text.null close || Text.null name || Text.any (`elem` ['{', '}']) name+                  then malformed+                  else (Literal prefix :) . (Placeholder (ParameterName name) :) <$> go (Text.drop 2 close)+    malformed = Left "malformed parameter placeholder"
+ src/HurlWorkbench/Hurl/Capabilities.hs view
@@ -0,0 +1,63 @@+-- | Detection of the external Hurl toolchain used by execution commands.+module HurlWorkbench.Hurl.Capabilities+  ( HurlCapabilities (..),+    detectHurlCapabilities,+    parseHurlVersion,+    hurlCapabilityWarnings,+  )+where++import Control.Exception (IOException, displayException, try)+import Data.ByteString.Lazy qualified as LazyByteString+import Data.Generics.Labels ()+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import Data.Text.Encoding.Error (lenientDecode)+import Data.Version (Version, makeVersion, versionBranch)+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Prelude+import System.Directory (findExecutable)+import System.Exit (ExitCode (..))+import System.Process.Typed (proc, readProcess)++data HurlCapabilities = HurlCapabilities+  { hurlExecutable :: !FilePath,+    hurlVersion :: !Version,+    hurlfmt :: !HurlfmtCapabilities+  }+  deriving stock (Generic, Eq, Show)++detectHurlCapabilities :: IO (Either DependencyError HurlCapabilities)+detectHurlCapabilities = do+  located <- findExecutable "hurl"+  case located of+    Nothing -> pure (Left (DependencyNotFound "hurl" "hurl"))+    Just executable -> do+      probed <- try @IOException (readProcess (proc executable ["--version"]))+      case probed of+        Left err -> pure (Left (DependencyNotFound "hurl" (executable <> ": " <> displayException err)))+        Right (exitCode, stdout, stderr)+          | exitCode /= ExitSuccess -> pure (Left (DependencyProbeFailed "hurl" exitCode (decodeOutput stderr)))+          | otherwise -> case parseHurlVersion (decodeOutput stdout) of+              Nothing -> pure (Left (DependencyVersionUnrecognized "hurl" (decodeOutput stdout)))+              Just version+                | version < makeVersion [8, 0, 0] -> pure (Left (DependencyVersionUnsupported "hurl" version (makeVersion [8, 0, 0])))+                | otherwise ->+                    detectHurlfmtCapabilities <&> fmap (HurlCapabilities executable version)++parseHurlVersion :: Text -> Maybe Version+parseHurlVersion = parseHurlfmtVersion++hurlCapabilityWarnings :: HurlCapabilities -> [Text]+hurlCapabilityWarnings capabilities =+  [ "warning: Hurl major version "+      <> Text.pack (show major)+      <> " is newer than the tested Hurl 8.x adapter"+  | let major = case versionBranch (capabilities ^. #hurlVersion) of+          value : _ -> value+          [] -> 0,+    major > 8+  ]++decodeOutput :: LazyByteString.ByteString -> Text+decodeOutput = Text.Encoding.decodeUtf8With lenientDecode . LazyByteString.toStrict
+ src/HurlWorkbench/Hurl/Format.hs view
@@ -0,0 +1,241 @@+-- | Hurlfmt capability detection and syntax validation. Hurlfmt remains the+--   parser oracle; this module does not interpret Hurl grammar.+module HurlWorkbench.Hurl.Format+  ( HurlfmtExecutable (..),+    HurlfmtCapabilities (..),+    DependencyError (..),+    HurlfmtError (..),+    WorkflowSyntaxError (..),+    detectHurlfmtCapabilities,+    parseHurlfmtVersion,+    validateRenderedWorkflow,+    validateWorkspaceSyntax,+    renderDependencyError,+    renderHurlfmtError,+    renderWorkflowSyntaxError,+  )+where++import Control.Exception (IOException, displayException, try)+import Data.ByteString qualified as ByteString+import Data.ByteString.Lazy qualified as LazyByteString+import Data.Char (isDigit)+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import Data.Text.Encoding.Error (lenientDecode)+import Data.Version (Version, makeVersion)+import HurlWorkbench.Prelude+import HurlWorkbench.Workflow.Render+import HurlWorkbench.Workflow.Resolve+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import System.Directory (findExecutable)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process.Typed (proc, readProcess)+import Text.Read (readMaybe)++newtype HurlfmtExecutable = HurlfmtExecutable {unHurlfmtExecutable :: FilePath}+  deriving stock (Generic, Eq, Ord, Show)++data HurlfmtCapabilities = HurlfmtCapabilities+  { executable :: !HurlfmtExecutable,+    version :: !Version+  }+  deriving stock (Generic, Eq, Show)++data DependencyError+  = DependencyNotFound !Text !FilePath+  | DependencyProbeFailed !Text !ExitCode !Text+  | DependencyVersionUnrecognized !Text !Text+  | DependencyVersionUnsupported !Text !Version !Version+  deriving stock (Generic, Eq, Show)++data HurlfmtError+  = HurlfmtNotFound !FilePath+  | InvalidHurl !WorkflowName !(Maybe RenderedFragmentSpan) !Text+  | HurlfmtFailed !ExitCode !Text+  deriving stock (Generic, Eq, Show)++data WorkflowSyntaxError+  = SyntaxResolutionFailed !WorkflowError+  | SyntaxRenderFailed !WorkflowName !RenderError+  | SyntaxFormatFailed !HurlfmtError+  deriving stock (Generic, Eq, Show)++detectHurlfmtCapabilities :: IO (Either DependencyError HurlfmtCapabilities)+detectHurlfmtCapabilities = do+  located <- findExecutable "hurlfmt"+  case located of+    Nothing -> pure (Left (DependencyNotFound "hurlfmt" "hurlfmt"))+    Just path -> do+      probe <- try (readProcess (proc path ["--version"]))+      pure $ case probe of+        Left (err :: IOException) -> Left (DependencyNotFound "hurlfmt" (path <> ": " <> displayException err))+        Right (exitCode, stdout, stderr)+          | exitCode /= ExitSuccess ->+              Left (DependencyProbeFailed "hurlfmt" exitCode (decodeOutput stderr))+          | otherwise -> case parseHurlfmtVersion (decodeOutput stdout) of+              Nothing -> Left (DependencyVersionUnrecognized "hurlfmt" (decodeOutput stdout))+              Just detected ->+                Right+                  HurlfmtCapabilities+                    { executable = HurlfmtExecutable path,+                      version = detected+                    }++parseHurlfmtVersion :: Text -> Maybe Version+parseHurlfmtVersion output =+  makeVersion <$> firstJust (map parseCandidate (Text.words output))+  where+    parseCandidate token =+      let candidate = Text.takeWhile (\c -> isDigit c || c == '.') (Text.dropWhile (not . isDigit) token)+          components = Text.splitOn "." candidate+       in if null components || any Text.null components+            then Nothing+            else traverse (readMaybe . Text.unpack) components++    firstJust = \case+      [] -> Nothing+      Nothing : remaining -> firstJust remaining+      Just value : _ -> Just value++validateRenderedWorkflow :: HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())+validateRenderedWorkflow capabilities rendered =+  withSystemTempDirectory "hurl-workbench-hurlfmt" $ \directory -> do+    let temporaryFile = directory </> "workflow.hurl"+        HurlfmtExecutable executablePath = capabilities ^. #executable+    writeResult <- try (ByteString.writeFile temporaryFile (Text.Encoding.encodeUtf8 (rendered ^. #contents)))+    case writeResult of+      Left (err :: IOException) ->+        pure (Left (HurlfmtFailed (ExitFailure 1) (Text.pack (displayException err))))+      Right () -> do+        processResult <-+          try+            ( readProcess+                (proc executablePath ["--no-color", "--out", "json", temporaryFile])+            )+        pure $ case processResult of+          Left (_err :: IOException) -> Left (HurlfmtNotFound executablePath)+          Right (ExitSuccess, _stdout, _stderr) -> Right ()+          Right (exitCode, _stdout, stderr) ->+            let diagnostics = decodeOutput stderr+             in case diagnosticLine diagnostics of+                  Just line ->+                    Left+                      ( InvalidHurl+                          (rendered ^. #workflowName)+                          (spanForLine line (rendered ^. #fragmentSpans))+                          diagnostics+                      )+                  Nothing -> Left (HurlfmtFailed exitCode diagnostics)++validateWorkspaceSyntax ::+  HurlfmtCapabilities ->+  ValidatedWorkspace ->+  IO (Either DependencyError [WorkflowSyntaxError])+validateWorkspaceSyntax capabilities validated =+  go [] (Map.keys (validatedWorkflows validated))+  where+    HurlfmtExecutable executablePath = capabilities ^. #executable++    go issues [] = pure (Right (reverse issues))+    go issues (name : remaining) =+      case resolveWorkflow validated name of+        Left err -> go (SyntaxResolutionFailed err : issues) remaining+        Right resolved ->+          renderWorkflow resolved >>= \case+            Left err -> go (SyntaxRenderFailed name err : issues) remaining+            Right rendered ->+              validateRenderedWorkflow capabilities rendered >>= \case+                Left (HurlfmtNotFound _) -> pure (Left (DependencyNotFound "hurlfmt" executablePath))+                Left err -> go (SyntaxFormatFailed err : issues) remaining+                Right () -> go issues remaining++spanForLine :: Int -> NonEmpty RenderedFragmentSpan -> Maybe RenderedFragmentSpan+spanForLine line =+  findFirst+    (\span_ -> line >= span_ ^. #firstLine && line <= span_ ^. #lastLine)+    . NonEmpty.toList+  where+    findFirst _ [] = Nothing+    findFirst predicate (value : remaining)+      | predicate value = Just value+      | otherwise = findFirst predicate remaining++diagnosticLine :: Text -> Maybe Int+diagnosticLine diagnostics =+  firstJust (map parseLocation (Text.lines diagnostics))+  where+    parseLocation raw = do+      location <- Text.stripPrefix "--> " (Text.strip raw)+      let (throughLine, columnText) = Text.breakOnEnd ":" location+          withoutColumn = Text.dropEnd 1 throughLine+          (throughPath, lineText) = Text.breakOnEnd ":" withoutColumn+      if Text.null throughPath || Text.null columnText+        then Nothing+        else readMaybe (Text.unpack lineText)++    firstJust = \case+      [] -> Nothing+      Nothing : remaining -> firstJust remaining+      Just value : _ -> Just value++decodeOutput :: LazyByteString.ByteString -> Text+decodeOutput = Text.Encoding.decodeUtf8With lenientDecode . LazyByteString.toStrict++renderDependencyError :: DependencyError -> Text+renderDependencyError = \case+  DependencyNotFound name path ->+    "required dependency "+      <> quote name+      <> " was not found or could not be started at "+      <> Text.pack path+      <> ". Install Hurl 8.0 or newer and ensure both hurl and hurlfmt are on PATH"+  DependencyProbeFailed name exitCode message ->+    "dependency " <> quote name <> " failed its version probe with " <> Text.pack (show exitCode) <> detail message+  DependencyVersionUnrecognized name output ->+    "could not parse the version reported by dependency " <> quote name <> detail output+  DependencyVersionUnsupported name detected minimumVersion ->+    "dependency " <> quote name <> " is version " <> Text.pack (show detected) <> "; version " <> Text.pack (show minimumVersion) <> " or newer is required"++renderHurlfmtError :: HurlfmtError -> Text+renderHurlfmtError = \case+  HurlfmtNotFound path ->+    "hurlfmt could not be started at "+      <> Text.pack path+      <> ". Install Hurl 8.0 or newer and ensure both hurl and hurlfmt are on PATH"+  InvalidHurl name sourceSpan diagnostics ->+    "workflow "+      <> quote (unWorkflowName name)+      <> maybe "" renderSpan sourceSpan+      <> " is not valid Hurl:\n"+      <> Text.stripEnd diagnostics+  HurlfmtFailed exitCode diagnostics ->+    "hurlfmt failed with " <> Text.pack (show exitCode) <> detail diagnostics+  where+    renderSpan span_ =+      " (fragment "+        <> quote (unFragmentName (span_ ^. #fragmentName))+        <> " at "+        <> Text.pack (span_ ^. #fragmentPath)+        <> ")"++renderWorkflowSyntaxError :: WorkflowSyntaxError -> Text+renderWorkflowSyntaxError = \case+  SyntaxResolutionFailed err -> renderWorkflowError err+  SyntaxRenderFailed name err ->+    "workflow " <> quote (unWorkflowName name) <> ": " <> renderRenderError err+  SyntaxFormatFailed err -> renderHurlfmtError err++detail :: Text -> Text+detail value+  | Text.null (Text.strip value) = ""+  | otherwise = ": " <> Text.strip value++quote :: Text -> Text+quote value = "\"" <> value <> "\""
+ src/HurlWorkbench/Hurl/Run.hs view
@@ -0,0 +1,376 @@+-- | Secure execution of one rendered workflow through Hurl. This is the only+--   production module which constructs Hurl argv.+module HurlWorkbench.Hurl.Run+  ( HurlRunMode (..),+    RunOutputPolicy (..),+    HurlReportTarget (..),+    HurlVerbosity (..),+    AllowedHurlArgument,+    HurlOptionError (..),+    HurlOptions (..),+    defaultHurlOptions,+    mkAllowedHurlArgument,+    RunRequest (..),+    RunStartError (..),+    CapturedRunOutput (..),+    RunResult (..),+    HurlRunner (..),+    mkHurlRunner,+    renderRunStartError,+  )+where++import Control.Exception (IOException, SomeException, displayException, mask, onException, throwIO, try)+import Data.Bits ((.&.))+import Data.ByteString qualified as ByteString+import Data.Generics.Labels ()+import Data.List (nub)+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)+import HurlWorkbench.Hurl.Capabilities+import HurlWorkbench.Parameter.Resolve (ResolvedBindings (..))+import HurlWorkbench.Parameter.Resolve.Internal (secretValueText)+import HurlWorkbench.Prelude+import HurlWorkbench.Process.Run+import HurlWorkbench.Run.FileRoot+import HurlWorkbench.Workflow.Render+import HurlWorkbench.Workspace.Types+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, removeFile)+import System.Environment (getEnvironment)+import System.Exit (ExitCode)+import System.FilePath (takeDirectory)+import System.IO (IOMode (WriteMode), hClose, hFlush, withBinaryFile)+import System.IO.Temp (openBinaryTempFile, withSystemTempDirectory)+import System.Posix.Files+  ( accessModes,+    fileMode,+    getFileStatus,+    ownerExecuteMode,+    ownerReadMode,+    ownerWriteMode,+    setFileMode,+    unionFileModes,+  )+import System.Posix.IO (OpenFileFlags (..), OpenMode (WriteOnly), defaultFileFlags, fdToHandle, openFd)+import System.Posix.Types (FileMode)+import System.Process qualified as Process++data HurlRunMode = ClientMode | TestMode+  deriving stock (Generic, Eq, Show)++data RunOutputPolicy+  = InheritRunOutput+  | CaptureRunOutput+  | ResponseFile !FilePath+  deriving stock (Generic, Eq, Show)++data HurlReportTarget+  = JUnitReport !FilePath+  | HtmlReport !FilePath+  | JsonReport !FilePath+  | TapReport !FilePath+  deriving stock (Generic, Eq, Show)++data HurlVerbosity = Verbose | VeryVerbose+  deriving stock (Generic, Eq, Show)++newtype AllowedHurlArgument = AllowedHurlArgument Text+  deriving stock (Generic, Eq, Ord, Show)++data HurlOptionError+  = NegativeOption !Text !Int+  | UnsupportedHurlArgument !Text+  | DuplicateReportFormat !Text+  deriving stock (Generic, Eq, Show)++data HurlOptions = HurlOptions+  { connectTimeoutSeconds :: !(Maybe Int),+    maxTimeSeconds :: !(Maybe Int),+    retryCount :: !(Maybe Int),+    retryIntervalMilliseconds :: !(Maybe Int),+    insecureTls :: !Bool,+    includeHeaders :: !Bool,+    jsonOutput :: !Bool,+    verbosity :: !(Maybe HurlVerbosity),+    curlExportPath :: !(Maybe FilePath),+    additionalArguments :: ![AllowedHurlArgument]+  }+  deriving stock (Generic, Eq, Show)++defaultHurlOptions :: HurlOptions+defaultHurlOptions =+  HurlOptions+    { connectTimeoutSeconds = Nothing,+      maxTimeSeconds = Nothing,+      retryCount = Nothing,+      retryIntervalMilliseconds = Nothing,+      insecureTls = False,+      includeHeaders = False,+      jsonOutput = False,+      verbosity = Nothing,+      curlExportPath = Nothing,+      additionalArguments = []+    }++mkAllowedHurlArgument :: Text -> Either HurlOptionError AllowedHurlArgument+mkAllowedHurlArgument rawArgument+  | rawArgument `elem` allowedArguments = Right (AllowedHurlArgument rawArgument)+  | otherwise = Left (UnsupportedHurlArgument rawArgument)+  where+    allowedArguments = ["--compressed", "--location", "--location-trusted", "--no-color", "--path-as-is"]++data RunRequest = RunRequest+  { renderedWorkflow :: !RenderedWorkflow,+    fileRoot :: !FileRoot,+    mode :: !HurlRunMode,+    bindings :: !ResolvedBindings,+    options :: !HurlOptions,+    outputPolicy :: !RunOutputPolicy,+    reportTargets :: ![HurlReportTarget]+  }+  deriving stock (Generic, Eq)++instance Show RunRequest where+  show request =+    "RunRequest {workflow="+      <> show (request ^. #renderedWorkflow . #workflowName)+      <> ", mode="+      <> show (request ^. #mode)+      <> ", bindings=<redacted>}"++data RunStartError+  = InvalidFileRootLayout !FileRootError+  | InvalidRunOptions !(NonEmpty HurlOptionError)+  | SecureRunFileError !FilePath !Text+  | HurlSpawnFailed !FilePath !Text+  deriving stock (Generic, Eq, Show)++data CapturedRunOutput = CapturedRunOutput+  { stdout :: !ByteString.ByteString,+    stderr :: !ByteString.ByteString+  }+  deriving stock (Generic, Eq, Show)++data RunResult = RunResult+  { exitCode :: !ExitCode,+    elapsed :: !NominalDiffTime,+    capturedOutput :: !(Maybe CapturedRunOutput)+  }+  deriving stock (Generic, Eq, Show)++newtype HurlRunner = HurlRunner+  { runHurl :: RunRequest -> IO (Either RunStartError RunResult)+  }++mkHurlRunner :: HurlCapabilities -> HurlRunner+mkHurlRunner capabilities = HurlRunner (runRequest capabilities)++runRequest :: HurlCapabilities -> RunRequest -> IO (Either RunStartError RunResult)+runRequest capabilities request = case validateRequest request of+  Just issues -> pure (Left (InvalidRunOptions issues))+  Nothing ->+    checkFileRootOutputs (request ^. #fileRoot) outputPaths >>= \case+      Left err -> pure (Left (InvalidFileRootLayout err))+      Right () -> do+        attempted <- try @IOException (withSystemTempDirectory "hurl-workbench-run" (prepareAndRun capabilities request))+        pure $ case attempted of+          Left err -> Left (SecureRunFileError "temporary execution directory" (Text.pack (displayException err)))+          Right result -> result+  where+    outputPaths = maybe [] pure (responseTarget (request ^. #outputPolicy)) <> maybe [] pure (request ^. #options . #curlExportPath) <> map (\case JUnitReport p -> p; HtmlReport p -> p; JsonReport p -> p; TapReport p -> p) (request ^. #reportTargets)++prepareAndRun :: HurlCapabilities -> RunRequest -> FilePath -> IO (Either RunStartError RunResult)+prepareAndRun capabilities request directory = do+  renderedPath <- writeSecureTemporary directory "workflow.hurl" (Text.Encoding.encodeUtf8 (request ^. #renderedWorkflow . #contents))+  variablesPath <- writeBindings directory "variables.env" renderVariable (request ^. #bindings . #variables)+  secretsPath <- writeBindings directory "secrets.env" renderSecret (request ^. #bindings . #secrets)+  traverse_ prepareReportTarget (request ^. #reportTargets)+  traverse_ prepareResponseTarget (responseTarget (request ^. #outputPolicy))+  traverse_ prepareSecureFile (request ^. #options . #curlExportPath)+  environment <- filter (not . Text.isPrefixOf "HURL_" . Text.pack . fst) <$> getEnvironment+  let arguments = buildArguments request renderedPath variablesPath secretsPath+  spawn capabilities request environment arguments directory+  where+    renderVariable name value = unParameterName name <> "=" <> hurlValueLiteralText value+    renderSecret name value = unParameterName name <> "=" <> secretValueText value++writeBindings :: FilePath -> FilePath -> (ParameterName -> value -> Text) -> Map ParameterName value -> IO (Maybe FilePath)+writeBindings _directory _template _render values | Map.null values = pure Nothing+writeBindings directory template render values =+  Just <$> writeSecureTemporary directory template (Text.Encoding.encodeUtf8 (Text.unlines [render name value | (name, value) <- Map.toAscList values]))++writeSecureTemporary :: FilePath -> FilePath -> ByteString.ByteString -> IO FilePath+writeSecureTemporary directory template bytes = do+  (path, handle) <- openBinaryTempFile directory template+  let cleanup = do+        _ <- try @IOException (hClose handle)+        _ <- try @IOException (removeFile path)+        pure ()+  ( do+      verifyMode secureFileMode path+      ByteString.hPut handle bytes+      hFlush handle+      hClose handle+      pure path+    )+    `onException` cleanup++prepareResponseTarget :: FilePath -> IO ()+prepareResponseTarget = prepareSecureFile++prepareReportTarget :: HurlReportTarget -> IO ()+prepareReportTarget = \case+  JUnitReport path -> prepareSecureFileWith path "<?xml version=\"1.0\"?>\n<testsuites/>\n"+  TapReport path -> prepareSecureFileWith path "TAP version 13\n1..0\n"+  HtmlReport path -> prepareSecureDirectory path+  JsonReport path -> prepareSecureDirectory path++prepareSecureFile :: FilePath -> IO ()+prepareSecureFile path = prepareSecureFileWith path ""++-- Hurl 8 appends to JUnit and TAP files by parsing any existing target. Seed+-- those owner-only files with valid empty documents rather than zero bytes;+-- File.create then preserves the secure mode when Hurl replaces the content.+prepareSecureFileWith :: FilePath -> ByteString.ByteString -> IO ()+prepareSecureFileWith path initialContent = do+  createDirectoryIfMissing True (takeDirectory path)+  handle <- fdToHandle =<< openFd path WriteOnly defaultFileFlags {creat = Just secureFileMode, trunc = True, nofollow = True}+  ByteString.hPut handle initialContent+  hClose handle+  setFileMode path secureFileMode+  verifyMode secureFileMode path++prepareSecureDirectory :: FilePath -> IO ()+prepareSecureDirectory path = do+  exists <- doesDirectoryExist path+  unless exists (createDirectoryIfMissing True path)+  setFileMode path secureDirectoryMode+  verifyMode secureDirectoryMode path++verifyMode :: FileMode -> FilePath -> IO ()+verifyMode expected path = do+  actual <- (.&. accessModes) . fileMode <$> getFileStatus path+  unless (actual == expected) (ioError (userError ("insecure permissions on " <> path)))++secureFileMode :: FileMode+secureFileMode = ownerReadMode `unionFileModes` ownerWriteMode++secureDirectoryMode :: FileMode+secureDirectoryMode = secureFileMode `unionFileModes` ownerExecuteMode++-- Private files avoid closing a live output pipe before signalling its writer.+-- That pipe-close ordering can block cancellation inside typed-process cleanup.+spawn :: HurlCapabilities -> RunRequest -> [(String, String)] -> [String] -> FilePath -> IO (Either RunStartError RunResult)+spawn capabilities request environment arguments directory = case request ^. #outputPolicy of+  InheritRunOutput -> runOwned config+  CaptureRunOutput -> capture+  ResponseFile _ -> capture+  where+    config = (Process.proc (capabilities ^. #hurlExecutable) arguments) {Process.env = Just environment, Process.create_group = True}+    runOwned processConfig = mask $ \restore -> do+      began <- getCurrentTime+      spawnGroup (ServiceName "hurl") processConfig >>= \case+        Left _ -> pure (Left (HurlSpawnFailed (capabilities ^. #hurlExecutable) "process launch failed"))+        Right owned -> do+          execution <- try @SomeException (restore (waitExitCode owned))+          cleanup <- terminateGroup (ServiceName "hurl") 2 owned+          ended <- getCurrentTime+          case execution of+            Left err -> throwIO err+            Right exit -> pure $ case cleanup of+              Left _ -> Left (SecureRunFileError "Hurl process group" "cleanup failed")+              Right () -> Right (RunResult exit (diffUTCTime ended began) Nothing)+    capture = do+      stdoutPath <- writeSecureTemporary directory "stdout" ""+      stderrPath <- writeSecureTemporary directory "stderr" ""+      result <- withBinaryFile stdoutPath WriteMode $ \stdout ->+        withBinaryFile stderrPath WriteMode $ \stderr ->+          runOwned config {Process.std_in = Process.NoStream, Process.std_out = Process.UseHandle stdout, Process.std_err = Process.UseHandle stderr}+      case result of+        Left err -> pure (Left err)+        Right finished -> do+          stdout <- ByteString.readFile stdoutPath+          stderr <- ByteString.readFile stderrPath+          pure (Right (finished & #capturedOutput .~ Just (CapturedRunOutput stdout stderr)))++buildArguments :: RunRequest -> FilePath -> Maybe FilePath -> Maybe FilePath -> [String]+buildArguments request renderedPath variablesPath secretsPath =+  ["--file-root", root]+    <> maybe [] (\path -> ["--variables-file", path]) variablesPath+    <> maybe [] (\path -> ["--secrets-file", path]) secretsPath+    <> ["--test" | request ^. #mode == TestMode]+    <> renderOptions (request ^. #options)+    <> concatMap renderReportTarget (request ^. #reportTargets)+    <> maybe [] (\path -> ["--output", path]) (responseTarget (request ^. #outputPolicy))+    <> [renderedPath]+  where+    root = fileRootPath (request ^. #fileRoot)++renderOptions :: HurlOptions -> [String]+renderOptions options =+  valued "--connect-timeout" (options ^. #connectTimeoutSeconds)+    <> valued "--max-time" (options ^. #maxTimeSeconds)+    <> valued "--retry" (options ^. #retryCount)+    <> valued "--retry-interval" (options ^. #retryIntervalMilliseconds)+    <> ["--insecure" | options ^. #insecureTls]+    <> ["--include" | options ^. #includeHeaders]+    <> ["--json" | options ^. #jsonOutput]+    <> case options ^. #verbosity of+      Just Verbose -> ["--verbose"]+      Just VeryVerbose -> ["--very-verbose"]+      Nothing -> []+    <> maybe [] (\path -> ["--curl", path]) (options ^. #curlExportPath)+    <> map (Text.unpack . allowedArgumentText) (options ^. #additionalArguments)+  where+    valued flag = maybe [] (\value -> [flag, show value])++allowedArgumentText :: AllowedHurlArgument -> Text+allowedArgumentText (AllowedHurlArgument value) = value++renderReportTarget :: HurlReportTarget -> [String]+renderReportTarget = \case+  JUnitReport path -> ["--report-junit", path]+  HtmlReport path -> ["--report-html", path]+  JsonReport path -> ["--report-json", path]+  TapReport path -> ["--report-tap", path]++responseTarget :: RunOutputPolicy -> Maybe FilePath+responseTarget = \case+  ResponseFile path -> Just path+  _ -> Nothing++validateRequest :: RunRequest -> Maybe (NonEmpty HurlOptionError)+validateRequest request = nonEmpty (numericIssues <> reportIssues)+  where+    options = request ^. #options+    numericIssues =+      concat+        [ nonNegative "connect timeout" (options ^. #connectTimeoutSeconds),+          nonNegative "max time" (options ^. #maxTimeSeconds),+          nonNegative "retry count" (options ^. #retryCount),+          nonNegative "retry interval" (options ^. #retryIntervalMilliseconds)+        ]+    formats = map reportFormat (request ^. #reportTargets)+    reportIssues = [DuplicateReportFormat format | format <- nub formats, length (filter (== format) formats) > 1]+    nonNegative name = maybe [] (\value -> [NegativeOption name value | value < 0])++reportFormat :: HurlReportTarget -> Text+reportFormat = \case+  JUnitReport _ -> "JUnit"+  HtmlReport _ -> "HTML"+  JsonReport _ -> "JSON"+  TapReport _ -> "TAP"++renderRunStartError :: RunStartError -> Text+renderRunStartError = \case+  InvalidFileRootLayout err -> renderFileRootError err+  InvalidRunOptions issues -> Text.intercalate "\n" (map renderOptionError (toList issues))+  SecureRunFileError path message -> "could not prepare secure run file " <> Text.pack path <> ": " <> message+  HurlSpawnFailed path message -> "Hurl could not be started at " <> Text.pack path <> ": " <> message+  where+    renderOptionError = \case+      NegativeOption name value -> name <> " must not be negative, got " <> Text.pack (show value)+      UnsupportedHurlArgument rawArgument -> "unsupported --hurl-arg " <> rawArgument+      DuplicateReportFormat format -> "at most one " <> format <> " report target is allowed"
+ src/HurlWorkbench/Parameter/Generate.hs view
@@ -0,0 +1,132 @@+-- | Bounded generation of scenario inputs. No generated data enters errors.+module HurlWorkbench.Parameter.Generate+  ( GeneratorEnvironment (..),+    defaultGeneratorEnvironment,+    generateValue,+    validateGenerator,+    generatorName,+    uuid4Bytes,+    uuid7Bytes,+    formatUuid,+    encodeTypeId,+  )+where++import Control.Exception (IOException, try)+import Data.Bifunctor (first)+import Data.Bits (shiftR, (.&.), (.|.))+import Data.ByteString qualified as BS+import Data.Text qualified as Text+import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Data.Word (Word8)+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Types+import Numeric (showHex)+import System.IO (IOMode (ReadMode), withBinaryFile)++data GeneratorEnvironment = GeneratorEnvironment+  { currentTime :: IO UTCTime,+    entropyBytes :: Int -> IO BS.ByteString+  }++defaultGeneratorEnvironment :: GeneratorEnvironment+defaultGeneratorEnvironment = GeneratorEnvironment getCurrentTime $ \count ->+  if count < 0 || count > 16384+    then ioError (userError "invalid entropy request")+    else withBinaryFile "/dev/urandom" ReadMode $ \handle ->+      let readExactly remaining chunks+            | remaining == 0 = pure (BS.concat (reverse chunks))+            | otherwise = do+                bytes <- BS.hGet handle remaining+                if BS.null bytes+                  then ioError (userError "entropy EOF")+                  else readExactly (remaining - BS.length bytes) (bytes : chunks)+       in readExactly count []++generatorName :: Generator -> Text+generatorName = \case+  Uuid4 -> "Uuid4"+  Uuid7 -> "Uuid7"+  TypeId _ -> "TypeId"+  Rfc3339Now -> "Rfc3339Now"+  RandomAlphanumeric _ -> "RandomAlphanumeric"++validateGenerator :: Generator -> Either Text ()+validateGenerator = \case+  TypeId (TypeIdOptions prefix)+    | Text.length prefix > 63+        || not (Text.all (\c -> letter c || c == '_') prefix)+        || (not (Text.null prefix) && (not (letter (Text.head prefix)) || not (letter (Text.last prefix)))) ->+        Left "TypeId prefix must be empty or at most 63 lowercase ASCII letters/underscores, starting and ending with a letter"+  RandomAlphanumeric (RandomOptions count) | count < 1 || count > 4096 -> Left "RandomAlphanumeric length must be between 1 and 4096"+  _ -> Right ()+  where+    letter c = c >= 'a' && c <= 'z'++-- | Synchronous IO failures are redacted; cancellation propagates normally.+generateValue :: GeneratorEnvironment -> Generator -> IO (Either Text HurlValueLiteral)+generateValue env generator = case validateGenerator generator of+  Left err -> pure (Left err)+  Right () -> do+    result <- try @IOException generate+    pure $ case result of+      Left _ -> Left "generation failed"+      Right (Left _) -> Left "generation failed"+      Right (Right value) -> first (const "generated value is not a Hurl literal") (mkHurlValueLiteral value)+  where+    draw count = do+      bytes <- entropyBytes env count+      if BS.length bytes == count then pure bytes else ioError (userError "short entropy read")+    uuid7 = do+      now <- currentTime env+      bytes <- BS.unpack <$> draw 16+      pure (uuid7Bytes (floor (utcTimeToPOSIXSeconds now * 1000)) bytes)+    generate = case generator of+      Uuid4 -> fmap (fmap formatUuid . uuid4Bytes . BS.unpack) (draw 16)+      Uuid7 -> fmap (fmap formatUuid) uuid7+      TypeId (TypeIdOptions prefix) -> fmap (fmap (\bytes -> (if Text.null prefix then "" else prefix <> "_") <> encodeTypeId bytes)) uuid7+      Rfc3339Now -> do+        now <- currentTime env+        let millis = (floor (utcTimeToPOSIXSeconds now * 1000) :: Integer) `mod` 1000+            digits = show millis+        pure (Right (Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now <> "." <> replicate (3 - length digits) '0' <> digits <> "Z")))+      RandomAlphanumeric (RandomOptions count) -> sample (fromIntegral count) (fromIntegral count * 32 + 128) []+    -- Rejection sampling has a finite entropy budget, including a broken source+    -- that supplies only rejected bytes. No modulo bias or unbounded loop.+    sample remaining budget chunks+      | remaining == 0 = pure (Right (Text.concat (reverse chunks)))+      | budget <= 0 = pure (Left "entropy rejection budget exhausted")+      | otherwise = do+          let count = min budget (max 32 (min 4096 (remaining * 2)))+          bytes <- draw count+          let accepted = take remaining [Text.index alphabet (fromIntegral byte `mod` 62) | byte <- BS.unpack bytes, byte < 248]+          sample (remaining - length accepted) (budget - count) (Text.pack accepted : chunks)+    alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"++uuid4Bytes :: [Word8] -> Either Text [Word8]+uuid4Bytes = setVersion 4++setVersion :: Word8 -> [Word8] -> Either Text [Word8]+setVersion version bytes+  | length bytes /= 16 = Left "UUID requires 16 bytes"+  | otherwise = Right [if index == 6 then (byte .&. 15) .|. (version * 16) else if index == 8 then (byte .&. 63) .|. 128 else byte | (index, byte) <- zip [0 :: Int ..] bytes]++uuid7Bytes :: Integer -> [Word8] -> Either Text [Word8]+uuid7Bytes millis bytes+  | millis < 0 || millis >= 2 ^ (48 :: Int) = Left "UUID7 timestamp outside 48-bit range"+  | length bytes /= 16 = Left "UUID requires 16 bytes"+  | otherwise = setVersion 7 ([fromIntegral (millis `shiftR` bits) | bits <- [40, 32 .. 0]] <> drop 6 bytes)++formatUuid :: [Word8] -> Text+formatUuid bytes = Text.pack (concat [separator index <> hex byte | (index, byte) <- zip [0 :: Int ..] bytes])+  where+    separator index = if index `elem` [4, 6, 8, 10] then "-" else ""+    hex byte = let digits = showHex byte "" in replicate (2 - length digits) '0' <> digits++-- | TypeID v0.3: mori://jetify-com/typeid, spec/README.md (artifact URI pending).+encodeTypeId :: [Word8] -> Text+encodeTypeId bytes = Text.pack [alphabet !! fromIntegral ((value `shiftR` bits) .&. 31) | bits <- [125, 120 .. 0]]+  where+    value = foldl (\acc byte -> acc * 256 + fromIntegral byte) (0 :: Integer) bytes+    alphabet = "0123456789abcdefghjkmnpqrstvwxyz"
+ src/HurlWorkbench/Parameter/Properties.hs view
@@ -0,0 +1,117 @@+-- | The deliberately small properties-file language accepted by Hurl 8 for+--   variables and secrets. This module parses the transport format; it does+--   not decide whether a parameter is plain or secret in the workspace.+module HurlWorkbench.Parameter.Properties+  ( PropertyFileKind (..),+    PropertyError (..),+    parseVariableProperties,+    parseSecretProperties,+    renderPropertyError,+  )+where++import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate (isValidParameterName)++data PropertyFileKind = VariableProperties | SecretProperties+  deriving stock (Generic, Eq, Show)++-- | A parse error which never retains a property value. That invariant is+--   important for secret files because callers may safely render or show it.+data PropertyError+  = InvalidPropertiesUtf8 !PropertyFileKind !FilePath !Int+  | MissingPropertyEquals !PropertyFileKind !FilePath !Int+  | InvalidPropertyName !PropertyFileKind !FilePath !Int !ParameterName+  | DuplicatePropertyName !PropertyFileKind !FilePath !Int !ParameterName+  | InvalidPropertyValue !PropertyFileKind !FilePath !Int !ParameterName !HurlValueLiteralError+  deriving stock (Generic, Eq, Show)++parseVariableProperties :: FilePath -> ByteString -> Either PropertyError (Map ParameterName HurlValueLiteral)+parseVariableProperties path bytes =+  parseProperties VariableProperties path bytes $ \line name value ->+    first (InvalidPropertyValue VariableProperties path line name) (mkHurlValueLiteral value)++parseSecretProperties :: FilePath -> ByteString -> Either PropertyError (Map ParameterName Text)+parseSecretProperties path bytes =+  parseProperties SecretProperties path bytes $ \line name value ->+    hurlValueLiteralText+      <$> first (InvalidPropertyValue SecretProperties path line name) (mkHurlValueLiteral value)++parseProperties :: PropertyFileKind -> FilePath -> ByteString -> (Int -> ParameterName -> Text -> Either PropertyError value) -> Either PropertyError (Map ParameterName value)+parseProperties kind path bytes parseValue = do+  input <- case Text.Encoding.decodeUtf8' bytes of+    Left _err -> Left (InvalidPropertiesUtf8 kind path (firstInvalidUtf8Offset bytes))+    Right value -> Right value+  foldMLine Map.empty (zip [1 ..] (Text.lines input))+  where+    foldMLine values [] = Right values+    foldMLine values ((lineNumber, rawLine) : remaining) =+      let line = Text.strip rawLine+       in if Text.null line || "#" `Text.isPrefixOf` line+            then foldMLine values remaining+            else case Text.breakOn "=" line of+              (_nameText, rest) | Text.null rest -> Left (MissingPropertyEquals kind path lineNumber)+              (nameText, rest) -> do+                let name = ParameterName nameText+                    valueText = Text.drop 1 rest+                unlessEither (isValidParameterName nameText) (InvalidPropertyName kind path lineNumber name)+                unlessEither (Map.notMember name values) (DuplicatePropertyName kind path lineNumber name)+                value <- parseValue lineNumber name valueText+                foldMLine (Map.insert name value values) remaining++unlessEither :: Bool -> err -> Either err ()+unlessEither condition err = if condition then Right () else Left err++firstInvalidUtf8Offset :: ByteString -> Int+firstInvalidUtf8Offset bytes = go 0+  where+    length_ = ByteString.length bytes+    byte = ByteString.index bytes+    go offset+      | offset >= length_ = max 0 (length_ - 1)+      | current <= 0x7F = go (offset + 1)+      | current >= 0xC2 && current <= 0xDF = continuationSequence offset [continuation]+      | current == 0xE0 = continuationSequence offset [between 0xA0 0xBF, continuation]+      | current >= 0xE1 && current <= 0xEC = continuationSequence offset [continuation, continuation]+      | current == 0xED = continuationSequence offset [between 0x80 0x9F, continuation]+      | current >= 0xEE && current <= 0xEF = continuationSequence offset [continuation, continuation]+      | current == 0xF0 = continuationSequence offset [between 0x90 0xBF, continuation, continuation]+      | current >= 0xF1 && current <= 0xF3 = continuationSequence offset [continuation, continuation, continuation]+      | current == 0xF4 = continuationSequence offset [between 0x80 0x8F, continuation, continuation]+      | otherwise = offset+      where+        current = byte offset+    continuationSequence start checks = check (start + 1) checks+      where+        check next [] = go next+        check next (valid : remaining)+          | next >= length_ = start+          | valid (byte next) = check (next + 1) remaining+          | otherwise = next+    continuation = between 0x80 0xBF+    between lower upper value = value >= lower && value <= upper++renderPropertyError :: PropertyError -> Text+renderPropertyError = \case+  InvalidPropertiesUtf8 kind path offset -> prefix kind path <> "is not UTF-8 at byte " <> tshow offset+  MissingPropertyEquals kind path line -> atLine kind path line <> "must contain NAME=VALUE"+  InvalidPropertyName kind path line name -> atLine kind path line <> "has invalid parameter name " <> quote (unParameterName name)+  DuplicatePropertyName kind path line name -> atLine kind path line <> "repeats parameter " <> quote (unParameterName name)+  InvalidPropertyValue kind path line name err ->+    atLine kind path line <> "cannot transport parameter " <> quote (unParameterName name) <> ": " <> renderHurlValueLiteralError err+  where+    prefix kind path = label kind <> " file " <> quote (Text.pack path) <> " "+    atLine kind path line = prefix kind path <> "line " <> tshow line <> " "+    label VariableProperties = "variables"+    label SecretProperties = "secrets"+    quote value = "\"" <> value <> "\""++tshow :: (Show a) => a -> Text+tshow = Text.pack . show
+ src/HurlWorkbench/Parameter/Resolve.hs view
@@ -0,0 +1,293 @@+-- | Resolve all runtime values for a validated workflow. Plain values and+--   secrets remain separate from discovery through serialization.+module HurlWorkbench.Parameter.Resolve+  ( BindingInput (..),+    BindingSource (..),+    BindingLayer (..),+    SecretValue,+    SecretValueError (..),+    ResolvedBindings (..),+    BindingIssue (..),+    BindingError (..),+    emptyBindingInput,+    mkSecretValue,+    resolveParameters,+    resolveParametersWithGenerator,+    resolveParametersWithLayersAndGenerator,+    resolveParameterSubset,+    resolveParameterSubsetInEnvironment,+    resolveParametersWithLayers,+    resolveWorkflowBindings,+    resolveWorkflowBindingsWithLayers,+    resolveWorkflowBindingSubsetWithLayers,+    renderBindingError,+    renderBindingIssue,+  )+where++import Control.Exception (IOException, try)+import Data.Bifunctor (first)+import Data.ByteString qualified as ByteString+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import HurlWorkbench.Parameter.Generate+import HurlWorkbench.Parameter.Properties+import HurlWorkbench.Parameter.Resolve.Internal+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate (isValidEnvironmentName)+import System.Environment (lookupEnv)++emptyBindingInput :: BindingInput+emptyBindingInput =+  BindingInput+    { plainOverrides = Map.empty,+      secretEnvironmentOverrides = Map.empty,+      variableFiles = [],+      secretFiles = []+    }++resolveWorkflowBindings :: ValidatedWorkspace -> Workflow -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveWorkflowBindings validated workflow input =+  resolveParameters validated (Set.fromList (workflow ^. #parameters)) input++resolveWorkflowBindingsWithLayers :: ValidatedWorkspace -> Workflow -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveWorkflowBindingsWithLayers validated workflow layers input =+  resolveParametersWithLayers validated (Set.fromList (workflow ^. #parameters)) layers input++resolveWorkflowBindingSubsetWithLayers :: ValidatedWorkspace -> Workflow -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveWorkflowBindingSubsetWithLayers validated workflow layers input =+  resolveParametersWithMode False validated (Set.fromList (workflow ^. #parameters)) layers input++resolveParameters :: ValidatedWorkspace -> Set ParameterName -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParameters validated selected = resolveParametersWithLayers validated selected []++-- | Resolve one consumer's parameter subset from a shared runtime input.+--   Bindings for other declared consumers are ignored, while selected names+--   retain the same kind and precedence validation as normal resolution.+resolveParameterSubset :: ValidatedWorkspace -> Set ParameterName -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParameterSubset validated selected = resolveParametersWithMode False validated selected []++-- | Resolve runtime inputs over committed plain-value layers ordered from+--   highest to lowest precedence. Runtime overrides and variable files remain+--   above these layers; declared environments and defaults remain below them.+resolveParametersWithLayers :: ValidatedWorkspace -> Set ParameterName -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParametersWithLayers = resolveParametersWithLayersAndGenerator defaultGeneratorEnvironment++-- | Inject clock/entropy while preserving the committed binding layers.+resolveParametersWithLayersAndGenerator :: GeneratorEnvironment -> ValidatedWorkspace -> Set ParameterName -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParametersWithLayersAndGenerator env = resolveParametersWithLookup env lookupEnv True++resolveParametersWithMode :: Bool -> ValidatedWorkspace -> Set ParameterName -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParametersWithMode = resolveParametersWithLookup defaultGeneratorEnvironment lookupEnv++-- | Resolve managed consumers from the invocation snapshot, including declared+-- parameter environments and explicit secret-environment channels.+resolveParameterSubsetInEnvironment :: [(String, String)] -> ValidatedWorkspace -> Set ParameterName -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParameterSubsetInEnvironment ambient validated selected = resolveParametersWithLookup defaultGeneratorEnvironment (pure . (`Map.lookup` Map.fromList ambient)) False validated selected []++resolveParametersWithGenerator :: GeneratorEnvironment -> ValidatedWorkspace -> Set ParameterName -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParametersWithGenerator env validated selected = resolveParametersWithLookup env lookupEnv True validated selected []++resolveParametersWithLookup :: GeneratorEnvironment -> (String -> IO (Maybe String)) -> Bool -> ValidatedWorkspace -> Set ParameterName -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)+resolveParametersWithLookup generatorEnvironment lookupEnvironment rejectUnselected validated selected layers input = do+  loadedVariables <- loadVariableFiles (input ^. #variableFiles)+  loadedSecrets <- loadSecretFiles (input ^. #secretFiles)+  case (loadedVariables, loadedSecrets) of+    (Left err, _) -> pure (Left err)+    (_, Left err) -> pure (Left err)+    (Right variableMaps, Right secretMaps) -> do+      let fileVariables = laterWins variableMaps+          fileSecrets = laterWins secretMaps+          explicitVariables = Map.map (,ExplicitVariable) (input ^. #plainOverrides)+          explicitSecrets = Map.mapWithKey (\_ env -> (env, ExplicitSecretEnvironment env)) (input ^. #secretEnvironmentOverrides)+          committedVariables = map sourcedLayer layers+          parameters = validatedParameters validated+          staticIssues =+            unknownSelected parameters selected+              <> [ issue+                 | rejectUnselected,+                   issue <-+                     unexpected selected explicitVariables+                       <> unexpected selected explicitSecrets+                       <> unexpected selected fileVariables+                       <> unexpected selected fileSecrets+                       <> concatMap (unexpected selected) committedVariables+                 ]+              <> kindMismatches parameters selected explicitVariables explicitSecrets fileVariables fileSecrets committedVariables+      resolved <- traverse (resolveOne generatorEnvironment lookupEnvironment parameters explicitVariables explicitSecrets fileVariables fileSecrets committedVariables) (Set.toAscList selected)+      let dynamicIssues = concatMap (\(issues, _, _) -> issues) resolved+          allIssues = staticIssues <> dynamicIssues+      pure $ case nonEmpty allIssues of+        Just issues -> Left (BindingIssues issues)+        Nothing ->+          Right+            ResolvedBindings+              { variables = Map.fromList (mapMaybe (\(_, variable, _) -> variable) resolved),+                secrets = Map.fromList (mapMaybe (\(_, _, secret) -> secret) resolved)+              }+  where+    sourcedLayer layer = Map.map (,(layer ^. #source)) (layer ^. #values)++type Sourced value = Map ParameterName (value, BindingSource)++loadVariableFiles :: [FilePath] -> IO (Either BindingError [Sourced HurlValueLiteral])+loadVariableFiles = loadFiles VariableProperties parseVariableProperties++loadSecretFiles :: [FilePath] -> IO (Either BindingError [Sourced Text])+loadSecretFiles = loadFiles SecretProperties parseSecretProperties++loadFiles :: PropertyFileKind -> (FilePath -> ByteString.ByteString -> Either PropertyError (Map ParameterName value)) -> [FilePath] -> IO (Either BindingError [Sourced value])+loadFiles kind parser = go []+  where+    go loaded [] = pure (Right (reverse loaded))+    go loaded (path : remaining) = do+      bytes <- try @IOException (ByteString.readFile path)+      case bytes of+        Left _err -> pure (Left (BindingFileReadError kind path))+        Right contents -> case parser path contents of+          Left err -> pure (Left (BindingPropertyError err))+          Right values ->+            let source = case kind of+                  VariableProperties -> VariableFile path+                  SecretProperties -> SecretFile path+             in go (Map.map (,source) values : loaded) remaining++laterWins :: [Sourced value] -> Sourced value+laterWins = foldl' (flip Map.union) Map.empty++unknownSelected :: Map ParameterName Parameter -> Set ParameterName -> [BindingIssue]+unknownSelected parameters selected =+  [UnknownDeclaredParameter name | name <- Set.toAscList selected, Map.notMember name parameters]++unexpected :: Set ParameterName -> Sourced value -> [BindingIssue]+unexpected selected values =+  [ UnexpectedBinding name source+  | (name, (_, source)) <- Map.toAscList values,+    name `Set.notMember` selected+  ]++kindMismatches :: Map ParameterName Parameter -> Set ParameterName -> Sourced HurlValueLiteral -> Sourced Text -> Sourced HurlValueLiteral -> Sourced Text -> [Sourced HurlValueLiteral] -> [BindingIssue]+kindMismatches parameters selected explicitVariables explicitSecrets fileVariables fileSecrets committedVariables =+  concatMap one (Set.toAscList selected)+  where+    one name = case Map.lookup name parameters of+      Nothing -> []+      Just parameter -> case parameter ^. #kind of+        Generated _ -> [BindingKindMismatch name Plain source | source <- sourcesFor name explicitSecrets <> sourcesFor name fileSecrets]+        Plain -> [BindingKindMismatch name Secret source | source <- sourcesFor name explicitSecrets <> sourcesFor name fileSecrets]+        Secret -> [BindingKindMismatch name Plain source | source <- sourcesFor name explicitVariables <> sourcesFor name fileVariables <> concatMap (sourcesFor name) committedVariables]++sourcesFor :: ParameterName -> Sourced value -> [BindingSource]+sourcesFor name values = maybe [] (pure . snd) (Map.lookup name values)++resolveOne :: GeneratorEnvironment -> (String -> IO (Maybe String)) -> Map ParameterName Parameter -> Sourced HurlValueLiteral -> Sourced Text -> Sourced HurlValueLiteral -> Sourced Text -> [Sourced HurlValueLiteral] -> ParameterName -> IO ([BindingIssue], Maybe (ParameterName, HurlValueLiteral), Maybe (ParameterName, SecretValue))+resolveOne generatorEnvironment lookupEnvironment parameters explicitVariables explicitSecrets fileVariables fileSecrets committedVariables name =+  case Map.lookup name parameters of+    Nothing -> pure ([], Nothing, Nothing)+    Just parameter -> case parameter ^. #kind of+      Generated generator -> do+        environmentValue <- traverse (lookupPlainEnvironment lookupEnvironment name) (parameter ^. #environment)+        case firstJust [Right <$> Map.lookup name explicitVariables, Right <$> Map.lookup name fileVariables, environmentValue] of+          Just (Left issue) -> pure ([issue], Nothing, Nothing)+          Just (Right (value, _)) -> pure ([], Just (name, value), Nothing)+          Nothing ->+            generateValue generatorEnvironment generator >>= \case+              Left _ -> pure ([GeneratorFailure name generator], Nothing, Nothing)+              Right value -> pure ([], Just (name, value), Nothing)+      Plain -> do+        environmentValue <- traverse (lookupPlainEnvironment lookupEnvironment name) (parameter ^. #environment)+        let selectedValue =+              firstJust+                [ Right <$> Map.lookup name explicitVariables,+                  Right <$> Map.lookup name fileVariables,+                  firstLayerValue name committedVariables,+                  environmentValue,+                  Right . (,DefaultValue) <$> parameter ^. #defaultValue+                ]+        pure $ case selectedValue of+          Nothing -> ([MissingBinding name], Nothing, Nothing)+          Just (Left issue) -> ([issue], Nothing, Nothing)+          Just (Right (value, _source)) -> ([], Just (name, value), Nothing)+      Secret -> do+        explicitValue <- traverse (lookupSecretEnvironment lookupEnvironment name) (Map.lookup name explicitSecrets)+        declaredValue <- traverse (\env -> lookupSecretEnvironment lookupEnvironment name (env, DeclaredEnvironment env)) (parameter ^. #environment)+        let fileValue = case Map.lookup name fileSecrets of+              Nothing -> Nothing+              Just (value, source) -> Just (first (InvalidSecretBinding name source) (mkSecretValue value) <&> (,source))+            selectedValue = firstJust [explicitValue, fileValue, declaredValue]+        pure $ case selectedValue of+          Nothing -> ([MissingBinding name], Nothing, Nothing)+          Just (Left issue) -> ([issue], Nothing, Nothing)+          Just (Right (value, _source)) -> ([], Nothing, Just (name, value))++lookupPlainEnvironment :: (String -> IO (Maybe String)) -> ParameterName -> Text -> IO (Either BindingIssue (HurlValueLiteral, BindingSource))+lookupPlainEnvironment lookupEnvironment name environmentName+  | not (isValidEnvironmentName environmentName) =+      pure (Left (InvalidBindingEnvironmentName name environmentName (DeclaredEnvironment environmentName)))+  | otherwise = do+      value <- lookupEnvironment (Text.unpack environmentName)+      pure $ case value of+        Nothing -> Left (MissingBindingEnvironment name environmentName (DeclaredEnvironment environmentName))+        Just raw -> first (InvalidPlainBinding name (DeclaredEnvironment environmentName)) (mkHurlValueLiteral (Text.pack raw)) <&> (,DeclaredEnvironment environmentName)++lookupSecretEnvironment :: (String -> IO (Maybe String)) -> ParameterName -> (Text, BindingSource) -> IO (Either BindingIssue (SecretValue, BindingSource))+lookupSecretEnvironment lookupEnvironment name (environmentName, source)+  | not (isValidEnvironmentName environmentName) =+      pure (Left (InvalidBindingEnvironmentName name environmentName source))+  | otherwise = do+      value <- lookupEnvironment (Text.unpack environmentName)+      pure $ case value of+        Nothing -> Left (MissingBindingEnvironment name environmentName source)+        Just raw -> first (InvalidSecretBinding name source) (mkSecretValue (Text.pack raw)) <&> (,source)++firstJust :: [Maybe a] -> Maybe a+firstJust = \case+  [] -> Nothing+  Nothing : rest -> firstJust rest+  Just value : _ -> Just value++firstLayerValue :: ParameterName -> [Sourced value] -> Maybe (Either issue (value, BindingSource))+firstLayerValue name = firstJust . map (fmap Right . Map.lookup name)++renderBindingError :: BindingError -> Text+renderBindingError = \case+  BindingFileReadError kind path -> label kind <> " file could not be read: " <> Text.pack path+  BindingPropertyError err -> renderPropertyError err+  BindingIssues issues -> Text.intercalate "\n" (map renderBindingIssue (toList issues))+  where+    label VariableProperties = "variables"+    label SecretProperties = "secrets"++renderBindingIssue :: BindingIssue -> Text+renderBindingIssue = \case+  UnexpectedBinding name source -> "parameter " <> quoted name <> " from " <> renderSource source <> " is not declared by the selected workflow"+  BindingKindMismatch name expected source -> "parameter " <> quoted name <> " from " <> renderSource source <> " must be supplied as " <> kindName expected+  MissingBinding name -> "required parameter " <> quoted name <> " has no value"+  MissingBindingEnvironment name environmentName source -> "environment variable " <> quote environmentName <> " for parameter " <> quoted name <> " from " <> renderSource source <> " is not set"+  InvalidBindingEnvironmentName name environmentName source -> "environment variable name " <> quote environmentName <> " for parameter " <> quoted name <> " from " <> renderSource source <> " is invalid"+  InvalidPlainBinding name source err -> "plain parameter " <> quoted name <> " from " <> renderSource source <> " is invalid: " <> renderHurlValueLiteralError err+  InvalidSecretBinding name source err -> "secret parameter " <> quoted name <> " from " <> renderSource source <> " is invalid: " <> secretError err+  GeneratorFailure name generator -> "generation failed for parameter " <> quoted name <> " (" <> generatorName generator <> ")"+  UnknownDeclaredParameter name -> "selected parameter " <> quoted name <> " does not exist in the validated workspace"+  where+    quoted = quote . unParameterName+    quote value = "\"" <> value <> "\""+    kindName (Generated _) = "a plain value"+    kindName Plain = "a plain value"+    kindName Secret = "a secret value"+    secretError SecretContainsLineBreakOrNul = "value contains a line break or NUL character, which Hurl secret files cannot carry"+    secretError SecretHasSurroundingWhitespace = "value has leading or trailing whitespace, which Hurl secret files would trim"++renderSource :: BindingSource -> Text+renderSource = \case+  ExplicitVariable -> "--variable"+  ExplicitSecretEnvironment env -> "--secret-env " <> env+  VariableFile path -> "variables file " <> Text.pack path+  SecretFile path -> "secrets file " <> Text.pack path+  CommittedBinding label -> "committed " <> label+  DeclaredEnvironment env -> "declared environment " <> env+  DefaultValue -> "the workspace default"
+ src/HurlWorkbench/Parameter/Resolve/Internal.hs view
@@ -0,0 +1,94 @@+-- | Internal representation of resolved parameter values. The public module+--   keeps the secret constructor and accessor abstract; the Hurl adapter is+--   process-boundary modules are the only production consumers of+--   'secretValueText'.+module HurlWorkbench.Parameter.Resolve.Internal+  ( BindingInput (..),+    BindingSource (..),+    BindingLayer (..),+    SecretValue,+    SecretValueError (..),+    ResolvedBindings (..),+    BindingIssue (..),+    BindingError (..),+    mkSecretValue,+    secretValueText,+  )+where++import HurlWorkbench.Parameter.Properties (PropertyError, PropertyFileKind)+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Types++data BindingInput = BindingInput+  { plainOverrides :: !(Map ParameterName HurlValueLiteral),+    secretEnvironmentOverrides :: !(Map ParameterName Text),+    variableFiles :: ![FilePath],+    secretFiles :: ![FilePath]+  }+  deriving stock (Generic, Eq, Show)++data BindingSource+  = ExplicitVariable+  | ExplicitSecretEnvironment !Text+  | VariableFile !FilePath+  | SecretFile !FilePath+  | CommittedBinding !Text+  | DeclaredEnvironment !Text+  | DefaultValue+  deriving stock (Generic, Eq, Ord, Show)++-- | One committed plain-value layer. Layers are ordered from highest to+--   lowest precedence. Recipe and matrix types stay outside this module.+data BindingLayer = BindingLayer+  { source :: !BindingSource,+    values :: !(Map ParameterName HurlValueLiteral)+  }+  deriving stock (Generic, Eq, Show)++newtype SecretValue = SecretValue Text+  deriving stock (Generic, Eq)++instance Show SecretValue where+  show _ = "SecretValue <redacted>"++data SecretValueError+  = SecretContainsLineBreakOrNul+  | SecretHasSurroundingWhitespace+  deriving stock (Generic, Eq, Show)++data ResolvedBindings = ResolvedBindings+  { variables :: !(Map ParameterName HurlValueLiteral),+    secrets :: !(Map ParameterName SecretValue)+  }+  deriving stock (Generic, Eq)++instance Show ResolvedBindings where+  show _ = "ResolvedBindings <redacted>"++data BindingIssue+  = UnexpectedBinding !ParameterName !BindingSource+  | BindingKindMismatch !ParameterName !ParameterKind !BindingSource+  | MissingBinding !ParameterName+  | MissingBindingEnvironment !ParameterName !Text !BindingSource+  | InvalidBindingEnvironmentName !ParameterName !Text !BindingSource+  | InvalidPlainBinding !ParameterName !BindingSource !HurlValueLiteralError+  | InvalidSecretBinding !ParameterName !BindingSource !SecretValueError+  | GeneratorFailure !ParameterName !Generator+  | UnknownDeclaredParameter !ParameterName+  deriving stock (Generic, Eq, Show)++data BindingError+  = BindingFileReadError !PropertyFileKind !FilePath+  | BindingPropertyError !PropertyError+  | BindingIssues !(NonEmpty BindingIssue)+  deriving stock (Generic, Eq, Show)++mkSecretValue :: Text -> Either SecretValueError SecretValue+mkSecretValue value = case mkHurlValueLiteral value of+  Left ContainsLineBreakOrNul -> Left SecretContainsLineBreakOrNul+  Left SurroundingWhitespace -> Left SecretHasSurroundingWhitespace+  Right _ -> Right (SecretValue value)++secretValueText :: SecretValue -> Text+secretValueText (SecretValue value) = value
+ src/HurlWorkbench/Prelude.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE PackageImports #-}++-- | Project-wide prelude for hurl-workbench. It re-exports the small set of+--   types and functions that nearly every module needs, plus the lens+--   operators.+--+--   It deliberately does not import @Data.Generics.Labels@: that orphan+--   @IsLabel@ instance would leak into every module. Modules that use+--   @#field@ access import @Data.Generics.Labels ()@ themselves.+module HurlWorkbench.Prelude+  ( module X,+    module Control.Lens,+  )+where++import "base" Control.Monad as X (forM, forM_, unless, void, when)+import "base" Data.Foldable as X (for_, toList, traverse_)+import "base" Data.List.NonEmpty as X (NonEmpty (..), nonEmpty)+import "base" Data.Maybe as X (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)+import "base" Data.Traversable as X (for)+import "base" GHC.Generics as X (Generic)+import "containers" Data.Map.Strict as X (Map)+import "containers" Data.Set as X (Set)+import "lens" Control.Lens+import "text" Data.Text as X (Text)
+ src/HurlWorkbench/Process/Run.hs view
@@ -0,0 +1,152 @@+-- | Acquire a POSIX group ID before any waiter can reap the leader. All owned+-- output handles are caller-managed files, so termination never waits on a pipe.+module HurlWorkbench.Process.Run+  ( OwnedProcess (..),+    spawnGroup,+    terminateGroup,+    commandConfig,+    runCommand,+    CommandOutcome (..),+    getExitCode,+    waitExitCode,+    getExitCodeSTM,+    waitExitCodeSTM,+  )+where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (Async, asyncWithUnmask, wait)+import Control.Concurrent.STM+import Control.Exception (IOException, displayException, mask, onException, try)+import Data.Generics.Labels ()+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime, addUTCTime, getCurrentTime)+import HurlWorkbench.Prelude+import HurlWorkbench.Service.Resolve+import HurlWorkbench.Workspace.Types (ServiceName)+import System.Exit (ExitCode (..))+import System.IO (Handle, IOMode (ReadWriteMode), withBinaryFile)+import System.IO.Error (isDoesNotExistError)+import System.Posix.Signals (nullSignal, sigKILL, sigTERM, signalProcessGroup)+import System.Posix.Types (ProcessID)+import System.Process qualified as Process+import System.Timeout qualified as Timeout++data OwnedProcess = OwnedProcess+  { processId :: !ProcessID,+    completion :: !(TMVar (Either IOException ExitCode)),+    reaper :: !(Async ())+  }+  deriving stock (Generic)++data CommandOutcome = CommandPassed | CommandFailed | CommandTimedOut | CommandStartFailed | CommandSkipped | CommandCancelled+  deriving stock (Generic, Eq, Show)++commandConfig :: ResolvedCommand -> Process.CreateProcess+commandConfig command =+  (Process.proc (command ^. #executable) (command ^. #arguments))+    { Process.create_group = True,+      Process.std_in = Process.NoStream,+      Process.std_out = Process.NoStream,+      Process.std_err = Process.NoStream,+      Process.cwd = Just (command ^. #workingDirectory),+      Process.env = Just (command ^. #environment)+    }++spawnGroup :: ServiceName -> Process.CreateProcess -> IO (Either ServiceError OwnedProcess)+spawnGroup name config = mask $ \_ -> do+  -- createProcess_ leaves UseHandle inputs open in the parent. No pipe handles+  -- or background waiter exist until the immutable group ID has been captured.+  started <- try @IOException $ withBinaryFile "/dev/null" ReadWriteMode $ \nullHandle -> do+    let output stream = case stream of Process.NoStream -> Process.UseHandle nullHandle; other -> other+    (_, _, _, handle) <-+      Process.createProcess_+        "owned process"+        config+          { Process.create_group = True,+            Process.std_out = output (Process.std_out config),+            Process.std_err = output (Process.std_err config)+          }+    pure handle+  case started of+    Left _ -> pure (Left (ServiceSpawnFailed "<redacted>" "process launch failed"))+    Right handle ->+      Process.getPid handle >>= \case+        Nothing -> do+          _ <- Timeout.timeout 1000000 (Process.terminateProcess handle >> Process.waitForProcess handle)+          pure (Left (ServiceProcessIdUnavailable name))+        Just pid -> do+          completion <- newEmptyTMVarIO+          reaper <- asyncWithUnmask $ \unmask -> do+            result <- try @IOException (unmask (Process.waitForProcess handle))+            atomically (putTMVar completion result)+          pure (Right (OwnedProcess pid completion reaper))++waitExitCodeSTM :: OwnedProcess -> STM ExitCode+waitExitCodeSTM owned = readTMVar (owned ^. #completion) >>= either throwSTM pure++getExitCodeSTM :: OwnedProcess -> STM (Maybe ExitCode)+getExitCodeSTM owned = tryReadTMVar (owned ^. #completion) >>= traverse (either throwSTM pure)++waitExitCode :: OwnedProcess -> IO ExitCode+waitExitCode = atomically . waitExitCodeSTM++getExitCode :: OwnedProcess -> IO (Maybe ExitCode)+getExitCode = atomically . getExitCodeSTM++-- | TERM and KILL address the group even if the leader has already exited.+-- The finite budget includes leader reaping and joining its one waiter.+terminateGroup :: ServiceName -> NominalDiffTime -> OwnedProcess -> IO (Either ServiceError ())+terminateGroup name budget owned = do+  attempted <- try @IOException terminate+  pure (either (const (Left failure)) id attempted)+  where+    failure = ServiceShutdownFailed name (Just (owned ^. #processId)) "process group cleanup failed or timed out"+    terminate = do+      finished <- Timeout.timeout micros $ do+        term <- signal sigTERM+        began <- getCurrentTime+        gone <- waitGroup (addUTCTime (budget / 2) began)+        killed <- if gone then pure "" else signal sigKILL+        _ <- waitExitCode owned+        wait (owned ^. #reaper)+        pure (term <> killed)+      pure $ case finished of+        Just "" -> Right ()+        Just message -> Left (ServiceShutdownFailed name (Just (owned ^. #processId)) message)+        Nothing -> Left failure+    micros = max 1 (floor (budget * 1000000))+    signal sig =+      try @IOException (signalProcessGroup sig (owned ^. #processId)) >>= \case+        Right () -> pure ""+        Left err | isDoesNotExistError err -> pure ""+        Left err -> do+          -- Darwin can report EPERM while an empty group is disappearing. Only+          -- suppress the failed signal once ESRCH positively confirms absence;+          -- a group that still exists or remains uncertain is a cleanup failure.+          vanished <- Timeout.timeout (max 1 (min 10000 (micros `div` 4))) confirmAbsent+          pure $ if vanished == Just True then "" else (if sig == sigTERM then "SIGTERM: " else "SIGKILL: ") <> Text.pack (displayException err)+    confirmAbsent =+      try @IOException (signalProcessGroup nullSignal (owned ^. #processId)) >>= \case+        Left err | isDoesNotExistError err -> pure True+        Left _ -> threadDelay 1000 >> confirmAbsent+        Right () -> threadDelay 1000 >> confirmAbsent+    waitGroup deadline = do+      alive <- try @IOException (signalProcessGroup nullSignal (owned ^. #processId))+      now <- getCurrentTime+      case alive of+        Left err | isDoesNotExistError err -> pure True+        Left _ -> pure False+        Right () | now >= deadline -> pure False+        Right () -> threadDelay 10000 >> waitGroup deadline++runCommand :: ServiceName -> NominalDiffTime -> ResolvedCommand -> Handle -> Handle -> IO (CommandOutcome, Maybe ServiceError)+runCommand name budget command stdout stderr = mask $ \restore -> do+  spawnGroup name (commandConfig command) {Process.std_out = Process.UseHandle stdout, Process.std_err = Process.UseHandle stderr} >>= \case+    Left _ -> pure (CommandStartFailed, Nothing)+    Right owned -> do+      let cleanupBudget = min 1 (budget / 4)+          cleanup = terminateGroup name cleanupBudget owned+      result <- restore (Timeout.timeout (max 1 (floor ((budget - cleanupBudget) * 1000000))) (waitExitCode owned)) `onException` void cleanup+      shutdown <- cleanup+      pure (case result of Just ExitSuccess -> CommandPassed; Just _ -> CommandFailed; Nothing -> CommandTimedOut, either Just (const Nothing) shutdown)
+ src/HurlWorkbench/Run/Artifact.hs view
@@ -0,0 +1,154 @@+-- | Collision-checked, owner-only response artifacts for batch client runs.+module HurlWorkbench.Run.Artifact+  ( ArtifactError (..),+    responseArtifactPath,+    prepareResponseArtifacts,+    renderArtifactError,+  )+where++import Control.Exception (IOException, displayException, try)+import Control.Monad (foldM)+import Data.Bits ((.&.))+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import HurlWorkbench.Prelude+import HurlWorkbench.Run.FileRoot+import HurlWorkbench.Run.Prepare (PreparedRun)+import System.Directory+  ( createDirectory,+    createDirectoryIfMissing,+    doesDirectoryExist,+    doesPathExist,+    pathIsSymbolicLink,+  )+import System.FilePath (addExtension, isAbsolute, splitDirectories, takeDirectory, (</>))+import System.IO (hClose)+import System.Posix.Files+  ( accessModes,+    fileMode,+    getFileStatus,+    ownerExecuteMode,+    ownerReadMode,+    ownerWriteMode,+    setFileMode,+    unionFileModes,+  )+import System.Posix.IO (OpenFileFlags (..), OpenMode (WriteOnly), defaultFileFlags, fdToHandle, openFd)+import System.Posix.Types (FileMode)++data ArtifactError+  = ArtifactFileRootConflict !FileRootError+  | InvalidArtifactStem !FilePath+  | DuplicateArtifactTarget !FilePath+  | ArtifactAlreadyExists !FilePath+  | ArtifactPathIsSymbolicLink !FilePath+  | ArtifactTargetIsDirectory !FilePath+  | ArtifactIoError !FilePath !Text+  deriving stock (Generic, Eq, Show)++responseArtifactPath :: FilePath -> PreparedRun -> Either ArtifactError FilePath+responseArtifactPath outputDirectory prepared+  | not (validStem stem) = Left (InvalidArtifactStem stem)+  | otherwise = Right (addExtension (outputDirectory </> stem) "response")+  where+    stem = prepared ^. #artifactStem++prepareResponseArtifacts :: FilePath -> Bool -> NonEmpty PreparedRun -> IO (Either (NonEmpty ArtifactError) (NonEmpty FilePath))+prepareResponseArtifacts outputDirectory overwrite prepared =+  case traverse (responseArtifactPath outputDirectory) prepared of+    Left err -> pure (Left (err :| []))+    Right targets -> do+      rootChecks <- traverse (\run -> checkFileRootOutputs (run ^. #fileRoot) [outputDirectory]) prepared+      existingIssues <- fmap concat (traverse existingIssue (NonEmpty.toList targets))+      let duplicateIssues =+            [ DuplicateArtifactTarget path+            | (path, count) <- Map.toAscList (Map.fromListWith (+) [(path, 1 :: Int) | path <- NonEmpty.toList targets]),+              count > 1+            ]+          preflightIssues = [ArtifactFileRootConflict err | Left err <- toList rootChecks] <> duplicateIssues <> existingIssues+      case nonEmpty preflightIssues of+        Just issues -> pure (Left issues)+        Nothing -> do+          preparedTargets <- try @IOException (prepareAll targets)+          pure $ case preparedTargets of+            Left err -> Left (ArtifactIoError outputDirectory (Text.pack (displayException err)) :| [])+            Right () -> Right targets+  where+    existingIssue path = do+      exists <- doesPathExist path+      symbolic <- if exists then pathIsSymbolicLink path else pure False+      directory <- if exists && not symbolic then doesDirectoryExist path else pure False+      pure $+        [ArtifactPathIsSymbolicLink path | symbolic]+          <> [ArtifactTargetIsDirectory path | directory]+          <> [ArtifactAlreadyExists path | exists && not symbolic && not directory && not overwrite]++    prepareAll targets = do+      createDirectoryIfMissing True outputDirectory+      setFileMode outputDirectory secureDirectoryMode+      verifyMode secureDirectoryMode outputDirectory+      traverse_ (prepareTarget outputDirectory) targets++prepareTarget :: FilePath -> FilePath -> IO ()+prepareTarget outputDirectory target = do+  let relativeDirectories = filter (not . null) (splitDirectories (dropPrefix outputDirectory target))+  _ <- foldM ensureDirectory outputDirectory relativeDirectories+  handle <- fdToHandle =<< openFd target WriteOnly defaultFileFlags {creat = Just secureFileMode, trunc = True, nofollow = True}+  hClose handle+  setFileMode target secureFileMode+  verifyMode secureFileMode target++ensureDirectory :: FilePath -> FilePath -> IO FilePath+ensureDirectory parent component = do+  let path = parent </> component+  exists <- doesPathExist path+  if exists+    then do+      symbolic <- pathIsSymbolicLink path+      when symbolic (ioError (userError ("artifact directory is a symbolic link: " <> path)))+      directory <- doesDirectoryExist path+      unless directory (ioError (userError ("artifact parent is not a directory: " <> path)))+    else createDirectory path+  setFileMode path secureDirectoryMode+  verifyMode secureDirectoryMode path+  pure path++dropPrefix :: FilePath -> FilePath -> FilePath+dropPrefix outputDirectory target =+  let rootParts = splitDirectories outputDirectory+      targetParts = splitDirectories (takeDirectory target)+   in foldl' (</>) "" (drop (length rootParts) targetParts)++validStem :: FilePath -> Bool+validStem stem =+  not (null stem)+    && not (isAbsolute stem)+    && all validComponent (splitDirectories stem)+  where+    validComponent component = not (null component) && component /= "." && component /= ".."++verifyMode :: FileMode -> FilePath -> IO ()+verifyMode expected path = do+  actual <- (.&. accessModes) . fileMode <$> getFileStatus path+  unless (actual == expected) (ioError (userError ("insecure permissions on " <> path)))++secureFileMode :: FileMode+secureFileMode = ownerReadMode `unionFileModes` ownerWriteMode++secureDirectoryMode :: FileMode+secureDirectoryMode = secureFileMode `unionFileModes` ownerExecuteMode++renderArtifactError :: ArtifactError -> Text+renderArtifactError = \case+  ArtifactFileRootConflict err -> renderFileRootError err+  InvalidArtifactStem stem -> "invalid generated artifact stem " <> quote stem+  DuplicateArtifactTarget path -> "more than one case resolves to artifact " <> quote path+  ArtifactAlreadyExists path -> "artifact already exists; use --overwrite to replace " <> quote path+  ArtifactPathIsSymbolicLink path -> "artifact path must not be a symbolic link: " <> quote path+  ArtifactTargetIsDirectory path -> "artifact target is a directory: " <> quote path+  ArtifactIoError path message -> "could not prepare artifacts under " <> quote path <> ": " <> message+  where+    quote = ("\"" <>) . (<> "\"") . Text.pack
+ src/HurlWorkbench/Run/Batch.hs view
@@ -0,0 +1,200 @@+-- | Batch-ready Hurl requests. Bounded scheduling and result aggregation are+--   added by EP-4's second milestone; preparation already targets this type.+module HurlWorkbench.Run.Batch+  ( PositiveInt,+    positiveIntValue,+    BatchOptionError (..),+    mkPositiveInt,+    BatchOptions (..),+    BatchCase (..),+    SkipReason (..),+    CaseOutcome (..),+    CaseResult (..),+    BatchResult (..),+    runBatch,+    runBatchObserved,+  )+where++import Control.Concurrent.Async (replicateConcurrently_)+import Control.Concurrent.STM+  ( TQueue,+    TVar,+    atomically,+    modifyTVar',+    newTQueue,+    newTVar,+    readTVar,+    readTVarIO,+    tryReadTQueue,+    writeTQueue,+    writeTVar,+  )+import Control.Exception (mask)+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Time.Clock (NominalDiffTime)+import HurlWorkbench.Hurl.Run+import HurlWorkbench.Prelude+import System.Exit (ExitCode (..))++newtype PositiveInt = PositiveInt Int+  deriving stock (Generic, Eq, Ord, Show)++positiveIntValue :: PositiveInt -> Int+positiveIntValue (PositiveInt value) = value++data BatchOptionError = NonPositiveJobs !Int+  deriving stock (Generic, Eq, Show)++mkPositiveInt :: Int -> Either BatchOptionError PositiveInt+mkPositiveInt value+  | value > 0 = Right (PositiveInt value)+  | otherwise = Left (NonPositiveJobs value)++data BatchOptions = BatchOptions+  { jobs :: !PositiveInt,+    failFast :: !Bool+  }+  deriving stock (Generic, Eq, Show)++data BatchCase = BatchCase+  { name :: !Text,+    artifactStem :: !FilePath,+    request :: !RunRequest+  }+  deriving stock (Generic, Eq)++instance Show BatchCase where+  show batchCase = "BatchCase " <> show (batchCase ^. #name) <> " <redacted request>"++data SkipReason+  = FailFastTriggered+  | BatchPrerequisiteFailed+  | BatchCancelled+  deriving stock (Generic, Eq, Show)++data CaseOutcome+  = CasePassed+  | CaseFailed !ExitCode+  | CaseStartFailed !RunStartError+  | CaseSkipped !SkipReason+  deriving stock (Generic, Eq, Show)++data CaseResult = CaseResult+  { name :: !Text,+    outcome :: !CaseOutcome,+    elapsed :: !(Maybe NominalDiffTime),+    outputPath :: !(Maybe FilePath),+    capturedOutput :: !(Maybe CapturedRunOutput)+  }+  deriving stock (Generic, Eq, Show)++data BatchResult = BatchResult+  { cases :: !(NonEmpty CaseResult),+    selectedExitCode :: !ExitCode+  }+  deriving stock (Generic, Eq, Show)++runBatch :: HurlRunner -> BatchOptions -> NonEmpty BatchCase -> IO BatchResult+runBatch runner options batchCases = runBatchObserved runner options batchCases (\_index _result -> pure ())++-- | Run a batch while publishing each completed case with its declaration+--   index. The observer lets orchestration retain completed outcomes if a+--   prerequisite failure asynchronously cancels the batch.+runBatchObserved :: HurlRunner -> BatchOptions -> NonEmpty BatchCase -> (Int -> CaseResult -> IO ()) -> IO BatchResult+runBatchObserved runner options batchCases observe = do+  queue <- atomically newTQueue+  results <- atomically (newTVar Map.empty)+  stopped <- atomically (newTVar False)+  let indexedCases = zip [0 ..] (NonEmpty.toList batchCases)+      workerCount = min (positiveIntValue (options ^. #jobs)) (length indexedCases)+  atomically (traverse_ (writeTQueue queue) indexedCases)+  replicateConcurrently_ workerCount (worker queue results stopped)+  completed <- readTVarIO results+  let ordered = NonEmpty.fromList (map (caseResult completed) indexedCases)+  pure+    BatchResult+      { cases = ordered,+        selectedExitCode = selectExitCode ordered+      }+  where+    worker queue results stopped =+      nextWork queue stopped >>= \case+        Nothing -> pure ()+        Just (caseIndex, batchCase) -> do+          mask $ \restore -> do+            result <- restore (executeCase runner batchCase)+            atomically $ do+              modifyTVar' results (Map.insert caseIndex result)+              when (options ^. #failFast && caseFailed result) (writeTVar stopped True)+            observe caseIndex result+          worker queue results stopped++    nextWork :: TQueue (Int, BatchCase) -> TVar Bool -> IO (Maybe (Int, BatchCase))+    nextWork queue stopped = atomically $ do+      shouldStop <- readTVar stopped+      if shouldStop then pure Nothing else tryReadTQueue queue++    caseResult completed (caseIndex, batchCase) =+      Map.findWithDefault (skippedCase batchCase FailFastTriggered) caseIndex completed++executeCase :: HurlRunner -> BatchCase -> IO CaseResult+executeCase runner batchCase = do+  executed <- runHurl runner (batchCase ^. #request)+  pure $ case executed of+    Left err ->+      CaseResult+        { name = batchCase ^. #name,+          outcome = CaseStartFailed err,+          elapsed = Nothing,+          outputPath = requestOutputPath (batchCase ^. #request),+          capturedOutput = Nothing+        }+    Right result ->+      CaseResult+        { name = batchCase ^. #name,+          outcome = case result ^. #exitCode of+            ExitSuccess -> CasePassed+            failed -> CaseFailed failed,+          elapsed = Just (result ^. #elapsed),+          outputPath = requestOutputPath (batchCase ^. #request),+          capturedOutput = result ^. #capturedOutput+        }++skippedCase :: BatchCase -> SkipReason -> CaseResult+skippedCase batchCase reason =+  CaseResult+    { name = batchCase ^. #name,+      outcome = CaseSkipped reason,+      elapsed = Nothing,+      outputPath = requestOutputPath (batchCase ^. #request),+      capturedOutput = Nothing+    }++requestOutputPath :: RunRequest -> Maybe FilePath+requestOutputPath request = case request ^. #outputPolicy of+  ResponseFile path -> Just path+  _ -> Nothing++caseFailed :: CaseResult -> Bool+caseFailed result = case result ^. #outcome of+  CasePassed -> False+  _ -> True++selectExitCode :: NonEmpty CaseResult -> ExitCode+selectExitCode results =+  fromMaybe fallback (firstFailure (NonEmpty.toList results))+  where+    fallback+      | all (not . caseFailed) results = ExitSuccess+      | otherwise = ExitFailure 3++    firstFailure = \case+      [] -> Nothing+      result : remaining -> case result ^. #outcome of+        CaseFailed exitCode -> Just exitCode+        CaseStartFailed _ -> Just (ExitFailure 3)+        CasePassed -> firstFailure remaining+        CaseSkipped _ -> firstFailure remaining
+ src/HurlWorkbench/Run/FileRoot.hs view
@@ -0,0 +1,98 @@+-- | Caller-owned Hurl body directories. Validation uses filesystem operations+-- under the effective identity; no mode-bit inference or process-global cwd.+module HurlWorkbench.Run.FileRoot+  ( FileRoot,+    FileRootError,+    validateFileRoot,+    fileRootPath,+    checkFileRootOutputs,+    selectSuiteFileRoot,+    renderFileRootError,+  )+where++import Control.Exception (IOException, try)+import Data.Generics.Labels ()+import Data.List (isPrefixOf)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import System.Directory (canonicalizePath, listDirectory)+import System.FilePath (isAbsolute, splitDirectories, (</>))+import System.Posix.Files (getFileStatus, isDirectory)++-- The flag records explicit selection, which requires disjoint output trees.+data FileRoot = FileRoot !FilePath !Bool+  deriving stock (Generic, Eq)++instance Show FileRoot where+  show _ = "FileRoot <redacted>"++data FileRootError = InvalidFileRoot | FileRootBindingFailed !BindingError | FileRootOutputOverlap | FileRootOutputUnreadable+  deriving stock (Generic, Eq)++instance Show FileRootError where+  show = Text.unpack . renderFileRootError++-- | Nothing selects the supplied workspace base. Explicit relative paths use+-- the supplied invocation or workspace base, according to the caller.+validateFileRoot :: FilePath -> Maybe FilePath -> IO (Either FileRootError FileRoot)+validateFileRoot base requested = do+  attempted <- try @IOException $ do+    let selected = fromMaybe base requested+        absolute = case requested of+          Nothing -> base+          Just _ -> if isAbsolute selected then selected else base </> selected+    when (maybe False null requested) (ioError (userError "empty file root"))+    canonical <- canonicalizePath absolute+    -- stat of root/. needs directory search access, and listing needs read+    -- access. Both use the effective identity, including ACLs and privileges.+    status <- getFileStatus (canonical </> ".")+    unless (isDirectory status) (ioError (userError "file root is not a directory"))+    _ <- listDirectory canonical+    pure (FileRoot canonical (isJust requested))+  pure (either (const (Left InvalidFileRoot)) Right attempted)++fileRootPath :: FileRoot -> FilePath+fileRootPath (FileRoot path _) = path++-- | Canonicalize existing parent components even for not-yet-created outputs.+-- This check must run before report reservation, overwrite, or chmod.+checkFileRootOutputs :: FileRoot -> [FilePath] -> IO (Either FileRootError ())+checkFileRootOutputs (FileRoot _ False) _ = pure (Right ())+checkFileRootOutputs (FileRoot root True) targets = do+  inspected <- try @IOException (traverse canonicalizePath targets)+  pure $ case inspected of+    Left _ -> Left FileRootOutputUnreadable+    Right paths+      | any overlaps paths -> Left FileRootOutputOverlap+      | otherwise -> Right ()+  where+    overlaps path = let a = splitDirectories root; b = splitDirectories path in a `isPrefixOf` b || b `isPrefixOf` a++-- | Only suite-wide bindings participate. A typed CLI selection wins without+-- resolving the shadowed parameter. Static workspace validation checks its kind.+selectSuiteFileRoot :: ValidatedWorkspace -> SuiteName -> BindingInput -> Maybe FileRoot -> IO (Either FileRootError FileRoot)+selectSuiteFileRoot workspace name input selected = case selected of+  Just root -> pure (Right root)+  Nothing -> case lookupSuite name workspace >>= view #fileRootParameter of+    Nothing -> validateFileRoot base Nothing+    Just parameter ->+      resolveParameterSubset workspace (Set.singleton parameter) input >>= \case+        Left err -> pure (Left (FileRootBindingFailed err))+        Right bindings -> case Map.lookup parameter (bindings ^. #variables) of+          Nothing -> pure (Left InvalidFileRoot)+          Just value -> validateFileRoot base (Just (Text.unpack (hurlValueLiteralText value)))+  where+    base = unWorkspaceRoot (validatedRoot workspace)++renderFileRootError :: FileRootError -> Text+renderFileRootError = \case+  InvalidFileRoot -> "--file-root must select an existing readable, searchable directory"+  FileRootBindingFailed err -> "suite file-root parameter: " <> renderBindingError err+  FileRootOutputOverlap -> "file-root input and output trees must be disjoint"+  FileRootOutputUnreadable -> "could not inspect file-root output layout"
+ src/HurlWorkbench/Run/Prepare.hs view
@@ -0,0 +1,185 @@+-- | Convert pure selections into fully rendered, syntax-checked, bound runs+--   before any Hurl process starts.+module HurlWorkbench.Run.Prepare+  ( PreparedRun (..),+    PreparationError (..),+    prepareSelection,+    prepareSelectionForSuite,+    prepareSelectionForSuiteWith,+    prepareSelectionWith,+    prepareSelectionWithGenerator,+    prepareExpandedForSuiteWith,+    prepareSelectionAtFileRootWith,+    prepareSelectionForSuiteAtFileRootWith,+    prepareExpandedForSuiteAtFileRootWith,+    buildBatchCase,+    renderPreparationError,+  )+where++import Control.Monad (foldM)+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Hurl.Run+import HurlWorkbench.Parameter.Generate (GeneratorEnvironment)+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Run.Batch+import HurlWorkbench.Run.FileRoot+import HurlWorkbench.Run.Selection+import HurlWorkbench.Workflow.Render+import HurlWorkbench.Workspace.Context (ValidatedWorkspace, validatedRoot)+import HurlWorkbench.Workspace.Types (Workflow, WorkspaceRoot (..))++data PreparedRun = PreparedRun+  { displayName :: !Text,+    artifactStem :: !FilePath,+    safety :: !SafetyDisposition,+    renderedWorkflow :: !RenderedWorkflow,+    bindings :: !ResolvedBindings,+    fileRoot :: !FileRoot,+    options :: !HurlOptions+  }+  deriving stock (Generic, Eq, Show)++data PreparationError+  = RunFileRootFailed !FileRootError+  | SelectionPreparationFailed !SelectionError+  | RunRenderFailed !Text !RenderError+  | RunFormatFailed !Text !HurlfmtError+  | RunBindingFailed !Text !BindingError+  deriving stock (Generic, Eq, Show)++data CachedWorkflow+  = CachedRenderFailure !RenderError+  | CachedFormatFailure !HurlfmtError+  | CachedRendered !RenderedWorkflow++prepareSelection :: HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelection = prepareSelectionWith validateRenderedWorkflow++-- | Prepare one selection from suite-wide runtime input. Bindings intended+--   for other selections in the same suite are ignored.+prepareSelectionForSuite :: HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionForSuite = prepareSelectionUsing resolveWorkflowBindingSubsetWithLayers validateRenderedWorkflow++prepareSelectionForSuiteWith :: (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionForSuiteWith = prepareSelectionUsing resolveWorkflowBindingSubsetWithLayers++prepareSelectionWith :: (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionWith = prepareSelectionUsing resolveWorkflowBindingsWithLayers++-- | Deterministic preflight with an injected clock and entropy provider.+prepareSelectionWithGenerator :: GeneratorEnvironment -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionWithGenerator env = prepareSelectionUsing (\validated workflow -> resolveParametersWithLayersAndGenerator env validated (Set.fromList (workflow ^. #parameters)))++prepareSelectionUsing :: (ValidatedWorkspace -> Workflow -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)) -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionUsing resolveBindings validateRendered capabilities validated input hurlOptions selection =+  case resolveSelection validated selection of+    Left err -> pure (Left (SelectionPreparationFailed err :| []))+    Right expanded -> withDefaultRoot validated $ \root -> prepareExpandedUsing resolveBindings root validateRendered capabilities validated hurlOptions (fmap (,input) expanded)++prepareExpandedForSuiteWith :: (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> HurlOptions -> NonEmpty (ExpandedRun, BindingInput) -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareExpandedForSuiteWith validateRendered capabilities validated options runs =+  withDefaultRoot validated $ \root -> prepareExpandedForSuiteAtFileRootWith root validateRendered capabilities validated options runs++withDefaultRoot :: ValidatedWorkspace -> (FileRoot -> IO (Either (NonEmpty PreparationError) a)) -> IO (Either (NonEmpty PreparationError) a)+withDefaultRoot validated action = validateFileRoot (unWorkspaceRoot (validatedRoot validated)) Nothing >>= either (pure . Left . (:| []) . RunFileRootFailed) action++prepareSelectionAtFileRootWith :: FileRoot -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionAtFileRootWith = prepareSelectionAtFileRootUsing resolveWorkflowBindingsWithLayers++prepareSelectionForSuiteAtFileRootWith :: FileRoot -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionForSuiteAtFileRootWith = prepareSelectionAtFileRootUsing resolveWorkflowBindingSubsetWithLayers++prepareSelectionAtFileRootUsing :: (ValidatedWorkspace -> Workflow -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)) -> FileRoot -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> BindingInput -> HurlOptions -> RunSelection -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareSelectionAtFileRootUsing resolveBindings root validateRendered capabilities validated input options selection =+  case resolveSelection validated selection of+    Left err -> pure (Left (SelectionPreparationFailed err :| []))+    Right expanded -> prepareExpandedUsing resolveBindings root validateRendered capabilities validated options (fmap (,input) expanded)++prepareExpandedForSuiteAtFileRootWith :: FileRoot -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> HurlOptions -> NonEmpty (ExpandedRun, BindingInput) -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareExpandedForSuiteAtFileRootWith = prepareExpandedUsing resolveWorkflowBindingSubsetWithLayers++prepareExpandedUsing :: (ValidatedWorkspace -> Workflow -> [BindingLayer] -> BindingInput -> IO (Either BindingError ResolvedBindings)) -> FileRoot -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> HurlOptions -> NonEmpty (ExpandedRun, BindingInput) -> IO (Either (NonEmpty PreparationError) (NonEmpty PreparedRun))+prepareExpandedUsing resolveBindings root validateRendered capabilities validated hurlOptions assignedRuns = do+  (_cache, errors, prepared) <- foldM prepareOne (Map.empty, [], []) (NonEmpty.toList assignedRuns)+  pure $ case (nonEmpty (reverse errors), nonEmpty (reverse prepared)) of+    (Just problems, _) -> Left problems+    (Nothing, Just ready) -> Right ready+    (Nothing, Nothing) -> error "prepareExpandedUsing: impossible empty expanded selection"+  where+    prepareOne (cache, errors, prepared) (expanded, input) = do+      (nextCache, cached) <- cachedWorkflow cache expanded+      case cached of+        CachedRenderFailure err -> pure (nextCache, RunRenderFailed (expanded ^. #displayName) err : errors, prepared)+        CachedFormatFailure err -> pure (nextCache, RunFormatFailed (expanded ^. #displayName) err : errors, prepared)+        CachedRendered rendered -> do+          resolved <-+            resolveBindings+              validated+              (expanded ^. #workflow . #workflow)+              (expanded ^. #bindingLayers)+              input+          pure $ case resolved of+            Left err -> (nextCache, RunBindingFailed (expanded ^. #displayName) err : errors, prepared)+            Right bindings ->+              ( nextCache,+                errors,+                PreparedRun+                  { displayName = expanded ^. #displayName,+                    artifactStem = expanded ^. #artifactStem,+                    safety = expanded ^. #safety,+                    renderedWorkflow = rendered,+                    bindings,+                    fileRoot = root,+                    options = hurlOptions+                  }+                  : prepared+              )++    cachedWorkflow cache expanded =+      let workflowName = expanded ^. #workflow . #workflow . #name+       in case Map.lookup workflowName cache of+            Just cached -> pure (cache, cached)+            Nothing -> do+              cached <- renderAndValidate expanded+              pure (Map.insert workflowName cached cache, cached)++    renderAndValidate expanded =+      renderWorkflow (expanded ^. #workflow) >>= \case+        Left err -> pure (CachedRenderFailure err)+        Right rendered ->+          validateRendered capabilities rendered <&> \case+            Left err -> CachedFormatFailure err+            Right () -> CachedRendered rendered++buildBatchCase :: HurlRunMode -> RunOutputPolicy -> [HurlReportTarget] -> PreparedRun -> BatchCase+buildBatchCase runMode output reports prepared =+  BatchCase+    { name = prepared ^. #displayName,+      artifactStem = prepared ^. #artifactStem,+      request =+        RunRequest+          { renderedWorkflow = prepared ^. #renderedWorkflow,+            fileRoot = prepared ^. #fileRoot,+            mode = runMode,+            bindings = prepared ^. #bindings,+            options = prepared ^. #options,+            outputPolicy = output,+            reportTargets = reports+          }+    }++renderPreparationError :: PreparationError -> Text+renderPreparationError = \case+  RunFileRootFailed err -> renderFileRootError err+  SelectionPreparationFailed err -> renderSelectionError err+  RunRenderFailed name err -> prefix name <> renderRenderError err+  RunFormatFailed name err -> prefix name <> renderHurlfmtError err+  RunBindingFailed name err -> prefix name <> renderBindingError err+  where+    prefix name = "run \"" <> name <> "\": "
+ src/HurlWorkbench/Run/Selection.hs view
@@ -0,0 +1,169 @@+-- | Pure expansion of workflow, recipe, and matrix selections. Each expanded+--   run names one resolved workflow plus ordered committed plain bindings.+module HurlWorkbench.Run.Selection+  ( RunSelection (..),+    SafetyDisposition (..),+    BindingLayer (..),+    ExpandedRun (..),+    SelectionError (..),+    resolveSelection,+    renderSelectionError,+  )+where++import Data.Bifunctor (first)+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import HurlWorkbench.Parameter.Resolve (BindingLayer (..), BindingSource (..))+import HurlWorkbench.Prelude+import HurlWorkbench.Workflow.Resolve+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import System.FilePath ((</>))++data RunSelection+  = SelectWorkflow !WorkflowName+  | SelectRecipe !RecipeName+  | SelectMatrix !MatrixName+  deriving stock (Generic, Eq, Show)++data SafetyDisposition+  = Classified !Safety+  | UnclassifiedWorkflow+  deriving stock (Generic, Eq, Show)++data ExpandedRun = ExpandedRun+  { displayName :: !Text,+    workflow :: !ResolvedWorkflow,+    safety :: !SafetyDisposition,+    bindingLayers :: ![BindingLayer],+    artifactStem :: !FilePath+  }+  deriving stock (Generic, Eq, Show)++data SelectionError+  = SelectedWorkflowInvalid !WorkflowError+  | SelectedRecipeNotFound !RecipeName+  | SelectedMatrixNotFound !MatrixName+  | RecipeWorkflowNotFound !RecipeName !WorkflowName+  | MatrixRecipeNotFound !MatrixName !RecipeName+  | MatrixHasNoCases !MatrixName+  | DuplicateMatrixCase !MatrixName !MatrixCaseName+  | DuplicateCommittedBinding !Text !ParameterName+  | UndeclaredCommittedBinding !Text !WorkflowName !ParameterName+  | SecretCommittedBinding !Text !ParameterName+  deriving stock (Generic, Eq, Show)++resolveSelection :: ValidatedWorkspace -> RunSelection -> Either SelectionError (NonEmpty ExpandedRun)+resolveSelection validated = \case+  SelectWorkflow name -> do+    resolved <- first SelectedWorkflowInvalid (resolveWorkflow validated name)+    pure+      ( ExpandedRun+          { displayName = unWorkflowName name,+            workflow = resolved,+            safety = UnclassifiedWorkflow,+            bindingLayers = [],+            artifactStem = Text.unpack (unWorkflowName name)+          }+          :| []+      )+  SelectRecipe name -> do+    recipe <- maybe (Left (SelectedRecipeNotFound name)) Right (lookupRecipe name validated)+    expanded <- expandRecipe validated recipe+    pure (expanded :| [])+  SelectMatrix name -> do+    matrix <- maybe (Left (SelectedMatrixNotFound name)) Right (lookupMatrix name validated)+    recipe <- maybe (Left (MatrixRecipeNotFound name (matrix ^. #recipe))) Right (lookupRecipe (matrix ^. #recipe) validated)+    let duplicateCase = firstDuplicate (map (view #name) (matrix ^. #cases))+    maybe (pure ()) (Left . DuplicateMatrixCase name) duplicateCase+    cases <- maybe (Left (MatrixHasNoCases name)) Right (nonEmpty (matrix ^. #cases))+    base <- expandRecipe validated recipe+    traverse (expandCase validated matrix base) cases++expandRecipe :: ValidatedWorkspace -> Recipe -> Either SelectionError ExpandedRun+expandRecipe validated recipe = do+  resolved <- first (const (RecipeWorkflowNotFound (recipe ^. #name) (recipe ^. #workflow))) (resolveWorkflow validated (recipe ^. #workflow))+  layer <- bindingLayer validated resolved (recipeLabel recipe) (recipe ^. #bindings)+  pure+    ExpandedRun+      { displayName = unRecipeName (recipe ^. #name),+        workflow = resolved,+        safety = Classified (recipe ^. #safety),+        bindingLayers = [layer],+        artifactStem = Text.unpack (unRecipeName (recipe ^. #name))+      }++expandCase :: ValidatedWorkspace -> Matrix -> ExpandedRun -> MatrixCase -> Either SelectionError ExpandedRun+expandCase validated matrix base matrixCase = do+  layer <- bindingLayer validated (base ^. #workflow) (matrixCaseLabel matrix matrixCase) (matrixCase ^. #bindings)+  let matrixName = unMatrixName (matrix ^. #name)+      caseName = unMatrixCaseName (matrixCase ^. #name)+  pure+    base+      { displayName = matrixName <> "/" <> caseName,+        bindingLayers = layer : base ^. #bindingLayers,+        artifactStem = Text.unpack matrixName </> Text.unpack caseName+      }++bindingLayer :: ValidatedWorkspace -> ResolvedWorkflow -> Text -> [Binding] -> Either SelectionError BindingLayer+bindingLayer validated resolved label bindings = do+  let duplicate = firstDuplicate (map (view #parameter) bindings)+  maybe (pure ()) (Left . DuplicateCommittedBinding label) duplicate+  traverse_ validateBinding bindings+  pure+    BindingLayer+      { source = CommittedBinding label,+        values = Map.fromList [(binding ^. #parameter, binding ^. #value) | binding <- bindings]+      }+  where+    definition = resolved ^. #workflow+    declared = Set.fromList (definition ^. #parameters)+    validateBinding binding+      | (binding ^. #parameter) `Set.notMember` declared =+          Left (UndeclaredCommittedBinding label (definition ^. #name) (binding ^. #parameter))+      | otherwise = case lookupParameter (binding ^. #parameter) validated of+          Just parameter | parameter ^. #kind == Secret -> Left (SecretCommittedBinding label (binding ^. #parameter))+          _ -> Right ()++firstDuplicate :: (Ord value) => [value] -> Maybe value+firstDuplicate values = go Set.empty values+  where+    go _ [] = Nothing+    go seen (value : remaining)+      | value `Set.member` seen = Just value+      | otherwise = go (Set.insert value seen) remaining++recipeLabel :: Recipe -> Text+recipeLabel recipe = "recipe " <> quote (unRecipeName (recipe ^. #name))++matrixCaseLabel :: Matrix -> MatrixCase -> Text+matrixCaseLabel matrix matrixCase =+  "matrix "+    <> quote (unMatrixName (matrix ^. #name))+    <> " case "+    <> quote (unMatrixCaseName (matrixCase ^. #name))++renderSelectionError :: SelectionError -> Text+renderSelectionError = \case+  SelectedWorkflowInvalid err -> renderWorkflowError err+  SelectedRecipeNotFound name -> "unknown recipe " <> quote (unRecipeName name)+  SelectedMatrixNotFound name -> "unknown matrix " <> quote (unMatrixName name)+  RecipeWorkflowNotFound recipe workflow ->+    "recipe " <> quote (unRecipeName recipe) <> " refers to unknown workflow " <> quote (unWorkflowName workflow)+  MatrixRecipeNotFound matrix recipe ->+    "matrix " <> quote (unMatrixName matrix) <> " refers to unknown recipe " <> quote (unRecipeName recipe)+  MatrixHasNoCases matrix -> "matrix " <> quote (unMatrixName matrix) <> " has no cases"+  DuplicateMatrixCase matrix matrixCase ->+    "matrix " <> quote (unMatrixName matrix) <> " declares case " <> quote (unMatrixCaseName matrixCase) <> " more than once"+  DuplicateCommittedBinding label parameter -> label <> " binds parameter " <> quotedParameter parameter <> " more than once"+  UndeclaredCommittedBinding label workflow parameter ->+    label <> " binds parameter " <> quotedParameter parameter <> " which workflow " <> quote (unWorkflowName workflow) <> " does not declare"+  SecretCommittedBinding label parameter -> label <> " commits a value for secret parameter " <> quotedParameter parameter+  where+    quotedParameter = quote . unParameterName++quote :: Text -> Text+quote value = "\"" <> value <> "\""
+ src/HurlWorkbench/Service/Environment.hs view
@@ -0,0 +1,22 @@+-- | One environment selection contract for managed command consumers.+module HurlWorkbench.Service.Environment (selectEnvironment) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Types (EnvironmentPolicy (..))++-- | Selected inherited names are required even when explicitly overridden.+-- Empty values count as present. No implicit platform variables are introduced.+selectEnvironment :: EnvironmentPolicy -> [(String, String)] -> [(String, String)] -> Either [Text] [(String, String)]+selectEnvironment policy ambient overrides =+  case policy of+    Inherit -> Right (overlay parent)+    Clean names ->+      let missing = filter (\name -> Map.notMember (Text.unpack name) parent) names+       in if null missing+            then Right (overlay (Map.filterWithKey (\key _ -> Text.pack key `elem` names) parent))+            else Left missing+  where+    parent = Map.fromList ambient+    overlay selected = Map.toAscList (Map.fromList overrides `Map.union` selected)
+ src/HurlWorkbench/Service/Group.hs view
@@ -0,0 +1,144 @@+-- | Dynamic group membership is the monitor generation. Removing an entry and+-- observing its exit happen in one STM transaction; no stale monitor can target+-- a replacement acquired by Restart.+module HurlWorkbench.Service.Group+  ( ServiceGroup,+    LifecycleOutcome (..),+    newServiceGroup,+    startNamed,+    startNamedObserved,+    stopNamed,+    applyServiceStep,+    applyServiceStepObserved,+    watchServices,+    cleanupServices,+  )+where++import Control.Concurrent.Async (race)+import Control.Concurrent.STM+import Control.Exception (mask)+import Data.Generics.Labels ()+import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)+import HurlWorkbench.Prelude+import HurlWorkbench.Process.Run+import HurlWorkbench.Service.Resolve+import HurlWorkbench.Service.Run (awaitService)+import HurlWorkbench.Workspace.Types (ServiceName (..), ServiceStep (..))++-- Newest acquisition first, including services still in readiness.+data Entry = Entry !ResolvedService !OwnedProcess !Bool++newtype ServiceGroup = ServiceGroup (TVar [Entry])++data LifecycleOutcome = LifecycleOutcome+  { name :: !ServiceName,+    action :: !Text,+    status :: !Text,+    elapsed :: !NominalDiffTime,+    failure :: !(Maybe ServiceError)+  }+  deriving stock (Generic, Eq, Show)++newServiceGroup :: IO ServiceGroup+newServiceGroup = ServiceGroup <$> newTVarIO []++unexpected :: ServiceGroup -> STM ServiceError+unexpected (ServiceGroup entries) = do+  active <- readTVar entries+  foldr+    orElse+    retry+    [ ServiceExitedDuringCallback (service ^. #name) <$> waitExitCodeSTM owned+    | Entry service owned True <- active+    ]++watchServices :: ServiceGroup -> IO (Either ServiceError a) -> IO (Either ServiceError a)+watchServices group action = race (atomically (unexpected group)) action <&> either Left id++startNamed :: ServiceGroup -> ResolvedService -> IO (Either ServiceError ())+startNamed group service = startNamedObserved group service (const (pure ()))++startNamedObserved :: ServiceGroup -> ResolvedService -> (LifecycleOutcome -> IO ()) -> IO (Either ServiceError ())+startNamedObserved group@(ServiceGroup entries) service observe = mask $ \restore -> do+  began <- getCurrentTime+  let emit action began_ result = do+        ended <- getCurrentTime+        observe (LifecycleOutcome (service ^. #name) action (either (const "failed") (const "passed") result) (diffUTCTime ended began_) (either Just (const Nothing) result))+  spawnGroup (service ^. #name) (commandConfig (service ^. #processConfig)) >>= \case+    Left err -> emit "start" began (Left err) >> pure (Left err)+    Right owned -> do+      -- Ownership is registered before readiness becomes interruptible.+      atomically (modifyTVar' entries (Entry service owned False :))+      emit "start" began (Right ())+      readyBegan <- getCurrentTime+      result <- restore (watchServices group (awaitService service owned))+      emit "readiness" readyBegan result+      case result of+        Left err -> pure (Left err)+        Right () -> do+          atomically (modifyTVar' entries (map (markReady (owned ^. #processId))))+          pure (Right ())+  where+    markReady pid entry@(Entry definition process _) =+      if process ^. #processId == pid then Entry definition process True else entry++stopNamed :: ServiceGroup -> ServiceName -> IO (Either ServiceError ())+stopNamed (ServiceGroup entries) name = mask $ \_ -> do+  retired <- atomically $ do+    active <- readTVar entries+    -- Check every current leader before retiring the intentional generation.+    exits <- for active $ \(Entry service owned ready) -> do+      exitCode <- getExitCodeSTM owned+      pure [ServiceExitedDuringCallback (service ^. #name) code | ready, Just code <- [exitCode]]+    case concat exits of+      err : _ -> pure (Left err)+      [] -> case [entry | entry@(Entry service _ _) <- active, service ^. #name == name] of+        [] -> pure (Left (ServiceShutdownFailed name Nothing "service is not running"))+        entry : _ -> do+          -- Keep ownership until termination finishes, but retire the monitor.+          modifyTVar' entries (map (\entry_@(Entry service owned _) -> if service ^. #name == name then Entry service owned False else entry_))+          pure (Right entry)+  case retired of+    Left err -> pure (Left err)+    Right (Entry service owned _) -> do+      result <- terminateGroup name (service ^. #shutdownTimeout) owned+      case result of+        Left err -> pure (Left err)+        Right () -> do+          atomically (modifyTVar' entries (filter (\(Entry _ process _) -> process ^. #processId /= owned ^. #processId)))+          pure (Right ())++applyServiceStep :: ServiceGroup -> [ResolvedService] -> ServiceStep -> IO (Either ServiceError ())+applyServiceStep group definitions operation = applyServiceStepObserved group definitions operation (const (pure ()))++applyServiceStepObserved :: ServiceGroup -> [ResolvedService] -> ServiceStep -> (LifecycleOutcome -> IO ()) -> IO (Either ServiceError ())+applyServiceStepObserved group definitions operation observe = case operation of+  Stop name -> watchServices group (stop name)+  Start name -> watchServices group (start name)+  Restart name ->+    watchServices group $+      stop name >>= \case+        Left err -> pure (Left err)+        Right () -> start name+  where+    stop name = do+      began <- getCurrentTime+      result <- stopNamed group name+      ended <- getCurrentTime+      observe (LifecycleOutcome name "stop" (either (const "failed") (const "passed") result) (diffUTCTime ended began) (either Just (const Nothing) result))+      pure result+    start name = case filter ((== name) . view #name) definitions of+      service : _ -> startNamedObserved group service observe+      [] -> pure (Left (ServiceProcessIdUnavailable name))++cleanupServices :: ServiceGroup -> IO [LifecycleOutcome]+cleanupServices (ServiceGroup entries) = do+  active <- readTVarIO entries+  results <- for active $ \(Entry service owned _) -> do+    began <- getCurrentTime+    result <- terminateGroup (service ^. #name) (service ^. #shutdownTimeout) owned+    ended <- getCurrentTime+    pure (LifecycleOutcome (service ^. #name) "cleanup" (either (const "failed") (const "passed") result) (diffUTCTime ended began) (either Just (const Nothing) result))+  atomically (writeTVar entries [])+  pure results
+ src/HurlWorkbench/Service/Resolve.hs view
@@ -0,0 +1,206 @@+-- | Resolve a validated service definition against suite-level runtime+--   bindings. Per-recipe and per-case binding layers never enter this module.+module HurlWorkbench.Service.Resolve+  ( ResolvedCommand (..),+    ResolvedReadiness (..),+    ResolvedService (..),+    ServiceError (..),+    requiredServiceParameters,+    resolveService,+    resolveCommand,+    renderServiceError,+  )+where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime)+import HurlWorkbench.Parameter.Resolve (ResolvedBindings (..))+import HurlWorkbench.Parameter.Resolve.Internal (secretValueText)+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import Numeric.Natural (Natural)+import System.Exit (ExitCode)+import System.FilePath ((</>))+import System.Posix.Types (ProcessID)++data ResolvedCommand = ResolvedCommand+  { executable :: !FilePath,+    arguments :: ![String],+    workingDirectory :: !FilePath,+    environmentPolicy :: !EnvironmentPolicy,+    environment :: ![(String, String)]+  }+  deriving stock (Generic, Eq)++instance Show ResolvedCommand where+  show _ = "ResolvedCommand <redacted>"++data ResolvedReadiness+  = ResolvedHttpReadiness !Text !Int !Int !NominalDiffTime+  | ResolvedCommandReadiness !ResolvedCommand !Int !NominalDiffTime+  deriving stock (Generic, Eq, Show)++data ResolvedService = ResolvedService+  { name :: !ServiceName,+    processConfig :: !ResolvedCommand,+    readiness :: !ResolvedReadiness,+    shutdownTimeout :: !NominalDiffTime+  }+  deriving stock (Generic, Eq, Show)++data ServiceError+  = ServicePhaseFailed !Text+  | ServiceBindingMissing !ParameterName+  | ServiceBindingUnknown !ParameterName+  | ServiceReadinessSecretPlaceholder !ParameterName+  | ServiceReadinessMalformedPlaceholder !Text+  | ServiceReadinessInvalidUrl !Text !Text+  | ServiceEnvironmentMissing !ServiceName !Text ![Text]+  | ServiceSpawnFailed !FilePath !Text+  | ServiceProcessIdUnavailable !ServiceName+  | ServiceExitedBeforeReady !ServiceName !ExitCode+  | ServiceReadinessTimedOut !ServiceName+  | ServiceReadinessProbeStartFailed !FilePath !Text+  | ServiceExitedDuringCallback !ServiceName !ExitCode+  | ServiceShutdownFailed !ServiceName !(Maybe ProcessID) !Text+  deriving stock (Generic, Eq, Show)++data UrlPart+  = UrlText !Text+  | UrlParameter !ParameterName++requiredServiceParameters :: Service -> Either ServiceError (Set ParameterName)+requiredServiceParameters service = do+  readinessParameters <- case service ^. #readiness of+    HttpReadinessCheck http ->+      Set.fromList . mapMaybe partParameter <$> parseUrlTemplate (http ^. #url)+    CommandReadinessCheck probe -> pure (commandParameters (probe ^. #command))+  pure (commandParameters (service ^. #command) <> readinessParameters)+  where+    commandParameters command = Set.fromList (map (view #parameter) (command ^. #environment))+    partParameter = \case+      UrlText _ -> Nothing+      UrlParameter name -> Just name++resolveService :: ValidatedWorkspace -> ResolvedBindings -> Service -> Either ServiceError ResolvedService+resolveService validated bindings service = do+  processConfig <- resolveCommand validated bindings (service ^. #command)+  readiness <- case service ^. #readiness of+    HttpReadinessCheck http ->+      ResolvedHttpReadiness+        <$> substituteReadinessUrl validated bindings (http ^. #url)+        <*> pure (fromIntegral (http ^. #expectedStatus))+        <*> pure (milliseconds (http ^. #intervalMilliseconds))+        <*> pure (seconds (http ^. #timeoutSeconds))+    CommandReadinessCheck probe ->+      ResolvedCommandReadiness+        <$> resolveCommand validated bindings (probe ^. #command)+        <*> pure (milliseconds (probe ^. #intervalMilliseconds))+        <*> pure (seconds (probe ^. #timeoutSeconds))+  pure+    ResolvedService+      { name = service ^. #name,+        processConfig,+        readiness,+        shutdownTimeout = seconds (service ^. #shutdownTimeoutSeconds)+      }++resolveCommand :: ValidatedWorkspace -> ResolvedBindings -> CommandSpec -> Either ServiceError ResolvedCommand+resolveCommand validated bindings command = do+  environment <- traverse resolveEnvironmentBinding (command ^. #environment)+  let WorkspaceRoot root = validatedRoot validated+      workingDirectory = maybe root (root </>) (command ^. #workingDirectory)+  pure+    ResolvedCommand+      { executable = Text.unpack (command ^. #executable),+        arguments = map Text.unpack (command ^. #arguments),+        workingDirectory,+        environmentPolicy = command ^. #environmentPolicy,+        environment+      }+  where+    resolveEnvironmentBinding binding = do+      value <- resolveValue (binding ^. #parameter)+      pure (Text.unpack (binding ^. #variable), Text.unpack value)++    resolveValue name =+      case Map.lookup name (bindings ^. #variables) of+        Just value -> Right (hurlValueLiteralText value)+        Nothing -> case Map.lookup name (bindings ^. #secrets) of+          Just value -> Right (secretValueText value)+          Nothing -> Left (ServiceBindingMissing name)++substituteReadinessUrl :: ValidatedWorkspace -> ResolvedBindings -> Text -> Either ServiceError Text+substituteReadinessUrl validated bindings template = do+  urlParts <- parseUrlTemplate template+  Text.concat <$> traverse renderPart urlParts+  where+    renderPart = \case+      UrlText value -> Right value+      UrlParameter name -> readinessValue name++    readinessValue name = case lookupParameter name validated of+      Nothing -> Left (ServiceBindingUnknown name)+      Just parameter+        | parameter ^. #kind == Secret -> Left (ServiceReadinessSecretPlaceholder name)+        | otherwise -> case Map.lookup name (bindings ^. #variables) of+            Nothing -> Left (ServiceBindingMissing name)+            Just value -> Right (hurlValueLiteralText value)++parseUrlTemplate :: Text -> Either ServiceError [UrlPart]+parseUrlTemplate template = go [] template+  where+    go accumulated remaining =+      case Text.breakOn "{{" remaining of+        (prefix, rest)+          | Text.null rest ->+              if "}}" `Text.isInfixOf` prefix+                then malformed+                else Right (reverse (prependText prefix accumulated))+          | otherwise ->+              let afterOpen = Text.drop 2 rest+                  (rawName, close) = Text.breakOn "}}" afterOpen+               in if Text.null close || Text.null rawName || "{{" `Text.isInfixOf` rawName+                    then malformed+                    else go (UrlParameter (ParameterName rawName) : prependText prefix accumulated) (Text.drop 2 close)++    prependText value accumulated+      | Text.null value = accumulated+      | otherwise = UrlText value : accumulated+    malformed = Left (ServiceReadinessMalformedPlaceholder template)++milliseconds :: Natural -> Int+milliseconds value = fromIntegral value * 1000++seconds :: Natural -> NominalDiffTime+seconds = fromIntegral++renderServiceError :: ServiceError -> Text+renderServiceError = \case+  ServicePhaseFailed phase -> "suite " <> phase <> " command failed"+  ServiceBindingMissing name -> "service parameter " <> quotedParameter name <> " has no suite-level runtime value"+  ServiceBindingUnknown name -> "readiness URL refers to unknown parameter " <> quotedParameter name+  ServiceReadinessSecretPlaceholder name -> "readiness URL must not contain secret parameter " <> quotedParameter name+  ServiceReadinessMalformedPlaceholder value -> "readiness URL contains a malformed placeholder near " <> quote value+  ServiceReadinessInvalidUrl url message -> "invalid readiness URL " <> quote url <> ": " <> message+  ServiceEnvironmentMissing name phase names -> "service " <> quotedService name <> " " <> phase <> " requires missing environment variables: " <> Text.intercalate ", " names+  ServiceSpawnFailed executable message -> "service executable " <> quote (Text.pack executable) <> " could not be started: " <> message+  ServiceProcessIdUnavailable name -> "service " <> quotedService name <> " started without an observable process id"+  ServiceExitedBeforeReady name exitCode -> "service " <> quotedService name <> " exited before readiness with " <> Text.pack (show exitCode)+  ServiceReadinessTimedOut name -> "service " <> quotedService name <> " did not become ready before its timeout"+  ServiceReadinessProbeStartFailed executable message -> "readiness executable " <> quote (Text.pack executable) <> " could not be started: " <> message+  ServiceExitedDuringCallback name exitCode -> "service " <> quotedService name <> " exited while its suite was running with " <> Text.pack (show exitCode)+  ServiceShutdownFailed name processId message ->+    "service "+      <> quotedService name+      <> maybe "" ((" (pid " <>) . (<> ")") . Text.pack . show) processId+      <> " could not be shut down cleanly: "+      <> message+  where+    quotedParameter = quote . unParameterName+    quotedService = quote . unServiceName+    quote value = "\"" <> value <> "\""
+ src/HurlWorkbench/Service/Run.hs view
@@ -0,0 +1,180 @@+-- | POSIX process-group lifecycle and readiness probes for one managed+--   service. Cleanup always completes before callback exceptions are rethrown.+module HurlWorkbench.Service.Run+  ( ServiceHandle,+    serviceProcessId,+    withService,+    freezeService,+    awaitService,+    prepareCommand,+  )+where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (race)+import Control.Exception (SomeException, finally, mask, throwIO, try)+import Data.Generics.Labels ()+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime)+import HurlWorkbench.Prelude+import HurlWorkbench.Process.Run+import HurlWorkbench.Service.Environment (selectEnvironment)+import HurlWorkbench.Service.Resolve+import HurlWorkbench.Workspace.Types (EnvironmentPolicy (..), ServiceName (..))+import Network.HTTP.Client+  ( HttpException,+    Manager,+    Request (responseTimeout),+    defaultManagerSettings,+    httpNoBody,+    newManager,+    parseRequest,+    responseStatus,+    responseTimeoutMicro,+  )+import Network.HTTP.Types.Status (statusCode)+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..))+import System.Posix.Types (ProcessID)+import System.Timeout qualified as Timeout++data ServiceHandle = ServiceHandle+  { name :: !Text,+    processId :: !ProcessID+  }+  deriving stock (Generic, Eq, Show)++serviceProcessId :: ServiceHandle -> ProcessID+serviceProcessId = view #processId++data PreparedReadiness+  = PreparedHttpReadiness !Manager !Request !Int !Int !NominalDiffTime+  | PreparedCommandReadiness !ResolvedCommand !Int !NominalDiffTime++withService :: ResolvedService -> (ServiceHandle -> IO a) -> IO (Either ServiceError a)+withService service callback = mask $ \restore -> do+  ambient <- getEnvironment+  case prepareCommand ambient (service ^. #name) "command" (service ^. #processConfig) of+    Left err -> pure (Left err)+    Right command -> do+      preparedReadiness <- prepareReadiness ambient (service ^. #name) (service ^. #readiness)+      case preparedReadiness of+        Left err -> pure (Left err)+        Right readiness -> launch restore command readiness+  where+    launch restore command readiness = do+      spawnGroup (service ^. #name) (commandConfig command) >>= \case+        Left err -> pure (Left err)+        Right owned -> do+          execution <- try @SomeException (restore (runLifecycle service readiness owned (owned ^. #processId) callback))+          shutdown <- terminateGroup (service ^. #name) (service ^. #shutdownTimeout) owned+          case execution of+            Left exception -> throwIO exception+            Right (Left err) -> pure (Left err)+            Right (Right value) -> pure (value <$ shutdown)++awaitService :: ResolvedService -> OwnedProcess -> IO (Either ServiceError ())+awaitService service owned = do+  prepared <- prepareReadiness [] (service ^. #name) (service ^. #readiness)+  case prepared of+    Left err -> pure (Left err)+    Right readiness -> awaitReadiness service readiness owned++runLifecycle :: ResolvedService -> PreparedReadiness -> OwnedProcess -> ProcessID -> (ServiceHandle -> IO a) -> IO (Either ServiceError a)+runLifecycle service readiness process pid callback =+  awaitReadiness service readiness process >>= \case+    Left err -> pure (Left err)+    Right () ->+      race+        (callback ServiceHandle {name = unServiceName (service ^. #name), processId = pid})+        (waitExitCode process)+        <&> \case+          Left value -> Right value+          Right exitCode -> Left (ServiceExitedDuringCallback (service ^. #name) exitCode)++prepareReadiness :: [(String, String)] -> ServiceName -> ResolvedReadiness -> IO (Either ServiceError PreparedReadiness)+prepareReadiness _ambient _name (ResolvedHttpReadiness url expectedStatus interval timeout) = do+  parsed <- try @HttpException (parseRequest (Text.unpack url))+  case parsed of+    Left _ -> pure (Left (ServiceReadinessInvalidUrl "<redacted>" "URL could not be parsed"))+    Right request -> do+      manager <- newManager defaultManagerSettings+      let withTimeout = request {responseTimeout = responseTimeoutMicro 1000000}+      pure+        ( Right+            ( PreparedHttpReadiness+                manager+                withTimeout+                expectedStatus+                interval+                timeout+            )+        )+prepareReadiness ambient name (ResolvedCommandReadiness command interval timeout) =+  pure ((\prepared -> PreparedCommandReadiness prepared interval timeout) <$> prepareCommand ambient name "readiness command" command)++prepareCommand :: [(String, String)] -> ServiceName -> Text -> ResolvedCommand -> Either ServiceError ResolvedCommand+prepareCommand ambient name phase command =+  case selectEnvironment (command ^. #environmentPolicy) ambient (command ^. #environment) of+    Left missing -> Left (ServiceEnvironmentMissing name phase missing)+    Right selected -> Right (command & #environment .~ selected & #environmentPolicy .~ Clean [])++freezeService :: [(String, String)] -> ResolvedService -> IO (Either ServiceError ResolvedService)+freezeService ambient service = case prepareCommand ambient (service ^. #name) "command" (service ^. #processConfig) of+  Left err -> pure (Left err)+  Right command ->+    prepareReadiness ambient (service ^. #name) (service ^. #readiness)+      <&> fmap+        ( \prepared ->+            service & #processConfig .~ command & #readiness .~ case prepared of+              PreparedCommandReadiness probe interval timeout -> ResolvedCommandReadiness probe interval timeout+              PreparedHttpReadiness {} -> service ^. #readiness+        )++awaitReadiness :: ResolvedService -> PreparedReadiness -> OwnedProcess -> IO (Either ServiceError ())+awaitReadiness service readiness process = do+  began <- getCurrentTime+  let deadline = addUTCTime (readinessTimeout readiness) began+  loop deadline+  where+    loop deadline = do+      getExitCode process >>= \case+        Just exitCode -> pure (Left (ServiceExitedBeforeReady (service ^. #name) exitCode))+        Nothing -> do+          now <- getCurrentTime+          if now >= deadline+            then pure (Left (ServiceReadinessTimedOut (service ^. #name)))+            else do+              attempted <- Timeout.timeout (remainingMicroseconds now deadline) (probeReadiness readiness)+              case attempted of+                Nothing -> pure (Left (ServiceReadinessTimedOut (service ^. #name)))+                Just (Left err) -> pure (Left err)+                Just (Right True) ->+                  getExitCode process <&> \case+                    Just exitCode -> Left (ServiceExitedBeforeReady (service ^. #name) exitCode)+                    Nothing -> Right ()+                Just (Right False) -> threadDelay (readinessInterval readiness) >> loop deadline++probeReadiness :: PreparedReadiness -> IO (Either ServiceError Bool)+probeReadiness (PreparedHttpReadiness manager request expected _interval _timeout) = do+  attempted <- try @HttpException (httpNoBody request manager)+  pure (Right (either (const False) ((== expected) . statusCode . responseStatus) attempted))+probeReadiness (PreparedCommandReadiness command _interval timeout) = mask $ \restore -> do+  spawnGroup (ServiceName "readiness") (commandConfig command) >>= \case+    Left _ -> pure (Left (ServiceReadinessProbeStartFailed "<redacted>" "process launch failed"))+    Right owned -> do+      exitCode <- restore (waitExitCode owned) `finally` void (terminateGroup (ServiceName "readiness") (min 1 timeout) owned)+      pure (Right (exitCode == ExitSuccess))++readinessInterval :: PreparedReadiness -> Int+readinessInterval = \case+  PreparedHttpReadiness _ _ _ interval _ -> interval+  PreparedCommandReadiness _ interval _ -> interval++readinessTimeout :: PreparedReadiness -> NominalDiffTime+readinessTimeout = \case+  PreparedHttpReadiness _ _ _ _ timeout -> timeout+  PreparedCommandReadiness _ _ timeout -> timeout++remainingMicroseconds :: UTCTime -> UTCTime -> Int+remainingMicroseconds now deadline = max 1 (floor (diffUTCTime deadline now * 1000000))
+ src/HurlWorkbench/Suite/Isolation.hs view
@@ -0,0 +1,59 @@+-- | Pure application-state checks, before formatting, binding IO, capability+-- probes, report replacement, or service resolution.+module HurlWorkbench.Suite.Isolation+  ( IsolationIssue (..),+    checkIsolation,+    checkSuiteIsolation,+    checkSuiteIsolationWith,+    renderIsolationIssue,+  )+where++import Data.Generics.Labels ()+import Data.Text qualified as Text+import HurlWorkbench.Prelude+import HurlWorkbench.Run.Batch (PositiveInt, positiveIntValue)+import HurlWorkbench.Run.Selection+import HurlWorkbench.Suite.Scenario (VerifiedScenarioInputs)+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types++data IsolationIssue+  = SharedStateParallelUnsafe !Text !SafetyDisposition+  | IndependentStateHandoffRequired+  deriving stock (Generic, Eq, Show)++checkIsolation :: IsolationPolicy -> PositiveInt -> [ExpandedRun] -> [IsolationIssue]+checkIsolation IndependentState _ _ = [IndependentStateHandoffRequired]+checkIsolation SharedState jobs runs =+  [ SharedStateParallelUnsafe (Text.pack (run ^. #artifactStem)) (run ^. #safety)+  | positiveIntValue jobs > 1,+    run <- runs,+    run ^. #safety /= Classified ReadOnly+  ]++-- | Expansion is pure; malformed references are handled by normal preparation.+checkSuiteIsolation :: ValidatedWorkspace -> SuiteName -> PositiveInt -> [IsolationIssue]+checkSuiteIsolation workspace name jobs = checkSuiteIsolationWith Nothing workspace name jobs++checkSuiteIsolationWith :: Maybe VerifiedScenarioInputs -> ValidatedWorkspace -> SuiteName -> PositiveInt -> [IsolationIssue]+checkSuiteIsolationWith verified workspace name jobs = case lookupSuite name workspace of+  Nothing -> []+  Just suite | suite ^. #isolation == IndependentState, isJust verified -> []+  Just suite -> checkIsolation (suite ^. #isolation) jobs (concatMap expanded (suite ^. #runs))+  where+    expanded (ServiceRun _) = []+    expanded (CheckRun _) = []+    expanded reference = either (const []) toList (resolveSelection workspace (selection reference))+    selection = \case+      WorkflowRun name_ -> SelectWorkflow name_+      RecipeRun name_ -> SelectRecipe name_+      MatrixRun name_ -> SelectMatrix name_+      CheckRun _ -> error "check step is not a Hurl selection"+      ServiceRun _ -> error "lifecycle step is not a Hurl selection"++renderIsolationIssue :: IsolationIssue -> Text+renderIsolationIssue = \case+  SharedStateParallelUnsafe scenario _ ->+    "shared-state-parallel-unsafe: scenario \"" <> scenario <> "\" requires --jobs 1; mutation permission does not establish isolation"+  IndependentStateHandoffRequired -> "independent-state-handoff-required: independent scenarios require a verified runtime handoff"
+ src/HurlWorkbench/Suite/Resolve.hs view
@@ -0,0 +1,558 @@+-- | Complete suite preflight. Every run, safety decision, report target, and+--   optional managed service is resolved before execution can start.+module HurlWorkbench.Suite.Resolve+  ( ReportFormat (..),+    SuiteOptions (..),+    SuiteRequest (..),+    SuitePreflightIssue (..),+    SuitePreflightError (..),+    PreparedSuite (..),+    PreparedStep (..),+    SuiteMetadata (..),+    ScenarioMetadata (..),+    suiteMetadata,+    reserveSuiteSummary,+    suitePreflightReasonCode,+    suitePreflightSetupFailure,+    preflightFileRoot,+    preflightScenarioInputs,+    prepareSuite,+    prepareSuiteWith,+    renderSuitePreflightIssue,+    renderSuitePreflightError,+  )+where++import Control.Exception (IOException, displayException, try)+import Data.Bits ((.&.))+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime)+import HurlWorkbench.Check.Resolve+import HurlWorkbench.Hurl.Format (HurlfmtCapabilities, HurlfmtError, validateRenderedWorkflow)+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.Service.Resolve+import HurlWorkbench.Service.Run (freezeService, prepareCommand)+import HurlWorkbench.Suite.Isolation+import HurlWorkbench.Suite.Scenario+import HurlWorkbench.Workflow.Render (RenderedWorkflow)+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import System.Directory+  ( canonicalizePath,+    createDirectory,+    createDirectoryIfMissing,+    doesPathExist,+    removePathForcibly,+  )+import System.Environment (getEnvironment)+import System.FilePath (normalise, splitDirectories, (</>))+import System.IO.Error (isDoesNotExistError)+import System.Info (os)+import System.Posix.Files+  ( accessModes,+    fileMode,+    getFileStatus,+    getSymbolicLinkStatus,+    isDirectory,+    isSymbolicLink,+    ownerExecuteMode,+    ownerReadMode,+    ownerWriteMode,+    setFileMode,+    unionFileModes,+  )+import System.Posix.Types (FileMode)++data ReportFormat = JUnit | Html | Json | Tap+  deriving stock (Generic, Eq, Ord, Show)++data SuiteOptions = SuiteOptions+  { jobs :: !PositiveInt,+    failFastOverride :: !(Maybe Bool),+    allowMutating :: !Bool,+    manageService :: !Bool,+    reportFormats :: !(Set ReportFormat),+    reportDirectory :: !(Maybe FilePath),+    overwriteReports :: !Bool+  }+  deriving stock (Generic, Eq, Show)++data SuiteRequest = SuiteRequest+  { suiteName :: !SuiteName,+    fileRoot :: !(Maybe FileRoot),+    scenarioInputs :: !(Maybe ScenarioInputs),+    bindingInput :: !BindingInput,+    hurlOptions :: !HurlOptions,+    suiteOptions :: !SuiteOptions+  }+  deriving stock (Generic, Eq, Show)++data SuitePreflightIssue+  = SuiteFileRootFailed !FileRootError+  | SuiteNotFound !SuiteName+  | SuiteRunPreparationFailed !PreparationError+  | SuiteDependencyUnavailable+  | SuiteScenarioFailed !ScenarioIssue+  | SuiteScenarioInputsUnexpected+  | SuiteIndependentExternalRequired+  | SuiteIsolationFailed !IsolationIssue+  | SuiteUnsafeRun !Text !SafetyDisposition+  | SuiteDuplicateArtifactStem !FilePath+  | SuiteSharedCurlExport !FilePath+  | SuiteReportDirectoryRequired+  | SuiteInvalidReportDirectory !FilePath+  | SuiteReportPathExists !FilePath+  | SuiteReportPathIsSymbolicLink !FilePath+  | SuiteReportPathIsNotDirectory !FilePath+  | SuiteReportIoError !FilePath !Text+  | SuiteExternalLifecycle+  | SuiteCheckFailed !CheckName !CheckResolutionError+  | SuiteServiceNotFound !ServiceName+  | SuiteServiceBindingFailed !BindingError+  | SuiteServiceResolutionFailed !ServiceError+  deriving stock (Generic, Eq, Show)++newtype SuitePreflightError = SuitePreflightError+  { issues :: NonEmpty SuitePreflightIssue+  }+  deriving stock (Generic, Eq, Show)++-- | Safe report data has no executable requests or provider/runtime values.+data ScenarioMetadata = ScenarioMetadata+  { name :: !Text,+    scenario :: !FilePath,+    reports :: ![FilePath]+  }+  deriving stock (Generic, Eq, Show)++data SuiteMetadata = SuiteMetadata+  { name :: !SuiteName,+    isolation :: !IsolationPolicy,+    scenarios :: ![ScenarioMetadata],+    summaryPath :: !(Maybe FilePath)+  }+  deriving stock (Generic, Eq, Show)++data PreparedStep = HurlBatch !Int !(NonEmpty BatchCase) | ServiceBarrier !ServiceStep | CheckBarrier !ResolvedCheck+  deriving stock (Generic, Show)++data PreparedSuite = PreparedSuite+  { metadata :: !SuiteMetadata,+    cases :: ![BatchCase],+    batchOptions :: !BatchOptions,+    managedServices :: ![ResolvedService],+    steps :: ![PreparedStep],+    setupCommands :: ![ResolvedCommand],+    teardownCommands :: ![ResolvedCommand],+    commandTimeout :: !NominalDiffTime,+    cleanupTimeout :: !NominalDiffTime+  }+  deriving stock (Generic, Show)++suiteMetadata :: ValidatedWorkspace -> SuiteRequest -> Either SuitePreflightError SuiteMetadata+suiteMetadata workspace request = do+  suite <- maybe (Left (SuitePreflightError (SuiteNotFound (request ^. #suiteName) :| []))) Right (lookupSuite (request ^. #suiteName) workspace)+  expanded <- either (Left . SuitePreflightError . (:| []) . SuiteRunPreparationFailed . SelectionPreparationFailed) Right (traverse (resolveSelection workspace . runSelection) (hurlReferences suite))+  let runs = concatMap toList expanded+  pure+    SuiteMetadata+      { name = suite ^. #name,+        isolation = suite ^. #isolation,+        scenarios = fmap (\run -> ScenarioMetadata (run ^. #displayName) (run ^. #artifactStem) (map reportPath (suiteReportTargets (request ^. #suiteOptions . #reportFormats) (run ^. #artifactStem)))) runs,+        summaryPath = fmap (\root -> root </> Text.unpack (unSuiteName (suite ^. #name)) </> "summary.json") (request ^. #suiteOptions . #reportDirectory)+      }+  where+    reportPath = \case+      JUnitReport path -> path+      HtmlReport path -> path+      JsonReport path -> path+      TapReport path -> path++-- | A refusal reserves only the suite directory, never fictitious Hurl reports.+reserveSuiteSummary :: ValidatedWorkspace -> SuiteRequest -> SuiteMetadata -> IO (Either SuitePreflightIssue ())+reserveSuiteSummary workspace request metadata =+  preflightFileRoot workspace request >>= \case+    Left err -> pure (Left (NonEmpty.head (err ^. #issues)))+    Right _ -> case request ^. #suiteOptions . #reportDirectory of+      Nothing -> pure (Right ())+      Just root -> prepareReportLayout root (root </> Text.unpack (unSuiteName (metadata ^. #name))) [] (request ^. #suiteOptions . #overwriteReports)++prepareSuite :: HurlfmtCapabilities -> ValidatedWorkspace -> SuiteRequest -> IO (Either SuitePreflightError PreparedSuite)+prepareSuite = prepareSuiteWith validateRenderedWorkflow++prepareSuiteWith :: (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> SuiteRequest -> IO (Either SuitePreflightError PreparedSuite)+prepareSuiteWith validateRendered capabilities validated request =+  preflightFileRoot validated request >>= \case+    Left err -> pure (Left err)+    Right root -> do+      preflight <- preflightScenarioInputs validated request+      case preflight of+        Left err -> pure (Left err)+        Right verified -> prepareVerifiedSuiteWith root verified validateRendered capabilities validated request++prepareVerifiedSuiteWith :: FileRoot -> Maybe VerifiedScenarioInputs -> (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlfmtCapabilities -> ValidatedWorkspace -> SuiteRequest -> IO (Either SuitePreflightError PreparedSuite)+prepareVerifiedSuiteWith root verified validateRendered capabilities validated request =+  case lookupSuite (request ^. #suiteName) validated of+    Nothing -> pure (Left (SuitePreflightError (SuiteNotFound (request ^. #suiteName) :| [])))+    Just _+      | Just problems <- nonEmpty (checkSuiteIsolationWith verified validated (request ^. #suiteName) (request ^. #suiteOptions . #jobs)) ->+          pure (Left (SuitePreflightError (fmap SuiteIsolationFailed problems)))+    Just suite -> do+      ambient <- getEnvironment+      selections <- case verified of+        Nothing -> traverse prepareReference (hurlReferences suite)+        Just inputs -> case traverse (resolveSelection validated . runSelection) (hurlReferences suite) of+          Left err -> pure [Left (SelectionPreparationFailed err :| [])]+          Right expanded -> case nonEmpty (concatMap toList expanded) of+            Nothing -> pure []+            Just runs -> case traverse (\run -> (run,) <$> scenarioBindingInput inputs run) runs of+              Nothing -> error "verified scenario assignment incomplete"+              Just assigned -> pure <$> prepareExpandedForSuiteAtFileRootWith root validateRendered capabilities validated (request ^. #hurlOptions) assigned+      serviceResult <- prepareManagedServices ambient suite+      checkResults <- traverse (\name -> fmap (either (Left . SuiteCheckFailed name) Right) (prepareCheck ambient validated (request ^. #bindingInput) name)) [name | CheckRun name <- suite ^. #runs]+      let preparationIssues =+            concat+              [ map preparationIssue (NonEmpty.toList errors)+              | Left errors <- selections+              ]+          preparedRuns = concat [NonEmpty.toList runs | Right runs <- selections]+          safetyIssues =+            [ SuiteUnsafeRun (prepared ^. #displayName) (prepared ^. #safety)+            | prepared <- preparedRuns,+              not (request ^. #suiteOptions . #allowMutating),+              requiresAuthorization (prepared ^. #safety)+            ]+          checkNames = [name | CheckRun name <- suite ^. #runs]+          duplicateIssues =+            map SuiteDuplicateArtifactStem (duplicates (map (view #artifactStem) preparedRuns))+              <> [SuiteDuplicateArtifactStem "phases" | not (null (suite ^. #setup) && null (suite ^. #teardown)), any (\run -> take 1 (splitDirectories (run ^. #artifactStem)) == ["phases"]) preparedRuns]+              <> map (SuiteDuplicateArtifactStem . ("checks" </>) . Text.unpack . unCheckName) (duplicates checkNames)+              <> [SuiteDuplicateArtifactStem "checks" | not (null checkNames), any (\run -> take 1 (splitDirectories (run ^. #artifactStem)) == ["checks"]) preparedRuns]+          curlIssues =+            [ SuiteSharedCurlExport path+            | length preparedRuns > 1,+              Just path <- [request ^. #hurlOptions . #curlExportPath]+            ]+          reportIssues =+            [SuiteReportDirectoryRequired | (not (null checkNames) || not (Set.null (request ^. #suiteOptions . #reportFormats))) && isNothing (request ^. #suiteOptions . #reportDirectory)]+          serviceIssues = either pure (const []) serviceResult+          issues = preparationIssues <> safetyIssues <> duplicateIssues <> curlIssues <> reportIssues <> serviceIssues <> [err | Left err <- checkResults]+      case nonEmpty issues of+        Just problems -> pure (Left (SuitePreflightError problems))+        Nothing -> case (preparedRuns, serviceResult) of+          (runs, Right (services, setup, teardown)) ->+            prepareReports suite runs >>= \case+              Left problem -> pure (Left (SuitePreflightError (problem :| [])))+              Right (batchCases, _summary) ->+                pure+                  ( Right+                      PreparedSuite+                        { metadata = either (error "validated suite metadata failed") id (suiteMetadata validated request),+                          cases = batchCases,+                          batchOptions =+                            BatchOptions+                              (request ^. #suiteOptions . #jobs)+                              (fromMaybe (suite ^. #failFast) (request ^. #suiteOptions . #failFastOverride)),+                          managedServices = services,+                          steps = orderedSteps validated suite batchCases [check | Right check <- checkResults],+                          setupCommands = setup,+                          teardownCommands = teardown,+                          commandTimeout = fromIntegral (suite ^. #commandTimeoutSeconds),+                          cleanupTimeout = fromIntegral (suite ^. #cleanupTimeoutSeconds)+                        }+                  )+          _ -> error "prepareSuite: validated suite produced no prepared runs"+  where+    preparationIssue RunBindingFailed {} | isJust verified = SuiteScenarioFailed ScenarioRuntimeInputFailed+    preparationIssue err = SuiteRunPreparationFailed err++    prepareReference reference =+      prepareSelectionForSuiteAtFileRootWith+        root+        validateRendered+        capabilities+        validated+        (request ^. #bindingInput)+        (request ^. #hurlOptions)+        (runSelection reference)++    prepareManagedServices ambient suite+      | not (request ^. #suiteOptions . #manageService) =+          pure $ if any isLifecycle (suite ^. #runs) then Left SuiteExternalLifecycle else Right ([], [], [])+      | otherwise = do+          services <- traverse (prepareService ambient) (suiteServices suite)+          setup <- traverse (preparePhase ambient "setup") (suite ^. #setup)+          teardown <- traverse (preparePhase ambient "teardown") (suite ^. #teardown)+          pure ((,,) <$> sequence services <*> sequence setup <*> sequence teardown)++    prepareService ambient serviceName = case lookupService serviceName validated of+      Nothing -> pure (Left (SuiteServiceNotFound serviceName))+      Just service -> case requiredServiceParameters service of+        Left err -> pure (Left (SuiteServiceResolutionFailed err))+        Right required ->+          resolveParameterSubsetInEnvironment ambient validated required (request ^. #bindingInput) >>= \case+            Left err -> pure (Left (SuiteServiceBindingFailed err))+            Right bindings -> case resolveService validated bindings service of+              Left err -> pure (Left (SuiteServiceResolutionFailed err))+              Right resolved -> fmap (either (Left . SuiteServiceResolutionFailed) Right) (freezeService ambient resolved)++    preparePhase ambient phase command =+      resolveParameterSubsetInEnvironment ambient validated (Set.fromList (map (view #parameter) (command ^. #environment))) (request ^. #bindingInput) <&> \case+        Left err -> Left (SuiteServiceBindingFailed err)+        Right bindings ->+          either+            (Left . SuiteServiceResolutionFailed)+            Right+            (resolveCommand validated bindings command >>= prepareCommand ambient (request ^. #suiteName & unSuiteName & ServiceName) phase)++    prepareReports suite runs = case request ^. #suiteOptions . #reportDirectory of+      Nothing ->+        pure+          ( Right+              ( fmap (buildBatchCase TestMode CaptureRunOutput []) runs,+                Nothing+              )+          )+      Just reportRoot -> do+        let suiteRoot = reportRoot </> Text.unpack (unSuiteName (suite ^. #name))+            runList = runs+            runRoots = map ((suiteRoot </>) . view #artifactStem) runList+            formats = request ^. #suiteOptions . #reportFormats+            batchCases =+              [ buildBatchCase TestMode CaptureRunOutput (suiteReportTargets formats runRoot) prepared+              | (prepared, runRoot) <- zip runList runRoots+              ]+            summary = suiteRoot </> "summary.json"+        prepared <- prepareReportLayout reportRoot suiteRoot (runRoots <> [suiteRoot </> "checks" </> Text.unpack (unCheckName name) | CheckRun name <- suite ^. #runs] <> [suiteRoot </> "phases" </> phase </> show ordinal | (phase, commands) <- [("setup", suite ^. #setup), ("teardown", suite ^. #teardown)], ordinal <- [0 .. length commands - 1]]) (request ^. #suiteOptions . #overwriteReports)+        pure ((,Just summary) batchCases <$ prepared)++-- | Select once before rendering, dependency probes, services, and reports.+preflightFileRoot :: ValidatedWorkspace -> SuiteRequest -> IO (Either SuitePreflightError FileRoot)+preflightFileRoot workspace request =+  selectSuiteFileRoot workspace (request ^. #suiteName) (request ^. #bindingInput) (request ^. #fileRoot) >>= \case+    Left err -> pure (Left (SuitePreflightError (SuiteFileRootFailed err :| [])))+    Right root -> do+      checked <- checkFileRootOutputs root (maybe [] pure (request ^. #suiteOptions . #reportDirectory) <> maybe [] pure (request ^. #hurlOptions . #curlExportPath))+      pure (either (Left . SuitePreflightError . (:| []) . SuiteFileRootFailed) (const (Right root)) checked)++-- | Public early boundary for core runners and CLI capability detection. Raw+-- assignments are checked in full before any syntax probe or binding preparation.+preflightScenarioInputs :: ValidatedWorkspace -> SuiteRequest -> IO (Either SuitePreflightError (Maybe VerifiedScenarioInputs))+preflightScenarioInputs workspace request = case lookupSuite (request ^. #suiteName) workspace of+  Nothing -> pure (failure (SuiteNotFound (request ^. #suiteName)))+  Just suite -> case (suite ^. #isolation, request ^. #scenarioInputs) of+    (SharedState, Just _) -> pure (failure SuiteScenarioInputsUnexpected)+    (SharedState, Nothing) -> pure $ case nonEmpty (checkSuiteIsolation workspace (request ^. #suiteName) (request ^. #suiteOptions . #jobs)) of+      Nothing -> Right Nothing+      Just issues -> Left (SuitePreflightError (fmap SuiteIsolationFailed issues))+    (IndependentState, Nothing) -> pure (failure (SuiteIsolationFailed IndependentStateHandoffRequired))+    (IndependentState, Just inputs)+      | request ^. #suiteOptions . #manageService -> pure (failure SuiteIndependentExternalRequired)+      | otherwise -> case traverse (resolveSelection workspace . runSelection) (hurlReferences suite) of+          Left err -> pure (failure (SuiteRunPreparationFailed (SelectionPreparationFailed err)))+          Right expanded -> verifyScenarioInputs workspace (concatMap toList expanded) (request ^. #bindingInput) inputs <&> either (failure . SuiteScenarioFailed) (Right . Just)+  where+    failure issue = Left (SuitePreflightError (issue :| []))++hurlReferences :: Suite -> [RunReference]+hurlReferences suite = filter (\case ServiceRun _ -> False; CheckRun _ -> False; _ -> True) (suite ^. #runs)++isLifecycle :: RunReference -> Bool+isLifecycle (ServiceRun _) = True+isLifecycle _ = False++-- | Partition adjacent Hurl references without losing global case indices.+orderedSteps :: ValidatedWorkspace -> Suite -> [BatchCase] -> [ResolvedCheck] -> [PreparedStep]+orderedSteps workspace suite cases checks = go 0 [] 0 cases (suite ^. #runs)+  where+    checkIndex = Map.fromList [(check ^. #name, check) | check <- checks]+    flush _ [] = []+    flush offset accumulated = [HurlBatch offset (NonEmpty.fromList accumulated)]+    go offset accumulated count _remaining [] = flush (offset - count) accumulated+    go offset accumulated count remaining (ServiceRun step : rest) =+      flush (offset - count) accumulated <> [ServiceBarrier step] <> go offset [] 0 remaining rest+    go offset accumulated count remaining (CheckRun name : rest) =+      let check = fromMaybe (error "preflighted check missing") (Map.lookup name checkIndex)+       in flush (offset - count) accumulated <> [CheckBarrier check] <> go offset [] 0 remaining rest+    go offset accumulated count remaining (reference : rest) =+      let size = either (const 0) length (resolveSelection workspace (runSelection reference))+          (batch, later) = splitAt size remaining+       in go (offset + size) (accumulated <> batch) (count + size) later rest++runSelection :: RunReference -> RunSelection+runSelection = \case+  WorkflowRun name -> SelectWorkflow name+  RecipeRun name -> SelectRecipe name+  MatrixRun name -> SelectMatrix name+  CheckRun _ -> error "check step is not a Hurl selection"+  ServiceRun _ -> error "lifecycle step is not a Hurl selection"++requiresAuthorization :: SafetyDisposition -> Bool+requiresAuthorization = \case+  Classified ReadOnly -> False+  Classified Mutating -> True+  UnclassifiedWorkflow -> True++suiteReportTargets :: Set ReportFormat -> FilePath -> [HurlReportTarget]+suiteReportTargets formats runRoot = map target (Set.toAscList formats)+  where+    target = \case+      JUnit -> JUnitReport (runRoot </> "junit.xml")+      Html -> HtmlReport (runRoot </> "html")+      Json -> JsonReport (runRoot </> "json")+      Tap -> TapReport (runRoot </> "report.tap")++prepareReportLayout :: FilePath -> FilePath -> [FilePath] -> Bool -> IO (Either SuitePreflightIssue ())+prepareReportLayout reportRoot suiteRoot runRoots overwrite+  | null reportRoot || reportRoot == "." || reportRoot == ".." || normalise reportRoot == "/" = pure (Left (SuiteInvalidReportDirectory reportRoot))+  | otherwise = do+      inspected <- concat <$> traverse inspectDirectory (filter (\path -> path /= "/" && path /= "") (drop 1 (scanl (</>) "" (splitDirectories (normalise suiteRoot)))))+      case inspected of+        problem : _ -> pure (Left problem)+        [] -> do+          suiteExists <- doesPathExist suiteRoot+          if suiteExists && not overwrite+            then pure (Left (SuiteReportPathExists suiteRoot))+            else do+              attempted <- try @IOException $ do+                when suiteExists (removePathForcibly suiteRoot)+                ensureOwnerDirectory reportRoot+                createDirectory suiteRoot+                secureDirectory suiteRoot+                traverse_ createRunRoot runRoots+              pure $ case attempted of+                Left err -> Left (SuiteReportIoError suiteRoot (Text.pack (displayException err)))+                Right () -> Right ()+  where+    createRunRoot path = do+      createDirectoryIfMissing True path+      secureTree suiteRoot path++inspectDirectory :: FilePath -> IO [SuitePreflightIssue]+inspectDirectory path = do+  inspected <- try @IOException (getSymbolicLinkStatus path)+  case inspected of+    Left err | isDoesNotExistError err -> pure []+    Left _ -> pure [SuiteReportIoError path "could not inspect report path"]+    Right status+      | isSymbolicLink status -> do+          -- macOS exposes these fixed OS-owned aliases for ordinary temporary+          -- directories. User-controlled symlink ancestors remain forbidden.+          canonical <- try @IOException (canonicalizePath path)+          pure [SuiteReportPathIsSymbolicLink path | not (os == "darwin" && path `elem` ["/tmp", "/var"] && either (const False) (== ("/private" <> path)) canonical)]+      | not (isDirectory status) -> pure [SuiteReportPathIsNotDirectory path]+      | otherwise -> pure []++ensureOwnerDirectory :: FilePath -> IO ()+ensureOwnerDirectory path = createDirectoryIfMissing True path >> secureDirectory path++secureTree :: FilePath -> FilePath -> IO ()+secureTree root target = go root relativeParts+  where+    rootParts = splitDirectories root+    targetParts = splitDirectories target+    relativeParts = drop (length rootParts) targetParts+    go _ [] = pure ()+    go parent (component : remaining) = do+      let path = parent </> component+      secureDirectory path+      go path remaining++secureDirectory :: FilePath -> IO ()+secureDirectory path = do+  setFileMode path secureDirectoryMode+  actual <- (.&. accessModes) . fileMode <$> getFileStatus path+  unless (actual == secureDirectoryMode) (ioError (userError ("insecure permissions on " <> path)))++secureDirectoryMode :: FileMode+secureDirectoryMode = ownerReadMode `unionFileModes` ownerWriteMode `unionFileModes` ownerExecuteMode++duplicates :: (Ord value) => [value] -> [value]+duplicates values =+  [ value+  | (value, count) <- Map.toAscList (Map.fromListWith (+) [(value, 1 :: Int) | value <- values]),+    count > 1+  ]++renderSuitePreflightError :: SuitePreflightError -> Text+renderSuitePreflightError = Text.intercalate "\n" . map renderSuitePreflightIssue . toList . view #issues++renderSuitePreflightIssue :: SuitePreflightIssue -> Text+renderSuitePreflightIssue = \case+  SuiteFileRootFailed err -> renderFileRootError err+  SuiteDependencyUnavailable -> "suite-dependency-unavailable"+  SuiteScenarioFailed issue -> renderScenarioIssue issue+  SuiteScenarioInputsUnexpected -> "scenario-inputs-unexpected: shared-state suites reject scenario inputs"+  SuiteIndependentExternalRequired -> "independent-state-external-required: use --external-service"+  SuiteIsolationFailed issue -> renderIsolationIssue issue+  SuiteExternalLifecycle -> "external-service-lifecycle: lifecycle steps require managed services"+  SuiteNotFound name -> "unknown suite " <> quote (unSuiteName name)+  SuiteRunPreparationFailed err -> renderPreparationError err+  SuiteUnsafeRun name disposition ->+    "run " <> quote name <> " requires --allow-mutating (" <> safetyLabel disposition <> ")"+  SuiteDuplicateArtifactStem stem -> "suite produces duplicate report path for " <> quote (Text.pack stem)+  SuiteSharedCurlExport path -> "--curl has one path and cannot be shared by multiple suite runs: " <> quote (Text.pack path)+  SuiteReportDirectoryRequired -> "--report-dir is required for checks or selected report formats"+  SuiteInvalidReportDirectory path -> "invalid report directory " <> quote (Text.pack path)+  SuiteReportPathExists path -> "report suite directory already exists; use --overwrite to replace " <> quote (Text.pack path)+  SuiteReportPathIsSymbolicLink path -> "report path must not be a symbolic link: " <> quote (Text.pack path)+  SuiteReportPathIsNotDirectory path -> "report path is not a directory: " <> quote (Text.pack path)+  SuiteReportIoError path message -> "could not prepare reports under " <> quote (Text.pack path) <> ": " <> message+  SuiteCheckFailed name err -> "check \"" <> unCheckName name <> "\": " <> renderCheckResolutionError err+  SuiteServiceNotFound name -> "suite refers to unknown service " <> quote (unServiceName name)+  SuiteServiceBindingFailed err -> "managed service: " <> renderBindingError err+  SuiteServiceResolutionFailed err -> "managed service: " <> renderServiceError err+  where+    safetyLabel = \case+      Classified Mutating -> "mutating recipe"+      Classified ReadOnly -> "read-only recipe"+      UnclassifiedWorkflow -> "unclassified workflow"+    quote value = "\"" <> value <> "\""++-- | Stable codes are the only diagnostic content serialized into summaries.+suitePreflightReasonCode :: SuitePreflightIssue -> Text+suitePreflightReasonCode = \case+  SuiteFileRootFailed _ -> "suite-file-root-invalid"+  SuiteIsolationFailed (SharedStateParallelUnsafe _ _) -> "shared-state-parallel-unsafe"+  SuiteIsolationFailed IndependentStateHandoffRequired -> "independent-state-handoff-required"+  SuiteScenarioFailed issue -> renderScenarioIssue issue+  SuiteScenarioInputsUnexpected -> "scenario-inputs-unexpected"+  SuiteIndependentExternalRequired -> "independent-state-external-required"+  SuiteDependencyUnavailable -> "suite-dependency-unavailable"+  SuiteExternalLifecycle -> "external-service-lifecycle"+  SuiteNotFound _ -> "suite-not-found"+  SuiteRunPreparationFailed RunBindingFailed {} -> "suite-binding-failed"+  SuiteRunPreparationFailed _ -> "suite-preparation-failed"+  SuiteUnsafeRun _ _ -> "mutation-authorization-required"+  SuiteDuplicateArtifactStem _ -> "suite-duplicate-scenario"+  SuiteSharedCurlExport _ -> "suite-shared-curl-export"+  SuiteReportDirectoryRequired -> "suite-report-directory-required"+  SuiteInvalidReportDirectory _ -> "suite-invalid-report-directory"+  SuiteReportPathExists _ -> "suite-report-path-exists"+  SuiteReportPathIsSymbolicLink _ -> "suite-report-path-symlink"+  SuiteReportPathIsNotDirectory _ -> "suite-report-path-not-directory"+  SuiteReportIoError _ _ -> "suite-report-io-error"+  SuiteCheckFailed _ _ -> "suite-check-preparation-failed"+  SuiteServiceNotFound _ -> "suite-service-not-found"+  SuiteServiceBindingFailed _ -> "suite-service-binding-failed"+  SuiteServiceResolutionFailed _ -> "suite-service-resolution-failed"++suitePreflightSetupFailure :: SuitePreflightIssue -> Bool+suitePreflightSetupFailure = \case+  SuiteDependencyUnavailable -> True+  SuiteScenarioFailed ScenarioFileUnreadable -> True+  SuiteScenarioFailed ScenarioRuntimeInputFailed -> True+  SuiteRunPreparationFailed RunBindingFailed {} -> True+  SuiteCheckFailed _ _ -> True+  SuiteServiceBindingFailed _ -> True+  _ -> False
+ src/HurlWorkbench/Suite/Run.hs view
@@ -0,0 +1,512 @@+-- | Execute a fully preflighted suite, optionally inside one managed-service+--   lifecycle, and emit a redacted atomic summary.+module HurlWorkbench.Suite.Run+  ( ServiceOutcome (..),+    SuiteResult (..),+    StepOutcome (..),+    PhaseOutcome (..),+    CommandOutcome (..),+    LifecycleOutcome (..),+    runSuite,+    runSuiteWith,+    finalizeSuitePreflight,+  )+where++import Control.Applicative ((<|>))+import Control.Concurrent.STM (atomically, modifyTVar', newTVarIO, readTVarIO)+import Control.Exception (IOException, SomeAsyncException, SomeException, fromException, mask, onException, throwIO, try)+import Data.Aeson qualified as Aeson+import Data.Bits ((.&.))+import Data.ByteString.Lazy qualified as LazyByteString+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime, addUTCTime, diffUTCTime, getCurrentTime)+import HurlWorkbench.Check.Run+import HurlWorkbench.Hurl.Format (HurlfmtCapabilities, HurlfmtError, validateRenderedWorkflow)+import HurlWorkbench.Hurl.Run+import HurlWorkbench.Prelude+import HurlWorkbench.Process.Run+import HurlWorkbench.Run.Batch+import HurlWorkbench.Service.Group+import HurlWorkbench.Service.Resolve+import HurlWorkbench.Suite.Resolve+import HurlWorkbench.Workflow.Render (RenderedWorkflow)+import HurlWorkbench.Workspace.Context (ValidatedWorkspace)+import HurlWorkbench.Workspace.Types (CheckName (..), IsolationPolicy (..), ServiceName (..), ServiceStep (..), SuiteName (..))+import System.Directory (createDirectoryIfMissing, removeFile, renameFile)+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory, (</>))+import System.IO (Handle, IOMode (WriteMode), hClose, withBinaryFile)+import System.IO.Temp (openBinaryTempFile, withSystemTempDirectory)+import System.Posix.Files+  ( accessModes,+    fileMode,+    getFileStatus,+    ownerExecuteMode,+    ownerReadMode,+    ownerWriteMode,+    setFileMode,+    unionFileModes,+  )+import System.Posix.Types (FileMode)+import System.Timeout qualified as Timeout++data ServiceOutcome+  = ServiceStopped+  | ServiceFailed !ServiceError+  deriving stock (Generic, Eq, Show)++data StepOutcome = HurlStep !CaseResult | LifecycleStep !LifecycleOutcome | CheckStep !CheckResult+  deriving stock (Generic, Eq, Show)++data PhaseOutcome = PhaseOutcome+  { phase :: !Text,+    ordinal :: !Int,+    status :: !CommandOutcome,+    elapsed :: !(Maybe NominalDiffTime),+    artifacts :: ![FilePath],+    cleanupFailure :: !(Maybe ServiceError)+  }+  deriving stock (Generic, Eq, Show)++data SuiteResult = SuiteResult+  { cases :: ![CaseResult],+    serviceOutcome :: !(Maybe ServiceOutcome),+    summaryPath :: !(Maybe FilePath),+    summaryError :: !(Maybe Text),+    selectedExitCode :: !ExitCode,+    steps :: ![StepOutcome],+    services :: ![LifecycleOutcome],+    phases :: ![PhaseOutcome],+    primaryFailure :: !(Maybe Text),+    cleanupDiagnostics :: ![ServiceError]+  }+  deriving stock (Generic, Eq, Show)++runSuite :: HurlRunner -> HurlfmtCapabilities -> ValidatedWorkspace -> SuiteRequest -> IO (Either SuitePreflightError SuiteResult)+runSuite = runSuiteWith validateRenderedWorkflow++runSuiteWith :: (HurlfmtCapabilities -> RenderedWorkflow -> IO (Either HurlfmtError ())) -> HurlRunner -> HurlfmtCapabilities -> ValidatedWorkspace -> SuiteRequest -> IO (Either SuitePreflightError SuiteResult)+runSuiteWith validateRendered runner capabilities validated request =+  preflightFileRoot validated request >>= \case+    Left err -> pure (Left err)+    Right root -> do+      let selected = request & #fileRoot .~ Just root+      prepareSuiteWith validateRendered capabilities validated selected >>= \case+        Left err -> Left <$> finalizeSuitePreflight validated selected err+        Right prepared -> Right <$> executePreparedSuite runner prepared++-- | One ownership boundary covers setup, every acquisition and barrier, active+-- batches, reverse service cleanup, and finally teardown. Observations survive+-- cancellation; only safe logical outcomes reach the summary.+executePreparedSuite :: HurlRunner -> PreparedSuite -> IO SuiteResult+executePreparedSuite runner prepared = withPhaseRoot $ \phaseRoot -> mask $ \restore -> do+  observed <- newTVarIO Map.empty+  lifecycle <- newTVarIO Map.empty+  checks <- newTVarIO Map.empty+  startups <- newTVarIO []+  phases <- newTVarIO Map.empty+  primary <- newTVarIO Nothing+  group <- newServiceGroup+  let remember reason = atomically (modifyTVar' primary (\current -> current <|> Just reason))+      phaseCommand phase ordinal budget command = do+        let relative = "phases" </> Text.unpack phase </> show ordinal+            directory = phaseRoot </> relative+            artifacts = if isJust (prepared ^. #metadata . #summaryPath) then [relative </> "stdout", relative </> "stderr"] else []+            pending = PhaseOutcome phase ordinal CommandCancelled Nothing artifacts Nothing+        atomically (modifyTVar' phases (Map.insert (phase, ordinal) pending))+        began <- getCurrentTime+        attempted <- try @IOException $ do+          createDirectoryIfMissing True directory+          traverse_ (`setFileMode` secureDirectoryMode) [takeDirectory (takeDirectory directory), takeDirectory directory, directory]+          withCapture (directory </> "stdout") $ \stdout ->+            withCapture (directory </> "stderr") $ \stderr ->+              runCommand (ServiceName phase) budget command stdout stderr+        let (outcome, cleanup) = either (const (CommandStartFailed, Nothing)) id attempted+        ended <- getCurrentTime+        atomically (modifyTVar' phases (Map.insert (phase, ordinal) (pending & #status .~ outcome & #elapsed .~ Just (diffUTCTime ended began) & #cleanupFailure .~ cleanup)))+        pure (outcome == CommandPassed && isNothing cleanup)+      setup = runSetup 0 (prepared ^. #setupCommands)+      runSetup _ [] = pure (Right ())+      runSetup ordinal (command : rest) = do+        passed <- phaseCommand "setup" ordinal (prepared ^. #commandTimeout) command+        if passed+          then runSetup (ordinal + 1) rest+          else do+            remember "setup-failed"+            pure (Left (ServicePhaseFailed "setup"))+      recordService event = atomically (modifyTVar' startups (<> [event]))+      startAll [] = pure (Right ())+      startAll (service : rest) = do+        result <- startNamedObserved group service recordService+        case result of+          Left err -> pure (Left err)+          Right () -> startAll rest+      executeSteps _ [] = pure (Right ())+      executeSteps ordinal (step : rest) = case step of+        HurlBatch offset cases -> do+          batch <-+            watchServices group $+              Right+                <$> runBatchObserved+                  runner+                  (prepared ^. #batchOptions)+                  cases+                  ( \caseIndex result -> do+                      atomically (modifyTVar' observed (Map.insert (offset + caseIndex) result))+                      when (result ^. #outcome /= CasePassed) (remember "hurl-failed")+                  )+          case batch of+            Left err -> pure (Left err)+            Right result+              | prepared ^. #batchOptions . #failFast, result ^. #selectedExitCode /= ExitSuccess -> pure (Right ())+              | otherwise -> executeSteps (ordinal + 1) rest+        CheckBarrier check -> do+          result <-+            watchServices group $+              Right+                <$> runCheckObserved+                  phaseRoot+                  check+                  ( \outcome -> do+                      atomically (modifyTVar' checks (Map.insert ordinal outcome))+                      unless (checkPassed outcome) (remember "check-failed")+                  )+          case result of+            Left err -> pure (Left err)+            Right outcome+              | not (null (outcome ^. #cleanupDiagnostics)) -> pure (Right ())+              | not (checkPassed outcome), prepared ^. #batchOptions . #failFast -> pure (Right ())+              | otherwise -> executeSteps (ordinal + 1) rest+        ServiceBarrier operation -> do+          let (name, action) = stepLabel operation+              pending = LifecycleOutcome name action "cancelled" 0 Nothing+          atomically (modifyTVar' lifecycle (Map.insert ordinal pending))+          began <- getCurrentTime+          result <- applyServiceStepObserved group (prepared ^. #managedServices) operation recordService+          ended <- getCurrentTime+          atomically (modifyTVar' lifecycle (Map.insert ordinal (pending & #status .~ either (const "failed") (const "passed") result & #elapsed .~ diffUTCTime ended began & #failure .~ either Just (const Nothing) result)))+          case result of+            Left err -> pure (Left err)+            Right () -> executeSteps (ordinal + 1) rest+      execute =+        setup >>= \case+          Left err -> pure (Left err)+          Right () ->+            startAll (prepared ^. #managedServices) >>= \case+              Left err -> pure (Left err)+              Right () -> executeSteps 0 (prepared ^. #steps)+      teardown = do+        began <- getCurrentTime+        let deadline = addUTCTime (prepared ^. #cleanupTimeout) began+            go _ [] = pure ()+            go ordinal (command : rest) = do+              now <- getCurrentTime+              if now >= deadline+                then pure ()+                else do+                  _passed <- phaseCommand "teardown" ordinal (min (prepared ^. #commandTimeout) (diffUTCTime deadline now)) command+                  outcomes <- readTVarIO phases+                  let timedOut = maybe False ((== CommandTimedOut) . view #status) (Map.lookup ("teardown", ordinal) outcomes)+                  unless (timedOut && diffUTCTime deadline now <= prepared ^. #commandTimeout) (go (ordinal + 1) rest)+        go 0 (prepared ^. #teardownCommands)+  execution <- try @SomeException (restore execute)+  case execution of+    Right (Left _) -> remember "service-failed"+    _ -> pure ()+  cleanup <- cleanupServices group+  teardown+  completed <- readTVarIO observed+  barrierResults <- readTVarIO lifecycle+  checkResults <- readTVarIO checks+  serviceStarts <- readTVarIO startups+  phaseResults <- readTVarIO phases+  primaryFailure <- readTVarIO primary+  let cancelled = case execution of Left err -> isJust (fromException err :: Maybe SomeAsyncException); _ -> False+      serviceError = case execution of Right (Left err) -> Just err; _ -> Nothing+      missingReason+        | cancelled = BatchCancelled+        | isJust serviceError || any (not . null . view #cleanupDiagnostics) checkResults = BatchPrerequisiteFailed+        | otherwise = FailFastTriggered+      caseResults = [Map.findWithDefault (prerequisiteFailed batchCase & #outcome .~ CaseSkipped missingReason) caseIndex completed | (caseIndex, batchCase) <- zip [0 ..] (toList (prepared ^. #cases))]+      phaseOutcomes = [Map.findWithDefault (PhaseOutcome phase ordinal CommandSkipped Nothing [] Nothing) (phase, ordinal) phaseResults | (phase, commands) <- [("setup", prepared ^. #setupCommands), ("teardown", prepared ^. #teardownCommands)], ordinal <- [0 .. length commands - 1]]+      cleanupErrors =+        mapMaybe (view #failure) cleanup+          <> mapMaybe (view #cleanupFailure) phaseOutcomes+          <> [ServicePhaseFailed "teardown" | phase <- phaseOutcomes, phase ^. #phase == "teardown", phase ^. #status /= CommandPassed]+      allServiceErrors = maybe [] pure serviceError <> cleanupErrors+      serviceOutcome+        | err : _ <- allServiceErrors = Just (ServiceFailed err)+        | null (prepared ^. #managedServices) = Nothing+        | otherwise = Just ServiceStopped+      exitCode+        | cancelled = ExitFailure 130+        | not (null allServiceErrors) = ExitFailure 4+        | any startFailed stepResults = ExitFailure 3+        | otherwise = selectStepExit stepResults+      stepResults =+        concat+          [ case step of+              HurlBatch offset cases -> map HurlStep (take (length cases) (drop offset (toList caseResults)))+              CheckBarrier check -> [CheckStep (Map.findWithDefault (skippedCheck (skipStatus missingReason) check) ordinal checkResults)]+              ServiceBarrier operation -> let (name, action) = stepLabel operation in [LifecycleStep (Map.findWithDefault (LifecycleOutcome name action "skipped" 0 Nothing) ordinal barrierResults)]+          | (ordinal, step) <- zip [0 :: Int ..] (prepared ^. #steps)+          ]+      provisional =+        SuiteResult+          caseResults+          serviceOutcome+          Nothing+          Nothing+          exitCode+          stepResults+          (serviceStarts <> [event | LifecycleStep event <- stepResults] <> cleanup)+          phaseOutcomes+          (primaryFailure <|> if null cleanupErrors then Nothing else Just "cleanup-failed")+          cleanupErrors+  summary <- case prepared ^. #metadata . #summaryPath of+    Nothing -> pure (Right Nothing)+    Just path -> do+      let write = writeSummary path (summaryValueWithStatus (if cancelled then "cancelled" else exitStatus exitCode) (prepared ^. #metadata) provisional)+      written <-+        if cancelled+          then fromMaybe (Left "suite summary write timed out") <$> Timeout.timeout 1000000 write+          else write+      pure (Just path <$ written)+  let finished = case summary of+        Right path -> provisional & #summaryPath .~ path+        Left message -> provisional & #summaryError .~ Just message & #selectedExitCode .~ (if null allServiceErrors then ExitFailure 3 else ExitFailure 4)+  case execution of+    Left err -> throwIO err+    Right _ -> pure finished+  where+    withPhaseRoot action = case prepared ^. #metadata . #summaryPath of+      Just path -> action (takeDirectory path)+      Nothing -> withSystemTempDirectory "hurl-workbench-phases" action++stepLabel :: ServiceStep -> (ServiceName, Text)+stepLabel = \case Stop name -> (name, "stop"); Start name -> (name, "start"); Restart name -> (name, "restart")++withCapture :: FilePath -> (Handle -> IO a) -> IO a+withCapture path action = withBinaryFile path WriteMode $ \handle -> do+  setFileMode path secureFileMode+  action handle++secureDirectoryMode :: FileMode+secureDirectoryMode = secureFileMode `unionFileModes` ownerExecuteMode++prerequisiteFailed :: BatchCase -> CaseResult+prerequisiteFailed batchCase =+  CaseResult+    { name = batchCase ^. #name,+      outcome = CaseSkipped BatchPrerequisiteFailed,+      elapsed = Nothing,+      outputPath = Nothing,+      capturedOutput = Nothing+    }++startFailed :: StepOutcome -> Bool+startFailed (HurlStep result) = case result ^. #outcome of CaseStartFailed _ -> True; _ -> False+startFailed (CheckStep result) = result ^. #outcome == CheckStartFailed+startFailed (LifecycleStep _) = False++selectStepExit :: [StepOutcome] -> ExitCode+selectStepExit results = fromMaybe fallback (firstFailure results)+  where+    fallback+      | all passed results = ExitSuccess+      | otherwise = ExitFailure 3+    passed (HurlStep result) = result ^. #outcome == CasePassed+    passed (CheckStep result) = checkPassed result+    passed (LifecycleStep result) = result ^. #status == "passed"+    firstFailure = \case+      [] -> Nothing+      HurlStep result : remaining -> case result ^. #outcome of+        CaseFailed code -> Just code+        CaseStartFailed _ -> Just (ExitFailure 3)+        _ -> firstFailure remaining+      CheckStep result : remaining | checkExitCode result /= ExitSuccess -> Just (checkExitCode result)+      _ : remaining -> firstFailure remaining++skipStatus :: SkipReason -> Text+skipStatus = \case+  FailFastTriggered -> "skipped-fail-fast"+  BatchPrerequisiteFailed -> "skipped-prerequisite-failed"+  BatchCancelled -> "cancelled"++writeSummary :: FilePath -> Aeson.Value -> IO (Either Text ())+writeSummary path value = do+  written <- try @IOException $ do+    let directory = takeDirectory path+    (temporaryPath, handle) <- openBinaryTempFile directory ".summary.json.tmp"+    let cleanup = do+          _ <- try @IOException (hClose handle)+          _ <- try @IOException (removeFile temporaryPath)+          pure ()+    ( do+        setFileMode temporaryPath secureFileMode+        verifyMode temporaryPath+        LazyByteString.hPut handle (Aeson.encode value)+        hClose handle+        renameFile temporaryPath path+        setFileMode path secureFileMode+        verifyMode path+      )+      `onException` cleanup+  pure $ case written of+    Left _ -> Left "could not write suite summary"+    Right () -> Right ()++summaryValueWithStatus :: Text -> SuiteMetadata -> SuiteResult -> Aeson.Value+summaryValueWithStatus status metadata result =+  Aeson.object+    [ "suite" Aeson..= unSuiteName (metadata ^. #name),+      "isolation" Aeson..= isolationLabel (metadata ^. #isolation),+      "status" Aeson..= status,+      "service" Aeson..= serviceStatus (result ^. #serviceOutcome),+      "primaryFailure" Aeson..= (result ^. #primaryFailure),+      "cleanupDiagnostics" Aeson..= (map (const ("cleanup-failed" :: Text)) (result ^. #cleanupDiagnostics) <> concat [check ^. #cleanupDiagnostics | CheckStep check <- result ^. #steps]),+      "services" Aeson..= map lifecycleValue (result ^. #services),+      "phases" Aeson..= map phaseValue (result ^. #phases),+      "steps" Aeson..= map stepValue (result ^. #steps),+      "cases" Aeson..= zipWith caseValue (toList (metadata ^. #scenarios)) (toList (result ^. #cases))+    ]+  where+    caseValue logical caseResult =+      Aeson.object+        [ "name" Aeson..= (logical ^. #name),+          "scenario" Aeson..= (logical ^. #scenario),+          "status" Aeson..= caseStatus (caseResult ^. #outcome),+          "elapsedSeconds" Aeson..= fmap (realToFrac @NominalDiffTime @Double) (caseResult ^. #elapsed),+          "reports" Aeson..= case (caseResult ^. #outcome) of+            CaseSkipped _ -> []+            CaseStartFailed _ -> []+            _ -> logical ^. #reports+        ]++lifecycleValue :: LifecycleOutcome -> Aeson.Value+lifecycleValue event =+  Aeson.object+    [ "kind" Aeson..= ("service" :: Text),+      "name" Aeson..= unServiceName (event ^. #name),+      "action" Aeson..= (event ^. #action),+      "status" Aeson..= (event ^. #status),+      "artifacts" Aeson..= ([] :: [FilePath]),+      "elapsedSeconds" Aeson..= realToFrac @NominalDiffTime @Double (event ^. #elapsed)+    ]++phaseValue :: PhaseOutcome -> Aeson.Value+phaseValue event =+  Aeson.object+    [ "phase" Aeson..= (event ^. #phase),+      "index" Aeson..= (event ^. #ordinal),+      "status" Aeson..= commandStatus (event ^. #status),+      "elapsedSeconds" Aeson..= fmap (realToFrac @NominalDiffTime @Double) (event ^. #elapsed),+      "artifacts" Aeson..= (event ^. #artifacts)+    ]++commandStatus :: CommandOutcome -> Text+commandStatus = \case+  CommandPassed -> "passed"+  CommandFailed -> "failed"+  CommandTimedOut -> "timed-out"+  CommandStartFailed -> "start-failed"+  CommandSkipped -> "skipped"+  CommandCancelled -> "cancelled"++stepValue :: StepOutcome -> Aeson.Value+stepValue (LifecycleStep event) = lifecycleValue event+stepValue (CheckStep result) =+  Aeson.object+    [ "kind" Aeson..= ("check" :: Text),+      "name" Aeson..= unCheckName (result ^. #name),+      "status" Aeson..= checkStatus result,+      "expectedStatus" Aeson..= (result ^. #expectedStatus),+      "actualStatus" Aeson..= (result ^. #actualStatus),+      "elapsedSeconds" Aeson..= fmap (realToFrac @NominalDiffTime @Double) (result ^. #elapsed),+      "stdout" Aeson..= (result ^. #stdoutPath),+      "stderr" Aeson..= (result ^. #stderrPath),+      "cleanupDiagnostics" Aeson..= (result ^. #cleanupDiagnostics)+    ]+stepValue (HurlStep result) =+  Aeson.object+    ["kind" Aeson..= ("hurl" :: Text), "name" Aeson..= (result ^. #name), "status" Aeson..= caseStatus (result ^. #outcome)]++isolationLabel :: IsolationPolicy -> Text+isolationLabel SharedState = "shared-state"+isolationLabel IndependentState = "independent-state"++-- | Report a refusal only when validated logical names and the ordinary safe+-- report reservation rules make a destination available. No runner is involved.+finalizeSuitePreflight :: ValidatedWorkspace -> SuiteRequest -> SuitePreflightError -> IO SuitePreflightError+finalizeSuitePreflight workspace request original+  | any isReportFailure (original ^. #issues) = pure original+  | otherwise = case suiteMetadata workspace request of+      Left _ -> pure original+      Right metadata -> case metadata ^. #summaryPath of+        Nothing -> pure original+        Just path ->+          reserveSuiteSummary workspace request metadata >>= \case+            Left issue -> pure (append issue)+            Right () ->+              writeSummary path (preflightSummary metadata) <&> \case+                Left _ -> append (SuiteReportIoError path "summary-write-failed")+                Right () -> original+  where+    append issue = original & #issues %~ (<> (issue :| []))+    isReportFailure = \case+      SuiteFileRootFailed _ -> True+      SuiteReportPathExists _ -> True+      SuiteReportPathIsSymbolicLink _ -> True+      SuiteReportPathIsNotDirectory _ -> True+      SuiteInvalidReportDirectory _ -> True+      SuiteReportIoError _ _ -> True+      _ -> False+    preflightSummary metadata =+      Aeson.object+        [ "suite" Aeson..= unSuiteName (metadata ^. #name),+          "isolation" Aeson..= isolationLabel (metadata ^. #isolation),+          "status" Aeson..= (if any suitePreflightSetupFailure (original ^. #issues) then "setup-failed" else "refused" :: Text),+          "reasonCodes" Aeson..= map suitePreflightReasonCode (toList (original ^. #issues)),+          "cases"+            Aeson..= map+              ( \logical ->+                  Aeson.object+                    [ "name" Aeson..= (logical ^. #name),+                      "scenario" Aeson..= (logical ^. #scenario),+                      "status" Aeson..= ("not-started" :: Text),+                      "reports" Aeson..= ([] :: [FilePath])+                    ]+              )+              (toList (metadata ^. #scenarios))+        ]++serviceStatus :: Maybe ServiceOutcome -> Text+serviceStatus = \case+  Nothing -> "external-or-not-configured"+  Just ServiceStopped -> "stopped"+  Just (ServiceFailed _) -> "failed"++caseStatus :: CaseOutcome -> Text+caseStatus = \case+  CasePassed -> "passed"+  CaseFailed _ -> "failed"+  CaseStartFailed _ -> "start-failed"+  CaseSkipped FailFastTriggered -> "skipped-fail-fast"+  CaseSkipped BatchPrerequisiteFailed -> "skipped-prerequisite-failed"+  CaseSkipped BatchCancelled -> "cancelled"++exitStatus :: ExitCode -> Text+exitStatus = \case+  ExitSuccess -> "passed"+  ExitFailure _ -> "failed"++verifyMode :: FilePath -> IO ()+verifyMode path = do+  actual <- (.&. accessModes) . fileMode <$> getFileStatus path+  unless (actual == secureFileMode) (ioError (userError ("insecure permissions on " <> path)))++secureFileMode :: FileMode+secureFileMode = ownerReadMode `unionFileModes` ownerWriteMode
+ src/HurlWorkbench/Suite/Scenario.hs view
@@ -0,0 +1,241 @@+-- | Private caller-owned fixture assignments. Only full verification produces+-- executable per-scenario inputs; raw provider values never appear in errors.+module HurlWorkbench.Suite.Scenario+  ( ScenarioInputs (..),+    ScenarioAssignment (..),+    ScenarioBinding (..),+    ScenarioSecret (..),+    VerifiedScenarioInputs,+    ScenarioIssue (..),+    decodeScenarioInputs,+    loadScenarioInputs,+    verifyScenarioInputs,+    scenarioBindingInput,+    renderScenarioIssue,+  )+where++import Control.Exception (IOException, try)+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Aeson.Types (Parser)+import Data.Bifunctor (first)+import Data.Bits ((.&.))+import Data.ByteString qualified as ByteString+import Data.ByteString.Char8 qualified as Char8+import Data.Char (isControl, isSpace)+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import HurlWorkbench.Parameter.Properties+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Run.Selection+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate (isValidEntityName, isValidEnvironmentName)+import Network.HTTP.Client qualified as HTTP+import System.FilePath (splitDirectories)+import System.Posix.Files+  ( fileMode,+    getSymbolicLinkStatus,+    groupModes,+    isRegularFile,+    otherModes,+    unionFileModes,+  )++newtype ScenarioInputs = ScenarioInputs [ScenarioAssignment]+  deriving stock (Generic, Eq)++data ScenarioAssignment = ScenarioAssignment+  { scenario :: !FilePath,+    fixtureId :: !Text,+    endpoint :: !Text,+    endpointParameter :: !ParameterName,+    bindings :: ![ScenarioBinding],+    secretEnvironment :: ![ScenarioSecret]+  }+  deriving stock (Generic, Eq)++data ScenarioBinding = ScenarioBinding+  { parameter :: !ParameterName,+    value :: !Text+  }+  deriving stock (Generic, Eq)++data ScenarioSecret = ScenarioSecret+  { parameter :: !ParameterName,+    variable :: !Text+  }+  deriving stock (Generic, Eq)++newtype VerifiedScenarioInputs = VerifiedScenarioInputs (Map FilePath BindingInput)++instance Show ScenarioInputs where show _ = "ScenarioInputs <redacted>"++instance Show ScenarioAssignment where show _ = "ScenarioAssignment <redacted>"++instance Show ScenarioBinding where show _ = "ScenarioBinding <redacted>"++instance Show ScenarioSecret where show _ = "ScenarioSecret <redacted>"++instance Show VerifiedScenarioInputs where show _ = "VerifiedScenarioInputs <redacted>"++data ScenarioIssue+  = ScenarioFileUnreadable+  | ScenarioFileNotPrivateRegular+  | ScenarioMalformedInput+  | ScenarioUnsupportedVersion+  | ScenarioInvalidLabel+  | ScenarioAssignmentMismatch+  | ScenarioDuplicateFixture+  | ScenarioInvalidFixture+  | ScenarioDuplicateEndpoint+  | ScenarioInvalidEndpoint+  | ScenarioInvalidParameter+  | ScenarioDuplicateParameter+  | ScenarioConflictingBinding+  | ScenarioRuntimeInputFailed+  deriving stock (Generic, Eq, Show)++instance Aeson.FromJSON ScenarioInputs where+  parseJSON = Aeson.withObject "scenario-inputs" $ \object -> do+    exactFields ["version", "scenarios"] object+    version <- object Aeson..: "version" :: Parser Int+    unless (version == 1) (fail "unsupported-version")+    ScenarioInputs <$> object Aeson..: "scenarios"++instance Aeson.FromJSON ScenarioAssignment where+  parseJSON = Aeson.withObject "assignment" $ \object -> do+    exactFields ["scenario", "fixtureId", "endpoint", "endpointParameter", "bindings", "secretEnvironment"] object+    ScenarioAssignment <$> object Aeson..: "scenario" <*> object Aeson..: "fixtureId" <*> object Aeson..: "endpoint" <*> (ParameterName <$> object Aeson..: "endpointParameter") <*> object Aeson..: "bindings" <*> object Aeson..: "secretEnvironment"++instance Aeson.FromJSON ScenarioBinding where+  parseJSON = Aeson.withObject "binding" $ \object -> do+    exactFields ["parameter", "value"] object+    ScenarioBinding <$> (ParameterName <$> object Aeson..: "parameter") <*> object Aeson..: "value"++instance Aeson.FromJSON ScenarioSecret where+  parseJSON = Aeson.withObject "secret" $ \object -> do+    exactFields ["parameter", "variable"] object+    ScenarioSecret <$> (ParameterName <$> object Aeson..: "parameter") <*> object Aeson..: "variable"++exactFields :: [Aeson.Key] -> Aeson.Object -> Parser ()+exactFields expected object = unless (Set.fromList expected == Set.fromList (KeyMap.keys object)) (fail "invalid-fields")++decodeScenarioInputs :: ByteString.ByteString -> Either ScenarioIssue ScenarioInputs+decodeScenarioInputs bytes = case Aeson.eitherDecodeStrict @Aeson.Value bytes of+  Left _ -> Left ScenarioMalformedInput+  Right (Aeson.Object object)+    | Just (Aeson.Number version) <- KeyMap.lookup "version" object, version /= 1 -> Left ScenarioUnsupportedVersion+  Right _ -> first (const ScenarioMalformedInput) (Aeson.eitherDecodeStrict bytes)++loadScenarioInputs :: FilePath -> IO (Either ScenarioIssue ScenarioInputs)+loadScenarioInputs path = do+  status <- try @IOException (getSymbolicLinkStatus path)+  case status of+    Left _ -> pure (Left ScenarioFileUnreadable)+    Right file+      | not (isRegularFile file) || fileMode file .&. (groupModes `unionFileModes` otherModes) /= 0 -> pure (Left ScenarioFileNotPrivateRegular)+      | otherwise -> fmap (either (const (Left ScenarioFileUnreadable)) decodeScenarioInputs) (try @IOException (ByteString.readFile path))++-- | Validate the entire assignment and common input before any run preparation.+-- File channels are inspected for conflicting names; the existing binding+-- resolver retains ordinary suite input precedence.+verifyScenarioInputs :: ValidatedWorkspace -> [ExpandedRun] -> BindingInput -> ScenarioInputs -> IO (Either ScenarioIssue VerifiedScenarioInputs)+verifyScenarioInputs workspace runs common (ScenarioInputs assignments) = do+  loaded <- snapshotInputs common+  origins <- traverse (endpointOrigin . view #endpoint) assignments+  pure $ do+    (input, fileNames) <- loaded+    endpointKeys <- sequence origins+    let expected = map (view #artifactStem) runs+        labels = map (view #scenario) assignments+    ensure (all validLabel labels) ScenarioInvalidLabel+    ensure (unique expected && unique labels && Set.fromList expected == Set.fromList labels) ScenarioAssignmentMismatch+    ensure (all (validFixture . view #fixtureId) assignments) ScenarioInvalidFixture+    ensure (unique (map (view #fixtureId) assignments)) ScenarioDuplicateFixture+    ensure (unique endpointKeys) ScenarioDuplicateEndpoint+    let assignmentsByStem = Map.fromList [(assignment ^. #scenario, assignment) | assignment <- assignments]+    verified <- traverse (verifyRun input fileNames assignmentsByStem) runs+    pure (VerifiedScenarioInputs (Map.fromList verified))+  where+    verifyRun input fileNames assignmentsByStem run = do+      assignment <- maybe (Left ScenarioAssignmentMismatch) Right (Map.lookup (run ^. #artifactStem) assignmentsByStem)+      let endpointName = assignment ^. #endpointParameter+          plain = (endpointName, assignment ^. #endpoint) : [(binding ^. #parameter, binding ^. #value) | binding <- assignment ^. #bindings]+          secret = [(binding ^. #parameter, binding ^. #variable) | binding <- assignment ^. #secretEnvironment]+          names = map fst plain <> map fst secret+          supplied = Set.fromList names+          committed = Set.unions (map (Map.keysSet . view #values) (run ^. #bindingLayers))+          runtime = Map.keysSet (input ^. #plainOverrides) <> Map.keysSet (input ^. #secretEnvironmentOverrides)+          declared = Set.fromList (run ^. #workflow . #workflow . #parameters)+          checkKind kind name = name `Set.member` declared && maybe False ((== kind) . view #kind) (lookupParameter name workspace)+      ensure (unique names) ScenarioDuplicateParameter+      ensure (all (checkKind Plain . fst) plain && all (checkKind Secret . fst) secret && all (isValidEnvironmentName . snd) secret) ScenarioInvalidParameter+      ensure (Set.null (supplied `Set.intersection` (committed <> runtime <> fileNames))) ScenarioConflictingBinding+      values <- traverse (\(name, value) -> (name,) <$> first (const ScenarioRuntimeInputFailed) (mkHurlValueLiteral value)) plain+      pure (run ^. #artifactStem, input {plainOverrides = Map.fromList values <> input ^. #plainOverrides, secretEnvironmentOverrides = Map.fromList secret <> input ^. #secretEnvironmentOverrides})++-- | Verified assignments are immutable; callers cannot manufacture a verified+-- value or change its mapping. Only expanded logical scenarios can select input.+scenarioBindingInput :: VerifiedScenarioInputs -> ExpandedRun -> Maybe BindingInput+scenarioBindingInput (VerifiedScenarioInputs inputs) run = Map.lookup (run ^. #artifactStem) inputs++snapshotInputs :: BindingInput -> IO (Either ScenarioIssue (BindingInput, Set ParameterName))+snapshotInputs input = do+  variables <- traverse (load parseVariableProperties) (input ^. #variableFiles)+  secrets <- traverse (load parseSecretProperties) (input ^. #secretFiles)+  pure $ do+    plainFiles <- sequence variables+    secretMaps <- sequence secrets+    pure (input, Set.unions (map Map.keysSet plainFiles <> map Map.keysSet secretMaps))+  where+    load parser path = do+      bytes <- try @IOException (ByteString.readFile path)+      pure $ first (const ScenarioRuntimeInputFailed) (bytes >>= first (const (userError "invalid runtime input")) . parser path)++endpointOrigin :: Text -> IO (Either ScenarioIssue (Bool, Text, Int))+endpointOrigin endpoint+  | Text.any (\c -> isControl c || isSpace c || c `elem` ("@?#" :: String)) endpoint = pure (Left ScenarioInvalidEndpoint)+  | not (any (`Text.isPrefixOf` lowered) ["http://", "https://"]) = pure (Left ScenarioInvalidEndpoint)+  | otherwise = do+      parsed <- try @HTTP.HttpException (HTTP.parseRequest (Text.unpack lowered))+      pure $ case parsed of+        Left _ -> Left ScenarioInvalidEndpoint+        Right request+          | HTTP.path request /= "/" || ByteString.null (HTTP.host request) || HTTP.port request < 1 || HTTP.port request > 65535 -> Left ScenarioInvalidEndpoint+          | otherwise -> Right (HTTP.secure request, Text.toLower (Text.pack (Char8.unpack (HTTP.host request))), HTTP.port request)+  where+    lowered = Text.toLower endpoint++validLabel :: FilePath -> Bool+validLabel path = not (null path) && all (isValidEntityName . Text.pack) (splitDirectories path)++validFixture :: Text -> Bool+validFixture value = not (Text.null value) && not (Text.any isControl value)++unique :: (Ord a) => [a] -> Bool+unique values = Set.size (Set.fromList values) == length values++ensure :: Bool -> issue -> Either issue ()+ensure condition issue = if condition then Right () else Left issue++renderScenarioIssue :: ScenarioIssue -> Text+renderScenarioIssue = \case+  ScenarioFileUnreadable -> "scenario-file-unreadable"+  ScenarioFileNotPrivateRegular -> "scenario-file-not-private-regular"+  ScenarioMalformedInput -> "scenario-malformed-input"+  ScenarioUnsupportedVersion -> "scenario-unsupported-version"+  ScenarioInvalidLabel -> "scenario-invalid-label"+  ScenarioAssignmentMismatch -> "scenario-assignment-mismatch"+  ScenarioDuplicateFixture -> "scenario-duplicate-fixture"+  ScenarioInvalidFixture -> "scenario-invalid-fixture"+  ScenarioDuplicateEndpoint -> "scenario-duplicate-endpoint"+  ScenarioInvalidEndpoint -> "scenario-invalid-endpoint"+  ScenarioInvalidParameter -> "scenario-invalid-parameter"+  ScenarioDuplicateParameter -> "scenario-duplicate-parameter"+  ScenarioConflictingBinding -> "scenario-conflicting-binding"+  ScenarioRuntimeInputFailed -> "scenario-runtime-input-failed"
+ src/HurlWorkbench/Workflow/Render.hs view
@@ -0,0 +1,190 @@+-- | Byte-faithful composition of complete Hurl entry fragments.+module HurlWorkbench.Workflow.Render+  ( RenderedFragmentSpan (..),+    RenderedWorkflow (..),+    RenderError (..),+    renderWorkflow,+    renderRenderError,+  )+where++import Control.Exception (IOException, displayException, 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.Prelude+import HurlWorkbench.Workflow.Resolve+import HurlWorkbench.Workspace.Types++-- | Inclusive rendered line range occupied by one source fragment. Separator+--   lines inserted by the composer do not belong to either adjacent fragment.+data RenderedFragmentSpan = RenderedFragmentSpan+  { fragmentName :: !FragmentName,+    fragmentPath :: !FilePath,+    firstLine :: !Int,+    lastLine :: !Int+  }+  deriving stock (Generic, Eq, Show)++-- | Deterministic Hurl source plus the provenance needed to explain parser+--   diagnostics.+data RenderedWorkflow = RenderedWorkflow+  { workspaceRoot :: !WorkspaceRoot,+    workflowName :: !WorkflowName,+    sourceFragments :: !(NonEmpty ResolvedFragment),+    fragmentSpans :: !(NonEmpty RenderedFragmentSpan),+    contents :: !Text+  }+  deriving stock (Generic, Eq, Show)++data RenderError+  = FragmentReadFailed !FragmentName !FilePath !Text+  | InvalidFragmentUtf8 !FragmentName !FilePath !Int !Text+  | EmptyFragment !FragmentName !FilePath+  deriving stock (Generic, Eq, Show)++data LoadedFragment = LoadedFragment+  { resolved :: !ResolvedFragment,+    text :: !Text+  }+  deriving stock (Generic, Eq, Show)++renderWorkflow :: ResolvedWorkflow -> IO (Either RenderError RenderedWorkflow)+renderWorkflow resolvedWorkflow = do+  loaded <- traverse loadFragment (resolvedWorkflow ^. #sourceFragments)+  pure $ do+    fragments <- sequenceA loaded+    let (renderedText, spans) = composeFragments fragments+        definition = resolvedWorkflow ^. #workflow+    pure+      RenderedWorkflow+        { workspaceRoot = resolvedWorkflow ^. #workspaceRoot,+          workflowName = definition ^. #name,+          sourceFragments = resolvedWorkflow ^. #sourceFragments,+          fragmentSpans = spans,+          contents = ensureFinalLineFeed renderedText+        }++loadFragment :: ResolvedFragment -> IO (Either RenderError LoadedFragment)+loadFragment resolvedFragment = do+  let definition = resolvedFragment ^. #fragment+      name = definition ^. #name+      path = resolvedFragment ^. #fragmentPath+  readResult <- try (ByteString.readFile path)+  pure $ case readResult of+    Left (err :: IOException) -> Left (FragmentReadFailed name path (Text.pack (displayException err)))+    Right bytes+      | ByteString.null bytes -> Left (EmptyFragment name path)+      | otherwise -> case Text.Encoding.decodeUtf8' bytes of+          Right decoded -> Right LoadedFragment {resolved = resolvedFragment, text = decoded}+          Left err ->+            Left+              ( InvalidFragmentUtf8+                  name+                  path+                  (firstInvalidUtf8Offset bytes)+                  (Text.pack (displayException err))+              )++composeFragments :: NonEmpty LoadedFragment -> (Text, NonEmpty RenderedFragmentSpan)+composeFragments fragments =+  case NonEmpty.toList fragments of+    first : rest ->+      let initialText = first ^. #text+          initialSpan = spanAt 1 first+          initialNextLine = 1 + lineFeeds initialText+          (pieces, spans, _, _) = foldl appendOne ([initialText], [initialSpan], initialNextLine, initialText) rest+       in (Text.concat (reverse pieces), NonEmpty.fromList (reverse spans))+    [] -> error "composeFragments: impossible empty NonEmpty"+  where+    appendOne (pieces, spans, nextLine, priorText) loaded =+      let separator = fragmentSeparator priorText+          first = nextLine + lineFeeds separator+          currentText = loaded ^. #text+          currentSpan = spanAt first loaded+          followingLine = first + lineFeeds currentText+       in (currentText : separator : pieces, currentSpan : spans, followingLine, currentText)++spanAt :: Int -> LoadedFragment -> RenderedFragmentSpan+spanAt first loaded =+  let resolvedFragment = loaded ^. #resolved+      definition = resolvedFragment ^. #fragment+      fragmentText = loaded ^. #text+      final = first + lineFeeds fragmentText - if Text.isSuffixOf "\n" fragmentText then 1 else 0+   in RenderedFragmentSpan+        { fragmentName = definition ^. #name,+          fragmentPath = resolvedFragment ^. #fragmentPath,+          firstLine = first,+          lastLine = max first final+        }++-- | Leave at least one blank line between fragments while never removing+--   source bytes.+fragmentSeparator :: Text -> Text+fragmentSeparator prior+  | Text.isSuffixOf "\n\n" prior = ""+  | Text.isSuffixOf "\n" prior = "\n"+  | otherwise = "\n\n"++ensureFinalLineFeed :: Text -> Text+ensureFinalLineFeed value+  | Text.isSuffixOf "\n" value = value+  | otherwise = value <> "\n"++lineFeeds :: Text -> Int+lineFeeds = Text.count "\n"++-- | Locate the first byte that makes the input invalid UTF-8. The public+--   decoder still decides validity; this scanner exists only to make its+--   otherwise offset-free error actionable.+firstInvalidUtf8Offset :: ByteString.ByteString -> Int+firstInvalidUtf8Offset bytes = go 0+  where+    length_ = ByteString.length bytes+    byte = ByteString.index bytes++    go offset+      | offset >= length_ = max 0 (length_ - 1)+      | current <= 0x7F = go (offset + 1)+      | current >= 0xC2 && current <= 0xDF = continuationSequence offset [continuation]+      | current == 0xE0 = continuationSequence offset [between 0xA0 0xBF, continuation]+      | current >= 0xE1 && current <= 0xEC = continuationSequence offset [continuation, continuation]+      | current == 0xED = continuationSequence offset [between 0x80 0x9F, continuation]+      | current >= 0xEE && current <= 0xEF = continuationSequence offset [continuation, continuation]+      | current == 0xF0 = continuationSequence offset [between 0x90 0xBF, continuation, continuation]+      | current >= 0xF1 && current <= 0xF3 = continuationSequence offset [continuation, continuation, continuation]+      | current == 0xF4 = continuationSequence offset [between 0x80 0x8F, continuation, continuation]+      | otherwise = offset+      where+        current = byte offset++    continuationSequence start checks = check (start + 1) checks+      where+        check next [] = go next+        check next (valid : remaining)+          | next >= length_ = start+          | valid (byte next) = check (next + 1) remaining+          | otherwise = next++    continuation = between 0x80 0xBF+    between lower upper value = value >= lower && value <= upper++renderRenderError :: RenderError -> Text+renderRenderError = \case+  FragmentReadFailed name path message ->+    "could not read fragment " <> quoteName name <> " at " <> Text.pack path <> ": " <> message+  InvalidFragmentUtf8 name path offset message ->+    "fragment "+      <> quoteName name+      <> " at "+      <> Text.pack path+      <> " is not valid UTF-8 at byte offset "+      <> Text.pack (show offset)+      <> ": "+      <> message+  EmptyFragment name path ->+    "fragment " <> quoteName name <> " at " <> Text.pack path <> " is empty"+  where+    quoteName = ("\"" <>) . (<> "\"") . unFragmentName
+ src/HurlWorkbench/Workflow/Resolve.hs view
@@ -0,0 +1,69 @@+-- | Resolve a validated workflow to the canonical files that supply its+--   ordered Hurl entries.+module HurlWorkbench.Workflow.Resolve+  ( ResolvedFragment (..),+    ResolvedWorkflow (..),+    WorkflowError (..),+    resolveWorkflow,+    renderWorkflowError,+  )+where++import Data.Generics.Labels ()+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types++-- | One declared fragment paired with the canonical, root-contained file+--   proved by semantic workspace validation.+data ResolvedFragment = ResolvedFragment+  { fragment :: !Fragment,+    fragmentPath :: !FilePath+  }+  deriving stock (Generic, Eq, Show)++-- | A workflow whose ordered fragment names have all been resolved.+data ResolvedWorkflow = ResolvedWorkflow+  { workspaceRoot :: !WorkspaceRoot,+    workflow :: !Workflow,+    sourceFragments :: !(NonEmpty ResolvedFragment)+  }+  deriving stock (Generic, Eq, Show)++-- | A defensive resolution failure. Public command paths normally cannot see+--   the latter two cases because 'ValidatedWorkspace' rejects them first.+data WorkflowError+  = WorkflowNotFound !WorkflowName+  | WorkflowHasNoFragments !WorkflowName+  | WorkflowFragmentNotFound !WorkflowName !FragmentName+  deriving stock (Generic, Eq, Show)++resolveWorkflow :: ValidatedWorkspace -> WorkflowName -> Either WorkflowError ResolvedWorkflow+resolveWorkflow validated selected = do+  definition <- maybe (Left (WorkflowNotFound selected)) Right (lookupWorkflow selected validated)+  fragmentNames <- maybe (Left (WorkflowHasNoFragments selected)) Right (nonEmpty (definition ^. #fragments))+  resolved <- traverse resolveFragment fragmentNames+  pure+    ResolvedWorkflow+      { workspaceRoot = validatedRoot validated,+        workflow = definition,+        sourceFragments = resolved+      }+  where+    resolveFragment fragmentName =+      case (lookupFragment fragmentName validated, lookupFragmentFile fragmentName validated) of+        (Just definition, Just path) -> Right ResolvedFragment {fragment = definition, fragmentPath = path}+        _ -> Left (WorkflowFragmentNotFound selected fragmentName)++renderWorkflowError :: WorkflowError -> Text+renderWorkflowError = \case+  WorkflowNotFound name -> "unknown workflow " <> quote (unWorkflowName name)+  WorkflowHasNoFragments name -> "workflow " <> quote (unWorkflowName name) <> " has no fragments"+  WorkflowFragmentNotFound workflowName fragmentName ->+    "workflow "+      <> quote (unWorkflowName workflowName)+      <> " refers to unresolved fragment "+      <> quote (unFragmentName fragmentName)++quote :: Text -> Text+quote value = "\"" <> value <> "\""
+ src/HurlWorkbench/Workspace/Context.hs view
@@ -0,0 +1,135 @@+-- | Loaded workspaces.+--+--   A 'WorkspaceContext' is a decoded manifest plus its location. A+--   'ValidatedWorkspace' is the only value later features accept: it can be+--   obtained solely through 'HurlWorkbench.Workspace.Validate.validateWorkspace',+--   carries its own root, and offers typed lookups by category-specific name.+module HurlWorkbench.Workspace.Context+  ( -- * Decoded context+    WorkspaceContext (..),+    loadWorkspaceContext,++    -- * Validated workspace+    ValidatedWorkspace,+    validatedContext,+    validatedManifestPath,+    validatedRoot,+    validatedWorkspace,++    -- ** Indexes+    validatedParameters,+    validatedFragments,+    validatedWorkflows,+    validatedRecipes,+    validatedMatrices,+    validatedChecks,+    validatedServices,+    validatedSuites,++    -- ** Lookups+    lookupParameter,+    lookupFragment,+    lookupFragmentFile,+    lookupWorkflow,+    lookupRecipe,+    lookupMatrix,+    lookupCheck,+    lookupCheckExecutable,+    lookupService,+    lookupSuite,+  )+where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context.Internal (ValidatedWorkspace (..), WorkspaceContext (..))+import HurlWorkbench.Workspace.Decode (decodeWorkspaceFile)+import HurlWorkbench.Workspace.Discover (WorkspaceSource, workspaceSourcePath)+import HurlWorkbench.Workspace.Error (WorkspaceError)+import HurlWorkbench.Workspace.Types+import System.Directory (canonicalizePath)+import System.FilePath (takeDirectory)++-- | Canonicalize the manifest path and decode it. The workspace root is the+--   canonical directory containing the manifest.+loadWorkspaceContext :: WorkspaceSource -> IO (Either WorkspaceError WorkspaceContext)+loadWorkspaceContext source = do+  manifest <- canonicalizePath (workspaceSourcePath source)+  decoded <- decodeWorkspaceFile manifest+  pure $+    decoded <&> \ws ->+      WorkspaceContext+        { manifestPath = manifest,+          workspaceRoot = WorkspaceRoot (takeDirectory manifest),+          workspace = ws+        }++validatedContext :: ValidatedWorkspace -> WorkspaceContext+validatedContext = view #context++validatedManifestPath :: ValidatedWorkspace -> FilePath+validatedManifestPath = view (#context . #manifestPath)++validatedRoot :: ValidatedWorkspace -> WorkspaceRoot+validatedRoot = view (#context . #workspaceRoot)++-- | The decoded workspace, with every list in declaration order.+validatedWorkspace :: ValidatedWorkspace -> Workspace+validatedWorkspace = view (#context . #workspace)++validatedParameters :: ValidatedWorkspace -> Map ParameterName Parameter+validatedParameters = view #parameterIndex++validatedFragments :: ValidatedWorkspace -> Map FragmentName Fragment+validatedFragments = view #fragmentIndex++validatedWorkflows :: ValidatedWorkspace -> Map WorkflowName Workflow+validatedWorkflows = view #workflowIndex++validatedRecipes :: ValidatedWorkspace -> Map RecipeName Recipe+validatedRecipes = view #recipeIndex++validatedMatrices :: ValidatedWorkspace -> Map MatrixName Matrix+validatedMatrices = view #matrixIndex++validatedChecks :: ValidatedWorkspace -> Map CheckName Check+validatedChecks = view #checkIndex++validatedServices :: ValidatedWorkspace -> Map ServiceName Service+validatedServices = view #serviceIndex++validatedSuites :: ValidatedWorkspace -> Map SuiteName Suite+validatedSuites = view #suiteIndex++lookupParameter :: ParameterName -> ValidatedWorkspace -> Maybe Parameter+lookupParameter name = Map.lookup name . validatedParameters++lookupFragment :: FragmentName -> ValidatedWorkspace -> Maybe Fragment+lookupFragment name = Map.lookup name . validatedFragments++-- | Canonical absolute path of a fragment file, guaranteed to be a regular+--   file inside the workspace root at validation time.+lookupFragmentFile :: FragmentName -> ValidatedWorkspace -> Maybe FilePath+lookupFragmentFile name = Map.lookup name . view #fragmentFiles++lookupWorkflow :: WorkflowName -> ValidatedWorkspace -> Maybe Workflow+lookupWorkflow name = Map.lookup name . validatedWorkflows++lookupRecipe :: RecipeName -> ValidatedWorkspace -> Maybe Recipe+lookupRecipe name = Map.lookup name . validatedRecipes++lookupMatrix :: MatrixName -> ValidatedWorkspace -> Maybe Matrix+lookupMatrix name = Map.lookup name . validatedMatrices++lookupCheck :: CheckName -> ValidatedWorkspace -> Maybe Check+lookupCheck name = Map.lookup name . validatedChecks++lookupCheckExecutable :: CheckName -> ValidatedWorkspace -> Maybe FilePath+lookupCheckExecutable name = Map.lookup name . view #checkExecutables++lookupService :: ServiceName -> ValidatedWorkspace -> Maybe Service+lookupService name = Map.lookup name . validatedServices++lookupSuite :: SuiteName -> ValidatedWorkspace -> Maybe Suite+lookupSuite name = Map.lookup name . validatedSuites
+ src/HurlWorkbench/Workspace/Context/Internal.hs view
@@ -0,0 +1,41 @@+-- | Internal representation of 'ValidatedWorkspace'. Only+--   "HurlWorkbench.Workspace.Validate" may construct it; everything else uses+--   the abstract type and accessors exported by+--   "HurlWorkbench.Workspace.Context".+module HurlWorkbench.Workspace.Context.Internal+  ( WorkspaceContext (..),+    ValidatedWorkspace (..),+  )+where++import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Types++-- | A decoded workspace together with where it was loaded from. It has not+--   been semantically validated.+data WorkspaceContext = WorkspaceContext+  { -- | Canonical absolute path of @hurl-workbench.dhall@.+    manifestPath :: !FilePath,+    -- | Canonical directory containing the manifest.+    workspaceRoot :: !WorkspaceRoot,+    workspace :: !Workspace+  }+  deriving stock (Generic, Eq, Show)++-- | A workspace that passed every semantic check, indexed by+--   category-specific names.+data ValidatedWorkspace = ValidatedWorkspace+  { context :: !WorkspaceContext,+    parameterIndex :: !(Map ParameterName Parameter),+    fragmentIndex :: !(Map FragmentName Fragment),+    -- | Canonical absolute path of each fragment file, inside the root.+    fragmentFiles :: !(Map FragmentName FilePath),+    workflowIndex :: !(Map WorkflowName Workflow),+    recipeIndex :: !(Map RecipeName Recipe),+    matrixIndex :: !(Map MatrixName Matrix),+    checkIndex :: !(Map CheckName Check),+    checkExecutables :: !(Map CheckName FilePath),+    serviceIndex :: !(Map ServiceName Service),+    suiteIndex :: !(Map SuiteName Suite)+  }+  deriving stock (Generic, Eq, Show)
+ src/HurlWorkbench/Workspace/Decode.hs view
@@ -0,0 +1,221 @@+-- | Evaluate a @hurl-workbench.dhall@ manifest and decode it into a+--   'Workspace'.+--+--   Decoding checks @schemaVersion@ on the evaluated expression before the+--   typed decode, so a manifest written for another schema version is+--   reported as such instead of as an opaque Dhall type mismatch.+module HurlWorkbench.Workspace.Decode+  ( decodeWorkspaceFile,+  )+where++import Control.Exception (SomeAsyncException, SomeException, fromException, throwIO, try)+import Data.ByteString qualified as ByteString+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import Data.Void (Void)+import Dhall qualified+import Dhall.Core qualified as Dhall.Core+import Dhall.Map qualified+import Dhall.Parser (Src)+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Error (WorkspaceError (..))+import HurlWorkbench.Workspace.Types (Check, Workspace, supportedSchemaVersion)+import Numeric.Natural (Natural)+import System.FilePath (takeDirectory)++-- | Read, evaluate, version-check, and decode a manifest. Relative imports+--   inside the manifest resolve against the manifest's own directory. No+--   JSON or YAML fallback exists.+decodeWorkspaceFile :: FilePath -> IO (Either WorkspaceError Workspace)+decodeWorkspaceFile path = do+  readResult <- trySync (ByteString.readFile path)+  case readResult of+    Left exception -> pure (Left (ManifestUnreadable path (renderException exception)))+    Right bytes -> case Text.Encoding.decodeUtf8' bytes of+      Left exception -> pure (Left (ManifestUnreadable path (renderException exception)))+      Right source -> decodeSource source+  where+    settings =+      Dhall.defaultInputSettings+        & Dhall.rootDirectory+        .~ takeDirectory path+        & Dhall.sourceName+        .~ path++    decoder = Dhall.auto @Workspace++    decodeSource source = do+      evaluated <- trySync $ do+        parsed <- Dhall.parseWithSettings settings source+        resolved <- Dhall.resolveWithSettings settings parsed+        Dhall.typecheckWithSettings settings resolved+        pure resolved+      case evaluated of+        Left exception -> pure (Left (DhallFailure path (renderException exception)))+        Right resolved -> do+          let normalized = Dhall.normalizeWithSettings settings resolved+          case schemaVersionOf normalized of+            Nothing -> pure (Left (MissingSchemaVersion path))+            Just version+              | version /= supportedSchemaVersion ->+                  pure (Left (UnsupportedSchemaVersion path version supportedSchemaVersion))+              | otherwise -> decodeTyped (normalizeChecks (normalizeParameterKinds (normalizeCommandPolicies (normalizeSuiteLifecycle normalized))))++    decodeTyped normalized = do+      expected <- trySync $ do+        Dhall.typecheckWithSettings settings normalized+        Dhall.expectWithSettings settings decoder normalized+      pure $ case expected of+        Left exception -> Left (DhallFailure path (renderException exception))+        Right () -> case Dhall.toMonadic (Dhall.extract decoder normalized) of+          Right workspace -> Right workspace+          Left errors -> Left (DhallFailure path (renderException errors))++-- | Find a literal @schemaVersion : Natural@ field on a normalized record.+schemaVersionOf :: Dhall.Core.Expr Src Void -> Maybe Natural+schemaVersionOf = \case+  Dhall.Core.RecordLit fields ->+    case Dhall.Core.recordFieldValue <$> Dhall.Map.lookup "schemaVersion" fields of+      Just (Dhall.Core.NaturalLit version) -> Just version+      _ -> Nothing+  _ -> Nothing++-- | Like 'try', but never intercepts asynchronous exceptions.+trySync :: IO a -> IO (Either SomeException a)+trySync action = do+  result <- try action+  case result of+    Left exception+      | Just (_ :: SomeAsyncException) <- fromException exception -> throwIO exception+    other -> pure other++-- | Render a library exception as plain text. Dhall colors some messages+--   with ANSI escape sequences, which are removed so redirected output stays+--   readable.+renderException :: (Show e) => e -> Text+renderException = stripAnsi . Text.pack . show++-- | Remove ANSI CSI sequences such as @ESC[1;31m@.+stripAnsi :: Text -> Text+stripAnsi text = case Text.breakOn "\ESC[" text of+  (before, rest)+    | Text.null rest -> before+    | otherwise ->+        let afterIntroducer = Text.drop 2 rest+            (_, final) = Text.span (\c -> c >= ' ' && c <= '?') afterIntroducer+         in before <> stripAnsi (Text.drop 1 final)++-- | Upgrade only the managed-service subtree, including the command types in+-- readiness unions and empty-list annotations. User expressions are typechecked+-- before this pass; explicit policy fields are never replaced.+normalizeCommandPolicies :: Dhall.Core.Expr Src Void -> Dhall.Core.Expr Src Void+normalizeCommandPolicies (Dhall.Core.RecordLit fields) =+  Dhall.Core.RecordLit+    ( Dhall.Map.fromList+        [(key, if key `elem` ["checks", "services", "suites"] then field {Dhall.Core.recordFieldValue = upgrade (Dhall.Core.recordFieldValue field)} else field) | (key, field) <- Dhall.Map.toList fields]+    )+  where+    policyType = Dhall.Core.Union (Dhall.Map.fromList [("Inherit", Nothing), ("Clean", Just (Dhall.Core.App Dhall.Core.List Dhall.Core.Text))])+    inherited = Dhall.Core.Field policyType (Dhall.Core.makeFieldSelection "Inherit")+    upgrade expression =+      let nested = runIdentity (Dhall.Core.subExpressions (Identity . upgrade) expression)+          add value record =+            if all (\key -> isJust (Dhall.Map.lookup key record)) ["executable", "arguments", "workingDirectory", "environment"]+              && not (isJust (Dhall.Map.lookup "environmentPolicy" record))+              then Dhall.Map.insert "environmentPolicy" (Dhall.Core.makeRecordField value) record+              else record+       in case nested of+            Dhall.Core.RecordLit record -> Dhall.Core.RecordLit (add inherited record)+            Dhall.Core.Record record -> Dhall.Core.Record (add policyType record)+            other -> other+normalizeCommandPolicies other = other++-- | Version-1 additive conversion, scoped to suites. Preserve explicit fields+-- and widen only the known Hurl run union (including empty-list annotations).+-- Both the original expression and the converted expression are typechecked.+normalizeSuiteLifecycle :: Dhall.Core.Expr Src Void -> Dhall.Core.Expr Src Void+normalizeSuiteLifecycle (Dhall.Core.RecordLit fields) =+  Dhall.Core.RecordLit+    ( Dhall.Map.fromList+        [(key, if key == "suites" then field {Dhall.Core.recordFieldValue = upgrade (Dhall.Core.recordFieldValue field)} else field) | (key, field) <- Dhall.Map.toList fields]+    )+  where+    list = Dhall.Core.App Dhall.Core.List+    record = Dhall.Core.Record . Dhall.Map.fromList . map (\(key, value) -> (key, Dhall.Core.makeRecordField value))+    union names = Dhall.Core.Union (Dhall.Map.fromList [(key, value) | (key, value) <- names])+    policyType = union [("SharedState", Nothing), ("IndependentState", Nothing)]+    commandType =+      record+        [ ("executable", Dhall.Core.Text),+          ("arguments", list Dhall.Core.Text),+          ("workingDirectory", Dhall.Core.App Dhall.Core.Optional Dhall.Core.Text),+          ("environmentPolicy", union [("Inherit", Nothing), ("Clean", Just (list Dhall.Core.Text))]),+          ("environment", list (record [("variable", Dhall.Core.Text), ("parameter", Dhall.Core.Text)]))+        ]+    stepType = union [(key, Just Dhall.Core.Text) | key <- ["Stop", "Start", "Restart"]]+    defaults =+      [ ("fileRootParameter", Dhall.Core.App Dhall.Core.Optional Dhall.Core.Text, Dhall.Core.App Dhall.Core.None Dhall.Core.Text),+        ("isolation", policyType, Dhall.Core.Field policyType (Dhall.Core.makeFieldSelection "SharedState")),+        ("services", list Dhall.Core.Text, Dhall.Core.ListLit (Just (list Dhall.Core.Text)) mempty),+        ("setup", list commandType, Dhall.Core.ListLit (Just (list commandType)) mempty),+        ("teardown", list commandType, Dhall.Core.ListLit (Just (list commandType)) mempty),+        ("commandTimeoutSeconds", Dhall.Core.Natural, Dhall.Core.NaturalLit 60),+        ("cleanupTimeoutSeconds", Dhall.Core.Natural, Dhall.Core.NaturalLit 30)+      ]+    add isType fields_ =+      if all (\key -> isJust (Dhall.Map.lookup key fields_)) ["name", "runs", "service", "failFast", "description"]+        then foldl (\acc (key, type_, value) -> if isJust (Dhall.Map.lookup key acc) then acc else Dhall.Map.insert key (Dhall.Core.makeRecordField (if isType then type_ else value)) acc) fields_ defaults+        else fields_+    upgrade expression =+      let nested = runIdentity (Dhall.Core.subExpressions (Identity . upgrade) expression)+       in case nested of+            Dhall.Core.RecordLit fields_ -> Dhall.Core.RecordLit (add False fields_)+            Dhall.Core.Record fields_ -> Dhall.Core.Record (add True fields_)+            Dhall.Core.Union alternatives+              | all (\key -> Dhall.Map.lookup key alternatives == Just (Just Dhall.Core.Text)) ["Workflow", "Recipe", "Matrix"],+                not (isJust (Dhall.Map.lookup "Service" alternatives)) ->+                  Dhall.Core.Union (Dhall.Map.insert "Service" (Just stepType) alternatives)+            other -> other+normalizeSuiteLifecycle other = other++-- | Widen the legacy parameter kind in values and empty typed lists. The+-- original and upgraded expressions both pass Dhall type checking.+normalizeParameterKinds :: Dhall.Core.Expr Src Void -> Dhall.Core.Expr Src Void+normalizeParameterKinds expression =+  let nested = runIdentity (Dhall.Core.subExpressions (Identity . normalizeParameterKinds) expression)+      record key type_ = Dhall.Core.Record (Dhall.Map.fromList [(key, Dhall.Core.makeRecordField type_)])+      generator =+        Dhall.Core.Union+          ( Dhall.Map.fromList+              [ ("Uuid4", Nothing),+                ("Uuid7", Nothing),+                ("TypeId", Just (record "prefix" Dhall.Core.Text)),+                ("Rfc3339Now", Nothing),+                ("RandomAlphanumeric", Just (record "length" Dhall.Core.Natural))+              ]+          )+   in case nested of+        Dhall.Core.Union alternatives+          | Dhall.Map.toList alternatives == [("Plain", Nothing), ("Secret", Nothing)] ->+              Dhall.Core.Union (Dhall.Map.insert "Generated" (Just generator) alternatives)+        other -> other++-- | Add the absent category and widen legacy run unions, including annotations+-- on empty lists. Original and upgraded expressions are both typechecked.+normalizeChecks :: Dhall.Core.Expr Src Void -> Dhall.Core.Expr Src Void+normalizeChecks (Dhall.Core.RecordLit fields) =+  let checkList = Dhall.Core.App Dhall.Core.List checkType+      withChecks = if isJust (Dhall.Map.lookup "checks" fields) then fields else Dhall.Map.insert "checks" (Dhall.Core.makeRecordField (Dhall.Core.ListLit (Just checkList) mempty)) fields+   in Dhall.Core.RecordLit (Dhall.Map.fromList [(key, if key == "suites" then field {Dhall.Core.recordFieldValue = upgrade (Dhall.Core.recordFieldValue field)} else field) | (key, field) <- Dhall.Map.toList withChecks])+  where+    checkType = case toList (Dhall.expected (Dhall.auto @Check)) of type_ : _ -> type_; [] -> error "invalid check decoder"+    upgrade expression =+      let nested = runIdentity (Dhall.Core.subExpressions (Identity . upgrade) expression)+       in case nested of+            Dhall.Core.Union alternatives+              | all (\key -> Dhall.Map.lookup key alternatives == Just (Just Dhall.Core.Text)) ["Workflow", "Recipe", "Matrix"],+                not (isJust (Dhall.Map.lookup "Check" alternatives)) ->+                  Dhall.Core.Union (Dhall.Map.insert "Check" (Just Dhall.Core.Text) alternatives)+            other -> other+normalizeChecks other = other
+ src/HurlWorkbench/Workspace/Discover.hs view
@@ -0,0 +1,62 @@+-- | Locate the workspace manifest.+--+--   An explicit @--workspace FILE@ always wins. Otherwise the start directory+--   and each of its parents are searched for 'manifestFileName', stopping at+--   the filesystem root. Neither @$HOME@, a global configuration directory,+--   nor the network is ever consulted.+module HurlWorkbench.Workspace.Discover+  ( WorkspaceSource (..),+    manifestFileName,+    discoverWorkspace,+    workspaceSourcePath,+  )+where++import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Error (WorkspaceError (..))+import System.Directory (doesFileExist, makeAbsolute)+import System.FilePath (normalise, takeDirectory, (</>))++-- | Where the manifest came from.+data WorkspaceSource+  = -- | Named with @--workspace FILE@.+    ExplicitWorkspace !FilePath+  | -- | Found by walking up from the start directory.+    DiscoveredWorkspace !FilePath+  deriving stock (Generic, Eq, Show)++-- | The manifest file name searched for during discovery.+manifestFileName :: FilePath+manifestFileName = "hurl-workbench.dhall"++-- | The absolute manifest path of a source.+workspaceSourcePath :: WorkspaceSource -> FilePath+workspaceSourcePath = \case+  ExplicitWorkspace path -> path+  DiscoveredWorkspace path -> path++-- | @discoverWorkspace explicit startDirectory@. A relative explicit path is+--   resolved against @startDirectory@.+discoverWorkspace :: Maybe FilePath -> FilePath -> IO (Either WorkspaceError WorkspaceSource)+discoverWorkspace explicit startDirectory = do+  start <- normalise <$> makeAbsolute startDirectory+  case explicit of+    Just file -> do+      let candidate = normalise (start </> file)+      exists <- doesFileExist candidate+      pure $+        if exists+          then Right (ExplicitWorkspace candidate)+          else Left (ManifestNotFound candidate)+    Nothing -> walk start start+  where+    walk start directory = do+      let candidate = directory </> manifestFileName+      exists <- doesFileExist candidate+      let parent = takeDirectory directory+      if exists+        then pure (Right (DiscoveredWorkspace candidate))+        else+          if parent == directory+            then pure (Left (NoWorkspaceFound start))+            else walk start parent
+ src/HurlWorkbench/Workspace/Error.hs view
@@ -0,0 +1,53 @@+-- | Failures that prevent a workspace from being located or decoded at all.+--   Semantic problems in a decoded workspace are reported separately as+--   'HurlWorkbench.Workspace.Validate.ValidationIssue' values.+module HurlWorkbench.Workspace.Error+  ( WorkspaceError (..),+    renderWorkspaceError,+  )+where++import Data.Text qualified as Text+import HurlWorkbench.Prelude+import Numeric.Natural (Natural)++-- | Why a workspace could not be discovered, read, or decoded.+data WorkspaceError+  = -- | An explicit @--workspace FILE@ does not name an existing file.+    ManifestNotFound !FilePath+  | -- | No @hurl-workbench.dhall@ exists in the start directory or any parent.+    NoWorkspaceFound !FilePath+  | -- | The manifest exists but could not be read as UTF-8 text.+    ManifestUnreadable !FilePath !Text+  | -- | Dhall parsing, import resolution, type checking, or decoding failed.+    DhallFailure !FilePath !Text+  | -- | The manifest's top level is not a record with a @schemaVersion@.+    MissingSchemaVersion !FilePath+  | -- | The manifest declares a schema version this build does not support.+    UnsupportedSchemaVersion !FilePath !Natural !Natural+  deriving stock (Generic, Eq, Show)++-- | Render an error for a human, naming the manifest path.+renderWorkspaceError :: WorkspaceError -> Text+renderWorkspaceError = \case+  ManifestNotFound path ->+    "workspace manifest not found: " <> Text.pack path+  NoWorkspaceFound start ->+    "no hurl-workbench.dhall found in "+      <> Text.pack start+      <> " or any parent directory (use --workspace FILE to name one)"+  ManifestUnreadable path reason ->+    "cannot read workspace manifest " <> Text.pack path <> ": " <> reason+  DhallFailure path reason ->+    "invalid Dhall in workspace manifest " <> Text.pack path <> ":\n" <> Text.strip reason+  MissingSchemaVersion path ->+    "workspace manifest "+      <> Text.pack path+      <> " must evaluate to a record with a Natural schemaVersion field"+  UnsupportedSchemaVersion path found supported ->+    "workspace manifest "+      <> Text.pack path+      <> " declares schemaVersion "+      <> Text.pack (show found)+      <> ", but this hurl-workbench supports only schemaVersion "+      <> Text.pack (show supported)
+ src/HurlWorkbench/Workspace/Types.hs view
@@ -0,0 +1,410 @@+-- | The decoded, pre-validation representation of a @hurl-workbench.dhall@+--   workspace. Every field corresponds one-to-one to the Dhall schema under+--   @schema/@ at the repository root.+--+--   These values describe existing Hurl source; they never describe HTTP+--   methods, URLs, bodies, captures, or assertions. Semantic guarantees+--   (unique names, resolved references, safe paths) only hold once a+--   'Workspace' has been turned into a+--   'HurlWorkbench.Workspace.Context.ValidatedWorkspace'.+module HurlWorkbench.Workspace.Types+  ( -- * Workspace+    Workspace (..),+    supportedSchemaVersion,++    -- * Category-specific names+    ParameterName (..),+    FragmentName (..),+    WorkflowName (..),+    RecipeName (..),+    MatrixName (..),+    MatrixCaseName (..),+    CheckName (..),+    ServiceName (..),+    SuiteName (..),+    WorkspaceRoot (..),++    -- * Plain Hurl values+    HurlValueLiteral,+    HurlValueLiteralError (..),+    mkHurlValueLiteral,+    hurlValueLiteralText,+    renderHurlValueLiteralError,++    -- * Entities+    Parameter (..),+    ParameterKind (..),+    Generator (..),+    TypeIdOptions (..),+    RandomOptions (..),+    Fragment (..),+    Workflow (..),+    Binding (..),+    Safety (..),+    Recipe (..),+    MatrixCase (..),+    Matrix (..),+    EnvironmentBinding (..),+    EnvironmentPolicy (..),+    CommandSpec (..),+    HttpReadiness (..),+    CommandReadiness (..),+    Readiness (..),+    Check (..),+    Service (..),+    RunReference (..),+    ServiceStep (..),+    suiteServices,+    IsolationPolicy (..),+    Suite (..),+  )+where++import Data.Text qualified as Text+import Dhall (FromDhall (..), InterpretOptions (..), defaultInterpretOptions, genericAutoWith)+import HurlWorkbench.Prelude+import Numeric.Natural (Natural)++-- | The only @schemaVersion@ this build understands.+supportedSchemaVersion :: Natural+supportedSchemaVersion = 1++-- | A complete workspace manifest after Dhall evaluation and decoding.+data Workspace = Workspace+  { schemaVersion :: !Natural,+    parameters :: ![Parameter],+    fragments :: ![Fragment],+    workflows :: ![Workflow],+    recipes :: ![Recipe],+    matrices :: ![Matrix],+    checks :: ![Check],+    services :: ![Service],+    suites :: ![Suite]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Name of an externally injected Hurl variable.+newtype ParameterName = ParameterName {unParameterName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Name of a fragment: one file containing complete Hurl entries.+newtype FragmentName = FragmentName {unFragmentName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Name of a workflow: an ordered list of fragments.+newtype WorkflowName = WorkflowName {unWorkflowName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Name of a recipe: a workflow plus plain bindings and a safety class.+newtype RecipeName = RecipeName {unRecipeName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Name of a matrix: a recipe applied to several binding sets.+newtype MatrixName = MatrixName {unMatrixName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Name of one case inside a matrix. Unique only within its matrix.+newtype MatrixCaseName = MatrixCaseName {unMatrixCaseName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++newtype CheckName = CheckName {unCheckName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Name of a managed service process.+newtype ServiceName = ServiceName {unServiceName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Name of a suite: a collection of workflow, recipe, or matrix runs.+newtype SuiteName = SuiteName {unSuiteName :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Canonical absolute directory containing @hurl-workbench.dhall@.+newtype WorkspaceRoot = WorkspaceRoot {unWorkspaceRoot :: FilePath}+  deriving stock (Generic, Eq, Ord, Show)++-- | A plain (non-secret) Hurl variable value that survives transport through+--   a Hurl 8 variables file unchanged.+--+--   Hurl reads such files line by line, trims each line, and splits it at the+--   first @=@. The remaining text is then inferred by Hurl as @true@,+--   @false@, @null@, an integer, a float, or a string. The smart constructor+--   therefore rejects CR, LF, and NUL characters and leading or trailing+--   whitespace; an @=@ inside the value is fine. The text is otherwise passed+--   through as written and Hurl's inference applies.+--+--   Values decoded from Dhall are checked by semantic validation, which+--   reports the offending location; runtime values must go through+--   'mkHurlValueLiteral'.+newtype HurlValueLiteral = HurlValueLiteral Text+  deriving stock (Generic, Eq, Ord, Show)+  deriving newtype (FromDhall)++-- | Why a text value cannot be a 'HurlValueLiteral'.+data HurlValueLiteralError+  = -- | The value contains a carriage return, line feed, or NUL character.+    ContainsLineBreakOrNul+  | -- | The value begins or ends with whitespace that Hurl would trim.+    SurroundingWhitespace+  deriving stock (Generic, Eq, Show)++-- | Check the lossless single-line transport rule.+mkHurlValueLiteral :: Text -> Either HurlValueLiteralError HurlValueLiteral+mkHurlValueLiteral value+  | Text.any (`elem` ['\r', '\n', '\0']) value = Left ContainsLineBreakOrNul+  | hasSurroundingWhitespace = Left SurroundingWhitespace+  | otherwise = Right (HurlValueLiteral value)+  where+    hasSurroundingWhitespace = case (Text.uncons value, Text.unsnoc value) of+      (Just (first, _), Just (_, final)) -> isTrimmed first || isTrimmed final+      _ -> False+    -- Hurl uses Rust's `str::trim`, which trims Unicode White_Space.+    isTrimmed c = Text.null (Text.strip (Text.singleton c)) || c `elem` ['\x85', '\x2028', '\x2029']++-- | The literal text written to a Hurl variables file.+hurlValueLiteralText :: HurlValueLiteral -> Text+hurlValueLiteralText (HurlValueLiteral value) = value++-- | Human-readable explanation of a 'HurlValueLiteralError'.+renderHurlValueLiteralError :: HurlValueLiteralError -> Text+renderHurlValueLiteralError = \case+  ContainsLineBreakOrNul -> "value contains a line break or NUL character, which Hurl variable files cannot carry"+  SurroundingWhitespace -> "value has leading or trailing whitespace, which Hurl variable files would trim"++-- | Whether a parameter's value may be committed and displayed.+data ParameterKind+  = Plain+  | Secret+  | Generated !Generator+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++-- | Declarative generation; never evaluated during inspection.+data Generator = Uuid4 | Uuid7 | TypeId TypeIdOptions | Rfc3339Now | RandomAlphanumeric RandomOptions+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++newtype TypeIdOptions = TypeIdOptions {prefix :: Text}+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++newtype RandomOptions = RandomOptions {randomLength :: Natural}+  deriving stock (Generic, Eq, Ord, Show)++instance FromDhall RandomOptions where+  autoWith _ = genericAutoWith defaultInterpretOptions {fieldModifier = \name -> if name == "randomLength" then "length" else name}++-- | An externally injected Hurl variable.+data Parameter = Parameter+  { name :: !ParameterName,+    description :: !(Maybe Text),+    kind :: !ParameterKind,+    -- | Committed default; never allowed for a secret.+    defaultValue :: !(Maybe HurlValueLiteral),+    -- | Environment variable that supplies the value at run time.+    environment :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | A file of one or more complete Hurl entries, relative to the workspace+--   root.+data Fragment = Fragment+  { name :: !FragmentName,+    path :: !FilePath,+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | An ordered composition of fragments and the parameters it consumes.+data Workflow = Workflow+  { name :: !WorkflowName,+    fragments :: ![FragmentName],+    parameters :: ![ParameterName],+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | A plain value bound to a parameter.+data Binding = Binding+  { parameter :: !ParameterName,+    value :: !HurlValueLiteral+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Whether running a recipe may change remote state.+data Safety+  = ReadOnly+  | Mutating+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++-- | A workflow with committed plain bindings and a safety classification.+data Recipe = Recipe+  { name :: !RecipeName,+    workflow :: !WorkflowName,+    bindings :: ![Binding],+    safety :: !Safety,+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | One named set of bindings layered over a matrix's recipe.+data MatrixCase = MatrixCase+  { name :: !MatrixCaseName,+    bindings :: ![Binding]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | A recipe applied to several binding sets.+data Matrix = Matrix+  { name :: !MatrixName,+    recipe :: !RecipeName,+    cases :: ![MatrixCase],+    failFast :: !Bool,+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Export a workspace parameter to a child process under @variable@.+data EnvironmentBinding = EnvironmentBinding+  { variable :: !Text,+    parameter :: !ParameterName+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Inherit the parent environment, or select required inherited names.+data EnvironmentPolicy = Inherit | Clean [Text]+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | A process invocation as executable plus argv, with an independent environment policy.+data CommandSpec = CommandSpec+  { executable :: !Text,+    arguments :: ![Text],+    workingDirectory :: !(Maybe FilePath),+    environmentPolicy :: !EnvironmentPolicy,+    environment :: ![EnvironmentBinding]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Poll an HTTP URL until it answers with the expected status.+data HttpReadiness = HttpReadiness+  { url :: !Text,+    expectedStatus :: !Natural,+    intervalMilliseconds :: !Natural,+    timeoutSeconds :: !Natural+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Run a command until it exits successfully.+data CommandReadiness = CommandReadiness+  { command :: !CommandSpec,+    intervalMilliseconds :: !Natural,+    timeoutSeconds :: !Natural+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | How to decide that a service is ready. Dhall alternatives are @Http@ and+--   @Command@.+data Readiness+  = HttpReadinessCheck !HttpReadiness+  | CommandReadinessCheck !CommandReadiness+  deriving stock (Generic, Eq, Show)++instance FromDhall Readiness where+  autoWith _ = genericAutoWith (stripConstructorAffixes "Readiness" "Check")++-- | A single executable assertion owned by the workspace.+data Check = Check+  { name :: !CheckName,+    command :: !CommandSpec,+    expectedStatus :: !Natural,+    timeoutSeconds :: !(Maybe Natural),+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | A managed process that suites can start and stop.+data Service = Service+  { name :: !ServiceName,+    command :: !CommandSpec,+    readiness :: !Readiness,+    shutdownTimeoutSeconds :: !Natural,+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | What a suite runs. Dhall alternatives are @Workflow@, @Recipe@, and+--   @Matrix@.+data ServiceStep = Stop !ServiceName | Start !ServiceName | Restart !ServiceName+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data RunReference+  = WorkflowRun !WorkflowName+  | RecipeRun !RecipeName+  | MatrixRun !MatrixName+  | CheckRun !CheckName+  | ServiceRun !ServiceStep+  deriving stock (Generic, Eq, Show)++instance FromDhall RunReference where+  autoWith _ = genericAutoWith (stripConstructorAffixes "" "Run")++-- | Application state sharing between expanded suite scenarios.+data IsolationPolicy = SharedState | IndependentState+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | A named collection of runs, optionally against a managed service.+data Suite = Suite+  { name :: !SuiteName,+    fileRootParameter :: !(Maybe ParameterName),+    runs :: ![RunReference],+    service :: !(Maybe ServiceName),+    services :: ![ServiceName],+    setup :: ![CommandSpec],+    teardown :: ![CommandSpec],+    commandTimeoutSeconds :: !Natural,+    cleanupTimeoutSeconds :: !Natural,+    isolation :: !IsolationPolicy,+    failFast :: !Bool,+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++suiteServices :: Suite -> [ServiceName]+suiteServices Suite {service, services} = if null services then maybe [] pure service else services++-- | Map Haskell constructor names such as @HttpReadinessCheck@ to Dhall+--   alternative names such as @Http@.+stripConstructorAffixes :: Text -> Text -> InterpretOptions+stripConstructorAffixes infix_ suffix =+  defaultInterpretOptions {constructorModifier = strip}+  where+    strip constructor =+      let withoutSuffix = fromMaybe constructor (Text.stripSuffix suffix constructor)+       in fromMaybe withoutSuffix (Text.stripSuffix infix_ withoutSuffix)
+ src/HurlWorkbench/Workspace/Validate.hs view
@@ -0,0 +1,529 @@+-- | Semantic validation of a decoded workspace.+--+--   Validation accumulates every independent issue instead of stopping at the+--   first one. Issues are reported in a fixed category order (schema,+--   parameters, fragments, workflows, recipes, matrices, services, suites) and+--   by entity name within a category, so the same workspace always produces+--   the same report.+module HurlWorkbench.Workspace.Validate+  ( ValidationIssue (..),+    validateWorkspace,+    renderValidationIssue,++    -- * Name rules+    isValidEntityName,+    isValidParameterName,+    isValidEnvironmentName,+    reservedParameterNames,+  )+where++import Control.Exception (IOException, try)+import Data.Char (isAsciiLower, isAsciiUpper, isDigit)+import Data.Generics.Labels ()+import Data.List (sortOn)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import HurlWorkbench.Check.Template+import HurlWorkbench.Parameter.Generate (validateGenerator)+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context.Internal (ValidatedWorkspace (..), WorkspaceContext (..))+import HurlWorkbench.Workspace.Types+import Numeric.Natural (Natural)+import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, getPermissions)+import System.Directory qualified as Directory+import System.FilePath (isAbsolute, splitDirectories, takeExtension, (</>))++-- | One semantic problem, located by entity path such as+--   @workflows/list-properties@ or @matrices/by-mls/cases/west@.+data ValidationIssue = ValidationIssue+  { location :: !Text,+    message :: !Text+  }+  deriving stock (Generic, Eq, Show)++-- | @location: message@.+renderValidationIssue :: ValidationIssue -> Text+renderValidationIssue problem = problem ^. #location <> ": " <> problem ^. #message++-- | Validate every category and, on success, build the typed indexes.+validateWorkspace :: WorkspaceContext -> IO (Either (NonEmpty ValidationIssue) ValidatedWorkspace)+validateWorkspace ctx = do+  (fragmentIssues, fragmentFiles) <- validateFragments root ws+  (checkIssues, checkExecutables) <- validateChecks root ws+  serviceIssues <- validateServices root ws+  phaseIssues <- fmap concat $ for (ws ^. #suites) $ \suite -> fmap concat $ for [("setup", suite ^. #setup), ("teardown", suite ^. #teardown)] $ \(phase, commands) -> fmap concat $ for (zip [0 :: Int ..] commands) $ \(ordinal, command) -> commandIssues root ws (unSuiteName (suite ^. #name)) ("suites/" <> unSuiteName (suite ^. #name) <> "/" <> phase <> "/" <> tshow ordinal) command+  let issues =+        concat+          [ schemaIssues ws,+            ordered (validateParameters ws),+            ordered fragmentIssues,+            ordered (validateWorkflows ws),+            ordered (validateRecipes ws),+            ordered (validateMatrices ws),+            ordered checkIssues,+            ordered serviceIssues,+            ordered (validateSuites ws <> phaseIssues)+          ]+  pure $ case nonEmpty issues of+    Just problems -> Left problems+    Nothing ->+      Right+        ValidatedWorkspace+          { context = ctx,+            parameterIndex = indexBy (view #name) (ws ^. #parameters),+            fragmentIndex = indexBy (view #name) (ws ^. #fragments),+            fragmentFiles,+            workflowIndex = indexBy (view #name) (ws ^. #workflows),+            recipeIndex = indexBy (view #name) (ws ^. #recipes),+            matrixIndex = indexBy (view #name) (ws ^. #matrices),+            checkIndex = indexBy (view #name) (ws ^. #checks),+            checkExecutables,+            serviceIndex = indexBy (view #name) (ws ^. #services),+            suiteIndex = indexBy (view #name) (ws ^. #suites)+          }+  where+    ws = ctx ^. #workspace+    root = ctx ^. #workspaceRoot++-- | Issues tagged with the entity name used for ordering within a category.+type Tagged = [(Text, ValidationIssue)]++ordered :: Tagged -> [ValidationIssue]+ordered = map snd . sortOn fst++issue :: Text -> Text -> Text -> (Text, ValidationIssue)+issue key loc msg = (key, ValidationIssue {location = loc, message = msg})++-- | First declaration wins; duplicates are reported by validation.+indexBy :: (Ord k) => (a -> k) -> [a] -> Map k a+indexBy key = Map.fromListWith (\_new old -> old) . map (\a -> (key a, a))++schemaIssues :: Workspace -> [ValidationIssue]+schemaIssues ws =+  [ ValidationIssue+      { location = "schemaVersion",+        message =+          "unsupported schema version "+            <> tshow (ws ^. #schemaVersion)+            <> "; expected "+            <> tshow supportedSchemaVersion+      }+  | ws ^. #schemaVersion /= supportedSchemaVersion+  ]++--------------------------------------------------------------------------------+-- Names++-- | Fragment, workflow, recipe, matrix, matrix-case, service, and suite names+--   match @[A-Za-z][A-Za-z0-9._-]*@.+isValidEntityName :: Text -> Bool+isValidEntityName name = case Text.uncons name of+  Just (first, rest) -> isAsciiLetter first && Text.all (\c -> isAsciiLetter c || isDigit c || c `elem` ['.', '_', '-']) rest+  Nothing -> False++-- | Parameter names are Hurl-template-safe: @[A-Za-z_][A-Za-z0-9_-]*@ and not+--   one of 'reservedParameterNames'.+isValidParameterName :: Text -> Bool+isValidParameterName name =+  name `notElem` reservedParameterNames && case Text.uncons name of+    Just (first, rest) -> (isAsciiLetter first || first == '_') && Text.all (\c -> isAsciiLetter c || isDigit c || c `elem` ['_', '-']) rest+    Nothing -> False++-- | Hurl 8 template functions that cannot be shadowed by a variable.+reservedParameterNames :: [Text]+reservedParameterNames = ["getEnv", "newDate", "newUuid"]++-- | Environment variable names: @[A-Za-z_][A-Za-z0-9_]*@.+isValidEnvironmentName :: Text -> Bool+isValidEnvironmentName name = case Text.uncons name of+  Just (first, rest) -> (isAsciiLetter first || first == '_') && Text.all (\c -> isAsciiLetter c || isDigit c || c == '_') rest+  Nothing -> False++isAsciiLetter :: Char -> Bool+isAsciiLetter c = isAsciiLower c || isAsciiUpper c++-- | Check a name's syntax and uniqueness within one category.+nameIssues :: Text -> (Text -> Bool) -> Text -> [Text] -> Tagged+nameIssues category valid rule names =+  [ issue name (category <> "/" <> name) ("invalid " <> categoryLabel <> " name; names must match " <> rule)+  | name <- Set.toList (Set.fromList names),+    not (valid name)+  ]+    <> [ issue name (category <> "/" <> name) ("duplicate " <> categoryLabel <> " name declared " <> tshow count <> " times")+       | (name, count) <- Map.toList (Map.fromListWith (+) [(name, 1 :: Int) | name <- names]),+         count > 1+       ]+  where+    categoryLabel = case category of+      "parameters" -> "parameter"+      "fragments" -> "fragment"+      "workflows" -> "workflow"+      "recipes" -> "recipe"+      "matrices" -> "matrix"+      "services" -> "service"+      "suites" -> "suite"+      "cases" -> "matrix case"+      other -> other++entityNameRule :: Text+entityNameRule = "[A-Za-z][A-Za-z0-9._-]*"++--------------------------------------------------------------------------------+-- Parameters++validateParameters :: Workspace -> Tagged+validateParameters ws =+  nameIssues+    "parameters"+    isValidParameterName+    "[A-Za-z_][A-Za-z0-9_-]* and must not be getEnv, newDate, or newUuid"+    (map (unParameterName . view #name) (ws ^. #parameters))+    <> concatMap parameterIssues (ws ^. #parameters)+  where+    parameterIssues p =+      let name = unParameterName (p ^. #name)+          loc = "parameters/" <> name+       in [ issue name loc "secret parameters must not have a committed defaultValue"+          | p ^. #kind == Secret,+            isJust (p ^. #defaultValue)+          ]+            <> [issue name loc "generated parameters must not have a committed defaultValue" | Generated _ <- [p ^. #kind], isJust (p ^. #defaultValue)]+            <> [issue name loc problem | Generated generator <- [p ^. #kind], Left problem <- [validateGenerator generator]]+            <> [ issue name (loc <> "/defaultValue") (renderHurlValueLiteralError err)+               | Just value <- [p ^. #defaultValue],+                 Left err <- [literalCheck value]+               ]+            <> [ issue name (loc <> "/environment") ("invalid environment variable name " <> quote env)+               | Just env <- [p ^. #environment],+                 not (isValidEnvironmentName env)+               ]++literalCheck :: HurlValueLiteral -> Either HurlValueLiteralError HurlValueLiteral+literalCheck = mkHurlValueLiteral . hurlValueLiteralText++--------------------------------------------------------------------------------+-- Fragments++validateFragments :: WorkspaceRoot -> Workspace -> IO (Tagged, Map FragmentName FilePath)+validateFragments root ws = do+  checked <- for (ws ^. #fragments) $ \fragment -> do+    let name = unFragmentName (fragment ^. #name)+        loc = "fragments/" <> name <> "/path"+    result <- checkContainedPath root (fragment ^. #path) FileEntry+    pure $ case result of+      Left problem -> ([issue name loc problem], Nothing)+      Right canonical+        | takeExtension (fragment ^. #path) /= ".hurl" ->+            ([issue name loc ("fragment path " <> quote (Text.pack (fragment ^. #path)) <> " must end in .hurl")], Nothing)+        | otherwise -> ([], Just (fragment ^. #name, canonical))+  let names = map (unFragmentName . view #name) (ws ^. #fragments)+      files = Map.fromListWith (\_new old -> old) (catMaybes (map snd checked))+  pure (nameIssues "fragments" isValidEntityName entityNameRule names <> concatMap fst checked, files)++data EntryKind = FileEntry | DirectoryEntry+  deriving stock (Eq, Show)++-- | A relative path that canonicalizes inside the root and exists with the+--   expected kind. Symlinks are followed before the containment check, so a+--   link pointing outside the root is rejected.+checkContainedPath :: WorkspaceRoot -> FilePath -> EntryKind -> IO (Either Text FilePath)+checkContainedPath (WorkspaceRoot root) relative entryKind+  | null relative = pure (Left "path must not be empty")+  | isAbsolute relative = pure (Left ("path " <> shown <> " must be relative to the workspace root"))+  | otherwise = do+      canonical <- canonicalizePath (root </> relative)+      if not (splitDirectories root `isPrefixOfList` splitDirectories canonical)+        then pure (Left ("path " <> shown <> " escapes the workspace root"))+        else do+          exists <- case entryKind of+            FileEntry -> doesFileExist canonical+            DirectoryEntry -> doesDirectoryExist canonical+          pure $+            if exists+              then Right canonical+              else Left ("path " <> shown <> " does not exist as a " <> kindName)+  where+    shown = quote (Text.pack relative)+    kindName = case entryKind of+      FileEntry -> "regular file"+      DirectoryEntry -> "directory"++isPrefixOfList :: (Eq a) => [a] -> [a] -> Bool+isPrefixOfList prefix xs = take (length prefix) xs == prefix++--------------------------------------------------------------------------------+-- Workflows++validateWorkflows :: Workspace -> Tagged+validateWorkflows ws =+  nameIssues "workflows" isValidEntityName entityNameRule (map (unWorkflowName . view #name) (ws ^. #workflows))+    <> concatMap workflowIssues (ws ^. #workflows)+  where+    fragmentNames = Set.fromList (map (view #name) (ws ^. #fragments))+    parameterNames = Set.fromList (map (view #name) (ws ^. #parameters))+    workflowIssues w =+      let name = unWorkflowName (w ^. #name)+          loc = "workflows/" <> name+       in [issue name (loc <> "/fragments") "workflow must list at least one fragment" | null (w ^. #fragments)]+            <> [ issue name (loc <> "/fragments") ("unknown fragment " <> quote (unFragmentName f))+               | f <- w ^. #fragments,+                 f `Set.notMember` fragmentNames+               ]+            <> [ issue name (loc <> "/parameters") ("unknown parameter " <> quote (unParameterName p))+               | p <- w ^. #parameters,+                 p `Set.notMember` parameterNames+               ]+            <> [ issue name (loc <> "/parameters") ("parameter " <> quote (unParameterName p) <> " is listed more than once")+               | p <- duplicates (w ^. #parameters)+               ]++--------------------------------------------------------------------------------+-- Bindings, recipes, and matrices++-- | Check one binding set against the parameters declared by a workflow.+bindingIssues :: Workspace -> Maybe Workflow -> Text -> Text -> [Binding] -> Tagged+bindingIssues ws selected key loc bindings =+  [ issue key (loc <> "/bindings") ("parameter " <> quote (unParameterName p) <> " is bound more than once")+  | p <- duplicates (map (view #parameter) bindings)+  ]+    <> concatMap one bindings+  where+    parametersByName = indexBy (view #name) (ws ^. #parameters)+    one b =+      let pname = b ^. #parameter+          bloc = loc <> "/bindings/" <> unParameterName pname+          declared = case selected of+            -- An unresolved workflow is reported where it is referenced.+            Nothing -> True+            Just w -> pname `elem` w ^. #parameters+       in [ issue key bloc ("parameter is not declared by workflow " <> quote (maybe "" (unWorkflowName . view #name) selected))+          | not declared,+            Map.member pname parametersByName+          ]+            <> [ issue key bloc "secret parameters cannot be bound to committed values"+               | Just p <- [Map.lookup pname parametersByName],+                 p ^. #kind == Secret+               ]+            <> [issue key bloc "generated parameters cannot be bound to committed values" | Just p <- [Map.lookup pname parametersByName], Generated _ <- [p ^. #kind]]+            <> [ issue key bloc "unknown parameter"+               | Map.notMember pname parametersByName+               ]+            <> [ issue key bloc (renderHurlValueLiteralError err)+               | Left err <- [literalCheck (b ^. #value)]+               ]++validateRecipes :: Workspace -> Tagged+validateRecipes ws =+  nameIssues "recipes" isValidEntityName entityNameRule (map (unRecipeName . view #name) (ws ^. #recipes))+    <> concatMap recipeIssues (ws ^. #recipes)+  where+    workflowsByName = indexBy (view #name) (ws ^. #workflows)+    recipeIssues r =+      let name = unRecipeName (r ^. #name)+          loc = "recipes/" <> name+          selected = Map.lookup (r ^. #workflow) workflowsByName+       in [ issue name (loc <> "/workflow") ("unknown workflow " <> quote (unWorkflowName (r ^. #workflow)))+          | isNothing selected+          ]+            <> bindingIssues ws selected name loc (r ^. #bindings)++validateMatrices :: Workspace -> Tagged+validateMatrices ws =+  nameIssues "matrices" isValidEntityName entityNameRule (map (unMatrixName . view #name) (ws ^. #matrices))+    <> concatMap matrixIssues (ws ^. #matrices)+  where+    recipesByName = indexBy (view #name) (ws ^. #recipes)+    workflowsByName = indexBy (view #name) (ws ^. #workflows)+    matrixIssues m =+      let name = unMatrixName (m ^. #name)+          loc = "matrices/" <> name+          recipe = Map.lookup (m ^. #recipe) recipesByName+          selected = recipe >>= \r -> Map.lookup (r ^. #workflow) workflowsByName+          caseNames = map (unMatrixCaseName . view #name) (m ^. #cases)+       in [ issue name (loc <> "/recipe") ("unknown recipe " <> quote (unRecipeName (m ^. #recipe)))+          | isNothing recipe+          ]+            <> [issue name (loc <> "/cases") "matrix must have at least one case" | null (m ^. #cases)]+            <> map (\(_, i) -> (name, i & #location %~ ((loc <> "/") <>))) (nameIssues "cases" isValidEntityName entityNameRule caseNames)+            <> concat+              [ bindingIssues ws selected name (loc <> "/cases/" <> unMatrixCaseName (c ^. #name)) (c ^. #bindings)+              | c <- m ^. #cases+              ]++--------------------------------------------------------------------------------+-- Checks++validateChecks :: WorkspaceRoot -> Workspace -> IO (Tagged, Map CheckName FilePath)+validateChecks root ws = do+  checked <- for (ws ^. #checks) $ \check -> do+    let name = unCheckName (check ^. #name)+        loc = "checks/" <> name+        spec = check ^. #command+        relative = Text.unpack (spec ^. #executable)+    common <- commandIssues root ws name (loc <> "/command") spec+    inspected <-+      try @IOException $+        if Text.any (== '\0') (spec ^. #executable)+          then pure (Left "executable path must not contain NUL")+          else+            if ".." `elem` splitDirectories relative+              then pure (Left "executable path must not contain parent traversal")+              else checkContainedPath root relative FileEntry+    let target = either (const (Left "could not inspect check executable")) id inspected+    executableResult <- case target of+      Left problem -> pure (Left problem)+      Right path -> do+        permissions <- getPermissions path+        pure (if Directory.executable permissions then Right path else Left "check file must be executable")+    let problems =+          common+            <> [issue name (loc <> "/command/executable") problem | Left problem <- [executableResult]]+            <> [issue name (loc <> "/expectedStatus") "expected status must be between 0 and 255" | check ^. #expectedStatus > 255]+            <> maybe [] (positive name (loc <> "/timeoutSeconds")) (check ^. #timeoutSeconds)+            <> concat [argumentIssues name (loc <> "/command/arguments/" <> tshow ordinal) arg | (ordinal, arg) <- zip [0 :: Int ..] (spec ^. #arguments)]+    pure (problems, (check ^. #name,) <$> either (const Nothing) Just executableResult)+  pure (nameIssues "checks" isValidEntityName entityNameRule (map (unCheckName . view #name) (ws ^. #checks)) <> concatMap fst checked, Map.fromList (mapMaybe snd checked))+  where+    argumentIssues key loc arg = case parseTemplate arg of+      Left problem -> [issue key loc problem]+      Right templateParts ->+        concat+          [ case filter ((== name) . view #name) (ws ^. #parameters) of+              [] -> [issue key loc ("unknown parameter " <> quote (unParameterName name))]+              parameter : _ -> [issue key loc "only Plain parameters may appear in check arguments" | parameter ^. #kind /= Plain]+          | Placeholder name <- templateParts+          ]++--------------------------------------------------------------------------------+-- Services++validateServices :: WorkspaceRoot -> Workspace -> IO Tagged+validateServices root ws = do+  perService <- for (ws ^. #services) $ \s -> do+    let name = unServiceName (s ^. #name)+        loc = "services/" <> name+    commandProblems <- commandIssues root ws name (loc <> "/command") (s ^. #command)+    readinessProblems <- case s ^. #readiness of+      HttpReadinessCheck http ->+        pure $+          [issue name (loc <> "/readiness/url") "readiness URL must not be empty" | Text.null (Text.strip (http ^. #url))]+            <> [ issue name (loc <> "/readiness/expectedStatus") "expected HTTP status must be between 100 and 599"+               | http ^. #expectedStatus < 100 || http ^. #expectedStatus > 599+               ]+            <> [issue name (loc <> "/readiness/url") "generated parameters cannot be used in readiness URLs" | p <- ws ^. #parameters, Generated _ <- [p ^. #kind], ("{{" <> unParameterName (p ^. #name) <> "}}") `Text.isInfixOf` (http ^. #url)]+            <> positive name (loc <> "/readiness/intervalMilliseconds") (http ^. #intervalMilliseconds)+            <> positive name (loc <> "/readiness/timeoutSeconds") (http ^. #timeoutSeconds)+      CommandReadinessCheck check -> do+        problems <- commandIssues root ws name (loc <> "/readiness/command") (check ^. #command)+        pure $+          problems+            <> positive name (loc <> "/readiness/intervalMilliseconds") (check ^. #intervalMilliseconds)+            <> positive name (loc <> "/readiness/timeoutSeconds") (check ^. #timeoutSeconds)+    pure (commandProblems <> readinessProblems <> positive name (loc <> "/shutdownTimeoutSeconds") (s ^. #shutdownTimeoutSeconds))+  pure (nameIssues "services" isValidEntityName entityNameRule (map (unServiceName . view #name) (ws ^. #services)) <> concat perService)++positive :: Text -> Text -> Natural -> Tagged+positive key loc n = [issue key loc "must be greater than zero" | n == 0] <> [issue key loc "exceeds supported timer range" | n > fromIntegral (maxBound @Int `div` 1000000)]++commandIssues :: WorkspaceRoot -> Workspace -> Text -> Text -> CommandSpec -> IO Tagged+commandIssues root ws key loc spec = do+  workingDirectoryProblems <- case spec ^. #workingDirectory of+    Nothing -> pure []+    Just dir -> do+      result <- checkContainedPath root dir DirectoryEntry+      pure [issue key (loc <> "/workingDirectory") problem | Left problem <- [result]]+  pure $+    [issue key (loc <> "/executable") "executable must not be empty" | Text.null (Text.strip (spec ^. #executable))]+      <> [issue key loc "process arguments must not contain NUL" | any (Text.any (== '\0')) (spec ^. #executable : spec ^. #arguments)]+      <> [issue key loc "generated parameters cannot be used by suite-scoped commands" | b <- spec ^. #environment, p <- ws ^. #parameters, p ^. #name == b ^. #parameter, Generated _ <- [p ^. #kind]]+      <> policyProblems+      <> workingDirectoryProblems+      <> [ issue key (loc <> "/environment") ("environment variable " <> quote v <> " is bound more than once")+         | v <- duplicates (map (view #variable) (spec ^. #environment))+         ]+      <> concat+        [ [ issue key (loc <> "/environment/" <> b ^. #variable) "invalid environment variable name"+          | not (isValidEnvironmentName (b ^. #variable))+          ]+            <> [ issue key (loc <> "/environment/" <> b ^. #variable) ("unknown parameter " <> quote (unParameterName (b ^. #parameter)))+               | (b ^. #parameter) `Set.notMember` parameterNames+               ]+        | b <- spec ^. #environment+        ]+  where+    policyProblems = case spec ^. #environmentPolicy of+      Inherit -> []+      Clean names ->+        [issue key (loc <> "/environmentPolicy") ("invalid inherited environment variable name " <> quote n) | n <- names, not (isValidEnvironmentName n)]+          <> [issue key (loc <> "/environmentPolicy") ("inherited environment variable " <> quote n <> " is selected more than once") | n <- duplicates names]+    parameterNames = Set.fromList (map (view #name) (ws ^. #parameters))++--------------------------------------------------------------------------------+-- Suites++validateSuites :: Workspace -> Tagged+validateSuites ws =+  nameIssues "suites" isValidEntityName entityNameRule (map (unSuiteName . view #name) (ws ^. #suites))+    <> concatMap suiteIssues (ws ^. #suites)+  where+    workflows = Set.fromList (map (view #name) (ws ^. #workflows))+    recipes = Set.fromList (map (view #name) (ws ^. #recipes))+    matrices = Set.fromList (map (view #name) (ws ^. #matrices))+    checks = Set.fromList (map (view #name) (ws ^. #checks))+    services = Set.fromList (map (view #name) (ws ^. #services))+    suiteIssues s =+      let name = unSuiteName (s ^. #name)+          loc = "suites/" <> name+       in [issue name (loc <> "/runs") "suite must have at least one run" | all (\case ServiceRun _ -> True; _ -> False) (s ^. #runs)]+            <> [issue name (loc <> "/service") "independent-state suites cannot declare a shared managed service" | s ^. #isolation == IndependentState, not (null (suiteServices s))]+            <> [issue name (loc <> "/services") "service and nonempty services cannot both be supplied" | isJust (s ^. #service), not (null (s ^. #services))]+            <> [issue name (loc <> "/services") ("duplicate service " <> quote (unServiceName svc)) | svc <- duplicates (suiteServices s)]+            <> [issue name (loc <> "/fileRootParameter") problem | Just parameter <- [s ^. #fileRootParameter], problem <- fileRootIssues parameter]+            <> positive name (loc <> "/commandTimeoutSeconds") (s ^. #commandTimeoutSeconds)+            <> positive name (loc <> "/cleanupTimeoutSeconds") (s ^. #cleanupTimeoutSeconds)+            <> [issue name (loc <> "/commandTimeoutSeconds") "timeout exceeds supported microsecond range" | s ^. #commandTimeoutSeconds > fromIntegral (maxBound @Int `div` 1000000)]+            <> [issue name (loc <> "/cleanupTimeoutSeconds") "timeout exceeds supported microsecond range" | s ^. #cleanupTimeoutSeconds > fromIntegral (maxBound @Int `div` 1000000)]+            <> map (issue name (loc <> "/runs")) (transitions (Set.fromList (suiteServices s)) (s ^. #runs))+            <> mapMaybe (fmap (issue name (loc <> "/runs")) . unresolvedRun) (s ^. #runs)+            <> [ issue name (loc <> "/service") ("unknown service " <> quote (unServiceName svc))+               | svc <- suiteServices s,+                 svc `Set.notMember` services+               ]+    fileRootIssues parameter =+      ["invalid parameter name" | not (isValidParameterName (unParameterName parameter))]+        <> case filter ((== parameter) . view #name) (ws ^. #parameters) of+          [] -> ["unknown file-root parameter " <> quote (unParameterName parameter)]+          definition : _ -> ["file-root parameter must be Plain" | definition ^. #kind /= Plain]+    transitions initial = go initial+      where+        go _ [] = []+        go running (ServiceRun step : remaining) =+          let (svc, requiresRunning, next) = case step of+                Stop n -> (n, True, Set.delete n running)+                Start n -> (n, False, Set.insert n running)+                Restart n -> (n, True, running)+              problems =+                ["lifecycle service does not belong to suite: " <> quote (unServiceName svc) | svc `Set.notMember` initial]+                  <> ["invalid lifecycle transition for " <> quote (unServiceName svc) | Set.member svc running /= requiresRunning]+           in problems <> go next remaining+        go running (_ : remaining) = go running remaining+    unresolvedRun = \case+      WorkflowRun w | w `Set.notMember` workflows -> Just ("unknown workflow " <> quote (unWorkflowName w))+      RecipeRun r | r `Set.notMember` recipes -> Just ("unknown recipe " <> quote (unRecipeName r))+      CheckRun c | c `Set.notMember` checks -> Just ("unknown check " <> quote (unCheckName c))+      MatrixRun m | m `Set.notMember` matrices -> Just ("unknown matrix " <> quote (unMatrixName m))+      _ -> Nothing++--------------------------------------------------------------------------------+-- Helpers++duplicates :: (Ord a) => [a] -> [a]+duplicates xs = [x | (x, count) <- Map.toList (Map.fromListWith (+) [(x, 1 :: Int) | x <- xs]), count > 1]++quote :: Text -> Text+quote t = "\"" <> t <> "\""++tshow :: (Show a) => a -> Text+tshow = Text.pack . show
+ test/HurlWorkbench/Check/RunTest.hs view
@@ -0,0 +1,253 @@+module HurlWorkbench.Check.RunTest (tests) where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (cancel, waitCatch, withAsync)+import Control.Exception (IOException, try)+import Data.Bits ((.&.))+import Data.ByteString qualified as Bytes+import Data.Generics.Labels ()+import Data.IORef+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Data.Time.Clock (diffUTCTime, getCurrentTime)+import Data.Version (makeVersion)+import HurlWorkbench.Check.Resolve+import HurlWorkbench.Check.Run+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Hurl.Run+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Run.Batch+import HurlWorkbench.Service.Resolve (ServiceError (..))+import HurlWorkbench.Suite.Resolve+import HurlWorkbench.Suite.Run+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Directory (canonicalizePath, createDirectoryIfMissing, createFileLink, doesFileExist, removeFile)+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (fileMode, getFileStatus, setFileMode)+import System.Posix.Signals (nullSignal, signalProcess)+import System.Timeout qualified as Timeout+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "executable checks"+    [ testCase "normal zero/nonzero matches, mismatch, private separate captures and redacted Show" $+        fixture $ \root workspace -> for_ [(0, 0, CheckPassed), (7, 7, CheckPassed), (0, 7, CheckMismatch), (7, 0, CheckMismatch)] $ \(expected, actual, outcome) -> do+          let directory = root </> show expected <> "-" <> show actual+          createDirectoryIfMissing True (directory </> "checks" </> "parity")+          check <- resolved workspace (definition [Text.pack (show actual)])+          result <- runCheck directory (check & #expectedStatus .~ expected)+          result ^. #outcome @?= outcome+          result ^. #actualStatus @?= Just actual+          result ^. #cleanupDiagnostics @?= []+          for_ ["stdout", "stderr"] $ \stream -> do+            let path = directory </> "checks" </> "parity" </> stream+            mode <- fileMode <$> getFileStatus path+            mode .&. 0o777 @?= 0o600+            content <- Bytes.readFile path+            assertBool "separate stream" ((if stream == "stdout" then "private-output" else "private-error") `Bytes.isInfixOf` content)+          assertBool "resolved command redacted" (not ("sensitive-argument" `Text.isInfixOf` Text.pack (show check))),+      testCase "signal termination never matches an expected normal exit" $+        fixture $ \root workspace -> do+          check <- resolved workspace (definition ["signal"] & #expectedStatus .~ 15)+          result <- runCheck root check+          result ^. #outcome @?= CheckSignalled+          result ^. #actualStatus @?= Just (-15)+          checkExitCode result @?= ExitFailure 143,+      testCase "timeout includes descendant cleanup and allows no live survivor" $+        fixture $ \root workspace -> do+          check <- resolved workspace (definition ["timeout"])+          began <- getCurrentTime+          result <- bounded (runCheck root (check & #timeout .~ 0.2))+          ended <- getCurrentTime+          result ^. #outcome @?= CheckTimedOut+          assertBool "bounded" (diffUTCTime ended began < 12)+          assertStopped root,+      testCase "normal leader exit still kills a TERM-ignoring descendant" $+        fixture $ \root workspace -> do+          check <- resolved workspace (definition ["orphan"])+          result <- bounded (runCheck root check)+          result ^. #outcome @?= CheckMismatch+          result ^. #actualStatus @?= Just 9+          assertStopped root,+      testCase "cancellation retains an observed cancelled outcome after cleanup" $+        fixture $ \root workspace -> do+          check <- resolved workspace (definition ["timeout"])+          observed <- newIORef Nothing+          withAsync (runCheckObserved root check (writeIORef observed . Just)) $ \worker -> do+            bounded (waitFor (root </> "child.pid"))+            bounded (cancel worker)+            waitCatch worker >>= \case Left _ -> pure (); Right _ -> assertFailure "cancel swallowed"+          result <- readIORef observed >>= maybe (assertFailure "no partial result") pure+          result ^. #outcome @?= CheckCancelled+          assertStopped root,+      testCase "cancellation during descendant cleanup still joins cleanup and observes cancellation" $+        fixture $ \root workspace -> do+          check <- resolved workspace (definition ["orphan"])+          observed <- newIORef Nothing+          withAsync (runCheckObserved root check (writeIORef observed . Just)) $ \worker -> do+            bounded (waitFor (root </> "child.pid"))+            -- The leader has exited; its descendant holds the TERM grace open.+            threadDelay 200000+            bounded (cancel worker)+            waitCatch worker >>= \case Left _ -> pure (); Right _ -> assertFailure "cancel swallowed"+          result <- readIORef observed >>= maybe (assertFailure "no cleanup observation") pure+          result ^. #outcome @?= CheckCancelled+          assertStopped root,+      testCase "spawn race and capture collision are distinct start failures" $+        fixture $ \root workspace -> do+          check <- resolved workspace (definition ["0"])+          removeFile (root </> "check.py")+          runCheck root check >>= (\result -> result ^. #outcome @?= CheckStartFailed)+          runCheck root check >>= (\result -> result ^. #outcome @?= CheckStartFailed),+      testCase "cleanup diagnostics do not replace a primary mismatch" $+        fixture $ \root workspace -> do+          check <- resolved workspace (definition ["7"])+          result <- runCheckObservedWith (const (pure (Left (ServicePhaseFailed "injected")))) root check (const (pure ()))+          result ^. #outcome @?= CheckMismatch+          result ^. #actualStatus @?= Just 7+          result ^. #cleanupDiagnostics @?= ["process-group-cleanup-failed"]+          checkExitCode result @?= ExitFailure 7,+      testCase "path, channel, name, status and timeout refusals are located and deterministic" $+        fixture $ \root workspace -> do+          createFileLink (root </> "check.py") (root </> "inside")+          withSystemTempDirectory "check-outside" $ \outside -> do+            writeFile (outside </> "outside") "outside"+            createFileLink (outside </> "outside") (root </> "escape")+            for_ ["", "\0", "/bin/sh", "../check.py", "checks", "missing", "escape"] $ \path -> reject workspace (definition [] & #command . #executable .~ path) "/command/executable"+            validateChanged workspace [definition [] & #command . #executable .~ "inside"] >>= either (assertFailure . show) (const (pure ()))+          setFileMode (root </> "check.py") 0o600+          reject workspace (definition []) "/command/executable"+          setFileMode (root </> "check.py") 0o700+          for_ ["{{secret}}", "{{generated}}", "{{unknown}}", "{{ plain }}", "{{plain", "{{}}", "x}}y{{plain}}"] $ \value -> reject workspace (definition [value]) "/command/arguments/0"+          reject workspace (definition [] & #expectedStatus .~ 256) "/expectedStatus"+          reject workspace (definition [] & #timeoutSeconds .~ Just 0) "/timeoutSeconds"+          reject workspace (definition [] & #timeoutSeconds .~ Just (10 ^ (30 :: Int))) "/timeoutSeconds"+          validateChanged workspace [definition [], definition []] >>= \case Left _ -> pure (); Right _ -> assertFailure "duplicate accepted",+      testCase "resolution preserves argv elements and suite-wide defaults without recipe bindings" $+        fixture $ \_ workspace -> do+          check <- resolved workspace (definition ["prefix={{plain}}", "sensitive-argument"])+          check ^. #processConfig . #arguments @?= ["prefix=one argument", "sensitive-argument"]+          assertBool "secret absent from argv" (not ("secret-sentinel" `Text.isInfixOf` Text.pack (show (check ^. #processConfig . #arguments)))),+      testCase "a check status 4 cannot masquerade as lifecycle failure when summary writing fails" $+        fixture $ \root workspace -> do+          changed <- validateChanged workspace [definition ["summary-error"]] >>= either (assertFailure . show) pure+          result <- runSuiteWith validate forbidden capabilities changed (suiteRequest root) >>= either (assertFailure . show) pure+          result ^. #selectedExitCode @?= ExitFailure 3+          assertBool "summary error retained" (isJust (result ^. #summaryError))+          [check ^. #actualStatus | CheckStep check <- result ^. #steps] @?= [Just 4],+      testCase "checks-only suites, late preflight, report requirement and duplicate occurrence refusal" $+        fixture $ \root workspace -> do+          let req = suiteRequest root+          result <- runSuiteWith validate forbidden capabilities workspace req >>= either (assertFailure . show) pure+          result ^. #cases @?= []+          result ^. #selectedExitCode @?= ExitSuccess+          [checkStatus check | CheckStep check <- result ^. #steps] @?= ["passed"]+          for_+            [ req & #suiteOptions . #reportDirectory .~ Nothing,+              req & #suiteOptions . #overwriteReports .~ False+            ]+            $ \bad ->+              prepareSuiteWith validate capabilities workspace bad >>= \case Left _ -> pure (); Right _ -> assertFailure "report refusal missing"+          let ctx = validatedContext workspace+          late <- validateWorkspace (ctx & #workspace . #checks %~ map (\check -> check & #command . #environmentPolicy .~ Clean ["HURL_WORKBENCH_NO_CHECK_ENV_8765"])) >>= either (assertFailure . show) pure+          prepareSuiteWith validate capabilities late (req & #suiteOptions . #overwriteReports .~ True) >>= \case Left _ -> pure (); Right _ -> assertFailure "late environment accepted"+          duplicate <- validateWorkspace (ctx & #workspace . #suites %~ map (\suite -> suite & #runs .~ [CheckRun (CheckName "parity"), CheckRun (CheckName "parity")])) >>= either (assertFailure . show) pure+          prepareSuiteWith validate capabilities duplicate req >>= \case Left _ -> pure (); Right _ -> assertFailure "duplicate occurrence accepted"+    ]++fixture :: (FilePath -> ValidatedWorkspace -> IO a) -> IO a+fixture action = withSystemTempDirectory "executable-check" $ \directory -> do+  root <- canonicalizePath directory+  schema <- canonicalizePath "schema/package.dhall"+  Text.IO.writeFile (root </> "hurl-workbench.dhall") ("let S = " <> Text.pack schema <> " in S.Workspace::{ schemaVersion = 1, parameters = [ S.Parameter::{name = \"plain\", defaultValue = Some \"one argument\"}, S.Parameter::{name = \"secret\", kind = S.ParameterKind.Secret}, S.Parameter::{name = \"generated\", kind = S.ParameterKind.Generated S.Generator.Uuid4} ], checks = [ S.Check::{name = \"parity\", command = S.CommandSpec::{executable = \"check.py\", arguments = [\"0\"]}} ], suites = [S.Suite::{name = \"only\", runs = [S.RunReference.Check \"parity\"]}] }")+  Text.IO.writeFile (root </> "check.py") script+  setFileMode (root </> "check.py") 0o700+  createDirectoryIfMissing True (root </> "checks" </> "parity")+  ctx <- loadWorkspaceContext (ExplicitWorkspace (root </> "hurl-workbench.dhall")) >>= either (assertFailure . show) pure+  workspace <- validateWorkspace ctx >>= either (assertFailure . show) pure+  action root workspace++script :: Text+script =+  Text.unlines+    [ "#!/usr/bin/env python3",+      "import os, sys, time, signal",+      "mode = sys.argv[1] if len(sys.argv) > 1 else '0'",+      "if mode == 'summary-error': os.mkdir('reports/only/summary.json'); raise SystemExit(4)",+      "if mode == 'signal': os.kill(os.getpid(), signal.SIGTERM)",+      "print('private-output', flush=True); print('private-error', file=sys.stderr, flush=True)",+      "if mode in ('timeout', 'orphan'):",+      "    pid = os.fork()",+      "    if pid == 0:",+      "        signal.signal(signal.SIGTERM, signal.SIG_IGN)",+      "        open('child.pid','w').write(str(os.getpid()))",+      "        while True: time.sleep(0.01)",+      "    while not os.path.exists('child.pid'): time.sleep(0.005)",+      "    if mode == 'orphan': raise SystemExit(9)",+      "    while True: time.sleep(0.01)",+      "raise SystemExit(int(mode) if mode.isdigit() else 0)"+    ]++definition :: [Text] -> Check+definition arguments = Check (CheckName "parity") (CommandSpec "check.py" arguments Nothing Inherit []) 0 Nothing Nothing++resolved :: ValidatedWorkspace -> Check -> IO ResolvedCheck+resolved workspace check = do+  changed <- validateChanged workspace [check] >>= either (assertFailure . show) pure+  ambient <- getEnvironment+  prepareCheck ambient changed emptyBindingInput (CheckName "parity") >>= either (assertFailure . show) pure++validateChanged :: ValidatedWorkspace -> [Check] -> IO (Either (NonEmpty ValidationIssue) ValidatedWorkspace)+validateChanged workspace checks = validateWorkspace (validatedContext workspace & #workspace . #checks .~ checks)++reject :: ValidatedWorkspace -> Check -> Text -> IO ()+reject workspace check suffix = do+  first <- validateChanged workspace [check]+  second <- validateChanged workspace [check]+  first @?= second+  case first of+    Left issues -> assertBool "located refusal" (any (Text.isSuffixOf suffix . view #location) issues)+    Right _ -> assertFailure "invalid check accepted"++bounded :: IO a -> IO a+bounded action = Timeout.timeout 15000000 action >>= maybe (assertFailure "check exceeded bound") pure++waitFor :: FilePath -> IO ()+waitFor path = doesFileExist path >>= \exists -> unless exists (threadDelay 5000 >> waitFor path)++assertStopped :: FilePath -> IO ()+assertStopped root = do+  pid <- read <$> readFile (root </> "child.pid")+  -- Linux orphan zombies cannot execute; PID 1 is responsible for reaping them.+  let stopped = do+        present <- try @IOException (signalProcess nullSignal pid)+        case present of+          Left _ -> pure ()+          Right () -> do+            status <- try @IOException (readFile ("/proc/" <> show pid <> "/stat"))+            case status of+              Right value | ") Z" `Text.isInfixOf` Text.pack value -> pure ()+              _ -> threadDelay 10000 >> stopped+  bounded stopped++suiteRequest :: FilePath -> SuiteRequest+suiteRequest root = SuiteRequest (SuiteName "only") Nothing Nothing emptyBindingInput defaultHurlOptions (SuiteOptions (either (error . show) id (mkPositiveInt 2)) Nothing False True mempty (Just (root </> "reports")) False)++capabilities :: HurlfmtCapabilities+capabilities = HurlfmtCapabilities (HurlfmtExecutable "true") (makeVersion [8, 0, 1])++validate :: HurlfmtCapabilities -> a -> IO (Either HurlfmtError ())+validate _ _ = pure (Right ())++forbidden :: HurlRunner+forbidden = HurlRunner (const (assertFailure "checks-only suite started Hurl"))
+ test/HurlWorkbench/Hurl/RunTest.hs view
@@ -0,0 +1,308 @@+module HurlWorkbench.Hurl.RunTest (tests) where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (cancel, replicateConcurrently_, waitCatch, withAsync)+import Control.Exception (IOException, bracket, try)+import Control.Monad (replicateM_)+import Data.Bits ((.&.))+import Data.ByteString.Char8 qualified as ByteString.Char8+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Data.Version (Version, makeVersion)+import HurlWorkbench.Hurl.Capabilities+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Hurl.Run+import HurlWorkbench.Parameter.Generate+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Run.FileRoot+import HurlWorkbench.Workflow.Render+import HurlWorkbench.Workflow.Resolve+import HurlWorkbench.Workspace.Context (WorkspaceContext (..))+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate (renderValidationIssue, validateWorkspace)+import System.Directory+  ( canonicalizePath,+    doesDirectoryExist,+    doesFileExist,+    getPermissions,+    setOwnerExecutable,+    setPermissions,+  )+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (accessModes, fileMode, getFileStatus)+import System.Posix.Signals (nullSignal, signalProcess)+import System.Posix.Types (FileMode)+import System.Timeout qualified as Timeout+import Test.Tasty (TestTree, inOrderTestGroup, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests = testGroup "Hurl execution" [capabilityTests, inOrderTestGroup "runner" runnerTests]++capabilityTests :: TestTree+capabilityTests =+  testGroup+    "capabilities"+    [ testCase "parses Hurl 8 version output" $ do+        parseHurlVersion "hurl 8.0.1 libcurl/8.7.1" @?= Just (makeVersion [8, 0, 1])+        parseHurlVersion "not a version" @?= Nothing,+      testCase "warns for a later major without rejecting it" $+        assertBool "later-major warning" (not (null (hurlCapabilityWarnings (capabilities "hurl" (makeVersion [9, 0, 0])))))+    ]++runnerTests :: [TestTree]+runnerTests =+  [ testCase "argv uses the explicit canonical body root independently of source root" $+      withSystemTempDirectory "hurl-file-root-source" $ \directory ->+        withSystemTempDirectory "hurl-file-root-body" $ \body -> do+          executable <- writeFakeHurl directory+          rendered <- renderedFixture directory+          root <- validateFileRoot body (Just body) >>= either (assertFailure . show) pure+          let logPath = directory </> "explicit"+          withEnvironment [("FAKE_HURL_LOG", logPath), ("FAKE_EXIT_CODE", "0")] $+            runHurl (mkHurlRunner (capabilities executable (makeVersion [8, 0, 1]))) (baseRequest root rendered) >>= either (assertFailure . show) (const (pure ()))+          arguments <- Text.lines <$> Text.IO.readFile (logPath <> ".args")+          assertBool "canonical body root reaches argv" (hasPair "--file-root" (Text.pack (fileRootPath root)) arguments),+    testCase "short-lived parallel children retain their real exit statuses" $+      withSystemTempDirectory "hurl-fast-exit" $ \dir -> do+        let executable = dir </> "instant-hurl"+        writeFile executable "#!/bin/sh\nexit 7\n"+        permissions <- getPermissions executable+        setPermissions executable (setOwnerExecutable True permissions)+        rendered <- renderedFixture dir+        root <- validateFileRoot dir Nothing >>= either (assertFailure . show) pure+        replicateConcurrently_ 4 $+          replicateM_ 12 $+            runHurl (mkHurlRunner (capabilities executable (makeVersion [8, 0, 1]))) (baseRequest root rendered) >>= \case+              Right result -> result ^. #exitCode @?= ExitFailure 7+              Left err -> assertFailure (Text.unpack (renderRunStartError err)),+    testCase "cancellation of a live captured Hurl process is bounded and reaps its group" $+      withSystemTempDirectory "hurl-cancel-capture" $ \dir -> do+        let executable = dir </> "blocked-hurl"+            marker = dir </> "running"+        writeFile executable ("#!/usr/bin/env python3\nimport os, sys, time\nsys.stdout.write('private stdout\\n'); sys.stdout.flush()\nsys.stderr.write('private stderr\\n'); sys.stderr.flush()\nopen(" <> show marker <> ", 'w').write(str(os.getpid()))\ntime.sleep(60)\n")+        permissions <- getPermissions executable+        setPermissions executable (setOwnerExecutable True permissions)+        rendered <- renderedFixture dir+        root <- validateFileRoot dir Nothing >>= either (assertFailure . show) pure+        let waitStarted = doesFileExist marker >>= \ready -> unless ready (threadDelay 10000 >> waitStarted)+        withAsync (runHurl (mkHurlRunner (capabilities executable (makeVersion [8, 0, 1]))) (baseRequest root rendered)) $ \worker -> do+          Timeout.timeout 3000000 waitStarted >>= maybe (assertFailure "Hurl did not start") pure+          Timeout.timeout 4000000 (cancel worker) >>= maybe (assertFailure "capture cleanup blocked on a live pipe") pure+          waitCatch worker >>= \case Left _ -> pure (); Right _ -> assertFailure "cancelled Hurl returned normally"+        pid <- read <$> readFile marker+        alive <- try @IOException (signalProcess nullSignal pid)+        assertBool "Hurl was reaped" (either (const True) (const False) alive),+    testCase "constructs secure argv, filters HURL environment, captures output, and cleans temporary files" $+      withSystemTempDirectory "hurl-workbench-run-test" $ \dir -> do+        executable <- writeFakeHurl dir+        rendered <- renderedFixture dir+        root <- validateFileRoot dir Nothing >>= either (assertFailure . show) pure+        secret <- requireSecret "super-secret-fixture"+        generated <- generateValue defaultGeneratorEnvironment (TypeId (TypeIdOptions "rcp")) >>= either (assertFailure . Text.unpack) pure+        let runLog = dir </> "fake"+            request =+              (baseRequest root rendered)+                { bindings =+                    ResolvedBindings+                      { variables = Map.fromList [(ParameterName "base_url", literal "http://127.0.0.1"), (ParameterName "recipientId", generated)],+                        secrets = Map.singleton (ParameterName "token") secret+                      },+                  mode = TestMode+                }+        withEnvironment+          [ ("FAKE_HURL_LOG", runLog),+            ("FAKE_EXIT_CODE", "23"),+            ("HURL_TEST", "1"),+            ("HURL_OUTPUT", dir </> "hostile-output"),+            ("HURL_SECRET_TOKEN", "ambient-secret")+          ]+          $ runHurl (mkHurlRunner (capabilities executable (makeVersion [8, 0, 1]))) request+            >>= \case+              Left err -> assertFailure (Text.unpack (renderRunStartError err))+              Right result -> do+                result ^. #exitCode @?= ExitFailure 23+                result ^. #capturedOutput+                  @?= Just (CapturedRunOutput "fake stdout\n" "fake stderr\n")+        arguments <- Text.lines <$> Text.IO.readFile (runLog <> ".args")+        assertBool "test mode" ("--test" `elem` arguments)+        assertBool "file root" (hasPair "--file-root" (Text.pack dir) arguments)+        assertBool "variables file" ("--variables-file" `elem` arguments)+        assertBool "secrets file" ("--secrets-file" `elem` arguments)+        assertBool "secret absent from argv" (not (any (Text.isInfixOf "super-secret-fixture") arguments))+        delivered <- Text.IO.readFile (runLog <> ".variables")+        assertBool "generated literal delivered unchanged" (("recipientId=" <> hurlValueLiteralText generated) `Text.isInfixOf` delivered)+        hurlEnvironment <- Text.IO.readFile (runLog <> ".hurl-env")+        hurlEnvironment @?= ""+        modes <- Text.lines <$> Text.IO.readFile (runLog <> ".modes")+        assertBool "all generated files were 0600" (not (null modes) && all (Text.isSuffixOf " 600") modes)+        let generatedPaths = map (Text.unpack . fst . Text.breakOn " ") modes+        remains <- traverse doesFileExist generatedPaths+        assertBool "temporary files removed" (not (or remains)),+    testCase "prepares response and report targets with owner-only permissions" $+      withSystemTempDirectory "hurl-workbench-target-test" $ \dir -> do+        executable <- writeFakeHurl dir+        rendered <- renderedFixture dir+        root <- validateFileRoot dir Nothing >>= either (assertFailure . show) pure+        let runLog = dir </> "fake"+            response = dir </> "response.txt"+            junit = dir </> "junit.xml"+            html = dir </> "html-report"+            json = dir </> "json-report"+            tap = dir </> "report.tap"+            curl = dir </> "requests.sh"+            request =+              (baseRequest root rendered)+                { outputPolicy = ResponseFile response,+                  reportTargets = [JUnitReport junit, HtmlReport html, JsonReport json, TapReport tap],+                  options = defaultHurlOptions {curlExportPath = Just curl}+                }+        withEnvironment [("FAKE_HURL_LOG", runLog), ("FAKE_EXIT_CODE", "0")] $+          runHurl (mkHurlRunner (capabilities executable (makeVersion [8, 0, 1]))) request+            >>= either (assertFailure . Text.unpack . renderRunStartError) (const (pure ()))+        ByteString.Char8.readFile response >>= (@?= "fake response\n")+        filePermissions response >>= (@?= 0o600)+        filePermissions junit >>= (@?= 0o600)+        filePermissions tap >>= (@?= 0o600)+        filePermissions curl >>= (@?= 0o600)+        directoryPermissions html >>= (@?= 0o700)+        directoryPermissions json >>= (@?= 0o700)+        ByteString.Char8.readFile junit >>= (@?= "<?xml version=\"1.0\"?>\n<testsuites/>\n")+        ByteString.Char8.readFile tap >>= (@?= "TAP version 13\n1..0\n")+        arguments <- Text.lines <$> Text.IO.readFile (runLog <> ".args")+        assertBool "client mode omits --test" ("--test" `notElem` arguments)+        assertBool "output flag" (hasPair "--output" (Text.pack response) arguments)+        assertBool "JUnit flag" (hasPair "--report-junit" (Text.pack junit) arguments)+        assertBool "HTML flag" (hasPair "--report-html" (Text.pack html) arguments)+        assertBool "JSON flag" (hasPair "--report-json" (Text.pack json) arguments)+        assertBool "TAP flag" (hasPair "--report-tap" (Text.pack tap) arguments)+        assertBool "curl flag" (hasPair "--curl" (Text.pack curl) arguments),+    testCase "inherits streams only for the interactive policy" $+      withSystemTempDirectory "hurl-workbench-inherit-test" $ \dir -> do+        executable <- writeFakeHurl dir+        rendered <- renderedFixture dir+        root <- validateFileRoot dir Nothing >>= either (assertFailure . show) pure+        let runLog = dir </> "fake"+            request = (baseRequest root rendered) {outputPolicy = InheritRunOutput}+        withEnvironment [("FAKE_HURL_LOG", runLog), ("FAKE_EXIT_CODE", "7"), ("FAKE_QUIET", "1")] $+          runHurl (mkHurlRunner (capabilities executable (makeVersion [8, 0, 1]))) request+            >>= \case+              Left err -> assertFailure (Text.unpack (renderRunStartError err))+              Right result -> do+                result ^. #exitCode @?= ExitFailure 7+                result ^. #capturedOutput @?= Nothing,+    testCase "represents a spawn failure separately from a child exit" $+      withSystemTempDirectory "hurl-workbench-spawn-test" $ \dir -> do+        rendered <- renderedFixture dir+        root <- validateFileRoot dir Nothing >>= either (assertFailure . show) pure+        runHurl (mkHurlRunner (capabilities (dir </> "missing-hurl") (makeVersion [8, 0, 1]))) (baseRequest root rendered)+          >>= \case+            Left HurlSpawnFailed {} -> pure ()+            other -> assertFailure ("expected HurlSpawnFailed, got " <> show other),+    testCase "rejects dangerous passthrough arguments and duplicate report formats before spawn" $+      withSystemTempDirectory "hurl-workbench-options-test" $ \dir -> do+        mkAllowedHurlArgument "--secret=value" @?= Left (UnsupportedHurlArgument "--secret=value")+        mkAllowedHurlArgument "--test" @?= Left (UnsupportedHurlArgument "--test")+        rendered <- renderedFixture dir+        root <- validateFileRoot dir Nothing >>= either (assertFailure . show) pure+        let request = (baseRequest root rendered) {reportTargets = [JUnitReport "one.xml", JUnitReport "two.xml"]}+        runHurl (mkHurlRunner (capabilities (dir </> "must-not-start") (makeVersion [8, 0, 1]))) request+          >>= \case+            Left (InvalidRunOptions issues) ->+              assertBool "duplicate format" (DuplicateReportFormat "JUnit" `elem` toList issues)+            other -> assertFailure ("expected option rejection, got " <> show other)+  ]++baseRequest :: FileRoot -> RenderedWorkflow -> RunRequest+baseRequest root rendered =+  RunRequest+    { renderedWorkflow = rendered,+      fileRoot = root,+      mode = ClientMode,+      bindings = ResolvedBindings Map.empty Map.empty,+      options = defaultHurlOptions,+      outputPolicy = CaptureRunOutput,+      reportTargets = []+    }++capabilities :: FilePath -> Version -> HurlCapabilities+capabilities executable version =+  HurlCapabilities+    executable+    version+    (HurlfmtCapabilities (HurlfmtExecutable "unused-hurlfmt") (makeVersion [8, 0, 1]))++renderedFixture :: FilePath -> IO RenderedWorkflow+renderedFixture directory = do+  canonicalRoot <- canonicalizePath directory+  let fragmentPath = canonicalRoot </> "request.hurl"+      fragment = Fragment (FragmentName "request") "request.hurl" Nothing+      workflow = Workflow (WorkflowName "request") [FragmentName "request"] [] Nothing+      workspace = Workspace supportedSchemaVersion [] [fragment] [workflow] [] [] [] [] []+      context = WorkspaceContext (canonicalRoot </> "hurl-workbench.dhall") (WorkspaceRoot canonicalRoot) workspace+  Text.IO.writeFile fragmentPath "GET http://127.0.0.1/health\n"+  validated <-+    validateWorkspace context+      >>= either (assertFailure . Text.unpack . Text.unlines . map renderValidationIssue . toList) pure+  resolved <- either (assertFailure . Text.unpack . renderWorkflowError) pure (resolveWorkflow validated (WorkflowName "request"))+  renderWorkflow resolved >>= either (assertFailure . Text.unpack . renderRenderError) pure++writeFakeHurl :: FilePath -> IO FilePath+writeFakeHurl directory = do+  let executable = directory </> "fake-hurl"+  Text.IO.writeFile+    executable+    ( Text.unlines+        [ "#!/bin/sh",+          "log=$FAKE_HURL_LOG",+          "printf '%s\\n' \"$@\" > \"$log.args\"",+          "env | grep '^HURL_' > \"$log.hurl-env\" || true",+          ": > \"$log.modes\"",+          "mode_of() { if stat -f '%Lp' \"$1\" >/dev/null 2>&1; then stat -f '%Lp' \"$1\"; else stat -c '%a' \"$1\"; fi; }",+          "for arg in \"$@\"; do",+          "  case \"$arg\" in *.hurl|*.env) printf '%s %s\\n' \"$arg\" \"$(mode_of \"$arg\")\" >> \"$log.modes\" ;; esac",+          "done",+          "previous=''",+          "for arg in \"$@\"; do",+          "  if [ \"$previous\" = '--output' ]; then printf 'fake response\\n' > \"$arg\"; fi",+          "  if [ \"$previous\" = '--variables-file' ]; then cat \"$arg\" > \"$log.variables\"; fi",+          "  previous=$arg",+          "done",+          "if [ \"${FAKE_QUIET:-0}\" != '1' ]; then printf 'fake stdout\\n'; printf 'fake stderr\\n' >&2; fi",+          "exit \"${FAKE_EXIT_CODE:-0}\""+        ]+    )+  permissions <- getPermissions executable+  setPermissions executable (setOwnerExecutable True permissions)+  pure executable++literal :: Text -> HurlValueLiteral+literal value = either (error . show) id (mkHurlValueLiteral value)++requireSecret :: Text -> IO SecretValue+requireSecret value = either (assertFailure . show) pure (mkSecretValue value)++hasPair :: Text -> Text -> [Text] -> Bool+hasPair first second values = any (== [first, second]) (zipWith (\a b -> [a, b]) values (drop 1 values))++filePermissions :: FilePath -> IO FileMode+filePermissions path = (.&. accessModes) . fileMode <$> getFileStatus path++directoryPermissions :: FilePath -> IO FileMode+directoryPermissions path = do+  exists <- doesDirectoryExist path+  unless exists (assertFailure ("missing directory " <> path))+  filePermissions path++withEnvironment :: [(String, String)] -> IO a -> IO a+withEnvironment values action = bracket save restore (const applyAndRun)+  where+    save = traverse (\(name, _value) -> (name,) <$> lookupEnv name) values+    restore previous = for_ previous $ \(name, old) -> maybe (unsetEnv name) (setEnv name) old+    applyAndRun = traverse_ (uncurry setEnv) values >> action
+ test/HurlWorkbench/Parameter/GenerateTest.hs view
@@ -0,0 +1,129 @@+module HurlWorkbench.Parameter.GenerateTest (tests) where++import Control.Exception (AsyncException (ThreadKilled), throwIO, try)+import Data.Bits ((.&.))+import Data.ByteString qualified as BS+import Data.Generics.Labels ()+import Data.IORef+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Version (makeVersion)+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Hurl.Run (defaultHurlOptions)+import HurlWorkbench.Parameter.Generate+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Run.Prepare+import HurlWorkbench.Run.Selection+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit++fixed :: GeneratorEnvironment+fixed = GeneratorEnvironment (pure (posixSecondsToUTCTime 1645557742.123)) (\n -> pure (BS.replicate n 255))++textValue :: Either Text HurlValueLiteral -> Either Text Text+textValue = fmap hurlValueLiteralText++tests :: TestTree+tests =+  testGroup+    "generated parameters"+    [ testCase "RFC UUID4 and UUID7 layouts use independent expected bytes" $ do+        fmap formatUuid (uuid4Bytes (replicate 16 255)) @?= Right "ffffffff-ffff-4fff-bfff-ffffffffffff"+        let expected = [1, 127, 34, 226, 121, 171, 127, 255, 191, 255, 255, 255, 255, 255, 255, 255]+        uuid7Bytes 1645557741995 (replicate 16 255) @?= Right expected+        uuid7Bytes (-1) (replicate 16 0) @?= Left "UUID7 timestamp outside 48-bit range"+        assertBool "overflow rejected" (isLeft (uuid7Bytes (2 ^ (48 :: Int)) (replicate 16 0))),+      testCase "TypeID big endian vector and leading zero bits" $ do+        encodeTypeId (replicate 16 255) @?= "7zzzzzzzzzzzzzzzzzzzzzzzzz"+        encodeTypeId (replicate 16 0) @?= Text.replicate 26 "0"+        result <- generateValue fixed (TypeId (TypeIdOptions "rcp"))+        case textValue result of+          Right value -> do+            let alphabet = "0123456789abcdefghjkmnpqrstvwxyz"+                number = foldl (\acc c -> acc * 32 + fromIntegral (fromMaybe (-100) (Text.findIndex (== c) alphabet))) (0 :: Integer) (Text.unpack (Text.drop 4 value))+            (number `div` (2 ^ (76 :: Int))) .&. 15 @?= 7+            (number `div` (2 ^ (62 :: Int))) .&. 3 @?= 2+          Left err -> assertFailure (Text.unpack err),+      testCase "prefix and length constraints" $ do+        for_ ["", "a", Text.replicate 63 "a", "a__z"] $ \p -> validateGenerator (TypeId (TypeIdOptions p)) @?= Right ()+        for_ ["_a", "a_", "A", "a1", Text.replicate 64 "a"] $ \p -> assertBool "bad prefix" (isLeft (validateGenerator (TypeId (TypeIdOptions p))))+        for_ [0, 4097] $ \n -> assertBool "bad length" (isLeft (validateGenerator (RandomAlphanumeric (RandomOptions n)))),+      testCase "all outputs are literals, timestamp has fixed milliseconds" $ do+        fmap textValue (generateValue fixed Rfc3339Now) >>= (@?= Right "2022-02-22T19:22:22.123Z")+        for_ [Uuid4, Uuid7, TypeId (TypeIdOptions ""), TypeId (TypeIdOptions (Text.replicate 63 "a"))] $ \g -> generateValue fixed g >>= assertBool "valid literal" . not . isLeft,+      testCase "random sampling rejects 248..255 and terminates for broken entropy" $ do+        let env = fixed {entropyBytes = \n -> pure (BS.pack (take n (cycle [248, 255, 0, 61, 62, 247])))}+        fmap textValue (generateValue env (RandomAlphanumeric (RandomOptions 4))) >>= (@?= Right "A9A9")+        generateValue fixed (RandomAlphanumeric (RandomOptions 1)) >>= assertBool "bounded" . isLeft,+      testCase "short entropy, IO failure, and cancellation" $ do+        for_ [fixed {entropyBytes = \_ -> pure BS.empty}, fixed {entropyBytes = \_ -> ioError (userError "sensitive bytes")}] $ \env -> do+          result <- generateValue env Uuid4+          assertBool "fails redacted" (isLeft result && not ("sensitive" `Text.isInfixOf` Text.pack (show result)))+        result <- try @AsyncException (generateValue (fixed {entropyBytes = \_ -> throwIO ThreadKilled}) Uuid4)+        case result of Left ThreadKilled -> pure (); _ -> assertFailure "cancellation swallowed",+      testCase "declarations reject committed values and suite command references" $ do+        context <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/minimal/hurl-workbench.dhall") >>= either (assertFailure . show) pure+        let name = ParameterName "fresh"+            parameter = Parameter name Nothing (Generated Uuid7) Nothing Nothing+            literal = either (error . show) id (mkHurlValueLiteral "committed")+            base = context & #workspace . #parameters %~ (parameter :)+            workflow = Workflow (WorkflowName "generated") [FragmentName "health"] [name] Nothing+            recipe = Recipe (RecipeName "generated") (WorkflowName "generated") [] ReadOnly Nothing+            command = CommandSpec "true" [] Nothing Inherit [EnvironmentBinding "FRESH" name]+            service = Service (ServiceName "generated") command (HttpReadinessCheck (HttpReadiness "http://localhost/health" 200 10 1)) 1 Nothing+            manifest = base & #workspace . #workflows %~ (workflow :) & #workspace . #recipes .~ [recipe]+        for_+          [ context & #workspace . #parameters %~ ((parameter & #defaultValue .~ Just literal) :),+            manifest & #workspace . #recipes .~ [recipe & #bindings .~ [Binding name literal]],+            manifest & #workspace . #matrices .~ [Matrix (MatrixName "generated") (RecipeName "generated") [MatrixCase (MatrixCaseName "one") [Binding name literal]] False Nothing],+            context & #workspace . #parameters %~ ((parameter & #name .~ ParameterName "newUuid") :),+            base & #workspace . #services .~ [service],+            base & #workspace . #services .~ [service & #command . #environment .~ [] & #readiness .~ HttpReadinessCheck (HttpReadiness "http://localhost/{{fresh}}" 200 10 1)],+            base & #workspace . #parameters %~ map (\p -> if p ^. #name == name then p & #kind .~ Generated (TypeId (TypeIdOptions "Bad")) else p)+          ]+          $ \candidate -> validateWorkspace candidate >>= assertBool "invalid manifest" . isLeft,+      testCase "resolution generates once per name and overrides consume no entropy" $ do+        context <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/minimal/hurl-workbench.dhall") >>= either (assertFailure . show) pure+        let parameter = Parameter (ParameterName "fresh") Nothing (Generated Uuid4) Nothing Nothing+        validated <- validateWorkspace (context & #workspace . #parameters %~ (parameter :) & #workspace . #workflows %~ map (\w -> w & #parameters %~ (ParameterName "fresh" :))) >>= either (assertFailure . show) pure+        calls <- newIORef (0 :: Int)+        let env = fixed {entropyBytes = \n -> do modifyIORef' calls (+ 1); count <- readIORef calls; pure (BS.replicate n (fromIntegral count))}+            resolve = resolveParametersWithGenerator env validated (Set.singleton (ParameterName "fresh"))+        first <- resolve emptyBindingInput >>= either (assertFailure . show) pure+        readIORef calls >>= (@?= 1)+        second <- resolve emptyBindingInput >>= either (assertFailure . show) pure+        assertBool "fresh executions" (first /= second)+        let literal = either (error . show) id (mkHurlValueLiteral "reproduce")+        third <- resolve (emptyBindingInput & #plainOverrides .~ Map.singleton (ParameterName "fresh") literal) >>= either (assertFailure . show) pure+        third ^. #variables @?= Map.singleton (ParameterName "fresh") literal+        readIORef calls >>= (@?= 2)+        show first @?= "ResolvedBindings <redacted>"+        failure <- resolveParametersWithGenerator (fixed {entropyBytes = \_ -> ioError (userError "private")}) validated (Set.singleton (ParameterName "fresh")) emptyBindingInput+        case failure of+          Left err -> assertBool "names kind, redacts cause" ("Uuid4" `Text.isInfixOf` renderBindingError err && not ("private" `Text.isInfixOf` renderBindingError err))+          Right _ -> assertFailure "expected generator failure"+        let broken = fixed {entropyBytes = \_ -> ioError (userError "private")}+            format = HurlfmtCapabilities (HurlfmtExecutable "unused") (makeVersion [8, 0, 1])+        preparation <- prepareSelectionWithGenerator broken (\_ _ -> pure (Right ())) format validated emptyBindingInput defaultHurlOptions (SelectWorkflow (WorkflowName "check-health"))+        assertBool "generation failure is a preparation failure before spawn" (isLeft preparation)+        withSystemTempDirectory "generated-overrides" $ \directory -> do+          let firstFile = directory </> "first.env"+              secondFile = directory </> "second.env"+          Text.IO.writeFile firstFile "fresh=first\n"+          Text.IO.writeFile secondFile "fresh=second\n"+          result <- resolveParametersWithGenerator broken validated (Set.singleton (ParameterName "fresh")) (emptyBindingInput & #variableFiles .~ [firstFile, secondFile]) >>= either (assertFailure . show) pure+          fmap hurlValueLiteralText (result ^. #variables) @?= Map.singleton (ParameterName "fresh") "second"+        resolve (emptyBindingInput & #secretEnvironmentOverrides .~ Map.singleton (ParameterName "fresh") "SECRET") >>= assertBool "secret channel rejected" . isLeft+    ]+  where+    isLeft (Left _) = True; isLeft _ = False
+ test/HurlWorkbench/Parameter/ParameterTest.hs view
@@ -0,0 +1,161 @@+module HurlWorkbench.Parameter.ParameterTest (tests) where++import Control.Exception (bracket)+import Data.ByteString qualified as ByteString+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import HurlWorkbench.Parameter.Properties+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Error (renderWorkspaceError)+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, inOrderTestGroup, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests = testGroup "parameters" [propertiesTests, resolutionTests]++propertiesTests :: TestTree+propertiesTests =+  testGroup+    "properties files"+    [ testCase "ignores comments and preserves additional equals signs" $ do+        let input = "  # comment\n\nalpha=one=two\ntop=10\n"+        parseVariableProperties "values.env" input+          @?= Right+            ( Map.fromList+                [ (ParameterName "alpha", literal "one=two"),+                  (ParameterName "top", literal "10")+                ]+            ),+      testCase "rejects duplicate names in one file" $+        case parseVariableProperties "values.env" "top=1\ntop=2\n" of+          Left (DuplicatePropertyName VariableProperties "values.env" 2 (ParameterName "top")) -> pure ()+          other -> assertFailure ("expected duplicate property error, got " <> show other),+      testCase "secret errors never retain the secret text" $ do+        let secret = "do-not-print-me" :: Text+            result = parseSecretProperties "secrets.env" (Text.Encoding.encodeUtf8 ("token=" <> secret <> "\ntoken=again\n"))+        assertBool "redacts first secret" (not (secret `Text.isInfixOf` Text.pack (show result)))+    ]++resolutionTests :: TestTree+resolutionTests =+  inOrderTestGroup+    "resolution"+    [ testCase "applies explicit, later-file, environment, and default precedence" $+        withSystemTempDirectory "hurl-workbench-bindings" $ \dir ->+          withEnvironment+            [ ("EXAMPLE_CLIENT_ID", "environment-id"),+              ("EXAMPLE_CLIENT_SECRET", "environment-secret"),+              ("OVERRIDE_SECRET", "explicit-secret")+            ]+            $ do+              ByteString.writeFile (dir </> "first.env") "client_id=file-id\ntop=10\n"+              ByteString.writeFile (dir </> "second.env") "top=20\n"+              ByteString.writeFile (dir </> "secrets.env") "client_secret=file-secret\n"+              workspace <- fullWorkspace+              workflow <- requireWorkflow workspace (WorkflowName "list-properties")+              let input =+                    BindingInput+                      { plainOverrides = Map.singleton (ParameterName "client_id") (literal "explicit-id"),+                        secretEnvironmentOverrides = Map.singleton (ParameterName "client_secret") "OVERRIDE_SECRET",+                        variableFiles = [dir </> "first.env", dir </> "second.env"],+                        secretFiles = [dir </> "secrets.env"]+                      }+              resolveWorkflowBindings workspace workflow input >>= \case+                Left err -> assertFailure (Text.unpack (renderBindingError err))+                Right resolved -> do+                  fmap hurlValueLiteralText (resolved ^. #variables)+                    @?= Map.fromList+                      [ (ParameterName "auth_url", "https://auth.example.test"),+                        (ParameterName "base_url", "https://api.example.test"),+                        (ParameterName "client_id", "explicit-id"),+                        (ParameterName "top", "20")+                      ]+                  Map.keys (resolved ^. #secrets) @?= [ParameterName "client_secret"]+                  show resolved @?= "ResolvedBindings <redacted>",+      testCase "reports every missing workflow parameter in sorted order" $+        withUnsetEnvironment ["EXAMPLE_CLIENT_ID", "EXAMPLE_CLIENT_SECRET"] $ do+          workspace <- fullWorkspace+          workflow <- requireWorkflow workspace (WorkflowName "list-properties")+          workflow ^. #parameters+            @?= map ParameterName ["auth_url", "client_id", "client_secret", "base_url", "top"]+          lookupEnv "EXAMPLE_CLIENT_ID" >>= (@?= Nothing)+          lookupEnv "EXAMPLE_CLIENT_SECRET" >>= (@?= Nothing)+          resolveWorkflowBindings workspace workflow emptyBindingInput >>= \case+            Left (BindingIssues issues) ->+              mapMaybe missingName (toList issues)+                @?= [ParameterName "client_id", ParameterName "client_secret"]+            other -> assertFailure ("expected missing binding issues, got " <> show other),+      testCase "rejects unexpected and wrong-channel bindings" $ do+        workspace <- fullWorkspace+        let input =+              emptyBindingInput+                { plainOverrides =+                    Map.fromList+                      [ (ParameterName "client_secret", literal "not-secret-channel"),+                        (ParameterName "not_declared", literal "unused")+                      ]+                }+        resolveParameters workspace (Set.singleton (ParameterName "client_secret")) input >>= \case+          Left (BindingIssues issues) -> do+            assertBool "wrong channel" (any isKindMismatch issues)+            assertBool "unexpected" (any isUnexpected issues)+          other -> assertFailure ("expected binding issues, got " <> show other),+      testCase "a malformed secret environment value is redacted" $+        withEnvironment [("BAD_SECRET", " hidden ")] $ do+          workspace <- fullWorkspace+          let input = emptyBindingInput {secretEnvironmentOverrides = Map.singleton (ParameterName "client_secret") "BAD_SECRET"}+          resolveParameters workspace (Set.singleton (ParameterName "client_secret")) input >>= \case+            Left err -> assertBool "does not reveal value" (not ("hidden" `Text.isInfixOf` renderBindingError err))+            Right _ -> assertFailure "expected the secret to be rejected"+    ]++literal :: Text -> HurlValueLiteral+literal value = case mkHurlValueLiteral value of+  Left err -> error (show err)+  Right valid -> valid++fullWorkspace :: IO ValidatedWorkspace+fullWorkspace = do+  loaded <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/full/hurl-workbench.dhall")+  context <- either (assertFailure . Text.unpack . renderWorkspaceError) pure loaded+  validateWorkspace context >>= either (assertFailure . Text.unpack . Text.unlines . map renderValidationIssue . toList) pure++requireWorkflow :: ValidatedWorkspace -> WorkflowName -> IO Workflow+requireWorkflow workspace name = maybe (assertFailure "workflow fixture missing") pure (lookupWorkflow name workspace)++withEnvironment :: [(String, String)] -> IO a -> IO a+withEnvironment values action = bracket save restore (const applyAndRun)+  where+    save = traverse (\(name, _value) -> (name,) <$> lookupEnv name) values+    restore previous = for_ previous $ \(name, old) -> maybe (unsetEnv name) (setEnv name) old+    applyAndRun = traverse_ (uncurry setEnv) values >> action++withUnsetEnvironment :: [String] -> IO a -> IO a+withUnsetEnvironment names action = bracket save restore (const (traverse_ unsetEnv names >> action))+  where+    save = traverse (\name -> (name,) <$> lookupEnv name) names+    restore previous = for_ previous $ \(name, old) -> maybe (unsetEnv name) (setEnv name) old++isKindMismatch :: BindingIssue -> Bool+isKindMismatch BindingKindMismatch {} = True+isKindMismatch _ = False++isUnexpected :: BindingIssue -> Bool+isUnexpected UnexpectedBinding {} = True+isUnexpected _ = False++missingName :: BindingIssue -> Maybe ParameterName+missingName (MissingBinding name) = Just name+missingName (MissingBindingEnvironment name _environment _source) = Just name+missingName _ = Nothing
+ test/HurlWorkbench/Run/FileRootTest.hs view
@@ -0,0 +1,54 @@+module HurlWorkbench.Run.FileRootTest (tests) where++import Control.Exception (bracket_)+import HurlWorkbench.Prelude+import HurlWorkbench.Run.FileRoot+import System.Directory (canonicalizePath, createDirectory, createDirectoryLink, removeDirectory)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (setFileMode)+import System.Posix.User (getEffectiveUserID)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "file roots"+    [ testCase "validates relative Unicode and symlink roots and redacts Show" $+        withSystemTempDirectory "file-root" $ \base -> do+          let path = base </> "private 雪 payload"+          createDirectory path+          createDirectoryLink path (base </> "alias")+          root <- validateFileRoot base (Just "alias") >>= either (assertFailure . show) pure+          canonicalizePath path >>= (@?= fileRootPath root)+          show root @?= "FileRoot <redacted>"+          checkFileRootOutputs root [base </> "separate"] >>= (@?= Right ())+          for_ [path, path </> "new/report", base, base </> "alias/new"] $ \target ->+            checkFileRootOutputs root [target] >>= assertBool "overlap refused" . isLeft,+      testCase "missing, file, and empty roots fail" $+        withSystemTempDirectory "file-root" $ \base -> do+          writeFile (base </> "file") "payload"+          for_ ["missing", "file", ""] $ \path ->+            validateFileRoot base (Just path) >>= assertBool "root refused" . isLeft,+      testCase "effective read and search permissions are required" $+        withSystemTempDirectory "file-root" $ \base -> do+          uid <- getEffectiveUserID+          if uid == 0+            then putStrLn "UNSUPPORTED: root bypasses permission denial; public CLI check uses an unprivileged identity"+            else for_ [0o300, 0o600] $ \mode ->+              bracket_ (setFileMode base mode) (setFileMode base 0o700) $+                validateFileRoot base (Just base) >>= assertBool "permission refusal" . isLeft,+      testCase "default root permits workspace reports and retains a snapshot" $+        withSystemTempDirectory "file-root" $ \base -> do+          root <- validateFileRoot base Nothing >>= either (assertFailure . show) pure+          checkFileRootOutputs root [base </> "report"] >>= (@?= Right ())+          let child = base </> "ephemeral"+          createDirectory child+          selected <- validateFileRoot base (Just child) >>= either (assertFailure . show) pure+          removeDirectory child+          assertBool "retains selected root without recreating it" (not (null (fileRootPath selected)))+    ]+  where+    isLeft (Left _) = True+    isLeft _ = False
+ test/HurlWorkbench/Run/SelectionTest.hs view
@@ -0,0 +1,277 @@+module HurlWorkbench.Run.SelectionTest (tests) where++import Control.Concurrent (threadDelay)+import Control.Concurrent.STM (atomically, modifyTVar', newEmptyTMVarIO, newTVarIO, putTMVar, readTVar, readTVarIO, takeTMVar, writeTVar)+import Control.Exception (bracket)+import Data.Bits ((.&.))+import Data.ByteString qualified as ByteString+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Version (makeVersion)+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Hurl.Run+import HurlWorkbench.Parameter.Resolve+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.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Error (renderWorkspaceError)+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files+  ( accessModes,+    fileMode,+    getFileStatus,+    ownerExecuteMode,+    ownerReadMode,+    ownerWriteMode,+    unionFileModes,+  )+import System.Posix.Types qualified+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "run selection and preparation"+    [ testCase "explicit roots survive matrix preparation and artifact overlap is refused" $+        withSystemTempDirectory "matrix-file-root" $ \directory -> do+          root <- validateFileRoot directory (Just directory) >>= either (assertFailure . show) pure+          prepared <- preparedMatrixAt (Just root)+          for_ prepared $ \ready -> do+            ready ^. #fileRoot @?= root+            buildBatchCase TestMode CaptureRunOutput [] ready ^. #request . #fileRoot @?= root+          prepareResponseArtifacts (directory </> "nested") True prepared >>= \case+            Left _ -> pure ()+            Right _ -> assertFailure "artifact preparation accepted input overlap",+      testCase "expands matrix cases in declaration order with case-over-recipe layers" $ do+        workspace <- fullWorkspace+        case resolveSelection workspace (SelectMatrix (MatrixName "property-page-sizes")) of+          Left err -> assertFailure (Text.unpack (renderSelectionError err))+          Right expanded -> do+            let runs = NonEmpty.toList expanded+            map (view #displayName) runs @?= ["property-page-sizes/small", "property-page-sizes/large"]+            map (view #artifactStem) runs @?= ["property-page-sizes" </> "small", "property-page-sizes" </> "large"]+            map (view #safety) runs @?= [Classified ReadOnly, Classified ReadOnly]+            map (map (view #source) . view #bindingLayers) runs+              @?= [ [CommittedBinding "matrix \"property-page-sizes\" case \"small\"", CommittedBinding "recipe \"top-properties\""],+                    [CommittedBinding "matrix \"property-page-sizes\" case \"large\"", CommittedBinding "recipe \"top-properties\""]+                  ],+      testCase "applies runtime, file, matrix, recipe, environment, and default precedence" $+        withSystemTempDirectory "hurl-workbench-layered-bindings" $ \directory -> do+          workspace <- fullWorkspace+          expanded <- case resolveSelection workspace (SelectMatrix (MatrixName "property-page-sizes")) of+            Left err -> assertFailure (Text.unpack (renderSelectionError err))+            Right value -> pure (NonEmpty.head value)+          let layers = expanded ^. #bindingLayers+              top = ParameterName "top"+              clientId = ParameterName "client_id"+              recipeOnly = drop 1 layers+              topValue result = hurlValueLiteralText <$> Map.lookup top (result ^. #variables)+          resolveParametersWithLayers workspace (Set.singleton top) [] emptyBindingInput >>= requireBindings >>= ((@?= Just "5") . topValue)+          resolveParametersWithLayers workspace (Set.singleton top) recipeOnly emptyBindingInput >>= requireBindings >>= ((@?= Just "10") . topValue)+          resolveParametersWithLayers workspace (Set.singleton top) layers emptyBindingInput >>= requireBindings >>= ((@?= Just "1") . topValue)+          ByteString.writeFile (directory </> "values.env") "top=20\n"+          let fileInput = emptyBindingInput {variableFiles = [directory </> "values.env"]}+          resolveParametersWithLayers workspace (Set.singleton top) layers fileInput >>= requireBindings >>= ((@?= Just "20") . topValue)+          let explicitInput = fileInput {plainOverrides = Map.singleton top (literal "30")}+          resolveParametersWithLayers workspace (Set.singleton top) layers explicitInput >>= requireBindings >>= ((@?= Just "30") . topValue)+          let committedClient = BindingLayer (CommittedBinding "recipe test") (Map.singleton clientId (literal "committed-id"))+          resolveParametersWithLayers workspace (Set.singleton clientId) [committedClient] emptyBindingInput >>= requireBindings >>= \resolved ->+            (hurlValueLiteralText <$> Map.lookup clientId (resolved ^. #variables)) @?= Just "committed-id",+      testCase "prepares every matrix case before building the shared request shape" $+        withEnvironment [("PREPARE_SELECTION_SECRET", "fixture-secret")] $ do+          workspace <- fullWorkspace+          let input =+                emptyBindingInput+                  { plainOverrides = Map.singleton (ParameterName "client_id") (literal "fixture-id"),+                    secretEnvironmentOverrides = Map.singleton (ParameterName "client_secret") "PREPARE_SELECTION_SECRET"+                  }+          prepared <-+            prepareSelection+              trueCapabilities+              workspace+              input+              defaultHurlOptions+              (SelectMatrix (MatrixName "property-page-sizes"))+          case prepared of+            Left errors -> assertFailure (Text.unpack (Text.unlines (map renderPreparationError (toList errors))))+            Right runs -> do+              map (view #displayName) (NonEmpty.toList runs) @?= ["property-page-sizes/small", "property-page-sizes/large"]+              map (fmap hurlValueLiteralText . Map.lookup (ParameterName "top") . view #variables . view #bindings) (NonEmpty.toList runs)+                @?= [Just "1", Just "100"]+              let batchCase = buildBatchCase TestMode CaptureRunOutput [] (NonEmpty.head runs)+              batchCase ^. #name @?= "property-page-sizes/small"+              batchCase ^. #request . #mode @?= TestMode,+      testCase "bounds concurrency and returns results in declaration order" $ do+        cases <- syntheticCases ["slow", "fast", "middle"]+        active <- newTVarIO (0 :: Int)+        maximumActive <- newTVarIO (0 :: Int)+        let runner = HurlRunner $ \request -> do+              atomically $ do+                modifyTVar' active (+ 1)+                current <- readTVar active+                observed <- readTVar maximumActive+                writeTVar maximumActive (max current observed)+              threadDelay (if requestPath request == Just "slow" then 150000 else 20000)+              atomically (modifyTVar' active (subtract 1))+              pure (Right (RunResult ExitSuccess 0 (Just (CapturedRunOutput "" ""))))+        result <- runBatch runner (BatchOptions (positive 2) False) cases+        readTVarIO maximumActive >>= (@?= 2)+        map (view #name) (toList (result ^. #cases)) @?= ["slow", "fast", "middle"]+        map (view #outcome) (toList (result ^. #cases)) @?= replicate 3 CasePassed+        result ^. #selectedExitCode @?= ExitSuccess,+      testCase "keeps one hundred scheduled cases within the requested job limit" $ do+        let names = ["case-" <> Text.pack (show number) | number <- [1 .. 100 :: Int]]+        cases <- syntheticCases names+        active <- newTVarIO (0 :: Int)+        maximumActive <- newTVarIO (0 :: Int)+        let runner = HurlRunner $ \_request -> do+              atomically $ do+                modifyTVar' active (+ 1)+                current <- readTVar active+                modifyTVar' maximumActive (max current)+              threadDelay 1000+              atomically (modifyTVar' active (subtract 1))+              pure (Right (RunResult ExitSuccess 0 Nothing))+        result <- runBatch runner (BatchOptions (positive 7) False) cases+        readTVarIO maximumActive >>= (@?= 7)+        map (view #name) (toList (result ^. #cases)) @?= names+        map (view #outcome) (toList (result ^. #cases)) @?= replicate 100 CasePassed,+      testCase "fail-fast stops queue scheduling and marks untouched cases skipped" $ do+        cases <- syntheticCases ["first", "active", "third", "fourth", "fifth"]+        starts <- newTVarIO (0 :: Int)+        activeStarted <- newEmptyTMVarIO+        failurePublished <- newEmptyTMVarIO+        let runner = HurlRunner $ \request -> do+              atomically (modifyTVar' starts (+ 1))+              if requestPath request == Just "first"+                then atomically (takeTMVar activeStarted) >> pure (Right (RunResult (ExitFailure 7) 0 Nothing))+                else do+                  atomically (putTMVar activeStarted ())+                  atomically (takeTMVar failurePublished)+                  pure (Right (RunResult ExitSuccess 0 Nothing))+            observe caseIndex _ = when (caseIndex == 0) (atomically (putTMVar failurePublished ()))+        result <- runBatchObserved runner (BatchOptions (positive 2) True) cases observe+        readTVarIO starts >>= (@?= 2)+        map (view #outcome) (toList (result ^. #cases))+          @?= [ CaseFailed (ExitFailure 7),+                CasePassed,+                CaseSkipped FailFastTriggered,+                CaseSkipped FailFastTriggered,+                CaseSkipped FailFastTriggered+              ]+        result ^. #selectedExitCode @?= ExitFailure 7,+      testCase "rejects non-positive worker counts" $ do+        mkPositiveInt 0 @?= Left (NonPositiveJobs 0)+        positiveIntValue (positive 1) @?= 1,+      testCase "prepares collision-checked owner-only response artifacts" $+        withSystemTempDirectory "hurl-workbench-artifacts" $ \directory -> do+          prepared <- preparedMatrix+          let outputDirectory = directory </> "responses"+              smallPath = outputDirectory </> "property-page-sizes" </> "small.response"+              expected = smallPath :| [outputDirectory </> "property-page-sizes" </> "large.response"]+          prepareResponseArtifacts outputDirectory False prepared >>= \case+            Left errors -> assertFailure (Text.unpack (Text.unlines (map renderArtifactError (toList errors))))+            Right paths -> do+              paths @?= expected+              traverse filePermissions expected >>= (@?= (ownerFileMode :| [ownerFileMode]))+              directoryPermissions outputDirectory >>= (@?= ownerDirectoryMode)+              directoryPermissions (outputDirectory </> "property-page-sizes") >>= (@?= ownerDirectoryMode)+          ByteString.writeFile smallPath "keep-me"+          prepareResponseArtifacts outputDirectory False prepared >>= \case+            Left errors -> map renderArtifactError (toList errors) @?= map (renderArtifactError . ArtifactAlreadyExists) (toList expected)+            Right _ -> assertFailure "expected existing artifacts to be rejected"+          ByteString.readFile smallPath >>= (@?= "keep-me")+          prepareResponseArtifacts outputDirectory True prepared >>= \case+            Left errors -> assertFailure (Text.unpack (Text.unlines (map renderArtifactError (toList errors))))+            Right _ -> ByteString.readFile smallPath >>= (@?= "")+    ]++trueCapabilities :: HurlfmtCapabilities+trueCapabilities = HurlfmtCapabilities (HurlfmtExecutable "true") (makeVersion [8, 0, 1])++literal :: Text -> HurlValueLiteral+literal value = either (error . show) id (mkHurlValueLiteral value)++requireBindings :: Either BindingError ResolvedBindings -> IO ResolvedBindings+requireBindings = either (assertFailure . Text.unpack . renderBindingError) pure++positive :: Int -> PositiveInt+positive value = either (error . show) id (mkPositiveInt value)++syntheticCases :: [Text] -> IO (NonEmpty BatchCase)+syntheticCases names = do+  prepared <- preparedMatrix+  let base = NonEmpty.head prepared+      makeCase name =+        let original = buildBatchCase ClientMode (ResponseFile (Text.unpack name)) [] base+         in BatchCase+              { name,+                artifactStem = original ^. #artifactStem,+                request = original ^. #request+              }+  maybe (assertFailure "synthetic case list must be non-empty") pure (nonEmpty (map makeCase names))++preparedMatrix :: IO (NonEmpty PreparedRun)+preparedMatrix = preparedMatrixAt Nothing++preparedMatrixAt :: Maybe FileRoot -> IO (NonEmpty PreparedRun)+preparedMatrixAt selected =+  withSystemTempDirectory "hurl-workbench-batch-bindings" $ \directory -> do+    let secretsPath = directory </> "secrets.env"+    ByteString.writeFile secretsPath "client_secret=fixture-secret\n"+    workspace <- fullWorkspace+    let input =+          emptyBindingInput+            { plainOverrides = Map.singleton (ParameterName "client_id") (literal "fixture-id"),+              secretFiles = [secretsPath]+            }+    let prepare = case selected of+          Nothing -> prepareSelectionWith (\_ _ -> pure (Right ()))+          Just root -> prepareSelectionAtFileRootWith root (\_ _ -> pure (Right ()))+    prepare trueCapabilities workspace input defaultHurlOptions (SelectMatrix (MatrixName "property-page-sizes")) >>= \case+      Left errors -> assertFailure (Text.unpack (Text.unlines (map renderPreparationError (toList errors))))+      Right prepared -> pure prepared++requestPath :: RunRequest -> Maybe FilePath+requestPath request = case request ^. #outputPolicy of+  ResponseFile path -> Just path+  _ -> Nothing++filePermissions :: FilePath -> IO System.Posix.Types.FileMode+filePermissions path = (.&. accessModes) . fileMode <$> getFileStatus path++directoryPermissions :: FilePath -> IO System.Posix.Types.FileMode+directoryPermissions = filePermissions++ownerFileMode :: System.Posix.Types.FileMode+ownerFileMode = ownerReadMode `unionFileModes` ownerWriteMode++ownerDirectoryMode :: System.Posix.Types.FileMode+ownerDirectoryMode = ownerFileMode `unionFileModes` ownerExecuteMode++fullWorkspace :: IO ValidatedWorkspace+fullWorkspace = do+  loaded <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/full/hurl-workbench.dhall")+  context <- either (assertFailure . Text.unpack . renderWorkspaceError) pure loaded+  validateWorkspace context >>= either (assertFailure . Text.unpack . Text.unlines . map renderValidationIssue . toList) pure++withEnvironment :: [(String, String)] -> IO a -> IO a+withEnvironment values action = bracket save restore (const applyAndRun)+  where+    save = traverse (\(name, _value) -> (name,) <$> lookupEnv name) values+    restore previous = for_ previous $ \(name, old) -> maybe (unsetEnv name) (setEnv name) old+    applyAndRun = traverse_ (uncurry setEnv) values >> action
+ test/HurlWorkbench/Service/RunTest.hs view
@@ -0,0 +1,391 @@+module HurlWorkbench.Service.RunTest (tests, runIsolatedScenario) where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (cancel, withAsync)+import Control.Exception (IOException, try)+import Data.ByteString.Lazy.Char8 qualified as LazyByteString+import Data.Generics.Labels ()+import Data.List (sort)+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Service.Environment (selectEnvironment)+import HurlWorkbench.Service.Resolve+import HurlWorkbench.Service.Run+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Error (renderWorkspaceError)+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Directory (canonicalizePath, doesFileExist, findExecutable, removeFile)+import System.Environment (getEnvironment, getExecutablePath)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Signals (nullSignal, signalProcess)+import System.Posix.Types (ProcessID)+import System.Process.Typed (proc, readProcessStdout, readProcessStdout_, runProcess, runProcess_, setEnv)+import System.Timeout qualified as Timeout+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "managed services"+    [ environmentTests,+      testCase "resolves suite bindings while rejecting secret URL placeholders" $ do+        workspace <- fullWorkspace+        secret <- either (assertFailure . show) pure (mkSecretValue "never-print-this")+        let bindings =+              ResolvedBindings+                (Map.singleton (ParameterName "top") (literal "43123"))+                (Map.singleton (ParameterName "client_secret") secret)+            processSpec =+              CommandSpec+                "python3"+                ["-c", "import time; time.sleep(60)"]+                Nothing+                Inherit+                [EnvironmentBinding "SERVICE_TOKEN" (ParameterName "client_secret")]+            httpReadiness url = HttpReadinessCheck (HttpReadiness url 200 20 2)+            service = Service (ServiceName "fixture") processSpec (httpReadiness "http://127.0.0.1:{{top}}/health") 1 Nothing+        case resolveService workspace bindings service of+          Left err -> assertFailure (Text.unpack (renderServiceError err))+          Right resolved -> do+            resolved ^. #readiness @?= ResolvedHttpReadiness "http://127.0.0.1:43123/health" 200 20000 2+            assertBool "resolved command show output redacts environment values" (not ("never-print-this" `Text.isInfixOf` Text.pack (show resolved)))+        let secretReadiness :: Service+            secretReadiness =+              Service+                (ServiceName "fixture")+                processSpec+                (httpReadiness "http://127.0.0.1/{{client_secret}}")+                1+                Nothing+        resolveService workspace bindings secretReadiness+          @?= Left (ServiceReadinessSecretPlaceholder (ParameterName "client_secret")),+      testCase "polls HTTP status and terminates the process group after the callback" $+        withSystemTempDirectory "hurl-workbench-http-service" $ \directory -> do+          port <- unusedPort+          let readyPath = directory </> "ready"+              countPath = directory </> "requests"+              service =+                directService+                  (pythonCommand [httpFixture, show port, readyPath, countPath])+                  (ResolvedHttpReadiness (healthUrl port) 200 20000 3)+          outcome <- withService service $ \handle -> do+            alive <- processAlive (serviceProcessId handle)+            assertBool "service is alive while callback runs" alive+            readCount countPath+          case outcome of+            Left err -> assertFailure (Text.unpack (renderServiceError err))+            Right requestCount -> assertBool "readiness retried a non-200 response" (requestCount >= 2)+          pid <- readFixturePid readyPath+          assertProcessStopped pid,+      testCase "supports command readiness probes" $+        withSystemTempDirectory "hurl-workbench-command-service" $ \directory -> do+          let readyPath = directory </> "ready"+              pidPath = directory </> "pid"+              service =+                directService+                  (pythonCommand [delayedMarkerFixture, readyPath, pidPath])+                  ( ResolvedCommandReadiness+                      (pythonCommand [fileProbe, readyPath])+                      20000+                      3+                  )+          outcome <- withService service (pure . serviceProcessId)+          case outcome of+            Left err -> assertFailure (Text.unpack (renderServiceError err))+            Right pid -> assertProcessStopped pid,+      testCase "bounds a hanging readiness command and cleans up the service" $+        withSystemTempDirectory "hurl-workbench-readiness-timeout" $ \directory -> do+          let pidPath = directory </> "pid"+              service =+                ( directService+                    (pythonCommand [pidSleepFixture, pidPath])+                    (ResolvedCommandReadiness (pythonCommand [hangingProbe]) 10000 0.15)+                )+                  { shutdownTimeout = 0.2+                  }+          withService service (const (pure ())) >>= (@?= Left (ServiceReadinessTimedOut (ServiceName "fixture")))+          readFixturePid pidPath >>= assertProcessStopped,+      testCase "reports a service that exits before readiness" $ do+        let service =+              directService+                (pythonCommand ["import sys; sys.exit(7)"])+                (ResolvedCommandReadiness (pythonCommand ["import sys; sys.exit(1)"]) 10000 1)+        withService service (const (pure ())) >>= \case+          Left (ServiceExitedBeforeReady (ServiceName "fixture") _) -> pure ()+          other -> assertFailure ("expected an early-exit error, got " <> show other),+      testCase "escalates from TERM to KILL when the service ignores TERM" $+        withSystemTempDirectory "hurl-workbench-service-kill" $ \directory -> do+          let pidPath = directory </> "pid"+              service =+                ( directService+                    (pythonCommand [ignoreTermFixture, pidPath])+                    (ResolvedCommandReadiness (pythonCommand ["import sys; sys.exit(0)"]) 10000 1)+                )+                  { shutdownTimeout = 0.1+                  }+          outcome <- withService service (pure . serviceProcessId)+          case outcome of+            Left err -> assertFailure (Text.unpack (renderServiceError err))+            Right pid -> assertProcessStopped pid,+      testCase "cleanup kills a TERM-ignoring descendant after its leader exits" $+        withSystemTempDirectory "service-orphan" $ \directory -> do+          let pidPath = directory </> "descendant"+              code =+                "import os, signal, sys, time; child = os.fork(); "+                  <> "exec(\"if child == 0:\\n signal.signal(signal.SIGTERM, signal.SIG_IGN)\\n open(sys.argv[1], 'w').write(str(os.getpid()))\\n while True: time.sleep(1)\\nelse:\\n while not os.path.exists(sys.argv[1]): time.sleep(0.01)\\n os._exit(7)\")"+              service = (directService (pythonCommand [code, pidPath]) (ResolvedCommandReadiness (pythonCommand ["import time; time.sleep(0.2); raise SystemExit(1)"]) 10000 1)) {shutdownTimeout = 0.3}+          withService service (const (assertFailure "orphaned service became ready" :: IO ())) >>= \case+            Left (ServiceExitedBeforeReady _ _) -> pure ()+            other -> assertFailure ("expected early exit, got " <> show other)+          pid <- readFixturePid pidPath+          -- A killed orphan may briefly remain as an init-owned zombie on Linux.+          alive <- processAlive pid+          state <- if not alive then pure "" else snd <$> readProcessStdout (proc "ps" ["-p", show pid, "-o", "stat="])+          assertBool "descendant is terminated" (LazyByteString.null state || 'Z' `elem` LazyByteString.unpack state),+      testCase "async cancellation waits for managed-service cleanup" $+        withSystemTempDirectory "hurl-workbench-service-cancel" $ \directory -> do+          let pidPath = directory </> "pid"+              callbackPath = directory </> "callback"+              service =+                directService+                  (pythonCommand [pidSleepFixture, pidPath])+                  (ResolvedCommandReadiness (pythonCommand ["import sys; sys.exit(0)"]) 10000 1)+          withAsync+            ( withService service $ \_handle -> do+                writeFile callbackPath "running"+                threadDelay 10000000+            )+            $ \worker -> do+              waitForFile callbackPath+              pid <- readFixturePid pidPath+              cancel worker+              assertProcessStopped pid+    ]++directService :: ResolvedCommand -> ResolvedReadiness -> ResolvedService+directService processConfig readiness =+  ResolvedService+    { name = ServiceName "fixture",+      processConfig,+      readiness,+      shutdownTimeout = 1+    }++pythonCommand :: [String] -> ResolvedCommand+pythonCommand arguments =+  ResolvedCommand+    { executable = "python3",+      arguments = "-c" : arguments,+      workingDirectory = ".",+      environmentPolicy = Inherit,+      environment = []+    }++healthUrl :: Int -> Text+healthUrl port = "http://127.0.0.1:" <> Text.pack (show port) <> "/health"++unusedPort :: IO Int+unusedPort = do+  output <-+    readProcessStdout_+      ( proc+          "python3"+          [ "-c",+            "import socket; s=socket.socket(); s.bind(('127.0.0.1', 0)); print(s.getsockname()[1]); s.close()"+          ]+      )+  case reads (LazyByteString.unpack output) of+    [(port, _)] -> pure port+    _ -> assertFailure "python failed to return an unused TCP port"++processAlive :: ProcessID -> IO Bool+processAlive pid = either (const False) (const True) <$> try @IOException (signalProcess nullSignal pid)++assertProcessStopped :: ProcessID -> IO ()+assertProcessStopped pid = do+  alive <- processAlive pid+  assertBool ("process " <> show pid <> " is still alive") (not alive)++waitForFile :: FilePath -> IO ()+waitForFile path = do+  result <- Timeout.timeout 2000000 loop+  case result of+    Nothing -> assertFailure ("timed out waiting for fixture file " <> path)+    Just () -> pure ()+  where+    loop = do+      exists <- doesFileExist path+      if exists then pure () else threadDelay 10000 >> loop++readFixturePid :: FilePath -> IO ProcessID+readFixturePid path = do+  waitForFile path+  read <$> readFile path++readCount :: FilePath -> IO Int+readCount path = do+  waitForFile path+  read <$> readFile path++literal :: Text -> HurlValueLiteral+literal value = either (error . show) id (mkHurlValueLiteral value)++fullWorkspace :: IO ValidatedWorkspace+fullWorkspace = do+  loaded <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/full/hurl-workbench.dhall")+  context <- either (assertFailure . Text.unpack . renderWorkspaceError) pure loaded+  validateWorkspace context >>= either (assertFailure . Text.unpack . Text.unlines . map renderValidationIssue . toList) pure++httpFixture :: String+httpFixture =+  unlines+    [ "import http.server, os, sys, threading",+      "port, ready, count = int(sys.argv[1]), sys.argv[2], sys.argv[3]",+      "open(ready, 'w').write(str(os.getpid()))",+      "threading.Timer(0.25, lambda: open(ready + '.status', 'w').close()).start()",+      "class Handler(http.server.BaseHTTPRequestHandler):",+      "  def do_GET(self):",+      "    n = int(open(count).read()) if os.path.exists(count) else 0",+      "    open(count, 'w').write(str(n + 1))",+      "    self.send_response(200 if os.path.exists(ready + '.status') else 503)",+      "    self.end_headers()",+      "  def log_message(self, format, *args): pass",+      "http.server.ThreadingHTTPServer(('127.0.0.1', port), Handler).serve_forever()"+    ]++delayedMarkerFixture :: String+delayedMarkerFixture =+  unlines+    [ "import os, sys, threading, time",+      "ready, pid = sys.argv[1], sys.argv[2]",+      "open(pid, 'w').write(str(os.getpid()))",+      "threading.Timer(0.2, lambda: open(ready, 'w').close()).start()",+      "time.sleep(60)"+    ]++pidSleepFixture :: String+pidSleepFixture = "import os, sys, time; open(sys.argv[1], 'w').write(str(os.getpid())); time.sleep(60)"++fileProbe :: String+fileProbe = "import os, sys; sys.exit(0 if os.path.exists(sys.argv[1]) else 1)"++hangingProbe :: String+hangingProbe = "import time; time.sleep(60)"++ignoreTermFixture :: String+ignoreTermFixture =+  "import os, signal, sys, time; signal.signal(signal.SIGTERM, signal.SIG_IGN); open(sys.argv[1], 'w').write(str(os.getpid())); time.sleep(60)"++environmentTests :: TestTree+environmentTests =+  testGroup+    "environment policies"+    [ testCase "private parent selects empty values, overrides selected values, and excludes sentinels" $+        withSystemTempDirectory "private-policy-parent" $ \directory -> do+          binary <- nativeBinary directory+          runner <- getExecutablePath+          let privateEnvironment = [("SELECTED", ""), ("BOUND", "private-ambient-sentinel"), ("REI_PG_CONNECTION_STRING", "private-rei-sentinel"), ("REI_CONFIG", "private-config-sentinel"), ("MORI_API_URL", "private-mori-sentinel")]+          runProcess (setEnv privateEnvironment (proc runner ["--clean-environment-scenario", binary, directory])) >>= (@?= ExitSuccess),+      testCase "old and clean manifests reach native children through validation and resolution" $+        withSystemTempDirectory "policy-roundtrip" $ \directory -> do+          binary <- nativeBinary directory+          schema <- canonicalizePath "schema/package.dhall"+          let clean = ", environmentPolicy = < Inherit | Clean : List Text >.Clean ([] : List Text)"+          for_ [("", "", "inherit", "inherit"), (clean, clean, "[]", "[]"), ("", clean, "inherit", "[]"), (clean, "", "[]", "inherit")] $ \(policy, probePolicy, expected, probeExpected) -> do+            let command policyField expectation mode marker = "{ executable = " <> show binary <> ", arguments = " <> show ["--environment-fixture", mode, marker, expectation] <> ", workingDirectory = None Text, environment = [] : List { variable : Text, parameter : Text }" <> policyField <> " }"+                source = "let Schema = " <> schema <> " in Schema.Workspace.default // { schemaVersion = 1, services = [ { name = \"fixture\", command = " <> command policy expected "service" (directory </> "service") <> ", readiness = < Command : { command : " <> commandType probePolicy <> ", intervalMilliseconds : Natural, timeoutSeconds : Natural } | Http : { url : Text, expectedStatus : Natural, intervalMilliseconds : Natural, timeoutSeconds : Natural } >.Command { command = " <> command probePolicy probeExpected "probe" (directory </> "probe") <> ", intervalMilliseconds = 10, timeoutSeconds = 2 }, shutdownTimeoutSeconds = 1, description = None Text } ] }"+                path = directory </> "hurl-workbench.dhall"+            writeFile path source+            loaded <- loadWorkspaceContext (ExplicitWorkspace path) >>= either (assertFailure . show) pure+            workspace <- validateWorkspace loaded >>= either (assertFailure . show) pure+            service <- maybe (assertFailure "missing fixture") pure (lookupService (ServiceName "fixture") workspace)+            resolved <- either (assertFailure . show) pure (resolveService workspace (ResolvedBindings Map.empty Map.empty) service)+            result <- withService resolved (pure . serviceProcessId)+            either (assertFailure . show) assertProcessStopped result+            removeFile (directory </> "service"),+      testCase "selection requires inherited names and overlays explicit bindings" $ do+        selectEnvironment Inherit [("A", "ambient"), ("B", "")] [("A", "explicit")] @?= Right [("A", "explicit"), ("B", "")]+        selectEnvironment (Clean []) [("PATH", "hidden")] [] @?= Right []+        selectEnvironment (Clean ["B", "A"]) [("A", "ambient"), ("B", ""), ("HOME", "hidden")] [("A", "explicit")] @?= Right [("A", "explicit"), ("B", "")]+        selectEnvironment (Clean ["MISSING"]) [] [("MISSING", "explicit")] @?= Left ["MISSING"],+      testCase "native clean service and readiness have exact independent environments" $+        withSystemTempDirectory "clean-native" $ \directory -> do+          binary <- nativeBinary directory+          let native :: String -> FilePath -> [String] -> ResolvedCommand+              native mode marker names = ResolvedCommand binary ["--environment-fixture", mode, marker, show (sort names)] "." (Clean []) []+              serviceCommand = native "service" (directory </> "service") ["BOUND"] & #environment .~ [("BOUND", "private-bound-sentinel")]+              readinessCommand = native "retry" (directory </> "probe") []+              service = directService serviceCommand (ResolvedCommandReadiness readinessCommand 10000 2)+          result <- withService service (pure . serviceProcessId)+          case result of+            Left err -> assertFailure (show err)+            Right pid -> assertProcessStopped pid+          readFile (directory </> "probe.attempts") >>= (@?= "2")+          assertBool "resolved metadata redacts bound secret" (not ("private-bound-sentinel" `Text.isInfixOf` Text.pack (show service))),+      testCase "native inherited children retain ambient variable names" $+        withSystemTempDirectory "inherit-native" $ \directory -> do+          binary <- nativeBinary directory+          let command mode path = ResolvedCommand binary ["--environment-fixture", mode, path, "inherit"] "." Inherit []+          result <- withService (directService (command "service" (directory </> "service")) (ResolvedCommandReadiness (command "probe" (directory </> "probe")) 10000 2)) (pure . serviceProcessId)+          either (assertFailure . show) assertProcessStopped result,+      testCase "clean cancellation and failed readiness finish service cleanup" $+        withSystemTempDirectory "clean-cleanup" $ \directory -> do+          binary <- nativeBinary directory+          let servicePath = directory </> "service"+              command mode marker = ResolvedCommand binary ["--environment-fixture", mode, marker, "[]"] "." (Clean []) []+              service probe = directService (command "service" servicePath) (ResolvedCommandReadiness probe 10000 0.3)+          withService (service (command "service" (directory </> "hanging-probe"))) (const (pure ())) >>= (@?= Left (ServiceReadinessTimedOut (ServiceName "fixture")))+          readFixturePid servicePath >>= assertProcessStopped+          removeFile servicePath+          withAsync (withService (service (command "probe" (directory </> "probe"))) (\_ -> writeFile (directory </> "callback") "ready" >> threadDelay 10000000)) $ \worker -> do+            waitForFile (directory </> "callback")+            pid <- readFixturePid servicePath+            cancel worker+            assertProcessStopped pid,+      testCase "failure diagnostics redact bound secret values" $ do+        let bound = pythonCommand [] & #environmentPolicy .~ Clean [] & #environment .~ [("BOUND", "private-bound-sentinel")]+            absent = bound & #executable .~ "/missing/clean-environment-executable"+            missing = bound & #environmentPolicy .~ Clean ["HURL_WORKBENCH_TEST_ABSENT_972638"]+        for_ [(absent, bound), (bound, absent), (missing, bound)] $ \(command, probe) -> do+          outcome <- withService (directService command (ResolvedCommandReadiness probe 10000 1)) (const (pure ()))+          case outcome of+            Left err -> assertBool "diagnostics exclude secret" (not ("private-bound-sentinel" `Text.isInfixOf` (renderServiceError err <> Text.pack (show err))))+            Right () -> assertFailure "expected command failure",+      testCase "missing service or readiness names fail before startup" $+        withSystemTempDirectory "clean-missing" $ \directory -> do+          binary <- nativeBinary directory+          let marker = directory </> "started"+              command = ResolvedCommand binary ["--environment-fixture", "service", marker, "[]"] "." (Clean []) []+              missing = command & #environmentPolicy .~ Clean ["HURL_WORKBENCH_TEST_ABSENT_972638"]+          for_ [(missing, command, "command"), (command, missing, "readiness command")] $ \(serviceCommand, probe, phase) -> do+            withService (directService serviceCommand (ResolvedCommandReadiness probe 10000 1)) (const (pure ()))+              >>= (@?= Left (ServiceEnvironmentMissing (ServiceName "fixture") phase ["HURL_WORKBENCH_TEST_ABSENT_972638"]))+            doesFileExist marker >>= (@?= False)+    ]++nativeBinary :: FilePath -> IO FilePath+nativeBinary directory = do+  let binary = directory </> "environment-fixture"+  compiler <- findExecutable "cc" >>= maybe (assertFailure "cc is required for native environment tests") pure+  ambient <- getEnvironment+  runProcess_ (setEnv ambient (proc compiler ["test/fixtures/processes/environment.c", "-o", binary]))+  pure binary++commandType :: String -> String+commandType policy =+  "{ executable : Text, arguments : List Text, workingDirectory : Optional Text, environment : List { variable : Text, parameter : Text }" <> (if null policy then "" else ", environmentPolicy : < Inherit | Clean : List Text >") <> " }"++-- | Invoked in a subprocess whose environment belongs exclusively to this test.+runIsolatedScenario :: FilePath -> FilePath -> IO ()+runIsolatedScenario binary directory = do+  let serviceCommand = ResolvedCommand binary ["--environment-fixture", "service", directory </> "service", "[\"BOUND\",\"SELECTED\"]"] "." (Clean ["SELECTED", "BOUND"]) [("BOUND", "private-bound-sentinel")]+      probe = ResolvedCommand binary ["--environment-fixture", "probe", directory </> "probe", "[\"SELECTED\"]"] "." (Clean ["SELECTED"]) []+  result <- withService (directService serviceCommand (ResolvedCommandReadiness probe 10000 2)) (pure . serviceProcessId)+  either (assertFailure . show) assertProcessStopped result
+ test/HurlWorkbench/Suite/LifecycleTest.hs view
@@ -0,0 +1,354 @@+module HurlWorkbench.Suite.LifecycleTest (tests) where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (cancel, waitCatch, withAsync)+import Control.Concurrent.MVar (newMVar, withMVar)+import Control.Concurrent.STM+import Control.Exception (IOException, bracket_, try)+import Data.ByteString qualified as ByteString+import Data.Generics.Labels ()+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Version (makeVersion)+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Hurl.Run+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Run.Batch+import HurlWorkbench.Suite.Resolve+import HurlWorkbench.Suite.Run+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Directory (doesFileExist)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Signals (nullSignal, signalProcess)+import System.Timeout qualified as Timeout+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "ordered multi-service lifecycle"+    [ testCase "jobs=2 batches drain around restart and cleanup follows new acquisition order" $+        fixture $ \directory original -> do+          workspace <- changed original $ \ws -> ws & #suites %~ map (\suite -> suite & #runs .~ [RecipeRun (RecipeName "r1"), RecipeRun (RecipeName "r2"), ServiceRun (Restart (ServiceName "s1")), RecipeRun (RecipeName "r3"), RecipeRun (RecipeName "r4")])+          eventLock <- newMVar ()+          active <- newTVarIO (0 :: Int)+          peak <- newTVarIO (0 :: Int)+          calls <- newTVarIO (0 :: Int)+          let runner = HurlRunner $ \_ -> bracket_+                (atomically (modifyTVar' active (+ 1) >> readTVar active >>= \n -> modifyTVar' peak (max n)))+                (atomically (modifyTVar' active (subtract 1)))+                $ do+                  ordinal <- atomically (modifyTVar' calls (+ 1) >> readTVar calls)+                  withMVar eventLock $ \_ -> appendFile (directory </> "events") ("hurl-start-" <> show ordinal <> "\n")+                  threadDelay 80000+                  withMVar eventLock $ \_ -> appendFile (directory </> "events") ("hurl-end-" <> show ordinal <> "\n")+                  pure (Right success)+          result <- run directory workspace 2 runner+          result ^. #selectedExitCode @?= ExitSuccess+          readTVarIO peak >>= (@?= 2)+          events <- lines <$> readFile (directory </> "events")+          take 7 events @?= ["setup", "s1-start", "s1-ready", "s2-start", "s2-ready", "s3-start", "s3-ready"]+          take 3 (drop 11 events) @?= ["s1-stop", "s1-start", "s1-ready"]+          drop (length events - 4) events @?= ["s1-stop", "s3-stop", "s2-stop", "teardown"]+          [event ^. #action | LifecycleStep event <- result ^. #steps] @?= ["restart"]+          map (view #outcome) (toList (result ^. #cases)) @?= replicate 4 CasePassed+          raw <- ByteString.readFile (directory </> "reports" </> "failure" </> "summary.json")+          assertBool "private output not serialized" (not ("private-phaseSpec-sentinel" `ByteString.isInfixOf` raw))+          ByteString.readFile (directory </> "reports" </> "failure" </> "phases" </> "setup" </> "0" </> "stdout") >>= (@?= "private-phaseSpec-sentinel\n")+          assertStopped directory,+      testCase "Stop and Start are barriers and intentional monitor retirement succeeds" $+        fixture $ \directory original -> do+          workspace <- changed original $ \ws -> ws & #suites %~ map (\suite -> suite & #runs .~ [ServiceRun (Stop (ServiceName "s2")), RecipeRun (RecipeName "r1"), ServiceRun (Start (ServiceName "s2")), RecipeRun (RecipeName "r2")])+          result <- run directory workspace 1 passingRunner+          result ^. #selectedExitCode @?= ExitSuccess+          [event ^. #action | LifecycleStep event <- result ^. #steps] @?= ["stop", "start"]+          assertStopped directory,+      testCase "second and third readiness failures clean the failing group first" $+        for_ ["s2", "s3"] $ \failed -> fixture $ \directory original -> do+          workspace <- changed original $ \ws -> ws & #services %~ map (\definition -> if definition ^. #name == ServiceName failed then definition & #readiness .~ CommandReadinessCheck (CommandReadiness (pythonSpec "raise SystemExit(1)") 10 1) else definition)+          result <- run directory workspace 1 forbidden+          result ^. #selectedExitCode @?= ExitFailure 4+          events <- lines <$> readFile (directory </> "events")+          let count = if failed == "s2" then 2 else 3+          drop (1 + 2 * count) events @?= (reverse (take count ["s1-stop", "s2-stop", "s3-stop"]) <> ["teardown"])+          assertStopped directory,+      testCase "setup failure skips later setup and services, attempts every teardown" $+        fixture $ \directory original -> do+          workspace <- changed original $ \ws ->+            ws+              & #suites+              %~ map+                ( \suite ->+                    suite+                      & #setup+                      .~ [phaseSpec directory "setup-failed" 9, phaseSpec directory "unreachable" 0]+                      & #teardown+                      .~ [phaseSpec directory "teardown-failed" 7, phaseSpec directory "teardown-last" 0]+                )+          result <- run directory workspace 1 forbidden+          result ^. #selectedExitCode @?= ExitFailure 4+          result ^. #primaryFailure @?= Just "setup-failed"+          map (view #status) (result ^. #phases) @?= [CommandFailed, CommandSkipped, CommandFailed, CommandPassed]+          lines <$> readFile (directory </> "events") >>= (@?= ["setup-failed", "teardown-failed", "teardown-last"]),+      testCase "Hurl primary failure survives failing teardown and fail-fast skips barriers" $+        fixture $ \directory original -> do+          workspace <- changed original $ \ws ->+            ws+              & #suites+              %~ map+                ( \suite ->+                    suite+                      & #failFast+                      .~ True+                      & #runs+                      .~ [RecipeRun (RecipeName "r1"), ServiceRun (Restart (ServiceName "s1")), RecipeRun (RecipeName "r2")]+                      & #teardown+                      .~ [phaseSpec directory "teardown" 8]+                )+          result <- run directory workspace 1 (HurlRunner (const (pure (Right (success & #exitCode .~ ExitFailure 5)))))+          result ^. #selectedExitCode @?= ExitFailure 4+          result ^. #primaryFailure @?= Just "hurl-failed"+          [event ^. #status | LifecycleStep event <- result ^. #steps] @?= ["skipped"]+          map (view #outcome) (toList (result ^. #cases)) @?= [CaseFailed (ExitFailure 5), CaseSkipped FailFastTriggered]+          assertStopped directory,+      testCase "keep-going reaches later batches after ordinary Hurl failures" $+        fixture $ \directory original -> do+          workspace <- changed original $ \ws -> ws & #suites %~ map (\suite -> suite & #runs .~ [RecipeRun (RecipeName "r1"), ServiceRun (Restart (ServiceName "s1")), RecipeRun (RecipeName "r2")])+          result <- run directory workspace 1 (HurlRunner (const (pure (Right (success & #exitCode .~ ExitFailure 5)))))+          result ^. #selectedExitCode @?= ExitFailure 5+          [event ^. #status | LifecycleStep event <- result ^. #steps] @?= ["passed"]+          map (view #outcome) (toList (result ^. #cases)) @?= replicate 2 (CaseFailed (ExitFailure 5)),+      testCase "unexpected leader death cancels active children and preserves completed cases" $+        fixture $ \directory original -> do+          calls <- newTVarIO (0 :: Int)+          active <- newTVarIO (0 :: Int)+          blocked <- newEmptyTMVarIO+          let runner = HurlRunner $ \_ -> do+                ordinal <- atomically (modifyTVar' calls (+ 1) >> readTVar calls)+                if ordinal == 1+                  then pure (Right success)+                  else bracket_+                    (atomically (modifyTVar' active (+ 1)))+                    (atomically (modifyTVar' active (subtract 1)))+                    $ do+                      writeFile (directory </> "s1-die") "die"+                      _ <- atomically (takeTMVar blocked)+                      pure (Right success)+          result <- bounded (run directory original 1 runner)+          result ^. #selectedExitCode @?= ExitFailure 4+          readTVarIO active >>= (@?= 0)+          map (view #outcome) (take 1 (toList (result ^. #cases))) @?= [CasePassed]+          assertStopped directory,+      testCase "cancellation reaps all services before teardown and writes partial summary" $+        fixture $ \directory original -> do+          started <- newEmptyTMVarIO+          blocked <- newEmptyTMVarIO+          let runner = HurlRunner $ \_ -> do+                atomically (putTMVar started ())+                _ <- atomically (takeTMVar blocked)+                pure (Right success)+          withAsync (run directory original 1 runner) $ \worker -> do+            bounded (atomically (takeTMVar started))+            bounded (cancel worker)+            waitCatch worker >>= \case Left _ -> pure (); Right _ -> assertFailure "cancellation was swallowed"+          events <- lines <$> readFile (directory </> "events")+          drop (length events - 4) events @?= ["s3-stop", "s2-stop", "s1-stop", "teardown"]+          summary <- ByteString.readFile (directory </> "reports" </> "failure" </> "summary.json")+          assertBool "cancelled summary retained" ("cancelled" `ByteString.isInfixOf` summary)+          assertStopped directory,+      testCase "teardown collectively expires and records remaining skips" $+        fixture $ \directory original -> do+          workspace <- changed original $ \ws ->+            ws+              & #suites+              %~ map+                ( \suite ->+                    suite+                      & #cleanupTimeoutSeconds+                      .~ 1+                      & #teardown+                      .~ [pythonSpec "import time; time.sleep(30)", phaseSpec directory "unreachable-teardown" 0]+                )+          result <- bounded (run directory workspace 1 passingRunner)+          result ^. #selectedExitCode @?= ExitFailure 4+          map (view #status) (filter ((== "teardown") . view #phase) (result ^. #phases)) @?= [CommandTimedOut, CommandSkipped]+          assertStopped directory,+      testCase "service restarts and teardown retain the preflight environment snapshot" $+        fixture $ \directory original -> do+          previous <- lookupEnv "HURL_WORKBENCH_SNAPSHOT_TEST"+          let restore = maybe (unsetEnv "HURL_WORKBENCH_SNAPSHOT_TEST") (setEnv "HURL_WORKBENCH_SNAPSHOT_TEST") previous+          bracket_ (setEnv "HURL_WORKBENCH_SNAPSHOT_TEST" "initial") restore $ do+            workspace <- changed original $ \ws ->+              ws+                & #services+                %~ map+                  ( \definition ->+                      definition+                        & #command+                        . #arguments+                        %~ ( \args -> case args of+                               [flag, code] -> [flag, "import os; assert os.environ['HURL_WORKBENCH_SNAPSHOT_TEST'] == 'initial'; " <> code]+                               _ -> args+                           )+                  )+                & #suites+                %~ map+                  ( \suite ->+                      suite+                        & #runs+                        .~ [RecipeRun (RecipeName "r1"), ServiceRun (Restart (ServiceName "s1")), RecipeRun (RecipeName "r2")]+                        & #teardown+                        .~ [pythonSpec "import os; assert os.environ['HURL_WORKBENCH_SNAPSHOT_TEST'] == 'initial'"]+                  )+            let runner = HurlRunner (\_ -> setEnv "HURL_WORKBENCH_SNAPSHOT_TEST" "changed" >> pure (Right success))+            result <- run directory workspace 1 runner+            result ^. #selectedExitCode @?= ExitSuccess,+      testCase "all late phase environments are preflighted before setup" $+        fixture $ \directory original -> do+          workspace <- changed original $ \ws -> ws & #suites %~ map (\suite -> suite & #teardown .~ [pythonSpec "pass" & #environmentPolicy .~ Clean ["HURL_WORKBENCH_MISSING_PHASE_918273"]])+          result <- runSuiteWith validate forbidden capabilities workspace (suiteRequest directory 1)+          case result of Left _ -> pure (); Right _ -> assertFailure "bad late pythonSpec accepted"+          doesFileExist (directory </> "events") >>= (@?= False),+      testCase "external mode rejects lifecycle steps and bypasses all phases otherwise" $+        fixture $ \directory original -> do+          let req = suiteRequest directory 1 & #suiteOptions . #manageService .~ False+          result <- runSuiteWith validate passingRunner capabilities original req >>= requireResult+          result ^. #services @?= []+          result ^. #phases @?= []+          doesFileExist (directory </> "events") >>= (@?= False)+          workspace <- changed original $ \ws -> ws & #suites %~ map (\suite -> suite & #runs %~ (ServiceRun (Restart (ServiceName "s1")) :))+          rejected <- runSuiteWith validate forbidden capabilities workspace (req & #suiteOptions . #overwriteReports .~ True)+          case rejected of Left err -> assertBool "external lifecycle refusal" (SuiteExternalLifecycle `elem` toList (err ^. #issues)); Right _ -> assertFailure "external restart accepted",+      testCase "invalid transitions, duplicate services, ambiguous sugar, and zero budgets are rejected" $+        fixture $ \_ original -> for_+          [ \suite -> suite & #runs %~ (ServiceRun (Start (ServiceName "s1")) :),+            \suite -> suite & #runs %~ (ServiceRun (Stop (ServiceName "unknown")) :),+            \suite -> suite & #services .~ [ServiceName "s1", ServiceName "s1"],+            \suite -> suite & #service .~ Just (ServiceName "s1"),+            \suite -> suite & #commandTimeoutSeconds .~ 0,+            \suite -> suite & #cleanupTimeoutSeconds .~ 0+          ]+          $ \change -> do+            result <- validateWorkspace (validatedContext original & #workspace . #suites %~ map change)+            case result of Left _ -> pure (); Right _ -> assertFailure "invalid lifecycle accepted"+    ]++fixture :: (FilePath -> ValidatedWorkspace -> IO a) -> IO a+fixture action = withSystemTempDirectory "multi-service" $ \directory -> do+  context <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/suite-failure/hurl-workbench.dhall") >>= either (assertFailure . show) pure+  original <- validateWorkspace context >>= either (assertFailure . show) pure+  workspace <- changed original $ \ws ->+    ws+      & #services+      .~ map (serviceSpec directory) ["s1", "s2", "s3"]+      & #recipes+      .~ [recipe & #name .~ RecipeName name | recipe <- ws ^. #recipes, name <- ["r1", "r2", "r3", "r4"]]+      & #suites+      %~ map+        ( \suite ->+            suite+              & #service+              .~ Nothing+              & #services+              .~ map ServiceName ["s1", "s2", "s3"]+              & #runs+              .~ map (RecipeRun . RecipeName) ["r1", "r2", "r3", "r4"]+              & #setup+              .~ [phaseSpec directory "setup" 0]+              & #teardown+              .~ [phaseSpec directory "teardown" 0]+        )+  action directory workspace++changed :: ValidatedWorkspace -> (Workspace -> Workspace) -> IO ValidatedWorkspace+changed original change = validateWorkspace (validatedContext original & #workspace %~ change) >>= either (assertFailure . show) pure++pythonSpec :: Text -> CommandSpec+pythonSpec code = CommandSpec "python3" ["-c", code] Nothing Inherit []++phaseSpec :: FilePath -> String -> Int -> CommandSpec+phaseSpec directory label exitCode = pythonSpec (Text.pack ("open(" <> show (directory </> "events") <> ", 'a').write(" <> show (label <> "\n") <> "); print('private-phaseSpec-sentinel'); raise SystemExit(" <> show exitCode <> ")"))++serviceSpec :: FilePath -> Text -> Service+serviceSpec directory name =+  Service+    (ServiceName name)+    (pythonSpec script)+    (CommandReadinessCheck (CommandReadiness (pythonSpec probe) 10 2))+    1+    Nothing+  where+    prefix = directory </> Text.unpack name+    probe = Text.pack ("import os; raise SystemExit(0 if os.path.exists(" <> show (prefix <> "-ready") <> ") else 1)")+    script =+      Text.unlines+        [ "import os, signal, time",+          "prefix = " <> Text.pack (show prefix),+          "events = " <> Text.pack (show (directory </> "events")),+          "def event(value):",+          "    with open(events, 'a') as out: out.write(value + '\\n')",+          "def stop(*args):",+          "    event('" <> name <> "-stop')",+          "    if os.path.exists(prefix + '-ready'): os.unlink(prefix + '-ready')",+          "    raise SystemExit(0)",+          "signal.signal(signal.SIGTERM, stop)",+          "open(prefix + '-pid', 'a').write(str(os.getpid()) + '\\n')",+          "event('" <> name <> "-start')",+          "time.sleep(0.03)",+          "event('" <> name <> "-ready')",+          "open(prefix + '-ready', 'w').write('ready')",+          "while not os.path.exists(prefix + '-die'): time.sleep(0.01)",+          "raise SystemExit(9)"+        ]++suiteRequest :: FilePath -> Int -> SuiteRequest+suiteRequest directory jobs =+  SuiteRequest+    (SuiteName "failure")+    Nothing+    Nothing+    emptyBindingInput+    defaultHurlOptions+    (SuiteOptions (either (error . show) id (mkPositiveInt jobs)) Nothing False True Set.empty (Just (directory </> "reports")) False)++capabilities :: HurlfmtCapabilities+capabilities = HurlfmtCapabilities (HurlfmtExecutable "true") (makeVersion [8, 0, 1])++validate :: HurlfmtCapabilities -> a -> IO (Either HurlfmtError ())+validate _ _ = pure (Right ())++run :: FilePath -> ValidatedWorkspace -> Int -> HurlRunner -> IO SuiteResult+run directory workspace jobs runner = runSuiteWith validate runner capabilities workspace (suiteRequest directory jobs) >>= requireResult++requireResult :: Either SuitePreflightError SuiteResult -> IO SuiteResult+requireResult = either (assertFailure . show) pure++success :: RunResult+success = RunResult ExitSuccess 0.01 Nothing++passingRunner :: HurlRunner+passingRunner = HurlRunner (const (pure (Right success)))++forbidden :: HurlRunner+forbidden = HurlRunner (const (assertFailure "Hurl must not start"))++bounded :: IO a -> IO a+bounded action = Timeout.timeout 12000000 action >>= maybe (assertFailure "lifecycle did not finish within 12 seconds") pure++assertStopped :: FilePath -> IO ()+assertStopped directory = for_ ["s1", "s2", "s3"] $ \name -> do+  let path = directory </> name <> "-pid"+  exists <- doesFileExist path+  when exists $ do+    pids <- map read . lines <$> readFile path+    for_ pids $ \pid -> do+      alive <- try @IOException (signalProcess nullSignal pid)+      assertBool ("owned child survived: " <> show pid) (either (const True) (const False) alive)
+ test/HurlWorkbench/Suite/RunTest.hs view
@@ -0,0 +1,359 @@+module HurlWorkbench.Suite.RunTest (tests) where++import Control.Concurrent.Async (AsyncCancelled (..), cancel, waitCatch, withAsync)+import Control.Concurrent.STM (TVar, atomically, modifyTVar', newEmptyTMVarIO, newTVarIO, putTMVar, readTVar, readTVarIO, takeTMVar)+import Control.Exception (bracket_, fromException)+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString qualified as ByteString+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Version (makeVersion)+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.Suite.Isolation+import HurlWorkbench.Suite.LifecycleTest qualified as LifecycleTest+import HurlWorkbench.Suite.Resolve+import HurlWorkbench.Suite.Run+import HurlWorkbench.Suite.Scenario (ScenarioInputs (..))+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Error (renderWorkspaceError)+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Directory (createDirectoryIfMissing, createDirectoryLink, doesPathExist)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "integration suites"+    [ LifecycleTest.tests,+      testCase "explicit suite roots reach every request and protect refusal-summary inputs" $+        withSystemTempDirectory "suite-file-root" $ \directory -> do+          workspace <- loadValidated "test/fixtures/workspaces/isolation/hurl-workbench.dhall"+          root <- validateFileRoot directory (Just directory) >>= either (assertFailure . show) pure+          requests <- newTVarIO []+          let input = emptyBindingInput {plainOverrides = Map.singleton (ParameterName "baseUrl") (literal "http://fixture.test")}+              request = SuiteRequest (SuiteName "reads") (Just root) Nothing input defaultHurlOptions (SuiteOptions (positive 2) Nothing False False Set.empty Nothing False)+          _ <- runSuite (recordingRunner requests) trueCapabilities workspace request >>= requireSuite+          observed <- readTVarIO requests+          assertBool "all suite cases ran" (length observed > 1)+          for_ observed $ \run -> run ^. #fileRoot @?= root+          let forbidden _ _ = assertFailure "formatter ran before output preflight"+          result <- runSuiteWith forbidden (HurlRunner (const (assertFailure "Hurl ran"))) trueCapabilities workspace (request & #suiteOptions . #reportDirectory .~ Just directory & #suiteOptions . #overwriteReports .~ True)+          case result of+            Left err -> assertBool "root failure" (all (\case SuiteFileRootFailed _ -> True; _ -> False) (err ^. #issues))+            Right _ -> assertFailure "suite accepted overlapping report root"+          doesPathExist (directory </> "reads") >>= (@?= False),+      testCase "parallel unsafe suites are refused before syntax, binding IO, service, or Hurl" $ do+        workspace <- loadValidated "test/fixtures/workspaces/isolation/hurl-workbench.dhall"+        let request name allowed manage = SuiteRequest (SuiteName name) Nothing Nothing emptyBindingInput defaultHurlOptions (SuiteOptions (positive 2) Nothing allowed manage Set.empty Nothing False)+            forbidden _ _ = assertFailure "syntax validator called"+            runner = HurlRunner (const (assertFailure "Hurl started"))+        for_ [False, True] $ \allowed -> for_ [False, True] $ \manage -> do+          for_ ["mixed", "single-write"] $ \name -> do+            result <- runSuiteWith forbidden runner trueCapabilities workspace (request name allowed manage)+            case result of+              Left err -> do+                let unsafe = [scenario | SuiteIsolationFailed (SharedStateParallelUnsafe scenario _) <- toList (err ^. #issues)]+                unsafe @?= if name == "mixed" then ["dangerous-health", "writes/first", "writes/second", "health"] else ["dangerous-health"]+              Right _ -> assertFailure "unsafe suite started"+        for_ [1, 2] $ \jobs ->+          runSuiteWith forbidden runner trueCapabilities workspace (request "independent" True False & #suiteOptions . #jobs .~ positive jobs) >>= \case+            Left err -> toList (err ^. #issues) @?= [SuiteIsolationFailed IndependentStateHandoffRequired]+            Right _ -> assertFailure "bare independent declaration started"+        for_ [("reads", False, SuiteScenarioInputsUnexpected), ("independent", True, SuiteIndependentExternalRequired)] $ \(name, manage, issue) ->+          runSuiteWith forbidden runner trueCapabilities workspace (request name True manage & #scenarioInputs .~ Just (ScenarioInputs [])) >>= \case+            Left err -> toList (err ^. #issues) @?= [issue]+            Right _ -> assertFailure "invalid isolation mode accepted"+        for_ ["service-started", "readiness-started"] $ \marker ->+          doesPathExist ("test/fixtures/workspaces/isolation" </> marker) >>= (@?= False),+      testCase "parallel reads and serial authorized mutations remain supported" $ do+        workspace <- loadValidated "test/fixtures/workspaces/isolation/hurl-workbench.dhall"+        requests <- newTVarIO []+        let request name jobs allowed = SuiteRequest (SuiteName name) Nothing Nothing (emptyBindingInput {plainOverrides = Map.singleton (ParameterName "baseUrl") (literal "http://fixture.test")}) defaultHurlOptions (SuiteOptions (positive jobs) Nothing allowed False Set.empty Nothing False)+        readResult <- runSuite (recordingRunner requests) trueCapabilities workspace (request "reads" 2 False) >>= requireSuite+        readResult ^. #selectedExitCode @?= ExitSuccess+        length <$> readTVarIO requests >>= (@?= 3)+        write <- runSuite (recordingRunner requests) trueCapabilities workspace (request "single-write" 1 True) >>= requireSuite+        write ^. #selectedExitCode @?= ExitSuccess+        runSuite (recordingRunner requests) trueCapabilities workspace (request "single-write" 1 False) >>= \case+          Left err -> assertBool "serial still requires opt-in" (any isUnsafe (err ^. #issues))+          Right _ -> assertFailure "unauthorized mutation started",+      testCase "refusal and setup summaries contain logical cases and stable codes only" $+        withSystemTempDirectory "suite-preflight-summary" $ \directory -> do+          workspace <- loadValidated "test/fixtures/workspaces/isolation/hurl-workbench.dhall"+          let runner = HurlRunner (const (assertFailure "preflight started Hurl"))+              request name root = SuiteRequest (SuiteName name) Nothing Nothing emptyBindingInput defaultHurlOptions (SuiteOptions (positive 2) Nothing True False Set.empty (Just root) False)+          for_ [("mixed", "refused"), ("reads", "setup-failed")] $ \(name, status) -> do+            let root = directory </> name+            runSuiteWith (\_ _ -> pure (Right ())) runner trueCapabilities workspace (request (Text.pack name) root) >>= \case+              Left _ -> pure ()+              Right _ -> assertFailure "preflight unexpectedly succeeded"+            summary <- readJson (root </> name </> "summary.json")+            field "status" summary @?= Aeson.String status+            field "isolation" summary @?= Aeson.String "shared-state"+            let cases = arrayValues (field "cases" summary)+            assertBool "logical cases present" (not (null cases))+            for_ cases $ \logical -> do+              field "status" logical @?= Aeson.String "not-started"+              field "reports" logical @?= Aeson.toJSON ([] :: [Text])+              field "exitCode" logical @?= Aeson.Null+              assertBool "scenario is explicit" (field "scenario" logical /= Aeson.Null),+      testCase "unsafe report destinations and unknown suites preserve existing trees" $+        withSystemTempDirectory "suite-refusal-destination" $ \directory -> do+          workspace <- loadValidated "test/fixtures/workspaces/isolation/hurl-workbench.dhall"+          let outsideDirectory = directory </> "outside"+              link = directory </> "link"+              request name root = SuiteRequest (SuiteName name) Nothing Nothing emptyBindingInput defaultHurlOptions (SuiteOptions (positive 2) Nothing True False Set.empty (Just root) True)+              runner = HurlRunner (const (assertFailure "unexpected execution"))+          createDirectoryIfMissing True outsideDirectory+          ByteString.writeFile (outsideDirectory </> "sentinel") "preserve"+          createDirectoryLink outsideDirectory link+          result <- runSuiteWith (\_ _ -> assertFailure "unexpected format") runner trueCapabilities workspace (request "mixed" (link </> "nested"))+          case result of+            Left err -> assertBool "symlink ancestor rejected" (any (\case SuiteReportPathIsSymbolicLink _ -> True; _ -> False) (err ^. #issues))+            Right _ -> assertFailure "unsafe destination accepted"+          doesPathExist (outsideDirectory </> "nested") >>= (@?= False)+          _ <- runSuite runner trueCapabilities workspace (request "unknown" outsideDirectory)+          ByteString.readFile (outsideDirectory </> "sentinel") >>= (@?= "preserve")+          doesPathExist (outsideDirectory </> "unknown") >>= (@?= False),+      testCase "cancellation retains completed outcomes, joins workers, and propagates even if summary writing fails" $+        for_ [False, True] $ \breakSummary -> withSystemTempDirectory "suite-cancel-summary" $ \directory -> do+          workspace <- loadValidated "test/fixtures/workspaces/isolation/hurl-workbench.dhall"+          started <- newEmptyTMVarIO+          blocked <- newEmptyTMVarIO+          starts <- newTVarIO (0 :: Int)+          active <- newTVarIO (0 :: Int)+          let summaryPath = directory </> "reads" </> "summary.json"+              literal_ = literal "private-plain-sentinel"+              request = SuiteRequest (SuiteName "reads") Nothing Nothing (emptyBindingInput {plainOverrides = Map.singleton (ParameterName "baseUrl") literal_}) defaultHurlOptions (SuiteOptions (positive 1) Nothing False False Set.empty (Just directory) False)+              runner = HurlRunner $ \_ -> do+                ordinal <- atomically $ do+                  modifyTVar' starts (+ 1)+                  count <- readTVar starts+                  pure count+                if ordinal == 1+                  then pure (Right (RunResult ExitSuccess 0.01 (Just (CapturedRunOutput "private-captured-sentinel" "private-secret-sentinel"))))+                  else bracket_+                    (atomically (modifyTVar' active (+ 1)))+                    (atomically (modifyTVar' active (subtract 1)))+                    $ do+                      when breakSummary (createDirectoryIfMissing True summaryPath)+                      atomically (putTMVar started ())+                      _ <- atomically (takeTMVar blocked)+                      assertFailure "cancelled run resumed"+          withAsync (runSuiteWith (\_ _ -> pure (Right ())) runner trueCapabilities workspace request) $ \worker -> do+            atomically (takeTMVar started)+            cancel worker+            waitCatch worker >>= \case+              Left err -> (fromException err :: Maybe AsyncCancelled) @?= Just AsyncCancelled+              Right _ -> assertFailure "cancellation returned a SuiteResult"+          readTVarIO active >>= (@?= 0)+          readTVarIO starts >>= (@?= 2)+          unless breakSummary $ do+            raw <- ByteString.readFile summaryPath+            for_ ["private-plain-sentinel", "private-captured-sentinel", "private-secret-sentinel"] $ \sentinel -> assertBool "summary redacted" (not (sentinel `ByteString.isInfixOf` raw))+            summary <- readJson summaryPath+            field "status" summary @?= Aeson.String "cancelled"+            let cases = arrayValues (field "cases" summary)+            map (field "scenario") cases @?= map Aeson.String ["health-cases/first", "health-cases/second", "health-cases/third"]+            map (field "status") cases @?= map Aeson.String ["passed", "cancelled", "cancelled"],+      testCase "summary failure preserves a managed-service failure status" $+        withSystemTempDirectory "suite-service-summary-failure" $ \directory -> do+          original <- failureWorkspace+          let summaryPath = directory </> "failure" </> "summary.json"+              context = validatedContext original+              sabotage service = service & #command . #executable .~ "python3" & #command . #arguments .~ ["-c", "import os, sys; os.mkdir(sys.argv[1]); raise SystemExit(9)", Text.pack summaryPath]+          workspace <- validateWorkspace (context & #workspace . #services %~ map sabotage) >>= either (assertFailure . show) pure+          requests <- newTVarIO []+          let request = SuiteRequest (SuiteName "failure") Nothing Nothing emptyBindingInput defaultHurlOptions (SuiteOptions (positive 1) Nothing False True Set.empty (Just directory) False)+          result <- runSuite (recordingRunner requests) trueCapabilities workspace request >>= requireSuite+          result ^. #selectedExitCode @?= ExitFailure 4+          assertBool "summary failure retained" (isJust (result ^. #summaryError))+          readTVarIO requests >>= (@?= []),+      testCase "missing managed environment skips Hurl; external service bypasses policy" $ do+        original <- failureWorkspace+        let context = validatedContext original+            services = map (\service -> service & #command . #environmentPolicy .~ Clean ["HURL_WORKBENCH_TEST_ABSENT_972638"]) (validatedWorkspace original ^. #services)+        workspace <- validateWorkspace (context & #workspace . #services .~ services) >>= either (assertFailure . show) pure+        requests <- newTVarIO []+        let request = SuiteRequest (SuiteName "failure") Nothing Nothing emptyBindingInput defaultHurlOptions (SuiteOptions (positive 1) Nothing False True Set.empty Nothing False)+        result <- runSuite (recordingRunner requests) trueCapabilities workspace request+        case result of+          Left err -> assertBool "missing environment rejected in preflight" (any (\case SuiteServiceResolutionFailed _ -> True; _ -> False) (err ^. #issues))+          Right _ -> assertFailure "missing managed environment accepted"+        readTVarIO requests >>= (@?= [])+        external <- runSuite (recordingRunner requests) trueCapabilities workspace (request & #suiteOptions . #manageService .~ False) >>= requireSuite+        external ^. #selectedExitCode @?= ExitSuccess+        length <$> readTVarIO requests >>= (@?= 1),+      testCase "blocks unclassified runs before the managed service or Hurl starts" $+        withSystemTempDirectory "hurl-workbench-suite-gate" $ \directory -> do+          ByteString.writeFile (directory </> "secrets.env") "client_secret=suite-secret\n"+          workspace <- fullWorkspace+          requests <- newTVarIO []+          result <- runSuite (recordingRunner requests) trueCapabilities workspace (fullSuiteRequest directory False True Set.empty Nothing False)+          case result of+            Left err ->+              assertBool+                "preflight identifies the unclassified workflow"+                (any isUnsafe (toList (err ^. #issues)))+            Right _ -> assertFailure "expected the suite safety gate to fail"+          readTVarIO requests >>= (@?= []),+      testCase "flattens runs, isolates reports, and writes a redacted atomic summary" $+        withSystemTempDirectory "hurl-workbench-suite-reports" $ \directory -> do+          ByteString.writeFile (directory </> "secrets.env") "client_secret=suite-secret\n"+          workspace <- fullWorkspace+          requests <- newTVarIO []+          let reportRoot = directory </> "reports"+              request = fullSuiteRequest directory True False (Set.fromList [JUnit, Json]) (Just reportRoot) False+          result <- runSuite (recordingRunner requests) trueCapabilities workspace request >>= requireSuite+          map (view #name) (toList (result ^. #cases))+            @?= ["list-members", "top-properties", "property-page-sizes/small", "property-page-sizes/large"]+          result ^. #serviceOutcome @?= Nothing+          result ^. #selectedExitCode @?= ExitSuccess+          summary <- maybe (assertFailure "missing summary path") pure (result ^. #summaryPath)+          rawSummary <- ByteString.readFile summary+          assertBool "summary omits secret values" (not ("suite-secret" `ByteString.isInfixOf` rawSummary))+          assertBool "summary omits plain runtime values" (not ("suite-client" `ByteString.isInfixOf` rawSummary))+          assertBool "summary names relative report targets" ("property-page-sizes/small/junit.xml" `ByteString.isInfixOf` rawSummary)+          observed <- readTVarIO requests+          length observed @?= 4+          traverse_ assertTestRequest observed+          traverse_ (traverse_ assertReportExists . requestReportPaths) observed+          runSuite (recordingRunner requests) trueCapabilities workspace request >>= \case+            Left err -> assertBool "existing suite report root is rejected" (any isExistingReport (toList (err ^. #issues)))+            Right _ -> assertFailure "expected an existing report error"+          overwritten <- runSuite (recordingRunner requests) trueCapabilities workspace (request & #suiteOptions . #overwriteReports .~ True) >>= requireSuite+          overwritten ^. #selectedExitCode @?= ExitSuccess,+      testCase "turns managed-service failure into exit 4 and prerequisite skips" $ do+        workspace <- failureWorkspace+        requests <- newTVarIO []+        let request =+              SuiteRequest+                { suiteName = SuiteName "failure",+                  fileRoot = Nothing,+                  scenarioInputs = Nothing,+                  bindingInput = emptyBindingInput,+                  hurlOptions = defaultHurlOptions,+                  suiteOptions = SuiteOptions (positive 1) Nothing False True Set.empty Nothing False+                }+        result <- runSuite (recordingRunner requests) trueCapabilities workspace request >>= requireSuite+        result ^. #selectedExitCode @?= ExitFailure 4+        map (view #outcome) (toList (result ^. #cases)) @?= [CaseSkipped BatchPrerequisiteFailed]+        case result ^. #serviceOutcome of+          Just (ServiceFailed _) -> pure ()+          other -> assertFailure ("expected managed-service failure, got " <> show other)+        readTVarIO requests >>= (@?= [])+    ]++fullSuiteRequest :: FilePath -> Bool -> Bool -> Set ReportFormat -> Maybe FilePath -> Bool -> SuiteRequest+fullSuiteRequest directory allowMutating manageService reportFormats reportDirectory overwriteReports =+  SuiteRequest+    { suiteName = SuiteName "smoke",+      fileRoot = Nothing,+      scenarioInputs = Nothing,+      bindingInput =+        emptyBindingInput+          { plainOverrides = Map.singleton (ParameterName "client_id") (literal "suite-client"),+            secretFiles = [directory </> "secrets.env"]+          },+      hurlOptions = defaultHurlOptions,+      suiteOptions =+        SuiteOptions+          { jobs = positive 1,+            failFastOverride = Nothing,+            allowMutating,+            manageService,+            reportFormats,+            reportDirectory,+            overwriteReports+          }+    }++recordingRunner :: TVar [RunRequest] -> HurlRunner+recordingRunner requests = HurlRunner $ \request -> do+  materializeReports request+  atomically (modifyTVar' requests (request :))+  pure (Right (RunResult ExitSuccess 0.01 (Just (CapturedRunOutput "" ""))))++materializeReports :: RunRequest -> IO ()+materializeReports request = traverse_ create (request ^. #reportTargets)+  where+    create = \case+      JUnitReport path -> ByteString.writeFile path "<testsuites/>"+      TapReport path -> ByteString.writeFile path "1..0\n"+      HtmlReport path -> createDirectoryIfMissing True path >> ByteString.writeFile (path </> "index.html") ""+      JsonReport path -> createDirectoryIfMissing True path >> ByteString.writeFile (path </> "report.json") "{}"++requestReportPaths :: RunRequest -> [FilePath]+requestReportPaths request = map path (request ^. #reportTargets)+  where+    path = \case+      JUnitReport value -> value+      TapReport value -> value+      HtmlReport value -> value+      JsonReport value -> value++assertTestRequest :: RunRequest -> IO ()+assertTestRequest request = do+  request ^. #mode @?= TestMode+  length (request ^. #reportTargets) @?= 2++assertReportExists :: FilePath -> IO ()+assertReportExists path = doesPathExist path >>= assertBool ("fake report target was not created: " <> path)++requireSuite :: Either SuitePreflightError SuiteResult -> IO SuiteResult+requireSuite = either (assertFailure . Text.unpack . renderSuitePreflightError) pure++isUnsafe :: SuitePreflightIssue -> Bool+isUnsafe SuiteUnsafeRun {} = True+isUnsafe _ = False++isExistingReport :: SuitePreflightIssue -> Bool+isExistingReport SuiteReportPathExists {} = True+isExistingReport _ = False++literal :: Text -> HurlValueLiteral+literal value = either (error . show) id (mkHurlValueLiteral value)++positive :: Int -> PositiveInt+positive value = either (error . show) id (mkPositiveInt value)++trueCapabilities :: HurlfmtCapabilities+trueCapabilities = HurlfmtCapabilities (HurlfmtExecutable "true") (makeVersion [8, 0, 1])++fullWorkspace :: IO ValidatedWorkspace+fullWorkspace = loadValidated "test/fixtures/workspaces/full/hurl-workbench.dhall"++failureWorkspace :: IO ValidatedWorkspace+failureWorkspace = loadValidated "test/fixtures/workspaces/suite-failure/hurl-workbench.dhall"++loadValidated :: FilePath -> IO ValidatedWorkspace+loadValidated path = do+  loaded <- loadWorkspaceContext (ExplicitWorkspace path)+  context <- either (assertFailure . Text.unpack . renderWorkspaceError) pure loaded+  validateWorkspace context >>= either (assertFailure . Text.unpack . Text.unlines . map renderValidationIssue . toList) pure++readJson :: FilePath -> IO Aeson.Value+readJson path = ByteString.readFile path >>= either assertFailure pure . Aeson.eitherDecodeStrict++field :: Aeson.Key -> Aeson.Value -> Aeson.Value+field key (Aeson.Object object) = fromMaybe Aeson.Null (KeyMap.lookup key object)+field _ _ = Aeson.Null++arrayValues :: Aeson.Value -> [Aeson.Value]+arrayValues (Aeson.Array values) = toList values+arrayValues _ = []
+ test/HurlWorkbench/Suite/ScenarioTest.hs view
@@ -0,0 +1,113 @@+module HurlWorkbench.Suite.ScenarioTest (tests) where++import Data.ByteString qualified as ByteString+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import HurlWorkbench.Parameter.Resolve+import HurlWorkbench.Prelude+import HurlWorkbench.Run.Selection+import HurlWorkbench.Suite.Scenario+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Directory (createFileLink)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (setFileMode)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "scenario handoff"+    [ testCase "strict decoding never reveals malformed private input" $ do+        for_ ["{private-endpoint", "{\"version\":1,\"scenarios\":[],\"private-secret\":1}", "{\"version\":1,\"scenarios\":[{\"scenario\":\"private-fixture\"}]}"] $ \bytes ->+          decodeScenarioInputs bytes @?= Left ScenarioMalformedInput+        decodeScenarioInputs "{\"version\":2,\"scenarios\":[]}" @?= Left ScenarioUnsupportedVersion+        decodeScenarioInputs "{\"version\":1,\"scenarios\":[]}" @?= Right (ScenarioInputs []),+      testCase "file loader requires a private regular file and rejects symlinks" $+        withSystemTempDirectory "scenario-file" $ \directory -> do+          let path = directory </> "inputs.json"+          ByteString.writeFile path "{\"version\":1,\"scenarios\":[]}"+          setFileMode path 0o644+          loadScenarioInputs path >>= (@?= Left ScenarioFileNotPrivateRegular)+          setFileMode path 0o600+          loadScenarioInputs path >>= (@?= Right (ScenarioInputs []))+          createFileLink path (directory </> "link")+          loadScenarioInputs (directory </> "link") >>= (@?= Left ScenarioFileNotPrivateRegular)+          loadScenarioInputs directory >>= (@?= Left ScenarioFileNotPrivateRegular)+          loadScenarioInputs (directory </> "absent") >>= (@?= Left ScenarioFileUnreadable),+      testCase "whole assignments reject incomplete, duplicate, invalid, and conflicting inputs" $ do+        workspace <- loadValidated+        runs <- either (assertFailure . show) (pure . toList) (resolveSelection workspace (SelectMatrix (MatrixName "writes")))+        let first_ = assignment "writes/first" "private-fixture-a" "http://EXAMPLE.test"+            second_ = assignment "writes/second" "private-fixture-b" "http://other.test:81/"+            check expected common entries =+              verifyScenarioInputs workspace runs common (ScenarioInputs entries) >>= \case+                Left err -> err @?= expected+                Right _ -> assertFailure "invalid handoff verified"+        verified <- verifyScenarioInputs workspace runs emptyBindingInput (ScenarioInputs [second_, first_]) >>= either (assertFailure . show) pure+        assertBool "verified Show redacts runtime input" (not ("private" `Text.isInfixOf` Text.pack (show verified)))+        assertBool "raw Show redacts runtime input" (not ("private" `Text.isInfixOf` Text.pack (show (ScenarioInputs [first_]))))+        for_ runs $ \run -> do+          input <- maybe (assertFailure "missing assigned input") pure (scenarioBindingInput verified run)+          Map.keys (input ^. #plainOverrides) @?= [ParameterName "baseUrl"]+        check ScenarioAssignmentMismatch emptyBindingInput [first_]+        check ScenarioAssignmentMismatch emptyBindingInput [first_, first_]+        check ScenarioAssignmentMismatch emptyBindingInput [first_, second_ & #scenario .~ "writes/extra"]+        check ScenarioInvalidLabel emptyBindingInput [first_ & #scenario .~ "../private", second_]+        check ScenarioDuplicateFixture emptyBindingInput [first_, second_ & #fixtureId .~ "private-fixture-a"]+        check ScenarioInvalidFixture emptyBindingInput [first_ & #fixtureId .~ "private\nfixture", second_]+        for_ ["http://example.TEST:80/", "HTTP://EXAMPLE.TEST", "http://example.test:080/"] $ \endpoint ->+          check ScenarioDuplicateEndpoint emptyBindingInput [first_, second_ & #endpoint .~ endpoint]+        for_ ["ftp://private.test", "http://private.test/path", "http://user:private@host", "http://private.test/?secret", "http://private.test/#fragment", "http://private.test:99999", "http://private.test/ "] $ \endpoint ->+          check ScenarioInvalidEndpoint emptyBindingInput [first_ & #endpoint .~ endpoint, second_]+        check ScenarioDuplicateParameter emptyBindingInput [first_ & #bindings .~ [ScenarioBinding (ParameterName "baseUrl") "private-value"], second_]+        check ScenarioInvalidParameter emptyBindingInput [first_ & #endpointParameter .~ ParameterName "undeclared", second_]+        check ScenarioDuplicateParameter emptyBindingInput [first_ & #secretEnvironment .~ [ScenarioSecret (ParameterName "baseUrl") "PRIVATE_ENV"], second_]+        let literal = either (error . show) id (mkHurlValueLiteral "private-override")+        check ScenarioConflictingBinding (emptyBindingInput {plainOverrides = Map.singleton (ParameterName "baseUrl") literal}) [first_, second_]+        withSystemTempDirectory "scenario-conflict" $ \directory -> do+          let file = directory </> "variables"+          ByteString.writeFile file "baseUrl=private-file-value\n"+          check ScenarioConflictingBinding (emptyBindingInput {variableFiles = [file]}) [first_, second_]+          check ScenarioConflictingBinding (emptyBindingInput {secretFiles = [file]}) [first_, second_],+      testCase "handoff conflicts with committed layers and enforces workflow parameter kinds" $ do+        loaded <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/full/hurl-workbench.dhall")+        context <- either (assertFailure . show) pure loaded+        workspace <- validateWorkspace context >>= either (assertFailure . show) pure+        runs <- either (assertFailure . show) (pure . toList) (resolveSelection workspace (SelectMatrix (MatrixName "property-page-sizes")))+        let inputs binding =+              ScenarioInputs+                [ (assignment (run ^. #artifactStem) (Text.pack (show ordinal)) ("https://fixture" <> Text.pack (show ordinal) <> ".test"))+                    { endpointParameter = ParameterName "base_url",+                      bindings = [binding]+                    }+                | (ordinal, run) <- zip [1 :: Int ..] runs+                ]+            check expected raw =+              verifyScenarioInputs workspace runs emptyBindingInput raw >>= \case+                Left issue -> issue @?= expected+                Right _ -> assertFailure "invalid provider binding accepted"+        check ScenarioConflictingBinding (inputs (ScenarioBinding (ParameterName "top") "private-generated-value"))+        check ScenarioInvalidParameter (inputs (ScenarioBinding (ParameterName "client_secret") "private-plain-secret"))+        check ScenarioRuntimeInputFailed (inputs (ScenarioBinding (ParameterName "client_id") " private-invalid-literal "))+        let ScenarioInputs valid = inputs (ScenarioBinding (ParameterName "client_id") "private-generated-client")+        verifyScenarioInputs workspace runs emptyBindingInput (ScenarioInputs valid) >>= \case+          Left issue -> assertFailure (show issue)+          Right verified -> for_ runs $ \run -> do+            input <- maybe (assertFailure "missing assignment") pure (scenarioBindingInput verified run)+            assertBool "provider overrides declared endpoint fallback" (Map.member (ParameterName "base_url") (input ^. #plainOverrides))+    ]++assignment :: FilePath -> Text -> Text -> ScenarioAssignment+assignment scenario fixtureId endpoint = ScenarioAssignment scenario fixtureId endpoint (ParameterName "baseUrl") [] []++loadValidated :: IO ValidatedWorkspace+loadValidated = do+  loaded <- loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/isolation/hurl-workbench.dhall")+  context <- either (assertFailure . show) pure loaded+  validateWorkspace context >>= either (assertFailure . show) pure
+ test/HurlWorkbench/Workflow/WorkflowTest.hs view
@@ -0,0 +1,244 @@+module HurlWorkbench.Workflow.WorkflowTest (tests) where++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 Data.Text.IO qualified as Text.IO+import Data.Version (makeVersion)+import HurlWorkbench.Hurl.Format+import HurlWorkbench.Prelude+import HurlWorkbench.Workflow.Render+import HurlWorkbench.Workflow.Resolve+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Discover (WorkspaceSource (..))+import HurlWorkbench.Workspace.Error (renderWorkspaceError)+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Directory+  ( canonicalizePath,+    doesFileExist,+    getPermissions,+    removeFile,+    setOwnerExecutable,+    setPermissions,+  )+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "workflow"+    [ resolutionTests,+      renderingTests,+      hurlfmtTests+    ]++resolutionTests :: TestTree+resolutionTests =+  testGroup+    "resolution"+    [ testCase "resolves declared fragments in workflow order" $+        withSystemTempDirectory "hurl-workbench-resolve" $ \dir -> do+          validated <- makeWorkspace dir [("first", "first.hurl", "GET https://first.test"), ("second", "second.hurl", "GET https://second.test")] [("ordered", ["second", "first"])]+          case resolveWorkflow validated (WorkflowName "ordered") of+            Left err -> assertFailure (Text.unpack (renderWorkflowError err))+            Right resolved ->+              map (view (#fragment . #name)) (NonEmpty.toList (resolved ^. #sourceFragments))+                @?= [FragmentName "second", FragmentName "first"],+      testCase "reports an unknown workflow without a partial lookup" $+        withSystemTempDirectory "hurl-workbench-resolve" $ \dir -> do+          validated <- makeWorkspace dir [("one", "one.hurl", "GET https://one.test")] [("known", ["one"])]+          resolveWorkflow validated (WorkflowName "missing") @?= Left (WorkflowNotFound (WorkflowName "missing"))+    ]++renderingTests :: TestTree+renderingTests =+  testGroup+    "rendering"+    [ testCase "preserves bytes and inserts only required line feeds" $+        withSystemTempDirectory "hurl-workbench-render" $ \dir -> do+          let first = Text.Encoding.encodeUtf8 "GET https://first.test\r\n# café"+              second = "POST https://second.test\n"+              third = "PUT https://third.test\n\n"+              fourth = "DELETE https://fourth.test"+          validated <-+            makeWorkspace+              dir+              [("first", "first.hurl", first), ("second", "second.hurl", second), ("third", "third.hurl", third), ("fourth", "fourth.hurl", fourth)]+              [("flow", ["first", "second", "third", "fourth"])]+          rendered <- renderNamed validated "flow"+          rendered ^. #contents+            @?= Text.Encoding.decodeUtf8 first+              <> "\n\n"+              <> Text.Encoding.decodeUtf8 second+              <> "\n"+              <> Text.Encoding.decodeUtf8 third+              <> Text.Encoding.decodeUtf8 fourth+              <> "\n"+          map (\span_ -> (span_ ^. #fragmentName, span_ ^. #firstLine, span_ ^. #lastLine)) (NonEmpty.toList (rendered ^. #fragmentSpans))+            @?= [ (FragmentName "first", 1, 2),+                  (FragmentName "second", 4, 4),+                  (FragmentName "third", 6, 7),+                  (FragmentName "fourth", 8, 8)+                ],+      testCase "keeps capture and use entries ordered with placeholders unresolved" $ do+        validated <- fullFixture+        rendered <- renderNamed validated "list-properties"+        let output = rendered ^. #contents+            (_beforeCapture, fromCapture) = Text.breakOn "access_token: jsonpath" output+            (_beforeUse, fromUse) = Text.breakOn "Authorization: Bearer {{access_token}}" output+        assertBool "contains the OAuth capture" (not (Text.null fromCapture))+        assertBool "contains the unresolved use" (not (Text.null fromUse))+        assertBool "capture precedes use" (Text.length fromCapture > Text.length fromUse),+      testCase "rejects an empty fragment" $+        withSystemTempDirectory "hurl-workbench-render" $ \dir -> do+          validated <- makeWorkspace dir [("empty", "empty.hurl", "")] [("flow", ["empty"])]+          resolved <- resolveNamed validated "flow"+          renderWorkflow resolved >>= \case+            Left (EmptyFragment (FragmentName "empty") _) -> pure ()+            other -> assertFailure ("expected EmptyFragment, got " <> show other),+      testCase "reports the invalid UTF-8 byte offset" $+        withSystemTempDirectory "hurl-workbench-render" $ \dir -> do+          validated <- makeWorkspace dir [("bad", "bad.hurl", ByteString.pack [0x47, 0x45, 0xFF, 0x54])] [("flow", ["bad"])]+          resolved <- resolveNamed validated "flow"+          renderWorkflow resolved >>= \case+            Left (InvalidFragmentUtf8 (FragmentName "bad") _ 2 _) -> pure ()+            other -> assertFailure ("expected byte offset 2, got " <> show other),+      testCase "turns a post-validation filesystem change into a render error" $+        withSystemTempDirectory "hurl-workbench-render" $ \dir -> do+          validated <- makeWorkspace dir [("gone", "gone.hurl", "GET https://gone.test")] [("flow", ["gone"])]+          resolved <- resolveNamed validated "flow"+          removeFile (dir </> "gone.hurl")+          renderWorkflow resolved >>= \case+            Left (FragmentReadFailed (FragmentName "gone") _ _) -> pure ()+            other -> assertFailure ("expected FragmentReadFailed, got " <> show other)+    ]++hurlfmtTests :: TestTree+hurlfmtTests =+  testGroup+    "hurlfmt"+    [ testCase "parses the released Hurlfmt version format" $ do+        parseHurlfmtVersion "hurlfmt 8.0.1" @?= Just (makeVersion [8, 0, 1])+        parseHurlfmtVersion "not a version" @?= Nothing,+      testCase "maps a Hurlfmt line diagnostic to its source fragment and cleans the temporary file" $+        withSystemTempDirectory "hurl-workbench-format" $ \dir -> do+          validated <- makeWorkspace dir [("broken", "broken.hurl", "GET https://example.test\n[Asserts")] [("flow", ["broken"])]+          rendered <- renderNamed validated "flow"+          executable <- writeFailingHurlfmt dir+          let capabilities = HurlfmtCapabilities (HurlfmtExecutable executable) (makeVersion [8, 0, 1])+          validateRenderedWorkflow capabilities rendered >>= \case+            Left (InvalidHurl (WorkflowName "flow") (Just span_) diagnostics) -> do+              span_ ^. #fragmentName @?= FragmentName "broken"+              assertBool "keeps Hurlfmt diagnostics" ("expecting" `Text.isInfixOf` diagnostics)+            other -> assertFailure ("expected mapped InvalidHurl, got " <> show other)+          temporaryPath <- Text.unpack . Text.strip <$> Text.IO.readFile (executable <> ".called")+          remains <- doesFileExist temporaryPath+          assertBool "temporary Hurl source was removed" (not remains),+      testCase "validates every workflow in stable name order" $+        withSystemTempDirectory "hurl-workbench-format" $ \dir -> do+          validated <-+            makeWorkspace+              dir+              [("broken", "broken.hurl", "GET https://example.test\n[Asserts")]+              [("zeta", ["broken"]), ("alpha", ["broken"])]+          executable <- writeFailingHurlfmt dir+          let capabilities = HurlfmtCapabilities (HurlfmtExecutable executable) (makeVersion [8, 0, 1])+          validateWorkspaceSyntax capabilities validated >>= \case+            Right issues -> map syntaxWorkflowName issues @?= [Just (WorkflowName "alpha"), Just (WorkflowName "zeta")]+            Left err -> assertFailure (Text.unpack (renderDependencyError err)),+      testCase "reports an executable that disappears after detection" $+        withSystemTempDirectory "hurl-workbench-format" $ \dir -> do+          validated <- makeWorkspace dir [("one", "one.hurl", "GET https://one.test")] [("flow", ["one"])]+          rendered <- renderNamed validated "flow"+          let missing = dir </> "missing-hurlfmt"+          validateRenderedWorkflow (HurlfmtCapabilities (HurlfmtExecutable missing) (makeVersion [8, 0, 1])) rendered+            >>= (@?= Left (HurlfmtNotFound missing))+    ]++syntaxWorkflowName :: WorkflowSyntaxError -> Maybe WorkflowName+syntaxWorkflowName = \case+  SyntaxFormatFailed (InvalidHurl name _span _diagnostics) -> Just name+  SyntaxRenderFailed name _err -> Just name+  SyntaxResolutionFailed _err -> Nothing+  SyntaxFormatFailed _err -> Nothing++makeWorkspace :: FilePath -> [(Text, FilePath, ByteString.ByteString)] -> [(Text, [Text])] -> IO ValidatedWorkspace+makeWorkspace directory fragmentInputs workflowInputs = do+  canonicalRoot <- canonicalizePath directory+  for_ fragmentInputs $ \(_name, path, bytes) -> ByteString.writeFile (canonicalRoot </> path) bytes+  let decoded =+        Workspace+          { schemaVersion = supportedSchemaVersion,+            parameters = [],+            fragments = [Fragment (FragmentName name) path Nothing | (name, path, _bytes) <- fragmentInputs],+            workflows =+              [ Workflow+                  { name = WorkflowName name,+                    fragments = map FragmentName fragmentNames,+                    parameters = [],+                    description = Nothing+                  }+              | (name, fragmentNames) <- workflowInputs+              ],+            recipes = [],+            matrices = [],+            checks = [],+            services = [],+            suites = []+          }+      context =+        WorkspaceContext+          { manifestPath = canonicalRoot </> "hurl-workbench.dhall",+            workspaceRoot = WorkspaceRoot canonicalRoot,+            workspace = decoded+          }+  validateWorkspace context >>= \case+    Left issues -> assertFailure (Text.unpack (Text.unlines (map renderValidationIssue (toList issues))))+    Right validated -> pure validated++resolveNamed :: ValidatedWorkspace -> Text -> IO ResolvedWorkflow+resolveNamed validated name =+  case resolveWorkflow validated (WorkflowName name) of+    Left err -> assertFailure (Text.unpack (renderWorkflowError err))+    Right resolved -> pure resolved++renderNamed :: ValidatedWorkspace -> Text -> IO RenderedWorkflow+renderNamed validated name = do+  resolved <- resolveNamed validated name+  renderWorkflow resolved >>= \case+    Left err -> assertFailure (Text.unpack (renderRenderError err))+    Right rendered -> pure rendered++fullFixture :: IO ValidatedWorkspace+fullFixture = do+  context <-+    loadWorkspaceContext (ExplicitWorkspace "test/fixtures/workspaces/full/hurl-workbench.dhall") >>= \case+      Left err -> assertFailure (Text.unpack (renderWorkspaceError err))+      Right loaded -> pure loaded+  validateWorkspace context >>= \case+    Left issues -> assertFailure (Text.unpack (Text.unlines (map renderValidationIssue (toList issues))))+    Right validated -> pure validated++writeFailingHurlfmt :: FilePath -> IO FilePath+writeFailingHurlfmt directory = do+  let executable = directory </> "hurlfmt-failure"+  Text.IO.writeFile+    executable+    ( Text.unlines+        [ "#!/bin/sh",+          "last=''",+          "for arg in \"$@\"; do last=\"$arg\"; done",+          "printf '%s\\n' \"$last\" > \"$0.called\"",+          "printf 'error: Parsing JSON\\n  --> %s:2:3\\n   |\\n 2 | [Asserts\\n   |   ^ expecting a closing bracket\\n' \"$last\" >&2",+          "exit 1"+        ]+    )+  permissions <- getPermissions executable+  setPermissions executable (setOwnerExecutable True permissions)+  pure executable
+ test/HurlWorkbench/Workspace/NameSafetyTest.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}++-- | Compile-time name safety, checked at run time: this module is compiled+--   with deferred type errors, so each ill-typed top-level binding below+--   compiles into a 'TypeError' exception. Each test forces one binding and+--   expects that exception, proving that category-specific names cannot be+--   interchanged. Each binding must stay top-level: GHC floats deferred-error+--   evidence to the enclosing binding, so an inline expression would throw+--   before the surrounding 'try' runs.+module HurlWorkbench.Workspace.NameSafetyTest (tests) where++import Control.Exception (TypeError (..), evaluate, try)+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Types+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertFailure, testCase)++tests :: TestTree+tests =+  testGroup+    "category-specific names"+    [ testCase "a recipe name is not a workflow name" (expectTypeError recipeAsWorkflow),+      testCase "a workflow name is not a fragment name" (expectTypeError workflowAsFragment),+      testCase "a matrix name is not a suite name" (expectTypeError matrixAsSuite),+      testCase "plain text is not a parameter name" (expectTypeError textAsParameter)+    ]++recipeAsWorkflow :: ValidatedWorkspace -> Maybe Workflow+recipeAsWorkflow = lookupWorkflow (RecipeName "top-properties")++workflowAsFragment :: ValidatedWorkspace -> Maybe Fragment+workflowAsFragment = lookupFragment (WorkflowName "list-properties")++matrixAsSuite :: ValidatedWorkspace -> Maybe Suite+matrixAsSuite = lookupSuite (MatrixName "grid")++textAsParameter :: ValidatedWorkspace -> Maybe Parameter+textAsParameter = lookupParameter ("base_url" :: Text)++expectTypeError :: a -> IO ()+expectTypeError value = do+  result <- try (evaluate value)+  case result of+    Left (TypeError _) -> pure ()+    Right _ -> assertFailure "expected the expression to be rejected by the type checker"
+ test/HurlWorkbench/Workspace/WorkspaceTest.hs view
@@ -0,0 +1,323 @@+module HurlWorkbench.Workspace.WorkspaceTest (tests) where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import HurlWorkbench.Prelude+import HurlWorkbench.Workspace.Context+import HurlWorkbench.Workspace.Decode+import HurlWorkbench.Workspace.Discover+import HurlWorkbench.Workspace.Error+import HurlWorkbench.Workspace.Types+import HurlWorkbench.Workspace.Validate+import System.Directory (canonicalizePath, createDirectoryIfMissing, createFileLink)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "workspace"+    [ decodingTests,+      discoveryTests,+      validationTests,+      literalTests+    ]++fixture :: FilePath -> FilePath+fixture name = "test/fixtures/workspaces" </> name </> "hurl-workbench.dhall"++--------------------------------------------------------------------------------+-- Decoding++decodingTests :: TestTree+decodingTests =+  testGroup+    "decoding"+    [ testCase "frozen old service suites normalize additive fields and run unions" $ do+        ws <- decodeOrFail (fixture "old-service-suite")+        map suiteServices (ws ^. #suites) @?= [[ServiceName "old"]]+        map (view #setup) (ws ^. #suites) @?= [[]]+        map (view #commandTimeoutSeconds) (ws ^. #suites) @?= [60],+      testCase "frozen populated old suites default to shared state" $ do+        old <- decodeOrFail (fixture "old-suite")+        shared <- decodeOrFail (fixture "shared-suite")+        old @?= shared+        map (view #isolation) (old ^. #suites) @?= [SharedState]+        independent <- decodeOrFail (fixture "independent-suite")+        independent @?= (shared & #suites .~ map (\suite -> suite & #isolation .~ IndependentState) (shared ^. #suites)),+      testCase "invalid isolation values fail typed decode" $+        withSystemTempDirectory "hurl-isolation" $ \dir -> do+          schema <- canonicalizePath schemaPackage+          for_ ["42", "< Wrong >.Wrong"] $ \policy -> do+            let manifest = dir </> manifestFileName+            Text.IO.writeFile manifest ("let S = " <> Text.pack schema <> " in S.Workspace::{ schemaVersion = 1, suites = [{ name = \"bad\", runs = [] : List S.RunReference, service = None Text, failFast = False, description = None Text, isolation = " <> policy <> " }] }")+            decodeWorkspaceFile manifest >>= \case+              Left DhallFailure {} -> pure ()+              other -> assertFailure ("expected invalid policy, got " <> show other),+      policyDecodingTests,+      testCase "frozen old service and readiness records inherit" $+        for_ ["old-command", "old-http"] $ \name -> do+          ws <- decodeOrFail (fixture name)+          map (view (#command . #environmentPolicy)) (ws ^. #services) @?= [Inherit],+      testCase "completion-based and fully specified manifests decode identically" $ do+        completed <- decodeOrFail (fixture "minimal")+        explicit <- decodeOrFail (fixture "minimal-explicit")+        completed @?= explicit+        completed ^. #schemaVersion @?= 1+        map (view #defaultValue) (completed ^. #parameters)+          @?= [Just (literal "https://api.example.test")],+      testCase "a manifest may import sibling Dhall modules" $ do+        ws <- decodeOrFail (fixture "full")+        map (unParameterName . view #name) (ws ^. #parameters)+          @?= ["auth_url", "base_url", "client_id", "client_secret", "top"],+      testCase "an unsupported schema version is reported before typed decoding" $ do+        path <- canonicalizePath (fixture "schema-version")+        result <- decodeWorkspaceFile path+        result @?= Left (UnsupportedSchemaVersion path 2 1),+      testCase "a Dhall type error is reported with the manifest path" $+        withSystemTempDirectory "hurl-workbench" $ \dir -> do+          let manifest = dir </> manifestFileName+          Text.IO.writeFile manifest "{ schemaVersion = 1, fragments = 42 }"+          result <- decodeWorkspaceFile manifest+          case result of+            Left (DhallFailure path message) -> do+              path @?= manifest+              assertBool "mentions the mismatch" ("doesn't match annotation" `Text.isInfixOf` message)+              assertBool "contains no ANSI escapes" (not ("\ESC" `Text.isInfixOf` message))+            other -> assertFailure ("expected a Dhall failure, got " <> show other)+    ]++decodeOrFail :: FilePath -> IO Workspace+decodeOrFail path =+  decodeWorkspaceFile path >>= \case+    Right ws -> pure ws+    Left err -> assertFailure (Text.unpack (renderWorkspaceError err))++literal :: Text -> HurlValueLiteral+literal value = either (error . show) id (mkHurlValueLiteral value)++--------------------------------------------------------------------------------+-- Discovery++discoveryTests :: TestTree+discoveryTests =+  testGroup+    "discovery"+    [ testCase "finds the manifest from a nested child directory" $+        withSystemTempDirectory "hurl-workbench" $ \dir -> do+          writeManifest dir []+          let nested = dir </> "a" </> "b" </> "c"+          createDirectoryIfMissing True nested+          result <- discoverWorkspace Nothing nested+          result @?= Right (DiscoveredWorkspace (dir </> manifestFileName)),+      testCase "an explicit manifest wins over discovery" $+        withSystemTempDirectory "hurl-workbench" $ \dir -> do+          writeManifest dir []+          let other = dir </> "other"+          createDirectoryIfMissing True other+          writeManifest other []+          result <- discoverWorkspace (Just ("other" </> manifestFileName)) dir+          result @?= Right (ExplicitWorkspace (other </> manifestFileName)),+      testCase "a missing explicit manifest is an error, even when discovery would succeed" $+        withSystemTempDirectory "hurl-workbench" $ \dir -> do+          writeManifest dir []+          result <- discoverWorkspace (Just "missing.dhall") dir+          result @?= Left (ManifestNotFound (dir </> "missing.dhall")),+      testCase "discovery stops at the filesystem root" $+        withSystemTempDirectory "hurl-workbench" $ \dir -> do+          result <- discoverWorkspace Nothing dir+          result @?= Left (NoWorkspaceFound dir)+    ]++-- | Write a manifest with the given @(name, path)@ fragments, importing the+--   repository schema by absolute path.+writeManifest :: FilePath -> [(Text, Text)] -> IO ()+writeManifest dir fragmentList = do+  schema <- canonicalizePath schemaPackage+  writeManifestWithSchema schema dir fragmentList++-- | The repository schema, relative to the package directory in which+--   @cabal test@ runs.+schemaPackage :: FilePath+schemaPackage = "schema/package.dhall"++--------------------------------------------------------------------------------+-- Validation++validationTests :: TestTree+validationTests =+  testGroup+    "validation"+    [ testCase "independent suites cannot declare a shared service" $ do+        original <- validFixture "full"+        let context = validatedContext original+            suites = map (\suite -> suite & #isolation .~ IndependentState) (validatedWorkspace original ^. #suites)+        validateWorkspace (context & #workspace . #suites .~ suites) >>= \case+          Left issues -> assertBool "service rejected" (any (Text.isInfixOf "cannot declare a shared managed service" . view #message) issues)+          Right _ -> assertFailure "expected invalid independent managed suite",+      testCase "a complete workspace validates and offers typed lookups" $ do+        vw <- validFixture "full"+        Map.keys (validatedWorkflows vw) @?= [WorkflowName "list-members", WorkflowName "list-properties"]+        let fragmentsOf name = maybe [] (view #fragments) (lookupWorkflow (WorkflowName name) vw)+        -- One OAuth fragment is shared by both resource workflows.+        take 1 (fragmentsOf "list-properties") @?= [FragmentName "oauth"]+        take 1 (fragmentsOf "list-members") @?= [FragmentName "oauth"]+        fmap (view #safety) (lookupRecipe (RecipeName "top-properties") vw) @?= Just ReadOnly+        fmap (length . view #cases) (lookupMatrix (MatrixName "property-page-sizes") vw) @?= Just 2+        fmap (view #service) (lookupSuite (SuiteName "smoke") vw) @?= Just (Just (ServiceName "api"))+        root <- canonicalizePath "test/fixtures/workspaces/full"+        validatedRoot vw @?= WorkspaceRoot root+        lookupFragmentFile (FragmentName "oauth") vw @?= Just (root </> "hurl/oauth.hurl"),+      testCase "every unresolved reference is reported together, in stable order" $ do+        issues <- invalidFixture "missing-reference"+        issues+          @?= [ ValidationIssue "workflows/empty/fragments" "workflow must list at least one fragment",+                ValidationIssue "workflows/flow/fragments" "unknown fragment \"missing-fragment\"",+                ValidationIssue "workflows/flow/parameters" "unknown parameter \"missing_parameter\"",+                ValidationIssue "recipes/orphan/workflow" "unknown workflow \"missing-workflow\"",+                ValidationIssue "matrices/grid/recipe" "unknown recipe \"missing-recipe\"",+                ValidationIssue "matrices/grid/cases" "matrix must have at least one case",+                ValidationIssue "suites/all/runs" "unknown matrix \"missing-matrix\"",+                ValidationIssue "suites/all/service" "unknown service \"missing-service\""+              ]+        again <- invalidFixture "missing-reference"+        again @?= issues,+      testCase "duplicate and malformed names are reported" $ do+        issues <- invalidFixture "duplicate"+        map (view #location) issues @?= ["fragments/a", "workflows/9-bad name", "workflows/flow"]+        assertMentions issues "duplicate fragment name declared 2 times"+        assertMentions issues "duplicate workflow name declared 2 times",+      testCase "unsafe fragment paths are rejected" $ do+        issues <- invalidFixture "escaping-path"+        issues+          @?= [ ValidationIssue "fragments/absolute/path" "path \"/etc/hosts\" must be relative to the workspace root",+                ValidationIssue "fragments/missing/path" "path \"hurl/missing.hurl\" does not exist as a regular file",+                ValidationIssue "fragments/not-hurl/path" "fragment path \"outside-notes.txt\" must end in .hurl",+                ValidationIssue "fragments/parent/path" "path \"../minimal/hurl/health.hurl\" escapes the workspace root"+              ],+      testCase "a symlink that leaves the workspace is rejected" $+        withSystemTempDirectory "hurl-workbench" $ \dir -> do+          let workspaceDir = dir </> "workspace"+          createDirectoryIfMissing True (workspaceDir </> "hurl")+          Text.IO.writeFile (dir </> "outside.hurl") "GET https://example.test\n"+          Text.IO.writeFile (workspaceDir </> "hurl" </> "inside.hurl") "GET https://example.test\n"+          createFileLink (dir </> "outside.hurl") (workspaceDir </> "hurl" </> "escape.hurl")+          createFileLink (workspaceDir </> "hurl" </> "inside.hurl") (workspaceDir </> "hurl" </> "alias.hurl")+          writeManifest workspaceDir [("escape", "hurl/escape.hurl"), ("alias", "hurl/alias.hurl")]+          issues <- invalidManifest (workspaceDir </> manifestFileName)+          issues @?= [ValidationIssue "fragments/escape/path" "path \"hurl/escape.hurl\" escapes the workspace root"],+      testCase "a secret with a committed default is rejected" $ do+        issues <- invalidFixture "secret-default"+        issues @?= [ValidationIssue "parameters/api_key" "secret parameters must not have a committed defaultValue"],+      testCase "values that Hurl variable files cannot carry are rejected with their location" $ do+        issues <- invalidFixture "invalid-value"+        map (view #location) issues+          @?= ["parameters/multiline/defaultValue", "parameters/newUuid", "parameters/padded/defaultValue"]+    ]+  where+    assertMentions issues needle =+      assertBool+        ("expected an issue mentioning " <> Text.unpack needle)+        (any (Text.isInfixOf needle . view #message) issues)++writeManifestWithSchema :: FilePath -> FilePath -> [(Text, Text)] -> IO ()+writeManifestWithSchema schema dir fragmentList =+  Text.IO.writeFile (dir </> manifestFileName) $+    Text.unlines+      [ "let Schema = " <> Text.pack schema,+        "in Schema.Workspace::{ schemaVersion = 1, fragments = ["+          <> Text.intercalate ", " [fragmentLiteral name path | (name, path) <- fragmentList]+          <> "] : List Schema.Fragment.Type }"+      ]+  where+    fragmentLiteral name path = "Schema.Fragment::{ name = \"" <> name <> "\", path = \"" <> path <> "\" }"++loadManifest :: FilePath -> IO (Either (NonEmpty ValidationIssue) ValidatedWorkspace)+loadManifest manifest = do+  context <-+    discoverWorkspace (Just manifest) "." >>= \case+      Left err -> assertFailure (Text.unpack (renderWorkspaceError err))+      Right source ->+        loadWorkspaceContext source >>= \case+          Left err -> assertFailure (Text.unpack (renderWorkspaceError err))+          Right ctx -> pure ctx+  validateWorkspace context++validFixture :: FilePath -> IO ValidatedWorkspace+validFixture name =+  loadManifest (fixture name) >>= \case+    Right vw -> pure vw+    Left issues -> assertFailure (Text.unpack (Text.unlines (map renderValidationIssue (toList issues))))++invalidFixture :: FilePath -> IO [ValidationIssue]+invalidFixture = invalidManifest . fixture++invalidManifest :: FilePath -> IO [ValidationIssue]+invalidManifest manifest =+  loadManifest manifest >>= \case+    Right _ -> assertFailure "expected validation to fail"+    Left issues -> pure (toList issues)++--------------------------------------------------------------------------------+-- Hurl value literals++literalTests :: TestTree+literalTests =+  testGroup+    "HurlValueLiteral"+    [ testCase "accepts values Hurl reads back unchanged" $+        for_ ["", "true", "null", "42", "3.5", "a=b", "has inner space", "\"quoted\""] $ \value ->+          fmap hurlValueLiteralText (mkHurlValueLiteral value) @?= Right value,+      testCase "rejects line breaks and NUL" $+        for_ ["a\nb", "a\rb", "a\0b"] $ \value ->+          mkHurlValueLiteral value @?= Left ContainsLineBreakOrNul,+      testCase "rejects surrounding whitespace that Hurl trims" $+        for_ [" a", "a ", "\ta", "a\x2028", "\x85"] $ \value ->+          mkHurlValueLiteral value @?= Left SurroundingWhitespace+    ]++policyDecodingTests :: TestTree+policyDecodingTests =+  testGroup+    "command policies"+    [ testCase "default, explicit inheritance, and empty clean policies" $+        withSystemTempDirectory "policy-decode" $ \dir -> do+          for_ [("", Inherit), (", environmentPolicy = Schema.EnvironmentPolicy.Inherit", Inherit), (", environmentPolicy = Schema.EnvironmentPolicy.Clean ([] : List Text)", Clean [])] $ \(field, expected) -> do+            writePolicyManifest dir field+            ws <- decodeOrFail (dir </> manifestFileName)+            map (view (#command . #environmentPolicy)) (ws ^. #services) @?= [expected],+      testCase "malformed policy types fail decoding" $+        withSystemTempDirectory "policy-malformed" $ \dir -> do+          for_ ["42", "< Inherit | Clean : Text >.Clean \"PATH\""] $ \value -> do+            writePolicyManifest dir (", environmentPolicy = " <> value)+            decodeWorkspaceFile (dir </> manifestFileName) >>= \case+              Left (DhallFailure _ _) -> pure ()+              other -> assertFailure (show other),+      testCase "invalid and duplicate inherited names reject deterministically in both commands" $+        withSystemTempDirectory "policy-validation" $ \dir -> do+          writePolicyManifest dir ", environmentPolicy = Schema.EnvironmentPolicy.Clean [ \"\", \"9BAD\", \"A=B\", \"A B\", \"PATH\", \"PATH\" ]"+          loaded <- loadWorkspaceContext (ExplicitWorkspace (dir </> manifestFileName)) >>= either (assertFailure . show) pure+          let extraNames = Clean ["A\NULB", "A\nB", "A\tB"]+              withExtra = loaded & #workspace . #services %~ map (\service -> service & #command . #environmentPolicy .~ extraNames)+          validateWorkspace withExtra >>= \case+            Left issues -> assertBool "NUL and whitespace rejected" (length (toList issues) >= 3)+            Right _ -> assertFailure "expected invalid control characters"+          first <- validateWorkspace loaded+          second <- validateWorkspace loaded+          case (first, second) of+            (Left issues, Left again) -> do+              issues @?= again+              length (toList issues) @?= 10+              assertBool "readiness locations present" (any (Text.isInfixOf "/readiness/command/environmentPolicy" . view #location) (toList issues))+            _ -> assertFailure "expected static policy errors"+    ]++writePolicyManifest :: FilePath -> Text -> IO ()+writePolicyManifest dir policyField = do+  schema <- canonicalizePath schemaPackage+  Text.IO.writeFile (dir </> manifestFileName) $+    "let Schema = " <> Text.pack schema <> " let command = Schema.CommandSpec::{ executable = \"/usr/bin/true\" " <> policyField <> " } in Schema.Workspace::{ schemaVersion = 1, services = [ Schema.Service::{ name = \"policy\", command = command, readiness = Schema.Readiness.Command Schema.CommandReadiness::{ command = command } } ] }"
+ test/Main.hs view
@@ -0,0 +1,46 @@+module Main (main) where++import HurlWorkbench.Check.RunTest qualified as CheckRunTest+import HurlWorkbench.Hurl.RunTest qualified as RunTest+import HurlWorkbench.Parameter.GenerateTest qualified as GenerateTest+import HurlWorkbench.Parameter.ParameterTest qualified as ParameterTest+import HurlWorkbench.Run.FileRootTest qualified as FileRootTest+import HurlWorkbench.Run.SelectionTest qualified as SelectionTest+import HurlWorkbench.Service.RunTest qualified as ServiceRunTest+import HurlWorkbench.Suite.RunTest qualified as SuiteRunTest+import HurlWorkbench.Suite.ScenarioTest qualified as ScenarioTest+import HurlWorkbench.Workflow.WorkflowTest qualified as WorkflowTest+import HurlWorkbench.Workspace.NameSafetyTest qualified as NameSafetyTest+import HurlWorkbench.Workspace.WorkspaceTest qualified as WorkspaceTest+import System.Environment (getArgs)+import Test.Tasty (defaultMain, localOption, testGroup)+import Test.Tasty.Runners (NumThreads (..))++main :: IO ()+main = do+  arguments <- getArgs+  case arguments of+    ["--clean-environment-scenario", binary, directory] -> ServiceRunTest.runIsolatedScenario binary directory+    _ -> runTests++runTests :: IO ()+runTests =+  -- Existing environment-binding tests mutate process-global state. Serialize+  -- test cases so concurrent POSIX spawns cannot race libc environ updates.+  defaultMain $+    localOption (NumThreads 1) $+      testGroup+        "hurl-workbench-core"+        [ CheckRunTest.tests,+          FileRootTest.tests,+          GenerateTest.tests,+          RunTest.tests,+          ParameterTest.tests,+          SelectionTest.tests,+          ServiceRunTest.tests,+          SuiteRunTest.tests,+          ScenarioTest.tests,+          WorkspaceTest.tests,+          NameSafetyTest.tests,+          WorkflowTest.tests+        ]
+ test/fixtures/processes/environment.c view
@@ -0,0 +1,62 @@+/* Inspect envp before any language runtime can add platform variables. */+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <unistd.h>++static int compare(const void *a, const void *b) {+  return strcmp(*(const char *const *)a, *(const char *const *)b);+}++int main(int argc, char **argv, char **envp) {+  if (argc != 5) return 2;+  size_t count = 0;+  while (envp[count]) count++;+  char **names = calloc(count + 1, sizeof(char *));+  size_t length = 3;+  for (size_t i = 0; i < count; i++) {+    char *equals = strchr(envp[i], '=');+    if (!equals) return 3;+    names[i] = strndup(envp[i], (size_t)(equals - envp[i]));+    length += strlen(names[i]) + 3;+    if (!strcmp(names[i], "SELECTED") && *(equals + 1)) return 4;+    if (!strcmp(names[i], "BOUND") && strcmp(equals + 1, "private-bound-sentinel")) return 4;+  }+  qsort(names, count, sizeof(char *), compare);+  char *observed = calloc(length, 1);+  strcat(observed, "[");+  for (size_t i = 0; i < count; i++) {+    if (i) strcat(observed, ",");+    strcat(observed, "\""); strcat(observed, names[i]); strcat(observed, "\"");+  }+  strcat(observed, "]");+  if (!strcmp(argv[4], "inherit")) {+    if (!getenv("PATH")) return 5;+  } else if (strcmp(observed, argv[4])) { puts(observed); return 5; }+  int probe = !strcmp(argv[2], "probe") || !strcmp(argv[2], "retry");+  if (probe) {+    char *service = calloc(strlen(argv[3]) + 16, 1);+    strcpy(service, argv[3]);+    char *slash = strrchr(service, '/');+    if (!slash) return 6;+    strcpy(slash + 1, "service");+    while (access(service, F_OK)) usleep(10000);+    free(service);+    if (!strcmp(argv[2], "retry")) {+      char *counter = calloc(strlen(argv[3]) + 16, 1);+      strcpy(counter, argv[3]); strcat(counter, ".attempts");+      int attempts = 0;+      FILE *previous = fopen(counter, "r");+      if (previous) { fscanf(previous, "%d", &attempts); fclose(previous); }+      FILE *next = fopen(counter, "w");+      if (!next) return 8;+      fprintf(next, "%d", attempts + 1); fclose(next); free(counter);+      if (!attempts) return 1;+    }+  }+  FILE *marker = fopen(argv[3], "w");+  if (!marker) return 7;+  fprintf(marker, "%d", getpid()); fclose(marker);+  if (!probe) sleep(60);+  return 0;+}
+ test/fixtures/workspaces/composition/hurl-workbench.dhall view
@@ -0,0 +1,27 @@+-- One authentication entry reused by a parameterized resource request.+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , parameters =+      [ Schema.Parameter::{ name = "auth_url" }+      , Schema.Parameter::{ name = "base_url" }+      , Schema.Parameter::{ name = "client_id" }+      , Schema.Parameter::{+        , name = "client_secret"+        , kind = Schema.ParameterKind.Secret+        }+      , Schema.Parameter::{ name = "top", defaultValue = Some "5" }+      ]+    , fragments =+      [ Schema.Fragment::{ name = "oauth", path = "hurl/oauth.hurl" }+      , Schema.Fragment::{ name = "property", path = "hurl/property.hurl" }+      ]+    , workflows =+      [ Schema.Workflow::{+        , name = "oauth-property"+        , fragments = [ "oauth", "property" ]+        , parameters = [ "auth_url", "base_url", "client_id", "client_secret", "top" ]+        }+      ]+    }
+ test/fixtures/workspaces/composition/hurl/oauth.hurl view
@@ -0,0 +1,9 @@+# Obtain an access token once; later entries use {{access_token}}.+POST {{auth_url}}/oauth/token+[FormParams]+grant_type: client_credentials+client_id: {{client_id}}+client_secret: {{client_secret}}+HTTP 200+[Captures]+access_token: jsonpath "$.access_token"
+ test/fixtures/workspaces/composition/hurl/property.hurl view
@@ -0,0 +1,3 @@+GET {{base_url}}/Property?$top={{top}}+Authorization: Bearer {{access_token}}+HTTP 200
+ test/fixtures/workspaces/duplicate/hurl-workbench.dhall view
@@ -0,0 +1,14 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , fragments =+      [ Schema.Fragment::{ name = "a", path = "hurl/a.hurl" }+      , Schema.Fragment::{ name = "a", path = "hurl/a.hurl" }+      ]+    , workflows =+      [ Schema.Workflow::{ name = "flow", fragments = [ "a" ] }+      , Schema.Workflow::{ name = "flow", fragments = [ "a" ] }+      , Schema.Workflow::{ name = "9-bad name", fragments = [ "a" ] }+      ]+    }
+ test/fixtures/workspaces/duplicate/hurl/a.hurl view
@@ -0,0 +1,2 @@+GET https://example.test+HTTP 200
+ test/fixtures/workspaces/escaping-path/hurl-workbench.dhall view
@@ -0,0 +1,11 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , fragments =+      [ Schema.Fragment::{ name = "parent", path = "../minimal/hurl/health.hurl" }+      , Schema.Fragment::{ name = "absolute", path = "/etc/hosts" }+      , Schema.Fragment::{ name = "not-hurl", path = "outside-notes.txt" }+      , Schema.Fragment::{ name = "missing", path = "hurl/missing.hurl" }+      ]+    }
+ test/fixtures/workspaces/escaping-path/outside-notes.txt view
@@ -0,0 +1,2 @@+GET https://example.test+HTTP 200
+ test/fixtures/workspaces/execution/hurl-workbench.dhall view
@@ -0,0 +1,41 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , parameters =+      [ Schema.Parameter::{ name = "baseUrl" }+      ]+    , fragments =+      [ Schema.Fragment::{ name = "health", path = "hurl/health.hurl" }+      ]+    , workflows =+      [ Schema.Workflow::{+        , name = "health"+        , fragments = [ "health" ]+        , parameters = [ "baseUrl" ]+        }+      ]+    , recipes =+      [ Schema.Recipe::{+        , name = "health"+        , workflow = "health"+        , safety = Schema.Safety.ReadOnly+        }+      , Schema.Recipe::{+        , name = "dangerous-health"+        , workflow = "health"+        , safety = Schema.Safety.Mutating+        }+      ]+    , matrices =+      [ Schema.Matrix::{+        , name = "health-cases"+        , recipe = "health"+        , cases =+          [ Schema.MatrixCase::{ name = "first" }+          , Schema.MatrixCase::{ name = "second" }+          , Schema.MatrixCase::{ name = "third" }+          ]+        }+      ]+    }
+ test/fixtures/workspaces/execution/hurl/health.hurl view
@@ -0,0 +1,4 @@+GET {{baseUrl}}/health+HTTP 200+[Asserts]+body contains "ok"
+ test/fixtures/workspaces/full/hurl-workbench.dhall view
@@ -0,0 +1,81 @@+-- One OAuth fragment reused by two resource workflows, plus a recipe, a+-- matrix, a managed service, and a suite.+let Schema = ../../../../schema/package.dhall++let oauthParameters = [ "auth_url", "client_id", "client_secret" ]++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , parameters = ./parameters.dhall+    , fragments =+      [ Schema.Fragment::{+        , name = "oauth"+        , path = "hurl/oauth.hurl"+        , description = Some "Client-credentials token"+        }+      , Schema.Fragment::{ name = "properties", path = "hurl/properties.hurl" }+      , Schema.Fragment::{ name = "members", path = "hurl/members.hurl" }+      ]+    , workflows =+      [ Schema.Workflow::{+        , name = "list-properties"+        , fragments = [ "oauth", "properties" ]+        , parameters = oauthParameters # [ "base_url", "top" ]+        }+      , Schema.Workflow::{+        , name = "list-members"+        , fragments = [ "oauth", "members" ]+        , parameters = oauthParameters # [ "base_url", "top" ]+        }+      ]+    , recipes =+      [ Schema.Recipe::{+        , name = "top-properties"+        , workflow = "list-properties"+        , bindings = [ Schema.Binding::{ parameter = "top", value = "10" } ]+        , safety = Schema.Safety.ReadOnly+        }+      ]+    , matrices =+      [ Schema.Matrix::{+        , name = "property-page-sizes"+        , recipe = "top-properties"+        , cases =+          [ Schema.MatrixCase::{+            , name = "small"+            , bindings = [ Schema.Binding::{ parameter = "top", value = "1" } ]+            }+          , Schema.MatrixCase::{+            , name = "large"+            , bindings = [ Schema.Binding::{ parameter = "top", value = "100" } ]+            }+          ]+        }+      ]+    , services =+      [ Schema.Service::{+        , name = "api"+        , command = Schema.CommandSpec::{+          , executable = "python3"+          , arguments = [ "-m", "http.server", "8080" ]+          , workingDirectory = Some "."+          , environment =+            [ Schema.EnvironmentBinding::{ variable = "CLIENT_ID", parameter = "client_id" } ]+          }+        , readiness =+            Schema.Readiness.Http+              Schema.HttpReadiness::{ url = "http://127.0.0.1:8080/" }+        }+      ]+    , suites =+      [ Schema.Suite::{+        , name = "smoke"+        , runs =+          [ Schema.RunReference.Workflow "list-members"+          , Schema.RunReference.Recipe "top-properties"+          , Schema.RunReference.Matrix "property-page-sizes"+          ]+        , service = Some "api"+        }+      ]+    }
+ test/fixtures/workspaces/full/hurl/members.hurl view
@@ -0,0 +1,3 @@+GET {{base_url}}/Member?$top={{top}}+Authorization: Bearer {{access_token}}+HTTP 200
+ test/fixtures/workspaces/full/hurl/oauth.hurl view
@@ -0,0 +1,9 @@+# Obtain an access token once; later entries use {{access_token}}.+POST {{auth_url}}/oauth/token+[FormParams]+grant_type: client_credentials+client_id: {{client_id}}+client_secret: {{client_secret}}+HTTP 200+[Captures]+access_token: jsonpath "$.access_token"
+ test/fixtures/workspaces/full/hurl/properties.hurl view
@@ -0,0 +1,3 @@+GET {{base_url}}/Property?$top={{top}}+Authorization: Bearer {{access_token}}+HTTP 200
+ test/fixtures/workspaces/full/parameters.dhall view
@@ -0,0 +1,14 @@+-- A sibling module imported relative to the manifest.+let Schema = ../../../../schema/package.dhall++in  [ Schema.Parameter::{ name = "auth_url", defaultValue = Some "https://auth.example.test" }+    , Schema.Parameter::{ name = "base_url", defaultValue = Some "https://api.example.test" }+    , Schema.Parameter::{ name = "client_id", environment = Some "EXAMPLE_CLIENT_ID" }+    , Schema.Parameter::{+      , name = "client_secret"+      , kind = Schema.ParameterKind.Secret+      , environment = Some "EXAMPLE_CLIENT_SECRET"+      , description = Some "OAuth client secret"+      }+    , Schema.Parameter::{ name = "top", defaultValue = Some "5" }+    ]
+ test/fixtures/workspaces/independent-suite/hurl-workbench.dhall view
@@ -0,0 +1,77 @@+-- The same workspace as ../minimal, with every field spelled out and no+-- schema import. Both must decode to the same Haskell value.+{ schemaVersion = 1+, parameters =+  [ { name = "base_url"+    , description = None Text+    , kind = < Plain | Secret >.Plain+    , defaultValue = Some "https://api.example.test"+    , environment = None Text+    }+  ]+, fragments =+  [ { name = "health", path = "hurl/health.hurl", description = None Text } ]+, workflows =+  [ { name = "check-health"+    , fragments = [ "health" ]+    , parameters = [ "base_url" ]+    , description = None Text+    }+  ]+, recipes =+    [] : List+           { name : Text+           , workflow : Text+           , bindings : List { parameter : Text, value : Text }+           , safety : < ReadOnly | Mutating >+           , description : Optional Text+           }+, matrices =+    [] : List+           { name : Text+           , recipe : Text+           , cases :+               List { name : Text, bindings : List { parameter : Text, value : Text } }+           , failFast : Bool+           , description : Optional Text+           }+, services =+    [] : List+           { name : Text+           , command :+               { executable : Text+               , arguments : List Text+               , workingDirectory : Optional Text+               , environment : List { variable : Text, parameter : Text }+               }+           , readiness :+               < Http :+                   { url : Text+                   , expectedStatus : Natural+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               | Command :+                   { command :+                       { executable : Text+                       , arguments : List Text+                       , workingDirectory : Optional Text+                       , environment : List { variable : Text, parameter : Text }+                       }+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               >+           , shutdownTimeoutSeconds : Natural+           , description : Optional Text+           }+, suites =+  [ { name = "compatibility"+    , isolation = < SharedState | IndependentState >.IndependentState+    , runs = [ < Workflow : Text | Recipe : Text | Matrix : Text >.Workflow "check-health" ]+    , service = None Text+    , failFast = False+    , description = None Text+    }+  ]+}
+ test/fixtures/workspaces/independent-suite/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/invalid-value/hurl-workbench.dhall view
@@ -0,0 +1,11 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , parameters =+      [ Schema.Parameter::{ name = "padded", defaultValue = Some "value " }+      , Schema.Parameter::{ name = "multiline", defaultValue = Some "line one\nline two" }+      , Schema.Parameter::{ name = "equals", defaultValue = Some "a=b" }+      , Schema.Parameter::{ name = "newUuid" }+      ]+    }
+ test/fixtures/workspaces/isolation/hurl-workbench.dhall view
@@ -0,0 +1,51 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , parameters =+      [ Schema.Parameter::{ name = "baseUrl" }+      ]+    , fragments =+      [ Schema.Fragment::{ name = "health", path = "hurl/health.hurl" }+      ]+    , workflows =+      [ Schema.Workflow::{+        , name = "health"+        , fragments = [ "health" ]+        , parameters = [ "baseUrl" ]+        }+      ]+    , recipes =+      [ Schema.Recipe::{+        , name = "health"+        , workflow = "health"+        , safety = Schema.Safety.ReadOnly+        }+      , Schema.Recipe::{+        , name = "dangerous-health"+        , workflow = "health"+        , safety = Schema.Safety.Mutating+        }+      ]+    , suites =+      [ Schema.Suite::{ name = "mixed", runs = [ Schema.RunReference.Recipe "health", Schema.RunReference.Recipe "dangerous-health", Schema.RunReference.Matrix "writes", Schema.RunReference.Workflow "health" ], service = Some "marker" }+      , Schema.Suite::{ name = "single-write", runs = [ Schema.RunReference.Recipe "dangerous-health" ] }+      , Schema.Suite::{ name = "reads", runs = [ Schema.RunReference.Matrix "health-cases" ] }+      , Schema.Suite::{ name = "independent", runs = [ Schema.RunReference.Matrix "writes" ], isolation = Schema.IsolationPolicy.IndependentState }+      ]+    , services =+      [ Schema.Service::{ name = "marker", command = Schema.CommandSpec::{ executable = "sh", arguments = [ "-c", "touch service-started; exit 1" ] }, readiness = Schema.Readiness.Command Schema.CommandReadiness::{ command = Schema.CommandSpec::{ executable = "sh", arguments = [ "-c", "touch readiness-started; exit 1" ] } } } ]+    , matrices =+      [ Schema.Matrix::{ name = "single-write", recipe = "dangerous-health", cases = [ Schema.MatrixCase::{ name = "only" } ] }+      , Schema.Matrix::{ name = "writes", recipe = "dangerous-health", cases = [ Schema.MatrixCase::{ name = "first" }, Schema.MatrixCase::{ name = "second" } ] }+      , Schema.Matrix::{+        , name = "health-cases"+        , recipe = "health"+        , cases =+          [ Schema.MatrixCase::{ name = "first" }+          , Schema.MatrixCase::{ name = "second" }+          , Schema.MatrixCase::{ name = "third" }+          ]+        }+      ]+    }
+ test/fixtures/workspaces/isolation/hurl/health.hurl view
@@ -0,0 +1,4 @@+GET {{baseUrl}}/health+HTTP 200+[Asserts]+body contains "ok"
+ test/fixtures/workspaces/minimal-explicit/hurl-workbench.dhall view
@@ -0,0 +1,76 @@+-- The same workspace as ../minimal, with every field spelled out and no+-- schema import. Both must decode to the same Haskell value.+{ schemaVersion = 1+, parameters =+  [ { name = "base_url"+    , description = None Text+    , kind = < Plain | Secret >.Plain+    , defaultValue = Some "https://api.example.test"+    , environment = None Text+    }+  ]+, fragments =+  [ { name = "health", path = "hurl/health.hurl", description = None Text } ]+, workflows =+  [ { name = "check-health"+    , fragments = [ "health" ]+    , parameters = [ "base_url" ]+    , description = None Text+    }+  ]+, recipes =+    [] : List+           { name : Text+           , workflow : Text+           , bindings : List { parameter : Text, value : Text }+           , safety : < ReadOnly | Mutating >+           , description : Optional Text+           }+, matrices =+    [] : List+           { name : Text+           , recipe : Text+           , cases :+               List { name : Text, bindings : List { parameter : Text, value : Text } }+           , failFast : Bool+           , description : Optional Text+           }+, services =+    [] : List+           { name : Text+           , command :+               { executable : Text+               , arguments : List Text+               , workingDirectory : Optional Text+               , environment : List { variable : Text, parameter : Text }+               }+           , readiness :+               < Http :+                   { url : Text+                   , expectedStatus : Natural+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               | Command :+                   { command :+                       { executable : Text+                       , arguments : List Text+                       , workingDirectory : Optional Text+                       , environment : List { variable : Text, parameter : Text }+                       }+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               >+           , shutdownTimeoutSeconds : Natural+           , description : Optional Text+           }+, suites =+    [] : List+           { name : Text+           , runs : List < Workflow : Text | Recipe : Text | Matrix : Text >+           , service : Optional Text+           , failFast : Bool+           , description : Optional Text+           }+}
+ test/fixtures/workspaces/minimal-explicit/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/minimal/hurl-workbench.dhall view
@@ -0,0 +1,21 @@+-- The smallest useful workspace, written with record completion so every+-- defaulted field is omitted.+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , parameters =+      [ Schema.Parameter::{+        , name = "base_url"+        , defaultValue = Some "https://api.example.test"+        }+      ]+    , fragments = [ Schema.Fragment::{ name = "health", path = "hurl/health.hurl" } ]+    , workflows =+      [ Schema.Workflow::{+        , name = "check-health"+        , fragments = [ "health" ]+        , parameters = [ "base_url" ]+        }+      ]+    }
+ test/fixtures/workspaces/minimal/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/missing-reference/hurl-workbench.dhall view
@@ -0,0 +1,38 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , fragments = [ Schema.Fragment::{ name = "a", path = "hurl/a.hurl" } ]+    , workflows =+      [ Schema.Workflow::{+        , name = "flow"+        , fragments = [ "a", "missing-fragment" ]+        , parameters = [ "missing_parameter" ]+        }+      , Schema.Workflow::{ name = "empty", fragments = [] : List Text }+      ]+    , recipes =+      [ Schema.Recipe::{+        , name = "orphan"+        , workflow = "missing-workflow"+        , safety = Schema.Safety.ReadOnly+        }+      ]+    , matrices =+      [ Schema.Matrix::{+        , name = "grid"+        , recipe = "missing-recipe"+        , cases = [] : List Schema.MatrixCase.Type+        }+      ]+    , suites =+      [ Schema.Suite::{+        , name = "all"+        , runs =+          [ Schema.RunReference.Workflow "flow"+          , Schema.RunReference.Matrix "missing-matrix"+          ]+        , service = Some "missing-service"+        }+      ]+    }
+ test/fixtures/workspaces/missing-reference/hurl/a.hurl view
@@ -0,0 +1,2 @@+GET https://example.test+HTTP 200
+ test/fixtures/workspaces/old-command/hurl-workbench.dhall view
@@ -0,0 +1,5 @@+let Command = { executable : Text, arguments : List Text, workingDirectory : Optional Text, environment : List { variable : Text, parameter : Text } }+let Readiness = < Http : { url : Text, expectedStatus : Natural, intervalMilliseconds : Natural, timeoutSeconds : Natural } | Command : { command : Command, intervalMilliseconds : Natural, timeoutSeconds : Natural } >+let command = { executable = "/usr/bin/true", arguments = [] : List Text, workingDirectory = None Text, environment = [] : List { variable : Text, parameter : Text } }+let old = ../minimal-explicit/hurl-workbench.dhall+in old // { services = [ { name = "old", command = command, readiness = Readiness.Command { command = command, intervalMilliseconds = 10, timeoutSeconds = 1 }, shutdownTimeoutSeconds = 1, description = None Text } ] }
+ test/fixtures/workspaces/old-command/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/old-http/hurl-workbench.dhall view
@@ -0,0 +1,5 @@+let Command = { executable : Text, arguments : List Text, workingDirectory : Optional Text, environment : List { variable : Text, parameter : Text } }+let Readiness = < Http : { url : Text, expectedStatus : Natural, intervalMilliseconds : Natural, timeoutSeconds : Natural } | Command : { command : Command, intervalMilliseconds : Natural, timeoutSeconds : Natural } >+let command = { executable = "/usr/bin/true", arguments = [] : List Text, workingDirectory = None Text, environment = [] : List { variable : Text, parameter : Text } }+let old = ../minimal-explicit/hurl-workbench.dhall+in old // { services = [ { name = "old", command = command, readiness = Readiness.Http { url = "http://127.0.0.1:1/health", expectedStatus = 200, intervalMilliseconds = 10, timeoutSeconds = 1 }, shutdownTimeoutSeconds = 1, description = None Text } ] }
+ test/fixtures/workspaces/old-http/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/old-parameters/hurl-workbench.dhall view
@@ -0,0 +1,77 @@+-- The same workspace as ../minimal, with every field spelled out and no+-- schema import. Both must decode to the same Haskell value.+{ schemaVersion = 1+, parameters =+  [ { name = "base_url"+    , description = None Text+    , kind = < Plain | Secret >.Plain+    , defaultValue = Some "https://api.example.test"+    , environment = None Text+    }+  , { name = "token", description = None Text, kind = < Plain | Secret >.Secret, defaultValue = None Text, environment = None Text }+  ]+, fragments =+  [ { name = "health", path = "hurl/health.hurl", description = None Text } ]+, workflows =+  [ { name = "check-health"+    , fragments = [ "health" ]+    , parameters = [ "base_url" ]+    , description = None Text+    }+  ]+, recipes =+    [] : List+           { name : Text+           , workflow : Text+           , bindings : List { parameter : Text, value : Text }+           , safety : < ReadOnly | Mutating >+           , description : Optional Text+           }+, matrices =+    [] : List+           { name : Text+           , recipe : Text+           , cases :+               List { name : Text, bindings : List { parameter : Text, value : Text } }+           , failFast : Bool+           , description : Optional Text+           }+, services =+    [] : List+           { name : Text+           , command :+               { executable : Text+               , arguments : List Text+               , workingDirectory : Optional Text+               , environment : List { variable : Text, parameter : Text }+               }+           , readiness :+               < Http :+                   { url : Text+                   , expectedStatus : Natural+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               | Command :+                   { command :+                       { executable : Text+                       , arguments : List Text+                       , workingDirectory : Optional Text+                       , environment : List { variable : Text, parameter : Text }+                       }+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               >+           , shutdownTimeoutSeconds : Natural+           , description : Optional Text+           }+, suites =+    [] : List+           { name : Text+           , runs : List < Workflow : Text | Recipe : Text | Matrix : Text >+           , service : Optional Text+           , failFast : Bool+           , description : Optional Text+           }+}
+ test/fixtures/workspaces/old-parameters/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/old-service-suite/hurl-workbench.dhall view
@@ -0,0 +1,3 @@+-- Frozen pre-lifecycle schema records and union, without completion defaults.+let old = ../old-http/hurl-workbench.dhall+in old // { suites = [ { name = "old-service", runs = [ < Workflow : Text | Recipe : Text | Matrix : Text >.Workflow "check-health" ], service = Some "old", failFast = False, description = None Text } ] }
+ test/fixtures/workspaces/old-service-suite/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/old-suite/hurl-workbench.dhall view
@@ -0,0 +1,76 @@+-- The same workspace as ../minimal, with every field spelled out and no+-- schema import. Both must decode to the same Haskell value.+{ schemaVersion = 1+, parameters =+  [ { name = "base_url"+    , description = None Text+    , kind = < Plain | Secret >.Plain+    , defaultValue = Some "https://api.example.test"+    , environment = None Text+    }+  ]+, fragments =+  [ { name = "health", path = "hurl/health.hurl", description = None Text } ]+, workflows =+  [ { name = "check-health"+    , fragments = [ "health" ]+    , parameters = [ "base_url" ]+    , description = None Text+    }+  ]+, recipes =+    [] : List+           { name : Text+           , workflow : Text+           , bindings : List { parameter : Text, value : Text }+           , safety : < ReadOnly | Mutating >+           , description : Optional Text+           }+, matrices =+    [] : List+           { name : Text+           , recipe : Text+           , cases :+               List { name : Text, bindings : List { parameter : Text, value : Text } }+           , failFast : Bool+           , description : Optional Text+           }+, services =+    [] : List+           { name : Text+           , command :+               { executable : Text+               , arguments : List Text+               , workingDirectory : Optional Text+               , environment : List { variable : Text, parameter : Text }+               }+           , readiness :+               < Http :+                   { url : Text+                   , expectedStatus : Natural+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               | Command :+                   { command :+                       { executable : Text+                       , arguments : List Text+                       , workingDirectory : Optional Text+                       , environment : List { variable : Text, parameter : Text }+                       }+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               >+           , shutdownTimeoutSeconds : Natural+           , description : Optional Text+           }+, suites =+  [ { name = "compatibility"+    , runs = [ < Workflow : Text | Recipe : Text | Matrix : Text >.Workflow "check-health" ]+    , service = None Text+    , failFast = False+    , description = None Text+    }+  ]+}
+ test/fixtures/workspaces/old-suite/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/schema-version/hurl-workbench.dhall view
@@ -0,0 +1,2 @@+-- Written for a future schema version this build does not understand.+{ schemaVersion = 2, somethingNew = True }
+ test/fixtures/workspaces/secret-default/hurl-workbench.dhall view
@@ -0,0 +1,12 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , parameters =+      [ Schema.Parameter::{+        , name = "api_key"+        , kind = Schema.ParameterKind.Secret+        , defaultValue = Some "committed-secret"+        }+      ]+    }
+ test/fixtures/workspaces/shared-suite/hurl-workbench.dhall view
@@ -0,0 +1,77 @@+-- The same workspace as ../minimal, with every field spelled out and no+-- schema import. Both must decode to the same Haskell value.+{ schemaVersion = 1+, parameters =+  [ { name = "base_url"+    , description = None Text+    , kind = < Plain | Secret >.Plain+    , defaultValue = Some "https://api.example.test"+    , environment = None Text+    }+  ]+, fragments =+  [ { name = "health", path = "hurl/health.hurl", description = None Text } ]+, workflows =+  [ { name = "check-health"+    , fragments = [ "health" ]+    , parameters = [ "base_url" ]+    , description = None Text+    }+  ]+, recipes =+    [] : List+           { name : Text+           , workflow : Text+           , bindings : List { parameter : Text, value : Text }+           , safety : < ReadOnly | Mutating >+           , description : Optional Text+           }+, matrices =+    [] : List+           { name : Text+           , recipe : Text+           , cases :+               List { name : Text, bindings : List { parameter : Text, value : Text } }+           , failFast : Bool+           , description : Optional Text+           }+, services =+    [] : List+           { name : Text+           , command :+               { executable : Text+               , arguments : List Text+               , workingDirectory : Optional Text+               , environment : List { variable : Text, parameter : Text }+               }+           , readiness :+               < Http :+                   { url : Text+                   , expectedStatus : Natural+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               | Command :+                   { command :+                       { executable : Text+                       , arguments : List Text+                       , workingDirectory : Optional Text+                       , environment : List { variable : Text, parameter : Text }+                       }+                   , intervalMilliseconds : Natural+                   , timeoutSeconds : Natural+                   }+               >+           , shutdownTimeoutSeconds : Natural+           , description : Optional Text+           }+, suites =+  [ { name = "compatibility"+    , isolation = < SharedState | IndependentState >.SharedState+    , runs = [ < Workflow : Text | Recipe : Text | Matrix : Text >.Workflow "check-health" ]+    , service = None Text+    , failFast = False+    , description = None Text+    }+  ]+}
+ test/fixtures/workspaces/shared-suite/hurl/health.hurl view
@@ -0,0 +1,2 @@+GET {{base_url}}/health+HTTP 200
+ test/fixtures/workspaces/suite-failure/health.hurl view
@@ -0,0 +1,2 @@+GET http://127.0.0.1/health+HTTP 200
+ test/fixtures/workspaces/suite-failure/hurl-workbench.dhall view
@@ -0,0 +1,40 @@+let Schema = ../../../../schema/package.dhall++in  Schema.Workspace::{+    , schemaVersion = Schema.schemaVersion+    , fragments =+      [ Schema.Fragment::{ name = "health", path = "health.hurl" } ]+    , workflows =+      [ Schema.Workflow::{ name = "health", fragments = [ "health" ] } ]+    , recipes =+      [ Schema.Recipe::{+        , name = "health"+        , workflow = "health"+        , safety = Schema.Safety.ReadOnly+        }+      ]+    , services =+      [ Schema.Service::{+        , name = "failure"+        , command = Schema.CommandSpec::{+          , executable = "python3"+          , arguments = [ "-c", "import sys; sys.exit(9)" ]+          }+        , readiness =+            Schema.Readiness.Command+              Schema.CommandReadiness::{+              , command = Schema.CommandSpec::{+                , executable = "python3"+                , arguments = [ "-c", "import time; time.sleep(0.2)" ]+                }+              }+        }+      ]+    , suites =+      [ Schema.Suite::{+        , name = "failure"+        , runs = [ Schema.RunReference.Recipe "health" ]+        , service = Some "failure"+        }+      ]+    }