From 971aafdedd96ad765d9eab4343352849eb1c69cd Mon Sep 17 00:00:00 2001 From: stepandra Date: Tue, 6 Oct 2026 23:18:12 +0900 Subject: [PATCH 1/8] feat(http-transport): make Warp bind host and port configurable Add WebTransport.host (default "*", unchanged behaviour), start Warp via runSettings with setHost/setPort, and add Application.withHost/withPort. Adds ADR-0079, spec 019, release fragment and BindSpec. --- .changes/019-server-bind-host-port.md | 33 ++++++ codemap/api-hot.md | 4 +- codemap/signatures/nhcore-service.txt | 13 +- core/nhcore.cabal | 2 + core/service/Service/Application.hs | 62 +++++++++- .../service/Service/Application/Transports.hs | 14 ++- core/service/Service/Transport/Web.hs | 37 +++++- core/test-service/Main.hs | 2 + core/test/Service/Transport/Web/BindSpec.hs | 111 ++++++++++++++++++ docs/changes/019-server-bind-host-port.md | 74 ++++++++++++ ...079-configurable-web-bind-host-and-port.md | 41 +++++++ docs/decisions/README.md | 1 + 12 files changed, 380 insertions(+), 14 deletions(-) create mode 100644 .changes/019-server-bind-host-port.md create mode 100644 core/test/Service/Transport/Web/BindSpec.hs create mode 100644 docs/changes/019-server-bind-host-port.md create mode 100644 docs/decisions/0079-configurable-web-bind-host-and-port.md diff --git a/.changes/019-server-bind-host-port.md b/.changes/019-server-bind-host-port.md new file mode 100644 index 000000000..0307e7a92 --- /dev/null +++ b/.changes/019-server-bind-host-port.md @@ -0,0 +1,33 @@ +--- +group: platform +component: Framework +impact: breaking +category: Breaking changes +--- + +## Summary + +You can now choose which network address and port your web server listens on. Add `Application.withHost "127.0.0.1"` to accept connections from the same machine only, which is the safe choice behind a reverse proxy, and `Application.withPort 9090` to change the port. `host` also accepts `"*"` (all addresses, IPv4 and IPv6), `"*4"`, `"*6"` or a literal address. + +Your app behaves as before unless you opt in: it still listens on all addresses on port 8080. It now also accepts IPv6 connections; use `"*4"` for IPv4 only. + +This is marked breaking for one narrow case. `WebTransport` and `Application` each gained fields, so code that builds either record by naming every field must add the new ones. Apps that use `WebTransport.server` or `Application.new` are not affected and need no change. + +## Migration + +Search your code for a `WebTransport { ... }` or `Application { ... }` record written with every field. Most apps have none and can stop here. + +- In a `WebTransport { ... }` record, add `host = "*"` to keep the old behaviour, or `host = "127.0.0.1"` to accept local connections only. +- In an `Application { ... }` record, add `bindHost = Nothing` and `bindPort = Nothing`. + +Prefer `WebTransport.server { port = 9090 }` or `Application.withHost` and `Application.withPort` over naming every field. + +### Verify + +Build your app, then start it and request `/health` on the address you chose. To check the framework change itself, run `./dev test "Service.Transport.Web.Bind" nhcore-test-service`. All 12 examples pass, including one that starts the server on `127.0.0.1` and fetches `/health`. + +## Agent prompt + +```text +My NeoHaskell app fails to compile after upgrading nhcore. `WebTransport` gained a `host :: Text` field and `Application` gained `bindHost :: Maybe Text` and `bindPort :: Maybe Int`. Find every place that builds a `WebTransport { ... }` or `Application { ... }` record by naming all fields (search for `WebTransport {`, `WebTransport$` followed by `{`, and `Application {`). In each `WebTransport` record add `host = "*"` so it keeps listening on all addresses. In each `Application` record add `bindHost = Nothing` and `bindPort = Nothing`. Do not change anything that uses `WebTransport.server` or `Application.new`. Keep the port and every other field exactly as they were. Then build the project and run its tests. Report which files you edited and whether the build and tests pass. If my app sits behind a reverse proxy, tell me I can use `Application.withHost "127.0.0.1"` for local-only access, but do not change it without asking. +``` diff --git a/codemap/api-hot.md b/codemap/api-hot.md index c2b8e1dd7..9f90904bf 100644 --- a/codemap/api-hot.md +++ b/codemap/api-hot.md @@ -46,7 +46,7 @@ codemap/signatures/ · type-directed search: ./dev api "" ## Text - `fromLinkedList :: LinkedList Char -> Text` -- `toLinkedList :: Text -> LinkedList Char` +- `toLinkedList :: Text -> LinkedList Char` - `toBytes :: Text -> Bytes` - `replace :: Text -> Text -> Text -> Text` - `fromBytes :: Bytes -> Text` @@ -130,7 +130,7 @@ codemap/signatures/ · type-directed search: ./dev api "" ## Maybe -- `withDefault :: a -> Maybe a -> a` +- `withDefault :: a -> Maybe a -> a` - `map :: (a -> b) -> Maybe a -> Maybe b` - `getOrDie :: HasCallStack => Maybe a -> a` - `andThen :: (a -> Maybe b) -> Maybe a -> Maybe b` diff --git a/codemap/signatures/nhcore-service.txt b/codemap/signatures/nhcore-service.txt index fcdbe6904..7b88b16ee 100644 --- a/codemap/signatures/nhcore-service.txt +++ b/codemap/signatures/nhcore-service.txt @@ -123,7 +123,7 @@ tenantOnly :: (query -> Text) -> Maybe UserClaims -> query -> Maybe AccessError module Service.Application ApiInfo :: Text -> Text -> Text -> ApiInfo -Application :: Maybe ConfigSpec -> Maybe EventStoreFactory -> Maybe QueryObjectStoreConfigValue -> Array QueryDefinition -> QueryRegistry -> Array ServiceRunner -> Map Text TransportValue -> Map Text QueryEndpointHandler -> Array OutboundRunner -> Array OutboundLifecycleRunner -> Array Inbound -> Maybe WebAuthFactory -> Maybe OAuth2Setup -> Maybe FileUploadFactory -> Maybe SecretStore -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe DispatcherConfig -> Maybe CorsFactory -> Maybe ApiInfoFactory -> Maybe HealthCheckFactory -> Maybe DispatcherConfigFactory -> Maybe SecretStoreFactory -> Array DeferredOutboundLifecycleReg -> Array DeferredInboundReg -> Array IntegrationRegistrationEntry -> Maybe ReadinessConfig -> Application +Application :: Maybe ConfigSpec -> Maybe EventStoreFactory -> Maybe QueryObjectStoreConfigValue -> Array QueryDefinition -> QueryRegistry -> Array ServiceRunner -> Map Text TransportValue -> Map Text QueryEndpointHandler -> Array OutboundRunner -> Array OutboundLifecycleRunner -> Array Inbound -> Maybe WebAuthFactory -> Maybe OAuth2Setup -> Maybe FileUploadFactory -> Maybe SecretStore -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe DispatcherConfig -> Maybe CorsFactory -> Maybe ApiInfoFactory -> Maybe HealthCheckFactory -> Maybe DispatcherConfigFactory -> Maybe SecretStoreFactory -> Array DeferredOutboundLifecycleReg -> Array DeferredInboundReg -> Array IntegrationRegistrationEntry -> Maybe ReadinessConfig -> Maybe Text -> Maybe Int -> Application DispatcherConfig :: Int -> Int -> Bool -> Int -> Int -> Maybe Int -> Int -> Int -> DispatcherConfig FileUploadSetup :: InternalFileUploadConfig -> BlobStore -> FileStateStore -> FileUploadSetup HealthCheckConfig :: Text -> HealthCheckConfig @@ -140,6 +140,8 @@ WebAuthSetup :: Text -> AuthOverrides -> WebAuthSetup [apiVersion] :: ApiInfo -> Text [authOverrides] :: WebAuthSetup -> AuthOverrides [authServerUrl] :: WebAuthSetup -> Text +[bindHost] :: Application -> Maybe Text +[bindPort] :: Application -> Maybe Int [blobStore] :: FileUploadSetup -> BlobStore [channelWriteTimeoutMs] :: DispatcherConfig -> Int [configSpec] :: Application -> Maybe ConfigSpec @@ -224,12 +226,14 @@ withDispatcherConfig :: Typeable config => (config -> DispatcherConfig) -> Appli withEventStore :: (Typeable config, EventStoreConfig eventStoreConfig) => (config -> eventStoreConfig) -> Application -> Application withFileUpload :: Typeable config => (config -> FileUploadConfig) -> Application -> Application withHealthCheck :: Typeable config => (config -> Text) -> Application -> Application +withHost :: Text -> Application -> Application withInbound :: Typeable config => (config -> Inbound) -> Application -> Application withIntegration :: (Integration request, Typeable request, Typeable (Response request), Inspectable request) => Application -> Application withOAuth2Provider :: Typeable config => (config -> OAuth2ProviderConfig) -> Application -> Application withOAuth2StateKey :: Text -> Application -> Application withOutbound :: (OutboundIntegration handler, entity ~ EntityOf handler, event ~ EventOf entity, event ~ HandledEvent handler, FromJSON entity, FromJSON event, FromJSON (EventOf entity), Inspectable entity, Default entity, Entity entity) => Application -> Application withOutboundLifecycle :: (Typeable config, Inspectable entity) => (config -> OutboundConfig state) -> Application -> Application +withPort :: Int -> Application -> Application withQuery :: forall query (queryName :: Symbol) (entities :: [Type]). (Query query, ToSchema query, ToJSON query, FromJSON query, queryName ~ NameOf query, entities ~ EntitiesOf query, KnownSymbol queryName, WireEntities entities query) => Application -> Application withQueryEndpoint :: Text -> QueryEndpointHandler -> Application -> Application withQueryObjectStore :: QueryObjectStoreConfig config => config -> Application -> Application @@ -248,7 +252,7 @@ withInbound :: Inbound -> (Array OutboundRunner, Array OutboundLifecycleRunner, withOutboundLifecycle :: Inspectable entity => OutboundConfig state -> (Array OutboundRunner, Array OutboundLifecycleRunner, Array Inbound) -> (Array OutboundRunner, Array OutboundLifecycleRunner, Array Inbound) module Service.Application.Transports -runTransports :: Map Text TransportValue -> Map Text (Map Text EndpointHandler) -> Map Text (Map Text EndpointSchema) -> Map Text QueryEndpointHandler -> Map Text EndpointSchema -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> QuerySubscriber -> Task Text Unit +runTransports :: Map Text TransportValue -> Map Text (Map Text EndpointHandler) -> Map Text (Map Text EndpointSchema) -> Map Text QueryEndpointHandler -> Map Text EndpointSchema -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> Maybe Text -> Maybe Int -> QuerySubscriber -> Task Text Unit module Service.Application.Types ApiInfo :: Text -> Text -> Text -> ApiInfo @@ -1778,7 +1782,7 @@ FileUploadEnabled :: FileUploadRoutes -> Int64 -> FileUploadEnabled HealthCheckConfig :: Text -> HealthCheckConfig IntegrationStatus :: !Text -> !Array Text -> IntegrationStatus OAuth2Config :: OAuth2Routes -> (Text -> Task Text Unit) -> OAuth2Config -WebTransport :: Int -> Int -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> Maybe (Task Text Readiness) -> WebTransport +WebTransport :: Int -> Text -> Int -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> Maybe (Task Text Readiness) -> WebTransport [allowedHeaders] :: CorsConfig -> Array Text [allowedMethods] :: CorsConfig -> Array Text [allowedOrigins] :: CorsConfig -> Array Text @@ -1792,6 +1796,7 @@ WebTransport :: Int -> Int -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe F [fileUploadRoutes] :: FileUploadEnabled -> FileUploadRoutes [healthCheck] :: WebTransport -> Maybe HealthCheckConfig [healthPath] :: HealthCheckConfig -> Text +[host] :: WebTransport -> Text [integrationStatus] :: WebTransport -> Maybe IntegrationStatus [jwksManager] :: AuthEnabled -> JwksManager [maxAge] :: CorsConfig -> Maybe Int @@ -1811,6 +1816,7 @@ data HealthCheckConfig data IntegrationStatus data OAuth2Config data WebTransport +hostPreference :: Text -> HostPreference instance Data.Record.Anon.Plugin.Internal.Runtime.KnownHash "WebTransport" instance Service.Transport.Transport Service.Transport.Web.WebTransport isHealthCheckPath :: Text -> WebTransport -> Bool @@ -1820,6 +1826,7 @@ respondReadiness :: WebTransport -> (Response -> Task Text ResponseReceived) -> server :: WebTransport unauthorizedResponse :: AccessError -> (Status, Text) unauthorizedResponseBody :: Text -> Text +warpSettings :: WebTransport -> Settings module Service.Transport.Web.BuiltinSchemas fileUploadEndpointSchemas :: Bool -> Map Text EndpointSchema diff --git a/core/nhcore.cabal b/core/nhcore.cabal index 4a0a2b444..085792dd5 100644 --- a/core/nhcore.cabal +++ b/core/nhcore.cabal @@ -475,6 +475,7 @@ test-suite nhcore-test Service.Transport.Mcp.ResponseSpec Service.Transport.WebSpec Service.Transport.Web.SwaggerUISpec + Service.Transport.Web.BindSpec Service.Transport.Web.HealthCheckSpec Service.Transport.Web.ReadinessRouteSpec Service.QueryObjectStore.InMemorySpec @@ -630,6 +631,7 @@ test-suite nhcore-test-service Service.Transport.Mcp.ResponseSpec Service.MultiTenantSpec Service.Transport.WebSpec + Service.Transport.Web.BindSpec Service.Transport.Web.HealthCheckSpec Service.Transport.Web.ReadinessRouteSpec Service.Command.AuthSpec diff --git a/core/service/Service/Application.hs b/core/service/Service/Application.hs index f62ab76d8..8c890ae13 100644 --- a/core/service/Service/Application.hs +++ b/core/service/Service/Application.hs @@ -45,6 +45,8 @@ module Service.Application ( withCors, withHealthCheck, withoutHealthCheck, + withHost, + withPort, withDispatcherConfig, useQueryObjectStore, useReadinessEndpoint, @@ -405,7 +407,11 @@ data Application = Application integrationRegistrations :: Array IntegrationRegistrationEntry, -- | Readiness endpoint configuration. Enabled by default at /ready. -- Use useReadinessEndpoint to customize. - readinessConfig :: Maybe ReadinessConfig + readinessConfig :: Maybe ReadinessConfig, + -- | Interface the WebTransport binds. Set via withHost; Nothing keeps the transport's own host. + bindHost :: Maybe Text, + -- | Port the WebTransport binds. Set via withPort; Nothing keeps the transport's own port. + bindPort :: Maybe Int } @@ -443,7 +449,9 @@ new = deferredOutboundLifecycleRegs = Array.empty, deferredInboundRegs = Array.empty, integrationRegistrations = Array.empty, - readinessConfig = Just ReadinessConfig {readinessPath = "ready", includeQueryStatus = True} + readinessConfig = Just ReadinessConfig {readinessPath = "ready", includeQueryStatus = True}, + bindHost = Nothing, + bindPort = Nothing } @@ -1319,7 +1327,7 @@ runWithResolved eventStore maybeFileUploadSetup fileUploadCleanup maybeWebAuthSe -- When transports complete (or fail), cancel inbound workers for clean shutdown -- Use Task.finally to ensure cleanup always runs even if runTransports fails result <- - Transports.runTransports app.transports combinedEndpointsByTransport combinedSchemasByTransport combinedQueryEndpoints combinedQuerySchemas maybeAuthEnabled maybeOAuth2Config maybeFileUploadEnabled app.apiInfo app.corsConfig app.healthCheckConfig maybeIntegrationStatus app.readinessConfig subscriber + Transports.runTransports app.transports combinedEndpointsByTransport combinedSchemasByTransport combinedQueryEndpoints combinedQuerySchemas maybeAuthEnabled maybeOAuth2Config maybeFileUploadEnabled app.apiInfo app.corsConfig app.healthCheckConfig maybeIntegrationStatus app.readinessConfig app.bindHost app.bindPort subscriber |> Task.finally cleanupAll |> Task.asResult @@ -1791,6 +1799,54 @@ withoutHealthCheck app = app {healthCheckConfig = Nothing, healthCheckFactory = Nothing} +-- | Set the interface the WebTransport binds. +-- +-- Overrides the host of the registered 'Web.server', whatever the order of +-- 'withTransport' and 'withHost'. Without it the transport binds all +-- interfaces (@"*"@). +-- +-- * @"127.0.0.1"@ (or any literal address such as @"::1"@): that address only. +-- Loopback-only is recommended behind a reverse proxy. +-- * @"*"@: all interfaces, IPv4 and IPv6. +-- * @"*4"@ / @"*6"@: all IPv4 / all IPv6 interfaces. +-- +-- Example: +-- +-- @ +-- app = Application.new +-- |> Application.withTransport WebTransport.server +-- |> Application.withHost "127.0.0.1" +-- |> Application.withService myService +-- @ +withHost :: + Text -> + Application -> + Application +withHost host app = + app {bindHost = Just host} + + +-- | Set the port the WebTransport binds. +-- +-- Overrides the port of the registered 'Web.server' (default 8080), whatever +-- the order of 'withTransport' and 'withPort'. +-- +-- Example: +-- +-- @ +-- app = Application.new +-- |> Application.withTransport WebTransport.server +-- |> Application.withPort 9090 +-- |> Application.withService myService +-- @ +withPort :: + Int -> + Application -> + Application +withPort port app = + app {bindPort = Just port} + + -- | Validate dispatcher configuration fields are positive. -- Returns 'Just errorMessage' if validation fails, 'Nothing' if valid. validateDispatcherConfig :: Dispatcher.DispatcherConfig -> Maybe Text diff --git a/core/service/Service/Application/Transports.hs b/core/service/Service/Application/Transports.hs index b044c3180..a89fa9ea0 100644 --- a/core/service/Service/Application/Transports.hs +++ b/core/service/Service/Application/Transports.hs @@ -58,10 +58,14 @@ runTransports :: -- ^ Optional integration selection status for /health reporting Maybe ReadinessConfig -> -- ^ Optional readiness endpoint configuration for WebTransport + Maybe Text -> + -- ^ Optional bind host override for WebTransport (Application.withHost) + Maybe Int -> + -- ^ Optional bind port override for WebTransport (Application.withPort) QuerySubscriber -> -- ^ The live subscriber whose readiness state /ready will reflect Task Text Unit -runTransports transportsMap endpointsByTransport schemasByTransport queryEndpoints querySchemas maybeWebAuth maybeOAuth2 maybeFileUpload maybeApiInfo maybeCors maybeHealthCheck maybeIntegrationStatus maybeReadinessConfig subscriber = do +runTransports transportsMap endpointsByTransport schemasByTransport queryEndpoints querySchemas maybeWebAuth maybeOAuth2 maybeFileUpload maybeApiInfo maybeCors maybeHealthCheck maybeIntegrationStatus maybeReadinessConfig maybeHost maybePort subscriber = do transportsMap |> Map.entries |> Task.forEach \(transportName, transportVal) -> do @@ -84,7 +88,7 @@ runTransports transportsMap endpointsByTransport schemasByTransport queryEndpoin -- Handle WebTransport specially to configure auth, OAuth2, and file uploads case transportName of - "WebTransport" -> runWebTransport transportVal commandEndpointsForTransport commandSchemasForTransport queryEndpoints querySchemas maybeWebAuth maybeOAuth2 maybeFileUpload maybeApiInfo maybeCors maybeHealthCheck maybeIntegrationStatus maybeReadinessConfig subscriber + "WebTransport" -> runWebTransport transportVal commandEndpointsForTransport commandSchemasForTransport queryEndpoints querySchemas maybeWebAuth maybeOAuth2 maybeFileUpload maybeApiInfo maybeCors maybeHealthCheck maybeIntegrationStatus maybeReadinessConfig maybeHost maybePort subscriber _ -> runGenericTransport transportVal commandEndpointsForTransport commandSchemasForTransport queryEndpoints querySchemas @@ -110,9 +114,11 @@ runWebTransport :: Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> + Maybe Text -> + Maybe Int -> QuerySubscriber -> Task Text Unit -runWebTransport transportVal commandEndpoints commandSchemas queryEndpoints querySchemas maybeAuth maybeOAuth2 maybeFileUpload maybeApiInfo maybeCors maybeHealthCheck maybeIntegrationStatus maybeReadinessConfig subscriber = do +runWebTransport transportVal commandEndpoints commandSchemas queryEndpoints querySchemas maybeAuth maybeOAuth2 maybeFileUpload maybeApiInfo maybeCors maybeHealthCheck maybeIntegrationStatus maybeReadinessConfig maybeHost maybePort subscriber = do case transportVal of TransportValue transport -> do -- Cast the existentially-typed transport to WebTransport @@ -136,6 +142,8 @@ runWebTransport transportVal commandEndpoints commandSchemas queryEndpoints quer , integrationStatus = maybeIntegrationStatus , readinessConfig = maybeReadinessConfig , readinessProbe = Just (Subscriber.readinessOf subscriber) + , host = maybeHost |> Maybe.withDefault baseWebTransport.host + , port = maybePort |> Maybe.withDefault baseWebTransport.port } -- Build endpoints with the configured transport let endpoints :: Endpoints WebTransport = diff --git a/core/service/Service/Transport/Web.hs b/core/service/Service/Transport/Web.hs index 58f8f91bb..c490e8f42 100644 --- a/core/service/Service/Transport/Web.hs +++ b/core/service/Service/Transport/Web.hs @@ -7,6 +7,8 @@ module Service.Transport.Web ( HealthCheckConfig (..), IntegrationStatus (..), server, + hostPreference, + warpSettings, isHealthCheckPath, buildHealthResponse, isReadinessPath, @@ -148,6 +150,13 @@ data IntegrationStatus = IntegrationStatus -- | HTTP/JSON transport using WAI/Warp. data WebTransport = WebTransport { port :: Int, + -- | Interface to bind. Set via Application.withHost. + -- + -- * @"127.0.0.1"@ (or any literal address such as @"::1"@): that address only. + -- Loopback-only is recommended behind a reverse proxy. + -- * @"*"@: all interfaces, IPv4 and IPv6 (the default). + -- * @"*4"@ / @"*6"@: all IPv4 / all IPv6 interfaces. + host :: Text, maxBodySize :: Int, -- | Optional JWT authentication. Set via Application.withAuth. authEnabled :: Maybe AuthEnabled, @@ -181,6 +190,7 @@ deriveKnownHash "WebTransport" -- | Default WebTransport configuration. -- Port defaults to 8080. +-- Host defaults to "*" (all interfaces) - use Application.withHost "127.0.0.1" to bind loopback only. -- Max body size defaults to 1MB (1048576 bytes) to prevent DoS attacks. -- Auth is disabled by default - use Application.withAuth to enable. -- OAuth2 is disabled by default - use Application.withOAuth2Provider to enable. @@ -190,6 +200,7 @@ server :: WebTransport server = WebTransport { port = 8080, + host = "*", maxBodySize = 1048576, authEnabled = Nothing, oauth2Config = Nothing, @@ -203,6 +214,25 @@ server = } +-- | Convert a 'WebTransport' host setting into a Warp 'Warp.HostPreference'. +-- +-- @"*"@ is all interfaces, @"*4"@ and @"*6"@ are all IPv4 / IPv6 interfaces, +-- anything else is a literal address or hostname. +hostPreference :: Text -> Warp.HostPreference +hostPreference hostText = + hostText + |> Text.toLinkedList + |> fromString + + +-- | Warp settings that bind the transport's configured host and port. +warpSettings :: WebTransport -> Warp.Settings +warpSettings transport = + Warp.defaultSettings + |> Warp.setPort transport.port + |> Warp.setHost (hostPreference transport.host) + + -- | Read request body with a size limit to prevent DoS attacks. -- Returns Err if the body exceeds the limit, Ok with the body bytes otherwise. readBodyWithLimit :: Int -> Wai.Request -> Task Text (Result Text Bytes) @@ -1044,12 +1074,13 @@ instance Transport WebTransport where Maybe.Nothing -> baseApp Maybe.Just cors -> corsMiddleware cors baseApp - -- Start the Warp server on the specified port + -- Start the Warp server on the configured host and port + let host = transport.host let port = transport.port Log.withScope [("component", "WebTransport")] do - Log.info [fmt|Starting WebTransport server on port #{port}|] + Log.info [fmt|Starting WebTransport server on #{host}:#{port}|] |> Task.ignoreError - Warp.run transport.port waiApp |> Task.fromIO + Warp.runSettings (warpSettings transport) waiApp |> Task.fromIO buildHandler :: diff --git a/core/test-service/Main.hs b/core/test-service/Main.hs index f00a9f639..3c83bb6bd 100644 --- a/core/test-service/Main.hs +++ b/core/test-service/Main.hs @@ -44,6 +44,7 @@ import Service.Transport.Mcp.JsonRpcSpec qualified import Service.Transport.Mcp.ProtocolSpec qualified import Service.Transport.Mcp.ResponseSpec qualified import Service.Transport.WebSpec qualified +import Service.Transport.Web.BindSpec qualified import Service.Transport.Web.HealthCheckSpec qualified import Service.Transport.Web.ReadinessRouteSpec qualified import Service.Command.AuthSpec qualified @@ -99,6 +100,7 @@ main = Hspec.hspec do Hspec.describe "Service.Transport.Mcp.Protocol" Service.Transport.Mcp.ProtocolSpec.spec Hspec.describe "Service.Transport.Mcp.Response" Service.Transport.Mcp.ResponseSpec.spec Hspec.describe "Service.Transport.Web" Service.Transport.WebSpec.spec + Hspec.describe "Service.Transport.Web.Bind" Service.Transport.Web.BindSpec.spec Hspec.describe "Health Check" Service.Transport.Web.HealthCheckSpec.spec Hspec.describe "Service.Transport.Web.ReadinessRoute" Service.Transport.Web.ReadinessRouteSpec.spec Hspec.describe "Service.Command.Auth" Service.Command.AuthSpec.spec diff --git a/core/test/Service/Transport/Web/BindSpec.hs b/core/test/Service/Transport/Web/BindSpec.hs new file mode 100644 index 000000000..5a4981aaf --- /dev/null +++ b/core/test/Service/Transport/Web/BindSpec.hs @@ -0,0 +1,111 @@ +module Service.Transport.Web.BindSpec where + +import AsyncTask qualified +import Core +import Http.Client qualified as Http +import Http.Client.Internal qualified as HttpInternal +import Network.Socket qualified as GhcSocket +import Network.Wai.Handler.Warp qualified as GhcWarp +import Service.Application (Application (..)) +import Service.Application qualified as Application +import Service.EventStore.InMemory qualified as InMemory +import Service.Transport.Web (WebTransport (..), hostPreference, server, warpSettings) +import Task qualified +import Test + + +spec :: Spec Unit +spec = do + describe "WebTransport bind host and port" do + describe "defaults" do + it "server binds all interfaces by default" \_ -> do + server.host |> shouldBe "*" + + it "server listens on port 8080 by default" \_ -> do + server.port |> shouldBe 8080 + + describe "Application builders" do + it "withHost records the bind host" \_ -> do + let app = Application.new |> Application.withHost "127.0.0.1" + app.bindHost |> shouldBe (Just "127.0.0.1") + + it "withPort records the bind port" \_ -> do + let app = Application.new |> Application.withPort 9090 + app.bindPort |> shouldBe (Just 9090) + + it "bind host and port are unset on a new Application" \_ -> do + Application.new.bindHost |> shouldBe Nothing + Application.new.bindPort |> shouldBe Nothing + + describe "hostPreference" do + it "maps a literal IPv4 address to that host" \_ -> do + show (hostPreference "127.0.0.1") |> shouldBe "Host \"127.0.0.1\"" + + it "maps * to all interfaces" \_ -> do + show (hostPreference "*") |> shouldBe "HostAny" + + it "maps *4 to all IPv4 interfaces" \_ -> do + show (hostPreference "*4") |> shouldBe "HostIPv4" + + it "maps *6 to all IPv6 interfaces" \_ -> do + show (hostPreference "*6") |> shouldBe "HostIPv6" + + it "maps a literal IPv6 address to that host" \_ -> do + show (hostPreference "::1") |> shouldBe "Host \"::1\"" + + describe "warpSettings" do + it "carries the configured host and port into Warp" \_ -> do + let transport = server {host = "127.0.0.1", port = 9191} + let settings = warpSettings transport + show (GhcWarp.getHost settings) |> shouldBe "Host \"127.0.0.1\"" + GhcWarp.getPort settings |> shouldBe 9191 + + describe "running" do + it "serves /health on loopback when bound to 127.0.0.1" \_ -> do + eventStore <- InMemory.new |> Task.mapError toText + freePort <- getFreePort + let app = + Application.new + |> Application.withTransport server + |> Application.withHost "127.0.0.1" + |> Application.withPort freePort + running <- AsyncTask.run (Application.runWith eventStore app) + let cancelApp = AsyncTask.cancel running |> Task.ignoreError + let probe = do + status <- getHealthStatus freePort 50 + status |> shouldBe 200 + probe |> Task.finally cancelApp + + +-- | Ask the OS for a currently free loopback port. +getFreePort :: Task Text Int +getFreePort = do + let hints = GhcSocket.defaultHints {GhcSocket.addrSocketType = GhcSocket.Stream} + addrInfos <- GhcSocket.getAddrInfo (Just hints) (Just "127.0.0.1") (Just "0") |> Task.fromIO + case addrInfos of + [] -> Task.throw "no loopback address available" + (addr : _) -> do + sock <- GhcSocket.openSocket addr |> Task.fromIO + GhcSocket.bind sock (GhcSocket.addrAddress addr) |> Task.fromIO + port <- GhcSocket.socketPort sock |> Task.fromIO + GhcSocket.close sock |> Task.fromIO + Task.yield (fromIntegral port) + + +-- | GET /health on loopback, retrying while the server is still binding. +getHealthStatus :: Int -> Int -> Task Text Int +getHealthStatus port attemptsLeft = do + result <- + Http.request + |> Http.withUrl [fmt|http://127.0.0.1:#{port}/health|] + |> Http.withTimeout 2 + |> HttpInternal.getRaw + |> Task.asResult + case result of + Ok response -> Task.yield response.statusCode + Err _ -> + if attemptsLeft <= 0 + then Task.throw "/health never answered on the bound loopback port" + else do + AsyncTask.sleep 100 + getHealthStatus port (attemptsLeft - 1) diff --git a/docs/changes/019-server-bind-host-port.md b/docs/changes/019-server-bind-host-port.md new file mode 100644 index 000000000..e3ae7dcec --- /dev/null +++ b/docs/changes/019-server-bind-host-port.md @@ -0,0 +1,74 @@ +# Change 019: Make the Warp bind host and port configurable + +The web server always bound Warp's default host on a port fixed in code, so an +app running behind a reverse proxy could not restrict itself to loopback and +could not choose its port without building a `WebTransport` by hand. The +maintainer accepted a loopback-bind fix and asked to "make the port configurable +too". `WebTransport` gains a `host` field (default `"*"`, all interfaces, so +behaviour is unchanged) and `Application` gains `withHost` and `withPort` +builders next to the other `with*` builders. `runTransport` now starts Warp with +`runSettings` built from that host and port, and logs `:`. + +```yaml spec +issue: adhoc:server-bind-host-port +kind: feature +touches: [http-transport] +breaking: true +new-dependency: false +new-capability: false +new-extension-point: false +``` + +## Contract delta + +`WebTransport` and `Application` are public records, so adding a field changes +their constructor signature lines (a `-`/`+` pair each). `runTransports` gains +the two optional overrides that carry `withHost` / `withPort` to the transport. +`hostPreference` and `warpSettings` are the small, testable conversion from the +transport's host and port to Warp settings. + +```diff signatures +- Service.Application: Application :: Maybe ConfigSpec -> Maybe EventStoreFactory -> Maybe QueryObjectStoreConfigValue -> Array QueryDefinition -> QueryRegistry -> Array ServiceRunner -> Map Text TransportValue -> Map Text QueryEndpointHandler -> Array OutboundRunner -> Array OutboundLifecycleRunner -> Array Inbound -> Maybe WebAuthFactory -> Maybe OAuth2Setup -> Maybe FileUploadFactory -> Maybe SecretStore -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe DispatcherConfig -> Maybe CorsFactory -> Maybe ApiInfoFactory -> Maybe HealthCheckFactory -> Maybe DispatcherConfigFactory -> Maybe SecretStoreFactory -> Array DeferredOutboundLifecycleReg -> Array DeferredInboundReg -> Array IntegrationRegistrationEntry -> Maybe ReadinessConfig -> Application ++ Service.Application: Application :: Maybe ConfigSpec -> Maybe EventStoreFactory -> Maybe QueryObjectStoreConfigValue -> Array QueryDefinition -> QueryRegistry -> Array ServiceRunner -> Map Text TransportValue -> Map Text QueryEndpointHandler -> Array OutboundRunner -> Array OutboundLifecycleRunner -> Array Inbound -> Maybe WebAuthFactory -> Maybe OAuth2Setup -> Maybe FileUploadFactory -> Maybe SecretStore -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe DispatcherConfig -> Maybe CorsFactory -> Maybe ApiInfoFactory -> Maybe HealthCheckFactory -> Maybe DispatcherConfigFactory -> Maybe SecretStoreFactory -> Array DeferredOutboundLifecycleReg -> Array DeferredInboundReg -> Array IntegrationRegistrationEntry -> Maybe ReadinessConfig -> Maybe Text -> Maybe Int -> Application ++ Service.Application: [bindHost] :: Application -> Maybe Text ++ Service.Application: [bindPort] :: Application -> Maybe Int ++ Service.Application: withHost :: Text -> Application -> Application ++ Service.Application: withPort :: Int -> Application -> Application +- Service.Application.Transports: runTransports :: Map Text TransportValue -> Map Text (Map Text EndpointHandler) -> Map Text (Map Text EndpointSchema) -> Map Text QueryEndpointHandler -> Map Text EndpointSchema -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> QuerySubscriber -> Task Text Unit ++ Service.Application.Transports: runTransports :: Map Text TransportValue -> Map Text (Map Text EndpointHandler) -> Map Text (Map Text EndpointSchema) -> Map Text QueryEndpointHandler -> Map Text EndpointSchema -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> Maybe Text -> Maybe Int -> QuerySubscriber -> Task Text Unit +- Service.Transport.Web: WebTransport :: Int -> Int -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> Maybe (Task Text Readiness) -> WebTransport ++ Service.Transport.Web: WebTransport :: Int -> Text -> Int -> Maybe AuthEnabled -> Maybe OAuth2Config -> Maybe FileUploadEnabled -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe IntegrationStatus -> Maybe ReadinessConfig -> Maybe (Task Text Readiness) -> WebTransport ++ Service.Transport.Web: [host] :: WebTransport -> Text ++ Service.Transport.Web: hostPreference :: Text -> HostPreference ++ Service.Transport.Web: warpSettings :: WebTransport -> Settings +``` + +## Criteria + +| ID | Behavior | Proving test | Level | Boundary | +|----|----------|--------------|-------|----------| +| C1 | `WebTransport` binds all interfaces on port 8080 by default, exactly as before | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#server binds all interfaces by default`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#server listens on port 8080 by default` | unit | none | +| C2 | `Application.withHost` / `Application.withPort` record the bind host and port, and a new `Application` leaves them unset | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withHost records the bind host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withPort records the bind port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#bind host and port are unset on a new Application` | unit | none | +| C3 | The host text maps to the right Warp `HostPreference` (`127.0.0.1`, `*`, `*4`, `*6`, `::1`) | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps a literal IPv4 address to that host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps * to all interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps *4 to all IPv4 interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps *6 to all IPv6 interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps a literal IPv6 address to that host` | unit | none | +| C4 | The Warp settings the transport runs with carry the configured host and port | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#carries the configured host and port into Warp` | unit | none | +| C5 | An application started with `withHost "127.0.0.1"` and `withPort ` answers `GET /health` on loopback | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#serves /health on loopback when bound to 127.0.0.1` | unit | none | + +## User impact + +Breaking only for code that builds the records positionally or with every field +named; nothing else changes. Apps that use `WebTransport.server`, including +`server { port = ... }`, and apps built with `Application.new` and the `with*` +builders are unaffected and keep binding all interfaces on port 8080 unless they +opt in. Migration: a program that writes `WebTransport { ... }` with all fields +must add `host = "*"` (the previous behaviour) or `host = "127.0.0.1"` for +loopback only; a program that writes `Application { ... }` with all fields must +add `bindHost = Nothing` and `bindPort = Nothing`. The testbed uses +`WebTransport.server` with no overrides, so its behaviour is unchanged. +New ways to use it: `Application.withHost "127.0.0.1"` and +`Application.withPort 9090`; `host` also accepts `"*"`, `"*4"`, `"*6"` or a +literal address. + +## ADR + +[ADR-0079](../decisions/0079-configurable-web-bind-host-and-port.md): why the +default stays `"*"` and why the overrides live on `Application`. diff --git a/docs/decisions/0079-configurable-web-bind-host-and-port.md b/docs/decisions/0079-configurable-web-bind-host-and-port.md new file mode 100644 index 000000000..edf8418c5 --- /dev/null +++ b/docs/decisions/0079-configurable-web-bind-host-and-port.md @@ -0,0 +1,41 @@ +# ADR-0079: Configurable web bind host and port + +## Status + +Accepted + +## Context + +`WebTransport` always bound Warp's default host and a port fixed in `server`. +Apps behind a reverse proxy want loopback-only binding, and the port could only +be changed by editing the `WebTransport` record, which `Application` hides +inside an existing transport value. The maintainer accepted a loopback-bind fix +and asked for the port to be configurable too. + +## Decision + +Add `host :: Text` to `WebTransport` and start Warp with `runSettings`, using +`setPort` and `setHost`. The text maps to Warp's `HostPreference`: `"*"` all +interfaces, `"*4"`, `"*6"`, or a literal address such as `"127.0.0.1"`. + +The default is `"*"`, not loopback. The previous `Warp.run` bound IPv4 only +(`"*4"`); `"*"` also listens on IPv6, which keeps every address that worked +before reachable and adds none that was reachable only by accident. A loopback +default would silently break containers and any app that is reached from +another machine, so safer-by-default is left to the app (`withHost`). + +Add `Application.withHost` and `Application.withPort`, stored as `bindHost` and +`bindPort` and applied when the web transport starts. They are on `Application`, +like `withCors` and `withHealthCheck`, because `withTransport` stores the +transport as an opaque value, so a builder cannot edit it. The override applies +whatever the order of `withTransport` and the builder. + +## Consequences + +- Constructing `WebTransport` or `Application` with every field named must add + the new fields. This is the one breaking effect; `WebTransport.server` users + are unaffected. +- Apps can bind loopback only, or choose the port, in one line. +- The start-up log now shows `:`. +- The default now also accepts IPv6 connections (it was IPv4 only). Apps that + need IPv4 only can set `"*4"`. diff --git a/docs/decisions/README.md b/docs/decisions/README.md index ef1a0d635..1a6307565 100644 --- a/docs/decisions/README.md +++ b/docs/decisions/README.md @@ -92,6 +92,7 @@ ADRs document significant architectural decisions made during the development of | [0076](0076-restore-resumable-change-pipeline.md) | Restore the resumable contract-delta change pipeline | Implemented | | [0077](0077-local-release-notes-and-main-publication.md) | Local release notes and coordinated publication from main | Implemented | | [0078](0078-documentation-image-zoom.md) | Documentation Image Zoom | Accepted | +| [0079](0079-configurable-web-bind-host-and-port.md) | Configurable web bind host and port | Accepted | -- `yield :: value -> Task w value` -- `asResult :: Task err value -> Task err2 (Result err value)` +- `mapError :: (err1 -> err2) -> Task err1 value -> Task err2 value` +- `yield :: value -> Task w value` +- `asResult :: Task err value -> Task err2 (Result err value)` - `mapArray :: (element -> Task err output) -> Array element -> Task err (Array output)` -- `throw :: err -> Task err w` +- `throw :: err -> Task err w` +- `fromIO :: IO value -> Task w value` - `andThen :: (input -> Task err output) -> Task err input -> Task err output` -- `fromIO :: IO value -> Task w value` - `map :: (input -> output) -> Task err input -> Task err output` ## Array @@ -377,4 +377,4 @@ when WRITING TESTS; they are not feature-code frequency signal. - `generateV5 :: Uuid -> Text -> Uuid` - `fromText :: Text -> Maybe Uuid` -*cut: 138 more modules (Map (257), Service.Application (250), Set (233), AsyncTask (223), Stream (212), …) — full surface: codemap/signatures/* +*cut: 138 more modules (Service.Application (269), Map (257), Set (233), AsyncTask (226), Stream (212), …) — full surface: codemap/signatures/* diff --git a/codemap/signatures/nhcore-service.txt b/codemap/signatures/nhcore-service.txt index 7b88b16ee..57c1f7c89 100644 --- a/codemap/signatures/nhcore-service.txt +++ b/codemap/signatures/nhcore-service.txt @@ -1808,6 +1808,7 @@ WebTransport :: Int -> Text -> Int -> Maybe AuthEnabled -> Maybe OAuth2Config -> [readinessConfig] :: WebTransport -> Maybe ReadinessConfig [readinessProbe] :: WebTransport -> Maybe (Task Text Readiness) [routes] :: OAuth2Config -> OAuth2Routes +applyBindOverrides :: Maybe Text -> Maybe Int -> WebTransport -> WebTransport buildHealthResponse :: WebTransport -> ByteString data AuthEnabled data CorsConfig diff --git a/core/service/Service/Application.hs b/core/service/Service/Application.hs index 8c890ae13..1752ce906 100644 --- a/core/service/Service/Application.hs +++ b/core/service/Service/Application.hs @@ -1802,8 +1802,9 @@ withoutHealthCheck app = -- | Set the interface the WebTransport binds. -- -- Overrides the host of the registered 'Web.server', whatever the order of --- 'withTransport' and 'withHost'. Without it the transport binds all --- interfaces (@"*"@). +-- 'withTransport' and 'withHost'. Without it the transport keeps the +-- registered transport's host; 'Web.server' defaults to all IPv4 interfaces +-- (@"*4"@, unchanged from the previous @Warp.run@). -- -- * @"127.0.0.1"@ (or any literal address such as @"::1"@): that address only. -- Loopback-only is recommended behind a reverse proxy. diff --git a/core/service/Service/Application/Transports.hs b/core/service/Service/Application/Transports.hs index a89fa9ea0..c9a8aeb4d 100644 --- a/core/service/Service/Application/Transports.hs +++ b/core/service/Service/Application/Transports.hs @@ -17,6 +17,7 @@ import Maybe qualified import Service.ServiceDefinition.Core (TransportValue (..)) import Service.Transport (Transport (..), QueryEndpointHandler, EndpointHandler, Endpoints (..), EndpointSchema (..)) import Service.Transport.Web (WebTransport (..), AuthEnabled, OAuth2Config, FileUploadEnabled (..), CorsConfig, HealthCheckConfig, IntegrationStatus) +import Service.Transport.Web qualified as Web import Service.Transport.Web.Readiness (ReadinessConfig) import Service.Application.Types (ApiInfo) import Service.Query.Subscriber (QuerySubscriber) @@ -142,9 +143,8 @@ runWebTransport transportVal commandEndpoints commandSchemas queryEndpoints quer , integrationStatus = maybeIntegrationStatus , readinessConfig = maybeReadinessConfig , readinessProbe = Just (Subscriber.readinessOf subscriber) - , host = maybeHost |> Maybe.withDefault baseWebTransport.host - , port = maybePort |> Maybe.withDefault baseWebTransport.port } + |> Web.applyBindOverrides maybeHost maybePort -- Build endpoints with the configured transport let endpoints :: Endpoints WebTransport = Endpoints diff --git a/core/service/Service/Transport/Web.hs b/core/service/Service/Transport/Web.hs index bf060663a..aeff6f93a 100644 --- a/core/service/Service/Transport/Web.hs +++ b/core/service/Service/Transport/Web.hs @@ -9,6 +9,7 @@ module Service.Transport.Web ( server, hostPreference, warpSettings, + applyBindOverrides, isHealthCheckPath, buildHealthResponse, isReadinessPath, @@ -44,6 +45,7 @@ import Json qualified import LinkedList qualified import Map qualified import Maybe (Maybe (..)) +import Maybe qualified import Network.HTTP.Types.Header qualified as HTTP import Network.HTTP.Types.Method qualified as GhcMethod import Network.HTTP.Types.Status qualified as HTTP @@ -233,6 +235,19 @@ warpSettings transport = |> Warp.setHost (hostPreference transport.host) +-- | Apply the application-level bind overrides ('Application.withHost' / +-- 'Application.withPort') to a registered transport. An absent override keeps +-- the transport's own setting, so a custom @server { port = ... }@ survives +-- when only the host is overridden (and the other way round). Pure, so the +-- composition rule is testable without starting a server. +applyBindOverrides :: Maybe Text -> Maybe Int -> WebTransport -> WebTransport +applyBindOverrides maybeHost maybePort transport = + transport + { host = maybeHost |> Maybe.withDefault transport.host + , port = maybePort |> Maybe.withDefault transport.port + } + + -- | Read request body with a size limit to prevent DoS attacks. -- Returns Err if the body exceeds the limit, Ok with the body bytes otherwise. readBodyWithLimit :: Int -> Wai.Request -> Task Text (Result Text Bytes) diff --git a/core/test/Service/Transport/Web/BindSpec.hs b/core/test/Service/Transport/Web/BindSpec.hs index 3b82045a1..5bf514295 100644 --- a/core/test/Service/Transport/Web/BindSpec.hs +++ b/core/test/Service/Transport/Web/BindSpec.hs @@ -9,7 +9,7 @@ import Network.Wai.Handler.Warp qualified as GhcWarp import Service.Application (Application (..)) import Service.Application qualified as Application import Service.EventStore.InMemory qualified as InMemory -import Service.Transport.Web (WebTransport (..), hostPreference, server, warpSettings) +import Service.Transport.Web (WebTransport (..), applyBindOverrides, hostPreference, server, warpSettings) import Task qualified import Test @@ -53,6 +53,36 @@ spec = do it "maps a literal IPv6 address to that host" \_ -> do show (hostPreference "::1") |> shouldBe "Host \"::1\"" + describe "override composition" do + it "withHost and withPort apply whether they come before or after withTransport" \_ -> do + let before = + Application.new + |> Application.withHost "127.0.0.1" + |> Application.withPort 9191 + |> Application.withTransport server + let after = + Application.new + |> Application.withTransport server + |> Application.withHost "127.0.0.1" + |> Application.withPort 9191 + let bound app = applyBindOverrides app.bindHost app.bindPort server + (bound before).host |> shouldBe "127.0.0.1" + (bound before).port |> shouldBe 9191 + (bound after).host |> shouldBe "127.0.0.1" + (bound after).port |> shouldBe 9191 + + it "absent overrides preserve the transport's custom host and port" \_ -> do + let custom = server {host = "::1", port = 7070} + let untouched = applyBindOverrides Nothing Nothing custom + untouched.host |> shouldBe "::1" + untouched.port |> shouldBe 7070 + let hostOnly = applyBindOverrides (Just "127.0.0.1") Nothing custom + hostOnly.host |> shouldBe "127.0.0.1" + hostOnly.port |> shouldBe 7070 + let portOnly = applyBindOverrides Nothing (Just 9191) custom + portOnly.host |> shouldBe "::1" + portOnly.port |> shouldBe 9191 + describe "warpSettings" do it "carries the configured host and port into Warp" \_ -> do let transport = server {host = "127.0.0.1", port = 9191} diff --git a/docs/changes/019-server-bind-host-port.md b/docs/changes/019-server-bind-host-port.md index b44dd2fcd..444d905ea 100644 --- a/docs/changes/019-server-bind-host-port.md +++ b/docs/changes/019-server-bind-host-port.md @@ -47,19 +47,21 @@ transport's host and port to Warp settings. | ID | Behavior | Proving test | Level | Boundary | |----|----------|--------------|-------|----------| -| C1 | `WebTransport` binds all interfaces on port 8080 by default, exactly as before | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#server binds all interfaces by default`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#server listens on port 8080 by default` | unit | none | +| C1 | `WebTransport` binds all IPv4 interfaces on port 8080 by default, exactly as before (`Warp.run`) | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#server binds all IPv4 interfaces by default (unchanged from Warp.run)`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#server listens on port 8080 by default` | unit | none | | C2 | `Application.withHost` / `Application.withPort` record the bind host and port, and a new `Application` leaves them unset | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withHost records the bind host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withPort records the bind port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#bind host and port are unset on a new Application` | unit | none | | C3 | The host text maps to the right Warp `HostPreference` (`127.0.0.1`, `*`, `*4`, `*6`, `::1`) | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps a literal IPv4 address to that host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps * to all interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps *4 to all IPv4 interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps *6 to all IPv6 interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps a literal IPv6 address to that host` | unit | none | | C4 | The Warp settings the transport runs with carry the configured host and port | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#carries the configured host and port into Warp` | unit | none | -| C5 | An application started with `withHost "127.0.0.1"` and `withPort ` answers `GET /health` on loopback | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#serves /health on loopback when bound to 127.0.0.1` | unit | none | +| C5 | An application started with `withHost "127.0.0.1"` and `withPort ` answers `GET /health` on loopback | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#serves /health on loopback when bound to 127.0.0.1` | integration | http:real | +| C6 | Overrides apply whatever the order of `withTransport` and the builders; an absent override preserves the transport's own host/port | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withHost and withPort apply whether they come before or after withTransport`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#absent overrides preserve the transport's custom host and port` | unit | none | ## User impact Breaking only for code that builds the records positionally or with every field -named; nothing else changes. Apps that use `WebTransport.server`, including -`server { port = ... }`, and apps built with `Application.new` and the `with*` -builders are unaffected and keep binding all interfaces on port 8080 unless they -opt in. Migration: a program that writes `WebTransport { ... }` with all fields +named; nothing else changes. Apps that use `WebTransport.server` and apps built with `Application.new` +and the `with*` builders are unaffected and keep binding all IPv4 interfaces +on port 8080 unless they opt in; an app that already sets `server { port = ... }` +keeps that port, because an absent `withPort` preserves the transport's own +setting. Migration: a program that writes `WebTransport { ... }` with all fields must add `host = "*4"` (the previous behaviour) or `host = "127.0.0.1"` for loopback only; a program that writes `Application { ... }` with all fields must add `bindHost = Nothing` and `bindPort = Nothing`. The testbed uses diff --git a/docs/changes/test-surfaces.json b/docs/changes/test-surfaces.json index 32fa31a81..6857091be 100644 --- a/docs/changes/test-surfaces.json +++ b/docs/changes/test-surfaces.json @@ -208,6 +208,15 @@ "boundary": "postgres:real", "expected_examples": 1, "fixture": "Service.QueryObjectStore.Postgres" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "serves /health on loopback when bound to 127.0.0.1", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Network.Wai.Handler.Warp (loopback, free port)" } ] } diff --git a/docs/decisions/0079-configurable-web-bind-host-and-port.md b/docs/decisions/0079-configurable-web-bind-host-and-port.md index fb45d6601..4f1bfb4dc 100644 --- a/docs/decisions/0079-configurable-web-bind-host-and-port.md +++ b/docs/decisions/0079-configurable-web-bind-host-and-port.md @@ -38,5 +38,6 @@ whatever the order of `withTransport` and the builder. are unaffected. - Apps can bind loopback only, or choose the port, in one line. - The start-up log now shows `:`. -- The default now also accepts IPv6 connections (it was IPv4 only). Apps that - need IPv4 only can set `"*4"`. +- The default is unchanged: all IPv4 interfaces (`"*4"`), exactly what + `Warp.run` bound before. IPv6 (`"*"` or `"*6"`) and loopback-only are opt-in + through `withHost`. From 676c06a1cee49bff0253e681018cc4b551886c09 Mon Sep 17 00:00:00 2001 From: stepandra Date: Thu, 8 Oct 2026 04:59:24 +0900 Subject: [PATCH 4/8] =?UTF-8?q?fix(http-transport):=20address=20second=20m?= =?UTF-8?q?aintainer=20review=20on=20#909=20=E2=80=94=20bind=20input=20con?= =?UTF-8?q?tract,=20loopback-exclusion=20evidence,=20single-setting=20cove?= =?UTF-8?q?rage,=20proxy=20guidance?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 1. Input/failure contract: pure Web.validateBindHost / validateBindPort run in runWebTransport before any socket opens (empty host, URL/path, host:port, whitespace; port 0 and out-of-range rejected), error names the builder. Warp.runSettings now goes through Task.fromFailableIO @IOException and fails as 'WebTransport could not bind :' on the existing Task.finally cleanup path. 2. Loopback evidence: per-test unique health path (instance identity) plus a discriminating probe — the port stays bindable on a non-loopback address only for a loopback listener; wildcard-bind negative control proves the probe fails otherwise. 3. Single-setting preservation split into explicit host-only / port-only examples. 4. Reverse-proxy guidance qualified by network namespace in the release fragment, withHost/WebTransport.host Haddock, ADR-0079 and change 019. Spec 019: C5 widened, C6 lists the single-setting examples, C7 (validation) and C8 (startup failures, integration | http:real) added; 4 attestations. BindSpec 14 -> 27 examples, 0 failures; lint no hints; spec-check, criteria-tests, spec-drift, codemap-check, changelog --check OK. --- .changes/019-server-bind-host-port.md | 10 +- codemap/api-hot.md | 36 ++-- codemap/signatures/nhcore-service.txt | 2 + core/service/Service/Application.hs | 14 +- .../service/Service/Application/Transports.hs | 8 + core/service/Service/Transport/Web.hs | 62 +++++- core/test/Service/Transport/Web/BindSpec.hs | 183 ++++++++++++++++-- docs/changes/019-server-bind-host-port.md | 30 ++- docs/changes/test-surfaces.json | 36 ++++ ...079-configurable-web-bind-host-and-port.md | 21 ++ 10 files changed, 362 insertions(+), 40 deletions(-) diff --git a/.changes/019-server-bind-host-port.md b/.changes/019-server-bind-host-port.md index 86628735c..33c3d6121 100644 --- a/.changes/019-server-bind-host-port.md +++ b/.changes/019-server-bind-host-port.md @@ -7,7 +7,11 @@ category: Breaking changes ## Summary -You can now choose which network address and port your web server listens on. Add `Application.withHost "127.0.0.1"` to accept connections from the same machine only, which is the safe choice behind a reverse proxy, and `Application.withPort 9090` to change the port. `host` also accepts `"*"` (all addresses, IPv4 and IPv6), `"*4"`, `"*6"` or a literal address. +You can now choose which network address and port your web server listens on. Add `Application.withHost "127.0.0.1"` to accept connections from the same machine only, and `Application.withPort 9090` to change the port. `host` also accepts `"*"` (all addresses, IPv4 and IPv6), `"*4"`, `"*6"` or a literal address. + +Loopback (`"127.0.0.1"`) is the right choice when your reverse proxy runs on the same machine or in the same container as the app. If the proxy runs somewhere else (its own container with its own network, another host), it cannot reach a loopback listener; keep the default bind and restrict access with your firewall or network policy instead. + +A mistake in these settings fails at startup with a clear message instead of starting something unintended. The host must be a bare address or hostname (an empty host, a URL like `"http://127.0.0.1"`, a `host:port` pair or whitespace is rejected with `Application.withHost: ...`), and the port must be between 1 and 65535 (`0` and out-of-range values are rejected with `Application.withPort: ...`). If the port is already in use or the address does not belong to this machine, the app stops with `WebTransport could not bind :: ...`. Your app behaves exactly as before unless you opt in: it still listens on all IPv4 addresses on port 8080. To also accept IPv6 connections, set `Application.withHost "*"`. @@ -24,10 +28,10 @@ Prefer `WebTransport.server { port = 9090 }` or `Application.withHost` and `Appl ### Verify -Build your app, then start it and request `/health` on the address you chose. To check the framework change itself, run `./dev test "Service.Transport.Web.Bind" nhcore-test-service`. All 12 examples pass, including one that starts the server on `127.0.0.1` and fetches `/health`. +Build your app, then start it and request `/health` on the address you chose. To check the framework change itself, run `./dev test "Service.Transport.Web.Bind" nhcore-test-service`. All 27 examples pass, including one that starts the server on `127.0.0.1`, fetches its health endpoint and confirms the port is still free on the machine's other addresses, and one that shows a port already in use is reported as `could not bind`. ## Agent prompt ```text -My NeoHaskell app fails to compile after upgrading nhcore. `WebTransport` gained a `host :: Text` field and `Application` gained `bindHost :: Maybe Text` and `bindPort :: Maybe Int`. Find every place that builds a `WebTransport { ... }` or `Application { ... }` record by naming all fields (search for `WebTransport {`, `WebTransport$` followed by `{`, and `Application {`). In each `WebTransport` record add `host = "*4"` so it keeps listening on all IPv4 addresses exactly as before. In each `Application` record add `bindHost = Nothing` and `bindPort = Nothing`. Do not change anything that uses `WebTransport.server` or `Application.new`. Keep the port and every other field exactly as they were. Then build the project and run its tests. Report which files you edited and whether the build and tests pass. If my app sits behind a reverse proxy, tell me I can use `Application.withHost "127.0.0.1"` for local-only access, but do not change it without asking. +My NeoHaskell app fails to compile after upgrading nhcore. `WebTransport` gained a `host :: Text` field and `Application` gained `bindHost :: Maybe Text` and `bindPort :: Maybe Int`. Find every place that builds a `WebTransport { ... }` or `Application { ... }` record by naming all fields (search for `WebTransport {`, `WebTransport$` followed by `{`, and `Application {`). In each `WebTransport` record add `host = "*4"` so it keeps listening on all IPv4 addresses exactly as before. In each `Application` record add `bindHost = Nothing` and `bindPort = Nothing`. Do not change anything that uses `WebTransport.server` or `Application.new`. Keep the port and every other field exactly as they were. Then build the project and run its tests. Report which files you edited and whether the build and tests pass. If my app sits behind a reverse proxy that runs on the same machine or in the same container, tell me I can use `Application.withHost "127.0.0.1"` for local-only access; if the proxy runs elsewhere, tell me to keep the default bind. Do not change the bind host without asking. ``` diff --git a/codemap/api-hot.md b/codemap/api-hot.md index 7cceba6bf..faefe4d4d 100644 --- a/codemap/api-hot.md +++ b/codemap/api-hot.md @@ -12,13 +12,13 @@ codemap/signatures/ · type-directed search: ./dev api "" - `yield :: value -> Task w value` - `ignoreError :: Task err Unit -> Task w Unit` -- `mapError :: (err1 -> err2) -> Task err1 value -> Task err2 value` -- `throw :: err -> Task err w` -- `fromIO :: IO value -> Task w value` +- `mapError :: (err1 -> err2) -> Task err1 value -> Task err2 value` +- `throw :: err -> Task err w` +- `fromIO :: IO value -> Task w value` - `asResult :: Task err value -> Task err2 (Result err value)` - `when :: Bool -> Task err Unit -> Task err Unit` - `forEach :: (element -> Task err Unit) -> Array element -> Task err Unit` -- `fromFailableIO :: Exception exception => IO result -> Task exception result` +- `fromFailableIO :: Exception exception => IO result -> Task exception result` - `map :: (input -> output) -> Task err input -> Task err output` ## Array @@ -34,10 +34,10 @@ codemap/signatures/ · type-directed search: ./dev api "" - `>>> isEmpty empty` → `True` … - `push :: a -> Array a -> Array a` - `>>> push 3 (fromLinkedList [1,2] :: Array Int)` → `Array [1,2,3]` +- `length :: Array a -> Int` + - `>>> length ([1,2,3] :: Array Int)` → `3` … - `takeIf :: (a -> Bool) -> Array a -> Array a` - `>>> takeIf Basics.isEven (fromLinkedList [1,2,3,4,5,6] :: Array Int)` → `Array [2,4,6]` -- `length :: Array a -> Int` - - `>>> length ([1,2,3] :: Array Int)` → `3` … - `append :: Array a -> Array a -> Array a` - `>>> (repeat 2 42) |> append (repeat 3 81) :: Array Int` → `Array [42,42,81,81,81]` - `reduce :: (a -> b -> b) -> b -> Array a -> b` @@ -49,10 +49,10 @@ codemap/signatures/ · type-directed search: ./dev api "" - `toLinkedList :: Text -> LinkedList Char` - `toBytes :: Text -> Bytes` - `replace :: Text -> Text -> Text -> Text` +- `trim :: Text -> Text` - `fromBytes :: Bytes -> Text` -- `trim :: Text -> Text` +- `isEmpty :: Text -> Bool` - `joinWith :: Text -> Array Text -> Text` -- `isEmpty :: Text -> Bool` - `append :: Text -> Text -> Text` - `toLower :: Text -> Text` @@ -294,12 +294,12 @@ when WRITING TESTS; they are not feature-code frequency signal. ## Task -- `mapError :: (err1 -> err2) -> Task err1 value -> Task err2 value` -- `yield :: value -> Task w value` -- `asResult :: Task err value -> Task err2 (Result err value)` +- `mapError :: (err1 -> err2) -> Task err1 value -> Task err2 value` +- `yield :: value -> Task w value` +- `asResult :: Task err value -> Task err2 (Result err value)` - `mapArray :: (element -> Task err output) -> Array element -> Task err (Array output)` -- `throw :: err -> Task err w` -- `fromIO :: IO value -> Task w value` +- `throw :: err -> Task err w` +- `fromIO :: IO value -> Task w value` - `andThen :: (input -> Task err output) -> Task err input -> Task err output` - `map :: (input -> output) -> Task err input -> Task err output` @@ -316,13 +316,13 @@ when WRITING TESTS; they are not feature-code frequency signal. ## Text -- `contains :: Text -> Text -> Bool` +- `contains :: Text -> Text -> Bool` - `toBytes :: Text -> Bytes` - `fromLinkedList :: LinkedList Char -> Text` - `length :: Text -> Int` - `repeat :: Int -> Text -> Text` - `toLinkedList :: Text -> LinkedList Char` -- `startsWith :: Text -> Text -> Bool` +- `startsWith :: Text -> Text -> Bool` - `all :: (Char -> Bool) -> Text -> Bool` ## Parser @@ -371,10 +371,10 @@ when WRITING TESTS; they are not feature-code frequency signal. ## Uuid -- `generate :: Task w Uuid` +- `generate :: Task w Uuid` - `nil :: Uuid` -- `toText :: Uuid -> Text` +- `toText :: Uuid -> Text` - `generateV5 :: Uuid -> Text -> Uuid` - `fromText :: Text -> Maybe Uuid` -*cut: 138 more modules (Service.Application (269), Map (257), Set (233), AsyncTask (226), Stream (212), …) — full surface: codemap/signatures/* +*cut: 139 more modules (Service.Application (288), Map (257), Set (233), AsyncTask (228), Stream (212), …) — full surface: codemap/signatures/* diff --git a/codemap/signatures/nhcore-service.txt b/codemap/signatures/nhcore-service.txt index 57c1f7c89..3e4b113a6 100644 --- a/codemap/signatures/nhcore-service.txt +++ b/codemap/signatures/nhcore-service.txt @@ -1827,6 +1827,8 @@ respondReadiness :: WebTransport -> (Response -> Task Text ResponseReceived) -> server :: WebTransport unauthorizedResponse :: AccessError -> (Status, Text) unauthorizedResponseBody :: Text -> Text +validateBindHost :: Text -> Maybe Text +validateBindPort :: Int -> Maybe Text warpSettings :: WebTransport -> Settings module Service.Transport.Web.BuiltinSchemas diff --git a/core/service/Service/Application.hs b/core/service/Service/Application.hs index 1752ce906..b0b52df92 100644 --- a/core/service/Service/Application.hs +++ b/core/service/Service/Application.hs @@ -1807,10 +1807,18 @@ withoutHealthCheck app = -- (@"*4"@, unchanged from the previous @Warp.run@). -- -- * @"127.0.0.1"@ (or any literal address such as @"::1"@): that address only. --- Loopback-only is recommended behind a reverse proxy. +-- Loopback-only suits a reverse proxy in the same network namespace (same +-- host or container, shared pod network). A proxy in a separate namespace +-- cannot reach a loopback listener; keep a non-loopback bind there. -- * @"*"@: all interfaces, IPv4 and IPv6. -- * @"*4"@ / @"*6"@: all IPv4 / all IPv6 interfaces. -- +-- The value is checked when the server starts ('Web.validateBindHost'): an +-- empty host, a URL such as @"http://127.0.0.1"@, a @host:port@ pair or +-- whitespace fails 'run' with @Application.withHost: ...@ before any socket is +-- opened. An address this machine does not own fails at bind time with +-- @WebTransport could not bind :@. +-- -- Example: -- -- @ @@ -1832,6 +1840,10 @@ withHost host app = -- Overrides the port of the registered 'Web.server' (default 8080), whatever -- the order of 'withTransport' and 'withPort'. -- +-- Accepted range is 1..65535 ('Web.validateBindPort'). Port 0 is rejected: +-- the OS would pick a port that nothing reports back. A port already in use +-- fails at bind time with @WebTransport could not bind :@. +-- -- Example: -- -- @ diff --git a/core/service/Service/Application/Transports.hs b/core/service/Service/Application/Transports.hs index c9a8aeb4d..38ae350ce 100644 --- a/core/service/Service/Application/Transports.hs +++ b/core/service/Service/Application/Transports.hs @@ -145,6 +145,14 @@ runWebTransport transportVal commandEndpoints commandSchemas queryEndpoints quer , readinessProbe = Just (Subscriber.readinessOf subscriber) } |> Web.applyBindOverrides maybeHost maybePort + -- Reject an unusable host or port here, before any socket is opened: + -- the error names the setting and reaches Application.run's caller. + case Web.validateBindHost webTransportWithConfig.host of + Just reason -> Task.throw [fmt|Application.withHost: #{reason}|] + Nothing -> pass + case Web.validateBindPort webTransportWithConfig.port of + Just reason -> Task.throw [fmt|Application.withPort: #{reason}|] + Nothing -> pass -- Build endpoints with the configured transport let endpoints :: Endpoints WebTransport = Endpoints diff --git a/core/service/Service/Transport/Web.hs b/core/service/Service/Transport/Web.hs index aeff6f93a..e34a7e89f 100644 --- a/core/service/Service/Transport/Web.hs +++ b/core/service/Service/Transport/Web.hs @@ -10,6 +10,8 @@ module Service.Transport.Web ( hostPreference, warpSettings, applyBindOverrides, + validateBindHost, + validateBindPort, isHealthCheckPath, buildHealthResponse, isReadinessPath, @@ -33,6 +35,7 @@ import Basics import Bytes (Bytes) import Bytes qualified import ConcurrentVar qualified +import Control.Exception (IOException) import Log qualified import Data.Aeson qualified as Aeson import Data.ByteString qualified as GhcBS @@ -155,9 +158,13 @@ data WebTransport = WebTransport -- | Interface to bind. Set via Application.withHost. -- -- * @"127.0.0.1"@ (or any literal address such as @"::1"@): that address only. - -- Loopback-only is recommended behind a reverse proxy. + -- Loopback-only suits a reverse proxy that runs in the same network + -- namespace (same host, same container, or a shared pod network); a proxy + -- in a separate namespace cannot reach this listener through its own loopback. -- * @"*4"@: all IPv4 interfaces (the default; what @Warp.run@ bound before). -- * @"*"@: all interfaces, IPv4 and IPv6. @"*6"@: all IPv6 interfaces. + -- + -- Checked by 'validateBindHost' before the server starts. host :: Text, maxBodySize :: Int, -- | Optional JWT authentication. Set via Application.withAuth. @@ -248,6 +255,51 @@ applyBindOverrides maybeHost maybePort transport = } +-- | Check a bind host before the server starts. Accepted forms are the Warp +-- wildcards (@"*"@, @"*4"@, @"*6"@) and a bare literal address or hostname +-- such as @"127.0.0.1"@, @"::1"@ or @"localhost"@. +-- +-- The checks target the mistakes a hand-written or LLM-written config makes: +-- an empty or blank host, a URL (@"http://127.0.0.1"@), a path, or a +-- @host:port@ pair pasted into the host field. A single colon can only be a +-- port suffix because a literal IPv6 address always contains at least two. +-- Anything that passes is handed to Warp as a 'Warp.HostPreference'; an +-- address this machine does not own still fails at bind time with the +-- @could not bind@ error from 'runTransport'. +-- +-- Returns the reason the host is rejected, or 'Nothing' when it is usable. +validateBindHost :: Text -> Maybe Text +validateBindHost hostText = do + let colonCount = hostText |> Text.indexes ":" |> Array.length + let wordCount = hostText |> Text.words |> Array.length + if Text.isEmpty (Text.trim hostText) + then Just "bind host must not be empty; use \"*4\" for all IPv4 interfaces or \"127.0.0.1\" for loopback only" + else + if wordCount != 1 + then Just [fmt|bind host "#{hostText}" must not contain whitespace|] + else + if Text.contains "/" hostText + then Just [fmt|bind host "#{hostText}" looks like a URL or path; use a bare address such as "127.0.0.1", not "http://127.0.0.1"|] + else + if colonCount == 1 + then Just [fmt|bind host "#{hostText}" carries a port; set the port with Application.withPort instead|] + else Nothing + + +-- | Check a bind port before the server starts. Only 1..65535 is accepted. +-- Port 0 is rejected on purpose: the OS would pick a free port, but nothing in +-- the application reports which one, so the server would be unreachable by +-- design. Returns the reason the port is rejected, or 'Nothing' when usable. +validateBindPort :: Int -> Maybe Text +validateBindPort portNumber = + if portNumber == 0 + then Just "bind port 0 asks the OS for a random port that nothing reports back; choose a fixed port between 1 and 65535" + else + if portNumber < 0 || portNumber > 65535 + then Just [fmt|bind port #{portNumber} is outside 1..65535|] + else Nothing + + -- | Read request body with a size limit to prevent DoS attacks. -- Returns Err if the body exceeds the limit, Ok with the body bytes otherwise. readBodyWithLimit :: Int -> Wai.Request -> Task Text (Result Text Bytes) @@ -1089,13 +1141,17 @@ instance Transport WebTransport where Maybe.Nothing -> baseApp Maybe.Just cors -> corsMiddleware cors baseApp - -- Start the Warp server on the configured host and port + -- Start the Warp server on the configured host and port. A bind that the + -- OS refuses (port in use, address not owned by this machine) surfaces as + -- a Task error naming the host and port instead of an uncaught IOException. let host = transport.host let port = transport.port Log.withScope [("component", "WebTransport")] do Log.info [fmt|Starting WebTransport server on #{host}:#{port}|] |> Task.ignoreError - Warp.runSettings (warpSettings transport) waiApp |> Task.fromIO + Warp.runSettings (warpSettings transport) waiApp + |> Task.fromFailableIO @IOException + |> Task.mapError (\ioError -> [fmt|WebTransport could not bind #{host}:#{port}: #{show ioError}|]) buildHandler :: diff --git a/core/test/Service/Transport/Web/BindSpec.hs b/core/test/Service/Transport/Web/BindSpec.hs index 5bf514295..f23b1a3b7 100644 --- a/core/test/Service/Transport/Web/BindSpec.hs +++ b/core/test/Service/Transport/Web/BindSpec.hs @@ -1,17 +1,22 @@ module Service.Transport.Web.BindSpec where +import Array qualified import AsyncTask qualified import Core import Http.Client qualified as Http import Http.Client.Internal qualified as HttpInternal +import IO qualified +import Maybe qualified import Network.Socket qualified as GhcSocket import Network.Wai.Handler.Warp qualified as GhcWarp import Service.Application (Application (..)) import Service.Application qualified as Application import Service.EventStore.InMemory qualified as InMemory -import Service.Transport.Web (WebTransport (..), applyBindOverrides, hostPreference, server, warpSettings) +import Service.Transport.Web (WebTransport (..), applyBindOverrides, hostPreference, server, validateBindHost, validateBindPort, warpSettings) import Task qualified import Test +import Text qualified +import Uuid qualified spec :: Spec Unit @@ -72,17 +77,53 @@ spec = do (bound after).port |> shouldBe 9191 it "absent overrides preserve the transport's custom host and port" \_ -> do - let custom = server {host = "::1", port = 7070} - let untouched = applyBindOverrides Nothing Nothing custom + let untouched = applyBindOverrides Nothing Nothing customTransport untouched.host |> shouldBe "::1" untouched.port |> shouldBe 7070 - let hostOnly = applyBindOverrides (Just "127.0.0.1") Nothing custom + + it "a host-only override keeps the transport's custom port" \_ -> do + let hostOnly = applyBindOverrides (Just "127.0.0.1") Nothing customTransport hostOnly.host |> shouldBe "127.0.0.1" hostOnly.port |> shouldBe 7070 - let portOnly = applyBindOverrides Nothing (Just 9191) custom + + it "a port-only override keeps the transport's custom host" \_ -> do + let portOnly = applyBindOverrides Nothing (Just 9191) customTransport portOnly.host |> shouldBe "::1" portOnly.port |> shouldBe 9191 + describe "validateBindHost" do + it "accepts the Warp wildcards and bare literal addresses or hostnames" \_ -> do + let accepted = ["*", "*4", "*6", "127.0.0.1", "0.0.0.0", "::1", "::", "fe80::1", "localhost", "app.internal"] + let rejected = accepted |> Array.takeIf (\candidate -> validateBindHost candidate != Nothing) + rejected |> shouldBe [] + + it "rejects an empty or blank host" \_ -> do + validateBindHost "" |> shouldSatisfy (\reason -> reason != Nothing) + validateBindHost " " |> shouldSatisfy (\reason -> reason != Nothing) + + it "rejects a URL pasted into the host field" \_ -> do + let reason = validateBindHost "http://127.0.0.1" |> Maybe.withDefault "" + reason |> shouldSatisfy (Text.contains "URL") + + it "rejects a host that carries a port" \_ -> do + let reason = validateBindHost "127.0.0.1:8080" |> Maybe.withDefault "" + reason |> shouldSatisfy (Text.contains "withPort") + + it "rejects a host with whitespace inside" \_ -> do + validateBindHost "127.0.0.1 8080" |> shouldSatisfy (\reason -> reason != Nothing) + + describe "validateBindPort" do + it "accepts the full 1..65535 range" \_ -> do + validateBindPort 1 |> shouldBe Nothing + validateBindPort 8080 |> shouldBe Nothing + validateBindPort 65535 |> shouldBe Nothing + + it "rejects port 0 and ports outside the range" \_ -> do + let reason = validateBindPort 0 |> Maybe.withDefault "" + reason |> shouldSatisfy (Text.contains "random port") + validateBindPort (-1) |> shouldSatisfy (\outOfRange -> outOfRange != Nothing) + validateBindPort 65536 |> shouldSatisfy (\outOfRange -> outOfRange != Nothing) + describe "warpSettings" do it "carries the configured host and port into Warp" \_ -> do let transport = server {host = "127.0.0.1", port = 9191} @@ -92,20 +133,98 @@ spec = do describe "running" do it "serves /health on loopback when bound to 127.0.0.1" \_ -> do + -- Instance identity: the health path is unique to this test, so a + -- 200 can only come from the application started here. eventStore <- InMemory.new |> Task.mapError toText freePort <- getFreePort + healthPath <- uniqueHealthPath let app = Application.new |> Application.withTransport server |> Application.withHost "127.0.0.1" |> Application.withPort freePort + |> Application.withHealthCheck @() (\_ -> healthPath) + running <- AsyncTask.run (Application.runWith eventStore app) + let cancelApp = AsyncTask.cancel running |> Task.ignoreError + let probe = do + status <- getHealthStatus healthPath freePort 50 + status |> shouldBe 200 + -- Loopback isolation: the port is still free on a non-loopback + -- address, which a wildcard listener would have taken as well. + nonLoopback <- nonLoopbackAddress + canBind <- canBindElsewhere nonLoopback freePort + canBind |> shouldBe True + probe |> Task.finally cancelApp + + it "a wildcard bind occupies the port on every address (negative control for the loopback probe)" \_ -> do + eventStore <- InMemory.new |> Task.mapError toText + freePort <- getFreePort + healthPath <- uniqueHealthPath + let app = + Application.new + |> Application.withTransport server + |> Application.withPort freePort + |> Application.withHealthCheck @() (\_ -> healthPath) running <- AsyncTask.run (Application.runWith eventStore app) let cancelApp = AsyncTask.cancel running |> Task.ignoreError let probe = do - status <- getHealthStatus freePort 50 + status <- getHealthStatus healthPath freePort 50 status |> shouldBe 200 + nonLoopback <- nonLoopbackAddress + canBind <- canBindElsewhere nonLoopback freePort + canBind |> shouldBe False probe |> Task.finally cancelApp + it "an invalid host fails before any socket is opened" \_ -> do + eventStore <- InMemory.new |> Task.mapError toText + let app = + Application.new + |> Application.withTransport server + |> Application.withHost "http://127.0.0.1" + result <- Application.runWith eventStore app |> Task.asResult + case result of + Ok _ -> fail "runWith accepted a URL as the bind host" + Err err -> err |> shouldSatisfy (Text.startsWith "Application.withHost:") + + it "an invalid port fails before any socket is opened" \_ -> do + eventStore <- InMemory.new |> Task.mapError toText + let app = + Application.new + |> Application.withTransport server + |> Application.withPort 0 + result <- Application.runWith eventStore app |> Task.asResult + case result of + Ok _ -> fail "runWith accepted port 0" + Err err -> err |> shouldSatisfy (Text.startsWith "Application.withPort:") + + it "a port already in use fails with an error naming the host and port" \_ -> do + eventStore <- InMemory.new |> Task.mapError toText + (occupied, occupiedPort) <- occupyLoopbackPort + let app = + Application.new + |> Application.withTransport server + |> Application.withHost "127.0.0.1" + |> Application.withPort occupiedPort + let attempt = do + result <- Application.runWith eventStore app |> Task.asResult + case result of + Ok _ -> fail "runWith started on a port that was already in use" + Err err -> err |> shouldSatisfy (Text.contains [fmt|could not bind 127.0.0.1:#{occupiedPort}|]) + attempt |> Task.finally (GhcSocket.close occupied |> Task.fromIO) + + +-- | A transport with a custom host and port, for the single-setting cases. +customTransport :: WebTransport +customTransport = server {host = "::1", port = 7070} + + +-- | A health path no other test (or stray process) serves. +uniqueHealthPath :: Task Text Text +uniqueHealthPath = do + uuid <- Uuid.generate + let suffix = Uuid.toText uuid |> Text.replace "-" "" + Task.yield [fmt|health-#{suffix}|] + -- | Ask the OS for a currently free loopback port. getFreePort :: Task Text Int @@ -122,12 +241,54 @@ getFreePort = do Task.yield (fromIntegral port) --- | GET /health on loopback, retrying while the server is still binding. -getHealthStatus :: Int -> Int -> Task Text Int -getHealthStatus port attemptsLeft = do +-- | Hold a loopback port open so a later bind on it must fail. +occupyLoopbackPort :: Task Text (GhcSocket.Socket, Int) +occupyLoopbackPort = do + let hints = GhcSocket.defaultHints {GhcSocket.addrSocketType = GhcSocket.Stream} + addrInfos <- GhcSocket.getAddrInfo (Just hints) (Just "127.0.0.1") (Just "0") |> Task.fromIO + case addrInfos of + [] -> Task.throw "no loopback address available" + (addr : _) -> do + sock <- GhcSocket.openSocket addr |> Task.fromIO + GhcSocket.bind sock (GhcSocket.addrAddress addr) |> Task.fromIO + GhcSocket.listen sock 1 |> Task.fromIO + port <- GhcSocket.socketPort sock |> Task.fromIO + Task.yield (sock, fromIntegral port) + + +-- | An IPv4 address of this machine that is not loopback. The OS fills it in +-- when a UDP socket is pointed at a routable address; nothing is sent. +nonLoopbackAddress :: Task Text GhcSocket.HostAddress +nonLoopbackAddress = Task.fromIO do + sock <- GhcSocket.socket GhcSocket.AF_INET GhcSocket.Datagram GhcSocket.defaultProtocol + GhcSocket.connect sock (GhcSocket.SockAddrInet 9 (GhcSocket.tupleToHostAddress (10, 255, 255, 255))) + localName <- GhcSocket.getSocketName sock + GhcSocket.close sock + case localName of + GhcSocket.SockAddrInet _ address -> pure address + _ -> pure (GhcSocket.tupleToHostAddress (127, 0, 0, 1)) + + +-- | Can a fresh TCP socket still bind @address:port@? True when the running +-- server only holds loopback, False when a wildcard listener owns the port on +-- every address. Warp sets SO_REUSEADDR, so this probe discriminates on +-- address, not on the reuse flag. +canBindElsewhere :: GhcSocket.HostAddress -> Int -> Task Text Bool +canBindElsewhere address port = Task.fromIO do + sock <- GhcSocket.socket GhcSocket.AF_INET GhcSocket.Stream GhcSocket.defaultProtocol + outcome <- GhcSocket.bind sock (GhcSocket.SockAddrInet (fromIntegral port) address) |> IO.try + GhcSocket.close sock + case outcome of + Ok _ -> pure True + Err _ -> pure False + + +-- | GET the health path on loopback, retrying while the server is still binding. +getHealthStatus :: Text -> Int -> Int -> Task Text Int +getHealthStatus healthPath port attemptsLeft = do result <- Http.request - |> Http.withUrl [fmt|http://127.0.0.1:#{port}/health|] + |> Http.withUrl [fmt|http://127.0.0.1:#{port}/#{healthPath}|] |> Http.withTimeout 2 |> HttpInternal.getRaw |> Task.asResult @@ -138,4 +299,4 @@ getHealthStatus port attemptsLeft = do then Task.throw "/health never answered on the bound loopback port" else do AsyncTask.sleep 100 - getHealthStatus port (attemptsLeft - 1) + getHealthStatus healthPath port (attemptsLeft - 1) diff --git a/docs/changes/019-server-bind-host-port.md b/docs/changes/019-server-bind-host-port.md index 444d905ea..4f44f9e31 100644 --- a/docs/changes/019-server-bind-host-port.md +++ b/docs/changes/019-server-bind-host-port.md @@ -9,6 +9,16 @@ exactly what `Warp.run` bound before, so behaviour is unchanged) and `Applicatio builders next to the other `with*` builders. `runTransport` now starts Warp with `runSettings` built from that host and port, and logs `:`. +Input contract: the host is a Warp wildcard (`"*"`, `"*4"`, `"*6"`) or a bare +literal address / hostname; the port is `1..65535`. An empty host, a URL or path +in the host field, a `host:port` pair, whitespace, port `0` or an out-of-range +port is rejected before any socket is opened, with an error that names the +builder (`Application.withHost: …` / `Application.withPort: …`). A bind the OS +refuses (port in use, address not owned) fails with +`WebTransport could not bind :: …` instead of an uncaught +`IOException`; the `Task.finally` cleanup in `Application.run` still releases +the resources the run owns (JWKS manager, dispatcher, file upload). + ```yaml spec issue: adhoc:server-bind-host-port kind: feature @@ -25,7 +35,9 @@ new-extension-point: false their constructor signature lines (a `-`/`+` pair each). `runTransports` gains the two optional overrides that carry `withHost` / `withPort` to the transport. `hostPreference` and `warpSettings` are the small, testable conversion from the -transport's host and port to Warp settings. +transport's host and port to Warp settings. `applyBindOverrides` is the pure +override rule; `validateBindHost` / `validateBindPort` are the pure input checks +that `runWebTransport` runs before starting Warp. ```diff signatures - Service.Application: Application :: Maybe ConfigSpec -> Maybe EventStoreFactory -> Maybe QueryObjectStoreConfigValue -> Array QueryDefinition -> QueryRegistry -> Array ServiceRunner -> Map Text TransportValue -> Map Text QueryEndpointHandler -> Array OutboundRunner -> Array OutboundLifecycleRunner -> Array Inbound -> Maybe WebAuthFactory -> Maybe OAuth2Setup -> Maybe FileUploadFactory -> Maybe SecretStore -> Maybe ApiInfo -> Maybe CorsConfig -> Maybe HealthCheckConfig -> Maybe DispatcherConfig -> Maybe CorsFactory -> Maybe ApiInfoFactory -> Maybe HealthCheckFactory -> Maybe DispatcherConfigFactory -> Maybe SecretStoreFactory -> Array DeferredOutboundLifecycleReg -> Array DeferredInboundReg -> Array IntegrationRegistrationEntry -> Maybe ReadinessConfig -> Application @@ -41,6 +53,9 @@ transport's host and port to Warp settings. + Service.Transport.Web: [host] :: WebTransport -> Text + Service.Transport.Web: hostPreference :: Text -> HostPreference + Service.Transport.Web: warpSettings :: WebTransport -> Settings ++ Service.Transport.Web: applyBindOverrides :: Maybe Text -> Maybe Int -> WebTransport -> WebTransport ++ Service.Transport.Web: validateBindHost :: Text -> Maybe Text ++ Service.Transport.Web: validateBindPort :: Int -> Maybe Text ``` ## Criteria @@ -51,8 +66,10 @@ transport's host and port to Warp settings. | C2 | `Application.withHost` / `Application.withPort` record the bind host and port, and a new `Application` leaves them unset | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withHost records the bind host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withPort records the bind port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#bind host and port are unset on a new Application` | unit | none | | C3 | The host text maps to the right Warp `HostPreference` (`127.0.0.1`, `*`, `*4`, `*6`, `::1`) | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps a literal IPv4 address to that host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps * to all interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps *4 to all IPv4 interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps *6 to all IPv6 interfaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#maps a literal IPv6 address to that host` | unit | none | | C4 | The Warp settings the transport runs with carry the configured host and port | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#carries the configured host and port into Warp` | unit | none | -| C5 | An application started with `withHost "127.0.0.1"` and `withPort ` answers `GET /health` on loopback | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#serves /health on loopback when bound to 127.0.0.1` | integration | http:real | -| C6 | Overrides apply whatever the order of `withTransport` and the builders; an absent override preserves the transport's own host/port | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withHost and withPort apply whether they come before or after withTransport`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#absent overrides preserve the transport's custom host and port` | unit | none | +| C5 | An application started with `withHost "127.0.0.1"` and `withPort ` answers `GET /` on loopback (instance identity) and leaves the port free on a non-loopback address (loopback exclusion); the same probe finds the port taken when the default wildcard bind is used (negative control) | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#serves /health on loopback when bound to 127.0.0.1`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a wildcard bind occupies the port on every address (negative control for the loopback probe)` | integration | http:real | +| C6 | Overrides apply whatever the order of `withTransport` and the builders; an absent override preserves the transport's own host/port; a host-only override keeps a custom port and a port-only override keeps a custom host | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withHost and withPort apply whether they come before or after withTransport`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#absent overrides preserve the transport's custom host and port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a host-only override keeps the transport's custom port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a port-only override keeps the transport's custom host` | unit | none | +| C7 | `validateBindHost` accepts the Warp wildcards and bare literal addresses or hostnames, and rejects an empty host, a URL, a `host:port` pair and whitespace; `validateBindPort` accepts `1..65535` and rejects `0` and out-of-range ports | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#accepts the Warp wildcards and bare literal addresses or hostnames`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects an empty or blank host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a URL pasted into the host field`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host that carries a port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host with whitespace inside`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#accepts the full 1..65535 range`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects port 0 and ports outside the range` | unit | none | +| C8 | An invalid host or port makes `Application.runWith` fail with an `Application.withHost:` / `Application.withPort:` error before any socket is opened; a port already in use fails with `could not bind :` | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#an invalid host fails before any socket is opened`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#an invalid port fails before any socket is opened`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a port already in use fails with an error naming the host and port` | integration | http:real | ## User impact @@ -68,7 +85,12 @@ add `bindHost = Nothing` and `bindPort = Nothing`. The testbed uses `WebTransport.server` with no overrides, so its behaviour is unchanged. New ways to use it: `Application.withHost "127.0.0.1"` and `Application.withPort 9090`; `host` also accepts `"*"`, `"*4"`, `"*6"` or a -literal address. +literal address. Loopback-only is the right choice when the reverse proxy runs +in the same network namespace as the app (same host or container, or a shared +pod network); a proxy in a separate namespace cannot reach the listener through +its own loopback and needs a non-loopback bind. A mistyped host or port now fails +at startup with a message naming the builder, instead of binding something +unintended or dying with a raw `IOException`. ## ADR diff --git a/docs/changes/test-surfaces.json b/docs/changes/test-surfaces.json index 6857091be..43eabfdb1 100644 --- a/docs/changes/test-surfaces.json +++ b/docs/changes/test-surfaces.json @@ -217,6 +217,42 @@ "boundary": "http:real", "expected_examples": 1, "fixture": "Network.Wai.Handler.Warp (loopback, free port)" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "a wildcard bind occupies the port on every address (negative control for the loopback probe)", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Network.Wai.Handler.Warp (loopback, free port)" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "an invalid host fails before any socket is opened", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Network.Wai.Handler.Warp (loopback, free port)" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "an invalid port fails before any socket is opened", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Network.Wai.Handler.Warp (loopback, free port)" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "a port already in use fails with an error naming the host and port", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Network.Wai.Handler.Warp (loopback, free port)" } ] } diff --git a/docs/decisions/0079-configurable-web-bind-host-and-port.md b/docs/decisions/0079-configurable-web-bind-host-and-port.md index 4f1bfb4dc..02a55962b 100644 --- a/docs/decisions/0079-configurable-web-bind-host-and-port.md +++ b/docs/decisions/0079-configurable-web-bind-host-and-port.md @@ -31,6 +31,16 @@ like `withCors` and `withHealthCheck`, because `withTransport` stores the transport as an opaque value, so a builder cannot edit it. The override applies whatever the order of `withTransport` and the builder. +The host and port stay plain `Text` and `Int` (no wrapper types), but the +contract is checked before Warp starts: `validateBindHost` accepts the Warp +wildcards and a bare literal address or hostname and rejects an empty host, a +URL or path, a `host:port` pair and whitespace; `validateBindPort` accepts +`1..65535` and rejects `0` (the OS would pick a port nothing reports back). +The error names the builder (`Application.withHost: …`). A bind the OS refuses +is caught as an `IOException` and re-thrown as +`WebTransport could not bind :: …`, so it travels the same +`Task.finally` cleanup path as every other startup failure. + ## Consequences - Constructing `WebTransport` or `Application` with every field named must add @@ -41,3 +51,14 @@ whatever the order of `withTransport` and the builder. - The default is unchanged: all IPv4 interfaces (`"*4"`), exactly what `Warp.run` bound before. IPv6 (`"*"` or `"*6"`) and loopback-only are opt-in through `withHost`. +- Loopback-only is advised only when the reverse proxy shares the app's + network namespace (same host or container, shared pod network). A proxy in + a separate namespace cannot reach a loopback listener; it needs a + non-loopback bind plus firewalling. +- A mistyped host or port fails at startup with a message naming the builder; + a port in use or an address this machine does not own fails with + `could not bind :` instead of an uncaught `IOException`. +- The loopback test proves exclusion, not only reachability: it serves a + per-test unique health path (instance identity) and checks that the port is + still bindable on a non-loopback address, with a wildcard-bind negative + control that shows the probe fails when the listener is not loopback-only. From 4d0a18c0318bb4407d868e73d098e69d5b65494c Mon Sep 17 00:00:00 2001 From: stepandra Date: Fri, 9 Oct 2026 03:12:47 +0900 Subject: [PATCH 5/8] fix(http-transport): reject surrounding host whitespace Amp-Thread-ID: https://ampcode.com/threads/T-01a11c53-f9bd-70df-81b8-4369dbfd3e1b --- core/service/Service/Transport/Web.hs | 7 +++--- core/test/Service/Transport/Web/BindSpec.hs | 20 +++++++++++++++++ docs/changes/019-server-bind-host-port.md | 11 ++++++++-- docs/changes/test-surfaces.json | 24 +++------------------ 4 files changed, 36 insertions(+), 26 deletions(-) diff --git a/core/service/Service/Transport/Web.hs b/core/service/Service/Transport/Web.hs index e34a7e89f..5092846db 100644 --- a/core/service/Service/Transport/Web.hs +++ b/core/service/Service/Transport/Web.hs @@ -260,7 +260,8 @@ applyBindOverrides maybeHost maybePort transport = -- such as @"127.0.0.1"@, @"::1"@ or @"localhost"@. -- -- The checks target the mistakes a hand-written or LLM-written config makes: --- an empty or blank host, a URL (@"http://127.0.0.1"@), a path, or a +-- an empty or blank host, whitespace anywhere (including a leading or +-- trailing space, tab or newline), a URL (@"http://127.0.0.1"@), a path, or a -- @host:port@ pair pasted into the host field. A single colon can only be a -- port suffix because a literal IPv6 address always contains at least two. -- Anything that passes is handed to Warp as a 'Warp.HostPreference'; an @@ -271,11 +272,11 @@ applyBindOverrides maybeHost maybePort transport = validateBindHost :: Text -> Maybe Text validateBindHost hostText = do let colonCount = hostText |> Text.indexes ":" |> Array.length - let wordCount = hostText |> Text.words |> Array.length + let containsWhitespace = Text.words hostText != Array.wrap hostText if Text.isEmpty (Text.trim hostText) then Just "bind host must not be empty; use \"*4\" for all IPv4 interfaces or \"127.0.0.1\" for loopback only" else - if wordCount != 1 + if containsWhitespace then Just [fmt|bind host "#{hostText}" must not contain whitespace|] else if Text.contains "/" hostText diff --git a/core/test/Service/Transport/Web/BindSpec.hs b/core/test/Service/Transport/Web/BindSpec.hs index f23b1a3b7..1f1b8c895 100644 --- a/core/test/Service/Transport/Web/BindSpec.hs +++ b/core/test/Service/Transport/Web/BindSpec.hs @@ -112,6 +112,18 @@ spec = do it "rejects a host with whitespace inside" \_ -> do validateBindHost "127.0.0.1 8080" |> shouldSatisfy (\reason -> reason != Nothing) + it "rejects a host with leading or trailing spaces" \_ -> do + validateBindHost "127.0.0.1" |> shouldBe Nothing + let padded = [" 127.0.0.1", "127.0.0.1 ", " 127.0.0.1 "] + let accepted = padded |> Array.takeIf (\candidate -> isWhitespaceRejection candidate |> not) + accepted |> shouldBe [] + + it "rejects a host surrounded by tabs or newlines" \_ -> do + validateBindHost "localhost" |> shouldBe Nothing + let padded = ["\tlocalhost", "localhost\n", "\r\nlocalhost\t"] + let accepted = padded |> Array.takeIf (\candidate -> isWhitespaceRejection candidate |> not) + accepted |> shouldBe [] + describe "validateBindPort" do it "accepts the full 1..65535 range" \_ -> do validateBindPort 1 |> shouldBe Nothing @@ -213,6 +225,14 @@ spec = do attempt |> Task.finally (GhcSocket.close occupied |> Task.fromIO) +-- | Does 'validateBindHost' reject this host because of whitespace? +isWhitespaceRejection :: Text -> Bool +isWhitespaceRejection candidate = + validateBindHost candidate + |> Maybe.withDefault "" + |> Text.contains "whitespace" + + -- | A transport with a custom host and port, for the single-setting cases. customTransport :: WebTransport customTransport = server {host = "::1", port = 7070} diff --git a/docs/changes/019-server-bind-host-port.md b/docs/changes/019-server-bind-host-port.md index 4f44f9e31..5bc4665fc 100644 --- a/docs/changes/019-server-bind-host-port.md +++ b/docs/changes/019-server-bind-host-port.md @@ -68,8 +68,15 @@ that `runWebTransport` runs before starting Warp. | C4 | The Warp settings the transport runs with carry the configured host and port | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#carries the configured host and port into Warp` | unit | none | | C5 | An application started with `withHost "127.0.0.1"` and `withPort ` answers `GET /` on loopback (instance identity) and leaves the port free on a non-loopback address (loopback exclusion); the same probe finds the port taken when the default wildcard bind is used (negative control) | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#serves /health on loopback when bound to 127.0.0.1`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a wildcard bind occupies the port on every address (negative control for the loopback probe)` | integration | http:real | | C6 | Overrides apply whatever the order of `withTransport` and the builders; an absent override preserves the transport's own host/port; a host-only override keeps a custom port and a port-only override keeps a custom host | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#withHost and withPort apply whether they come before or after withTransport`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#absent overrides preserve the transport's custom host and port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a host-only override keeps the transport's custom port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a port-only override keeps the transport's custom host` | unit | none | -| C7 | `validateBindHost` accepts the Warp wildcards and bare literal addresses or hostnames, and rejects an empty host, a URL, a `host:port` pair and whitespace; `validateBindPort` accepts `1..65535` and rejects `0` and out-of-range ports | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#accepts the Warp wildcards and bare literal addresses or hostnames`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects an empty or blank host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a URL pasted into the host field`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host that carries a port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host with whitespace inside`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#accepts the full 1..65535 range`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects port 0 and ports outside the range` | unit | none | -| C8 | An invalid host or port makes `Application.runWith` fail with an `Application.withHost:` / `Application.withPort:` error before any socket is opened; a port already in use fails with `could not bind :` | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#an invalid host fails before any socket is opened`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#an invalid port fails before any socket is opened`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a port already in use fails with an error naming the host and port` | integration | http:real | +| C7 | `validateBindHost` accepts the Warp wildcards and bare literal addresses or hostnames, and rejects an empty host, a URL, a `host:port` pair and whitespace anywhere, including surrounding spaces, tabs and newlines; `validateBindPort` accepts `1..65535` and rejects `0` and out-of-range ports | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#accepts the Warp wildcards and bare literal addresses or hostnames`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects an empty or blank host`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a URL pasted into the host field`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host that carries a port`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host with whitespace inside`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host with leading or trailing spaces`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects a host surrounded by tabs or newlines`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#accepts the full 1..65535 range`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects port 0 and ports outside the range` | unit | none | +| C8 | An invalid host or port makes `Application.runWith` fail with an `Application.withHost:` / `Application.withPort:` error before any socket is opened | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#an invalid host fails before any socket is opened`
`hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#an invalid port fails before any socket is opened` | unit | none | +| C9 | A port already in use fails with `could not bind :` | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a port already in use fails with an error naming the host and port` | integration | http:real | + +C8 uses an in-memory application and rejects the setting before Warp starts, +so it has no real HTTP boundary. C5 exercises real HTTP listeners; C9 exercises +Warp's socket-bind failure against an occupied port. Their exact selectors +are attested with the `WebTransport bind host and port` fixture group printed +by BindSpec. ## User impact diff --git a/docs/changes/test-surfaces.json b/docs/changes/test-surfaces.json index 43eabfdb1..3a3d8c132 100644 --- a/docs/changes/test-surfaces.json +++ b/docs/changes/test-surfaces.json @@ -216,7 +216,7 @@ "match": "serves /health on loopback when bound to 127.0.0.1", "boundary": "http:real", "expected_examples": 1, - "fixture": "Network.Wai.Handler.Warp (loopback, free port)" + "fixture": "WebTransport bind host and port" }, { "kind": "hspec", @@ -225,25 +225,7 @@ "match": "a wildcard bind occupies the port on every address (negative control for the loopback probe)", "boundary": "http:real", "expected_examples": 1, - "fixture": "Network.Wai.Handler.Warp (loopback, free port)" - }, - { - "kind": "hspec", - "suite": "nhcore-test-service", - "path": "core/test/Service/Transport/Web/BindSpec.hs", - "match": "an invalid host fails before any socket is opened", - "boundary": "http:real", - "expected_examples": 1, - "fixture": "Network.Wai.Handler.Warp (loopback, free port)" - }, - { - "kind": "hspec", - "suite": "nhcore-test-service", - "path": "core/test/Service/Transport/Web/BindSpec.hs", - "match": "an invalid port fails before any socket is opened", - "boundary": "http:real", - "expected_examples": 1, - "fixture": "Network.Wai.Handler.Warp (loopback, free port)" + "fixture": "WebTransport bind host and port" }, { "kind": "hspec", @@ -252,7 +234,7 @@ "match": "a port already in use fails with an error naming the host and port", "boundary": "http:real", "expected_examples": 1, - "fixture": "Network.Wai.Handler.Warp (loopback, free port)" + "fixture": "WebTransport bind host and port" } ] } From 1ddab0b5ebc443d1eb6e0f38111449ef715f6aec Mon Sep 17 00:00:00 2001 From: stepandra Date: Wed, 14 Oct 2026 01:53:32 +0900 Subject: [PATCH 6/8] test(web-bind): reproduce bracket misuse and late validation --- core/test/Service/Transport/Web/BindSpec.hs | 46 +++++++++++++++++ .../027-bind-validation-runtime-proof.md | 49 +++++++++++++++++++ docs/changes/test-surfaces.json | 9 ++++ 3 files changed, 104 insertions(+) create mode 100644 docs/changes/027-bind-validation-runtime-proof.md diff --git a/core/test/Service/Transport/Web/BindSpec.hs b/core/test/Service/Transport/Web/BindSpec.hs index 1f1b8c895..8c92fdb4b 100644 --- a/core/test/Service/Transport/Web/BindSpec.hs +++ b/core/test/Service/Transport/Web/BindSpec.hs @@ -6,6 +6,9 @@ import Core import Http.Client qualified as Http import Http.Client.Internal qualified as HttpInternal import IO qualified +import Data.IORef qualified as GhcIORef +import Network.Wai qualified as GhcWai +import Network.HTTP.Types qualified as GhcHttp import Maybe qualified import Network.Socket qualified as GhcSocket import Network.Wai.Handler.Warp qualified as GhcWarp @@ -109,6 +112,18 @@ spec = do let reason = validateBindHost "127.0.0.1:8080" |> Maybe.withDefault "" reason |> shouldSatisfy (Text.contains "withPort") + it "rejects bracketed IPv6 host-port before startup" \_ -> do + validateBindHost "::1" |> shouldBe Nothing + case validateBindHost "[::1]:8080" of + Nothing -> fail "REGRESSION_ASSERT:bracketed-host-port-accepted" + Just reason -> reason |> shouldSatisfy (Text.contains "withPort") + + it "rejects brackets around a bind host and preserves bare IPv6" \_ -> do + validateBindHost "fe80::1" |> shouldBe Nothing + let bracketed = ["[::1]", "[::1", "::1]", "[::1]trailing"] + let accepted = bracketed |> Array.takeIf (\candidate -> validateBindHost candidate == Nothing) + accepted |> shouldBe [] + it "rejects a host with whitespace inside" \_ -> do validateBindHost "127.0.0.1 8080" |> shouldSatisfy (\reason -> reason != Nothing) @@ -187,6 +202,37 @@ spec = do canBind |> shouldBe False probe |> Task.finally cancelApp + it "rejects invalid static bind before owned auth discovery" \_ -> do + requests <- GhcIORef.newIORef (0 :: Int) |> Task.fromIO + let discovery _ respond = do + GhcIORef.modifyIORef' requests (+ 1) + respond (GhcWai.responseLBS GhcHttp.status200 [] "not-json") + (result, count) <- Task.fromIO do + GhcWarp.testWithApplication (pure discovery) \authPort -> do + outcome <- IO.try (Task.runResult do + -- The owned fixture is live before the invalid application starts. + status <- getHealthStatus "fixture-control" authPort 0 + status |> shouldBe 200 + GhcIORef.writeIORef requests 0 |> Task.fromIO + eventStore <- InMemory.new |> Task.mapError toText + let app = + Application.new + |> Application.withTransport server + |> Application.withHost "http://127.0.0.1" + |> Application.withAuth @() (\_ -> [fmt|http://127.0.0.1:#{authPort}|]) + Application.runWith eventStore app |> Task.asResult) + count <- GhcIORef.readIORef requests + pure (outcome, count) + case count of + 0 -> pass + _ -> fail "REGRESSION_ASSERT:invalid-bind-contacted-auth" + case result of + Err err -> fail [fmt|unexpected startup exception: #{toText err}|] + Ok (Err err) -> fail [fmt|owned auth fixture failed: #{err}|] + Ok (Ok appResult) -> case appResult of + Ok _ -> fail "runWith accepted an invalid host" + Err err -> err |> shouldBe "Application.withHost: bind host \"http://127.0.0.1\" looks like a URL or path; use a bare address such as \"127.0.0.1\", not \"http://127.0.0.1\"" + it "an invalid host fails before any socket is opened" \_ -> do eventStore <- InMemory.new |> Task.mapError toText let app = diff --git a/docs/changes/027-bind-validation-runtime-proof.md b/docs/changes/027-bind-validation-runtime-proof.md new file mode 100644 index 000000000..21dc6ff9c --- /dev/null +++ b/docs/changes/027-bind-validation-runtime-proof.md @@ -0,0 +1,49 @@ +# Change 027: Enforce the existing bind validation and runtime proof contract + +Continuation of change019 and [NickSeagull’s maintainer-reviewed authorized follow-up](https://github.com/neohaskell/NeoHaskell/pull/909#issuecomment-6040979623), source identity `NickSeagull`, comment `6040979623`. It requests earliest-practical checks, owned cleanup, instance identity/isolation and single-setting preservation; it does not approve a new config API or a new machine receipt. Keep the existing static builders, `*4` default, custom transport settings and port range1..65535. Fix early validation and representative bracket misuse; prove owned-instance identity and real assembly behavior without a configuration API redesign. Preliminary regression draft, not final approval/readiness. + +```yaml spec +issue: adhoc:bind-validation-runtime-proof +kind: bug +touches: [http-transport, service-wiring] +breaking: false +new-dependency: false +new-capability: false +new-extension-point: false +``` + +## Contract delta + +No public signatures or new production constants. Present static overrides for a registered WebTransport are checked in run/runWith before avoidable owned startup effects. Effective transport settings remain validated before listener startup. Existing no-WebTransport behavior is not expanded in this slice. Bare IPv6 remains supported; bracketed host:port, unmatched brackets and bracket-wrapped host input produce actionable diagnostics. Port0 rejection remains, with truthful existing-breaking disclosure in change019 rather than new ephemeral-port behavior. + +```diff signatures +``` + +## Criteria + +| ID | Behavior | Proving test | Level | Boundary | +|----|----------|--------------|-------|----------| +| C1 | Bracketed host:port is rejected by the existing validator, with withPort guidance; bare IPv6 still accepted | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects bracketed IPv6 host-port before startup` | unit | none | +| C2 | Bracket-wrapped/malformed IPv6 is rejected, bare IPv6 retained | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects brackets around a bind host and preserves bare IPv6` | unit | none | +| C3 | Invalid present static bind override with a registered WebTransport fails before auth discovery; a positive control proves the owned auth HTTP fixture is reachable | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects invalid static bind before owned auth discovery` | integration | http:real | + +### Remaining executable criteria before implementation + +- Invalid present override with a real registered WebTransport and owned local auth fixture yields the intended validation error and zero discovery requests; fixture positive control proves it is listening. Cover run/runWith at their real effect boundary. +- Both builder orders, absent overrides, host-only/custom-port and port-only/custom-host consume the registered transport via real Application.runWith. Reset-to-default call-site mutant fails; original implementation currently preserves these settings. +- Intended application lifecycle is tied to readiness. A competing catch-all200 with failed intended bind cannot satisfy the success oracle. Preserve loopback exclusion and wildcard negative control. +- A bind-failure fixture with an observable owned worker proves its shutdown, not just the returned error. Wider inherited lifecycle defects require separate exact scope if discovered. + +These are mandatory unfinished tests, not passing locators. Native committed-red C1 and current verified receipt precede new product edits; final exact criteria and authentic continuation approval/review records remain required. Existing explicit maintainer requests are scoped authority, not fabricated receipt or final Gate2. + +## User impact + +Existing static builder signatures and custom transport settings are preserved. Invalid bracket input fails earlier and clearly. Invalid known bind settings no longer lose their intended error behind avoidable startup work. `*4`/`*6` are family preferences with platform-specific fallback; this change does not promise strict family isolation. Document existing port0 rejection accurately. No new config-factory API, no expanded transportless validation, no broad lifecycle rewrite or Local/FileUpload changes. + +## ADR + +Existing ADR0079 owns bind choices. ADR0035 config-factory parity/explicit deferral remains a separate unresolved decision; this repair does not claim to settle it or infer approval. No new mechanical ADR trigger for fulfilling the existing validation contract. + +## Localized scope and verification + +Files: Service/Application.hs entry run/runWith, Service/Application/Transports.hs effective validation, Service/Transport/Web.hs validateBindHost, core/test/Service/Transport/Web/BindSpec.hs and test-surfaces, change019/ADR0079/fragment wording, generated codemap. Tests copy-adapt current BindSpec and its held-loopback/socket fixture. Preserve all existing expectations; add tests first. Security design review is local-only after authentic Gate1 continuation and before product edits. Runtime tests use owned loopback listeners/synthetic payloads only. Full required suites/testbed and exact-head CI remain separate gates; no unrelated PostgreSQL access. diff --git a/docs/changes/test-surfaces.json b/docs/changes/test-surfaces.json index 3a3d8c132..14d815a45 100644 --- a/docs/changes/test-surfaces.json +++ b/docs/changes/test-surfaces.json @@ -33,6 +33,15 @@ } }, "boundaries": [ + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "rejects invalid static bind before owned auth discovery", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Owned Warp loopback discovery server with request counter, positive HTTP200 control before reset; Application.runWith actual WebTransport and invalid static host" + }, { "kind": "script", "path": "testbed/scripts/cold-start-readiness.sh", From 15c0a7aa112f39460e85e9b55b2112f386f72bb8 Mon Sep 17 00:00:00 2001 From: stepandra Date: Wed, 14 Oct 2026 02:02:25 +0900 Subject: [PATCH 7/8] chore(telemetry): record parked bind intake correction --- telemetry/runs.jsonl | 1 + 1 file changed, 1 insertion(+) diff --git a/telemetry/runs.jsonl b/telemetry/runs.jsonl index 8fb65e243..e5084b127 100644 --- a/telemetry/runs.jsonl +++ b/telemetry/runs.jsonl @@ -22,3 +22,4 @@ {"schema":6,"run_id":"2026-09-18-858-r1","request_ref":"issue#858","stages":{"intake":{"start":"2026-09-18T11:18:00.127476Z","stop":"2026-09-18T11:18:00.398779Z","model":null,"repair_rounds":0,"invented_api_events":0},"localize":{"start":"2026-09-18T11:18:01.172285Z","stop":"2026-09-18T11:18:20.684681Z","model":null,"repair_rounds":0,"invented_api_events":0},"spec":{"start":"2026-09-18T11:18:24.702141Z","stop":"2026-09-18T11:26:48.762906Z","model":null,"repair_rounds":0,"invented_api_events":0}},"activities":{"localization":[{"start":"2026-09-18T11:18:14.537828Z","stop":"2026-09-18T11:18:18.546710Z"}]},"waiting_on_human_s":0,"modules_rebuilt_after_restore":null,"assets_consulted":[],"outcome":"parked","failure_label":"wrong-localization","asset_delta":{"type":"none","destination":"command-level-concurrency-criteria","ref":null},"improvements":[],"failure_note":"The localized proving-test plan did not cover the executor-level acceptExisting, acceptNew, and acceptAny semantics required by the issue."} {"schema":6,"run_id":"2026-09-18-858-r2","request_ref":"issue#858","stages":{"intake":{"start":"2026-09-18T11:27:36.823249Z","stop":"2026-09-18T11:27:37.685232Z","model":null,"repair_rounds":0,"invented_api_events":0},"localize":{"start":"2026-09-18T11:27:39.975025Z","stop":"2026-09-18T11:27:46.978274Z","model":null,"repair_rounds":0,"invented_api_events":0},"spec":{"start":"2026-09-18T11:27:50.492267Z","stop":"2026-09-18T13:47:16.829101Z","model":null,"repair_rounds":0,"invented_api_events":0},"design-review":{"start":"2026-09-18T13:47:22.556765Z","stop":"2026-09-18T13:48:35.492240Z","model":null,"repair_rounds":0,"invented_api_events":0},"plan":{"start":"2026-09-18T13:48:36.738817Z","stop":"2026-09-18T13:50:14.439959Z","model":null,"repair_rounds":0,"invented_api_events":0},"test-writing":{"start":"2026-09-18T13:50:16.359262Z","stop":"2026-09-18T13:52:51.594195Z","model":null,"repair_rounds":0,"invented_api_events":0},"implement":{"start":"2026-09-18T13:52:55.458560Z","stop":"2026-09-18T14:03:43.761037Z","model":null,"repair_rounds":0,"invented_api_events":0},"verify":{"start":"2026-09-18T14:03:46.043421Z","stop":"2026-09-18T15:09:55.519012Z","model":null,"repair_rounds":0,"invented_api_events":0},"pr":{"start":"2026-09-22T11:54:16.032137Z","stop":"2026-09-22T12:17:52.491607Z","model":null,"repair_rounds":0,"invented_api_events":0}},"activities":{"localization":[{"start":"2026-09-18T11:27:41.113147Z","stop":"2026-09-18T11:27:45.847084Z"}],"test-execution":[{"start":"2026-09-18T11:46:20.030935Z","stop":"2026-09-18T11:47:58.163919Z"},{"start":"2026-09-18T11:48:51.586064Z","stop":"2026-09-18T11:51:15.694727Z"},{"start":"2026-09-18T11:51:49.325800Z","stop":"2026-09-18T11:53:33.412633Z"},{"start":"2026-09-18T11:53:56.497800Z","stop":"2026-09-18T11:55:30.044056Z"},{"start":"2026-09-18T11:55:50.981244Z","stop":"2026-09-18T11:57:20.586516Z"},{"start":"2026-09-18T12:13:56.719890Z","stop":"2026-09-18T12:14:52.022229Z"},{"start":"2026-09-18T13:54:33.500733Z","stop":"2026-09-18T13:56:32.327631Z"},{"start":"2026-09-18T13:56:47.695957Z","stop":"2026-09-18T13:57:39.936438Z"},{"start":"2026-09-18T13:57:56.070094Z","stop":"2026-09-18T13:58:44.117274Z"},{"start":"2026-09-18T13:58:56.455926Z","stop":"2026-09-18T13:59:41.169452Z"},{"start":"2026-09-18T14:00:53.115056Z","stop":"2026-09-18T14:02:59.338204Z"},{"start":"2026-09-18T14:04:24.769290Z","stop":"2026-09-18T14:05:15.281472Z"},{"start":"2026-09-18T14:05:42.086716Z","stop":"2026-09-18T14:08:02.289994Z"},{"start":"2026-09-18T14:17:59.573753Z","stop":"2026-09-18T15:07:35.683675Z"},{"start":"2026-09-18T15:08:02.753594Z","stop":"2026-09-18T15:08:04.978027Z"}],"compilation":[{"start":"2026-09-18T13:54:19.643115Z","stop":"2026-09-18T13:54:20.229655Z"}]},"waiting_on_human_s":0,"modules_rebuilt_after_restore":null,"assets_consulted":[],"outcome":"parked","failure_label":"other","asset_delta":{"type":"none","destination":"owning-base-moved-before-pr-ready","ref":null},"improvements":[],"failure_note":"The owning main base advanced before PR-ready validation; the immutable run base required a restart."} {"schema":6,"run_id":"2026-09-22-858-r3","request_ref":"issue#858","stages":{"intake":{"start":"2026-09-22T12:20:48.800790Z","stop":"2026-09-22T12:20:48.843700Z","model":null,"repair_rounds":0,"invented_api_events":0},"localize":{"start":"2026-09-22T12:20:48.933636Z","stop":"2026-09-22T12:20:49.285002Z","model":null,"repair_rounds":0,"invented_api_events":0},"spec":{"start":"2026-09-22T12:20:49.373741Z","stop":"2026-09-22T12:22:37.885730Z","model":null,"repair_rounds":0,"invented_api_events":0},"design-review":{"start":"2026-09-22T12:22:39.647951Z","stop":"2026-09-22T12:23:18.044654Z","model":null,"repair_rounds":0,"invented_api_events":0},"plan":{"start":"2026-09-22T12:23:18.138350Z","stop":"2026-09-22T12:23:18.180848Z","model":null,"repair_rounds":0,"invented_api_events":0},"test-writing":{"start":"2026-09-22T12:23:18.270302Z","stop":"2026-09-22T12:23:18.312367Z","model":null,"repair_rounds":0,"invented_api_events":0},"implement":{"start":"2026-09-22T12:23:18.402485Z","stop":"2026-09-22T12:23:45.894534Z","model":null,"repair_rounds":0,"invented_api_events":0},"verify":{"start":"2026-09-22T12:23:45.987361Z","stop":"2026-09-22T12:55:02.542480Z","model":null,"repair_rounds":0,"invented_api_events":0},"pr":{"start":"2026-09-22T12:55:02.648957Z","stop":"2026-09-22T12:55:41.342302Z","model":null,"repair_rounds":0,"invented_api_events":0},"ci":{"start":"2026-09-22T12:55:42.975955Z","stop":"2026-09-22T14:46:37.003188Z","model":null,"repair_rounds":0,"invented_api_events":0}},"activities":{"localization":[{"start":"2026-09-22T12:20:48.974983Z","stop":"2026-09-22T12:20:49.241719Z"}],"test-execution":[{"start":"2026-09-22T12:21:07.112497Z","stop":"2026-09-22T12:22:29.568087Z"},{"start":"2026-09-22T12:24:02.550046Z","stop":"2026-09-22T12:24:53.468995Z"},{"start":"2026-09-22T12:25:08.594113Z","stop":"2026-09-22T12:25:08.653526Z"},{"start":"2026-09-22T12:25:22.967166Z","stop":"2026-09-22T12:26:12.958842Z"},{"start":"2026-09-22T12:27:54.273173Z","stop":"2026-09-22T12:27:54.351264Z"},{"start":"2026-09-22T12:28:15.985998Z","stop":"2026-09-22T12:34:30.932426Z"},{"start":"2026-09-22T12:43:44.206038Z","stop":"2026-09-22T12:43:58.194624Z"},{"start":"2026-09-22T12:44:21.341640Z","stop":"2026-09-22T12:46:34.900802Z"}],"compilation":[{"start":"2026-09-22T12:23:26.609797Z","stop":"2026-09-22T12:23:26.705226Z"}]},"waiting_on_human_s":0,"modules_rebuilt_after_restore":null,"assets_consulted":["capability:commands","capability:event-store"],"outcome":"ok","failure_label":null,"asset_delta":null,"improvements":[]} +{"schema":6,"run_id":"2026-10-13-027","request_ref":"adhoc:bind-validation-runtime-proof","stages":{"intake":{"start":"2026-10-13T17:02:02.385194Z","stop":"2026-10-13T17:02:12.008235Z","model":null,"repair_rounds":0,"invented_api_events":0},"localize":{"start":"2026-10-13T17:00:43.431922Z","stop":"2026-10-13T17:00:58.231782Z","model":null,"repair_rounds":0,"invented_api_events":0},"spec":{"start":"2026-10-13T17:00:59.154684Z","stop":"2026-10-13T17:01:40.688613Z","model":null,"repair_rounds":0,"invented_api_events":0}},"activities":{},"waiting_on_human_s":0,"modules_rebuilt_after_restore":null,"assets_consulted":[],"outcome":"parked","failure_label":"wrong-localization","asset_delta":{"type":"none","destination":"orchestration CLI misuse, corrected JSON list input and fail-closed sequencing; no repository asset change needed","ref":null},"improvements":[]} From 107d5dbd965104c6e516d3e54605ff30cf5b5ee7 Mon Sep 17 00:00:00 2001 From: stepandra Date: Wed, 14 Oct 2026 02:11:18 +0900 Subject: [PATCH 8/8] test(web-bind): prove owned listeners and registered overrides --- core/test/Service/Transport/Web/BindSpec.hs | 241 +++++++++++++++++- .../027-bind-validation-runtime-proof.md | 8 + docs/changes/test-surfaces.json | 72 ++++++ 3 files changed, 317 insertions(+), 4 deletions(-) diff --git a/core/test/Service/Transport/Web/BindSpec.hs b/core/test/Service/Transport/Web/BindSpec.hs index ea8b6645a..88ed65fa6 100644 --- a/core/test/Service/Transport/Web/BindSpec.hs +++ b/core/test/Service/Transport/Web/BindSpec.hs @@ -1,6 +1,10 @@ module Service.Transport.Web.BindSpec where import Array qualified +import Bytes qualified +import Json qualified +import Data.Either qualified as GhcEither +import Service.EventStore (EventStore (..)) import AsyncTask qualified import Core import Http.Client qualified as Http @@ -159,10 +163,118 @@ spec = do show (GhcWarp.getHost settings) |> shouldBe "Host \"127.0.0.1\"" GhcWarp.getPort settings |> shouldBe 9191 + describe "Application.runWith registered bind settings" do + it "applies host and port set before withTransport at runtime" \_ -> do + withHeldLoopbackPort (GhcSocket.tupleToHostAddress (127, 0, 0, 1)) \occupiedPort -> do + freePort <- getDifferentFreePort occupiedPort + let custom = server {host = "*4", port = occupiedPort} + let app = Application.new + |> Application.withHost "127.0.0.1" + |> Application.withPort freePort + |> Application.withTransport custom + withOwnedBindAt freePort app + + it "applies host and port set after withTransport at runtime" \_ -> do + withHeldLoopbackPort (GhcSocket.tupleToHostAddress (127, 0, 0, 1)) \occupiedPort -> do + freePort <- getDifferentFreePort occupiedPort + let custom = server {host = "*4", port = occupiedPort} + let app = Application.new + |> Application.withTransport custom + |> Application.withHost "127.0.0.1" + |> Application.withPort freePort + withOwnedBindAt freePort app + + it "preserves a custom registered host and port with absent overrides at runtime" \_ -> do + freePort <- getOwnedFreePort + let custom = server {host = "127.0.0.1", port = freePort} + let app = Application.new |> Application.withTransport custom + withOwnedBindAt freePort app + + it "preserves a custom registered port with a host-only override at runtime" \_ -> do + freePort <- getOwnedFreePort + let custom = server {host = "*4", port = freePort} + let app = Application.new + |> Application.withTransport custom + |> Application.withHost "127.0.0.1" + withOwnedBindAt freePort app + + it "preserves a custom registered host with a port-only override at runtime" \_ -> do + withHeldLoopbackPort (GhcSocket.tupleToHostAddress (127, 0, 0, 1)) \occupiedPort -> do + freePort <- getDifferentFreePort occupiedPort + let custom = server {host = "127.0.0.1", port = occupiedPort} + let app = Application.new + |> Application.withTransport custom + |> Application.withPort freePort + withOwnedBindAt freePort app + + describe "owned runtime probe controls" do + it "accepts the intended Application and excludes another owned interface" \_ -> do + _ <- ownedNonLoopbackAddress + freePort <- getOwnedFreePort + let app = Application.new + |> Application.withTransport server + |> Application.withHost "127.0.0.1" + |> Application.withPort freePort + withOwnedBindAt freePort app + + it "a wildcard listener defeats the owned-interface bind probe" \_ -> do + otherAddress <- ownedNonLoopbackAddress + eventStore <- InMemory.new |> Task.mapError toText + freePort <- getOwnedFreePort + (app, hits, body) <- newIdentityApplication + (Application.new + |> Application.withTransport server + |> Application.withPort freePort) + let probe = do + owned <- probeOwnedInstance hits body freePort 50 + owned |> shouldBe True + available <- canBindAddress otherAddress freePort + available |> shouldBe False + let run = AsyncTask.process (Application.runWith eventStore app) \running -> do + outcome <- AsyncTask.race (AsyncTask.waitCatch running) probe + case outcome of + AsyncTask.LeftWon result -> Task.throw [fmt|wildcard Application ended early: #{show result}|] + AsyncTask.RightWon _ -> pass + run |> Task.finally eventStore.close + + it "rejects an unrelated catch-all 200 after the intended Application bind fails" \_ -> do + eventStore <- InMemory.new |> Task.mapError toText + (identified, hits, body) <- newIdentityApplication Application.new + -- Even copying the expected body is insufficient to impersonate the + -- owned query handler. The control must actually receive a request. + competitorHits <- GhcIORef.newIORef (0 :: Int) |> Task.fromIO + let competitor _ respond = do + GhcIORef.atomicModifyIORef' competitorHits (\n -> (n + 1, ())) + respond (GhcWai.responseLBS GhcHttp.status200 [] + (body |> Text.toBytes |> Bytes.toLazyLegacy)) + let exercise = do + outcome <- Task.fromIO do + GhcWarp.testWithApplication (pure competitor) \port -> Task.runResult do + let app = identified + |> Application.withTransport server + |> Application.withHost "127.0.0.1" + |> Application.withPort port + -- First prove the intended Application cannot bind. Do not + -- assume task failure merely because a probe rejected it. + result <- Application.runWith eventStore app |> Task.asResult + case result of + Ok _ -> fail "intended Application unexpectedly took the competitor's port" + Err err -> err |> shouldSatisfy + (Text.contains [fmt|could not bind 127.0.0.1:#{port}|]) + owned <- probeOwnedInstance hits body port 0 + owned |> shouldBe False + count <- GhcIORef.readIORef hits |> Task.fromIO + count |> shouldBe 0 + received <- GhcIORef.readIORef competitorHits |> Task.fromIO + received |> shouldSatisfy (\n -> n > 0) + case outcome of + Err err -> Task.throw err + Ok _ -> pass + exercise |> Task.finally eventStore.close + describe "running" do it "serves /health on loopback when bound to 127.0.0.1" \_ -> do - -- Instance identity: the health path is unique to this test, so a - -- 200 can only come from the application started here. + -- A unique path alone is not identity; the owned handler must also run. eventStore <- InMemory.new |> Task.mapError toText freePort <- getFreePort healthPath <- uniqueHealthPath @@ -172,9 +284,12 @@ spec = do |> Application.withHost "127.0.0.1" |> Application.withPort freePort |> Application.withHealthCheck @() (\_ -> healthPath) - running <- AsyncTask.run (Application.runWith eventStore app) + (ownedApp, hits, body) <- newIdentityApplication app + running <- AsyncTask.run (Application.runWith eventStore ownedApp) let cancelApp = AsyncTask.cancel running |> Task.ignoreError let probe = do + owned <- probeOwnedInstance hits body freePort 50 + owned |> shouldBe True status <- getHealthStatus healthPath freePort 50 status |> shouldBe 200 -- Loopback isolation: the port is still free on a non-loopback @@ -193,9 +308,12 @@ spec = do |> Application.withTransport server |> Application.withPort freePort |> Application.withHealthCheck @() (\_ -> healthPath) - running <- AsyncTask.run (Application.runWith eventStore app) + (ownedApp, hits, body) <- newIdentityApplication app + running <- AsyncTask.run (Application.runWith eventStore ownedApp) let cancelApp = AsyncTask.cancel running |> Task.ignoreError let probe = do + owned <- probeOwnedInstance hits body freePort 50 + owned |> shouldBe True status <- getHealthStatus healthPath freePort 50 status |> shouldBe 200 nonLoopback <- nonLoopbackAddress @@ -285,6 +403,121 @@ spec = do attempt |> Task.finally (GhcSocket.close occupied |> Task.fromIO) +-- A successful response must have run this instance's handler. The body alone +-- is not sufficient: the catch-all negative control deliberately copies it. +newIdentityApplication :: Application -> Task Text (Application, GhcIORef.IORef Int, Text) +newIdentityApplication app = do + nonce <- uniqueHealthPath + hits <- GhcIORef.newIORef (0 :: Int) |> Task.fromIO + let body = Json.encodeText nonce + let handler _ _ _ = do + GhcIORef.atomicModifyIORef' hits (\n -> (n + 1, ())) |> Task.fromIO + Task.yield body + Task.yield (app |> Application.withQueryEndpoint "BindProbe" handler, hits, body) + + +probeOwnedInstance :: GhcIORef.IORef Int -> Text -> Int -> Int -> Task Text Bool +probeOwnedInstance hits expectedBody port attemptsLeft = do + result <- + Http.request + |> Http.withUrl [fmt|http://127.0.0.1:#{port}/queries/bind-probe|] + |> Http.withTimeout 2 + |> HttpInternal.getRaw + |> Task.asResult + case result of + Ok response -> do + count <- GhcIORef.readIORef hits |> Task.fromIO + Task.yield + ( response.statusCode == 200 + && Text.fromBytes response.body == expectedBody + && count > 0 + ) + Err _ -> + if attemptsLeft <= 0 then + Task.throw "owned Application listener never answered" + else do + AsyncTask.sleep 100 + probeOwnedInstance hits expectedBody port (attemptsLeft - 1) + + +-- Never treat nonLoopbackAddress's fallback as a distinct-interface proof. +ownedNonLoopbackAddress :: Task Text GhcSocket.HostAddress +ownedNonLoopbackAddress = do + address <- nonLoopbackAddress + let (firstOctet, _, _, _) = GhcSocket.hostAddressToTuple address + firstOctet |> shouldSatisfy (\octet -> octet != 127 && octet != 0) + preflight <- canBindAddress address 0 + preflight |> shouldBe True + Task.yield address + + +assertLiteralLoopbackBind :: Int -> Task Text Unit +assertLiteralLoopbackBind port = do + address <- ownedNonLoopbackAddress + available <- canBindAddress address port + available |> shouldBe True + + +withOwnedBindAt :: Int -> Application -> Task Text Unit +withOwnedBindAt port configured = do + eventStore <- InMemory.new |> Task.mapError toText + (app, hits, body) <- newIdentityApplication configured + let probe = do + owned <- probeOwnedInstance hits body port 50 + owned |> shouldBe True + assertLiteralLoopbackBind port + let run = + AsyncTask.process (Application.runWith eventStore app) \running -> do + outcome <- AsyncTask.race (AsyncTask.waitCatch running) probe + case outcome of + AsyncTask.LeftWon result -> + Task.throw [fmt|Application ended before the owned bind probe: #{show result}|] + AsyncTask.RightWon _ -> pass + run |> Task.finally eventStore.close + + +-- Use this rather than broad IO.try for NEW socket probes. Catch only IOException; +-- asynchronous cancellation must propagate through bracket, not become False. +canBindAddress :: GhcSocket.HostAddress -> Int -> Task Text Bool +canBindAddress address port = Task.fromIO do + GhcException.bracket + (GhcSocket.socket GhcSocket.AF_INET GhcSocket.Stream GhcSocket.defaultProtocol) + GhcSocket.close + \sock -> do + outcome <- GhcException.try @GhcException.IOException + (GhcSocket.bind sock (GhcSocket.SockAddrInet (fromIntegral port) address)) + case outcome of + GhcEither.Left _ -> pure False + GhcEither.Right _ -> pure True + + +-- The loopback port reservation is held throughout action. +withHeldLoopbackPort :: GhcSocket.HostAddress -> (Int -> Task Text value) -> Task Text value +withHeldLoopbackPort address action = do + result <- Task.fromIO do + GhcException.bracket + (GhcSocket.socket GhcSocket.AF_INET GhcSocket.Stream GhcSocket.defaultProtocol) + GhcSocket.close + \sock -> do + GhcSocket.bind sock (GhcSocket.SockAddrInet 0 address) + GhcSocket.listen sock 1 + port <- GhcSocket.socketPort sock + Task.runResult (action (fromIntegral port)) + case result of + Ok value -> Task.yield value + Err err -> Task.throw err + + +getOwnedFreePort :: Task Text Int +getOwnedFreePort = + withHeldLoopbackPort (GhcSocket.tupleToHostAddress (127, 0, 0, 1)) Task.yield + + +getDifferentFreePort :: Int -> Task Text Int +getDifferentFreePort excluded = do + port <- getOwnedFreePort + if port == excluded then getDifferentFreePort excluded else Task.yield port + -- | Does 'validateBindHost' reject this host because of whitespace? isWhitespaceRejection :: Text -> Bool isWhitespaceRejection candidate = diff --git a/docs/changes/027-bind-validation-runtime-proof.md b/docs/changes/027-bind-validation-runtime-proof.md index 2ae4b115f..39f5daa82 100644 --- a/docs/changes/027-bind-validation-runtime-proof.md +++ b/docs/changes/027-bind-validation-runtime-proof.md @@ -27,6 +27,14 @@ No public signatures or new production constants. Present static overrides for a | C2 | Malformed bracketed IPv6 is rejected, bare IPv6 retained | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects malformed brackets and preserves bare IPv6` | unit | none | | C3 | Invalid present static bind override with a registered WebTransport fails before auth discovery; a positive control proves the owned auth HTTP fixture is reachable | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects invalid static bind before owned auth discovery` | integration | http:real | | C4 | run rejects an invalid known static override before attempting event-store setup | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects invalid static bind before run acquires an event store` | unit | none | +| C5 | applies host and port set before withTransport at runtime | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#applies host and port set before withTransport at runtime` | integration | http:real | +| C6 | applies host and port set after withTransport at runtime | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#applies host and port set after withTransport at runtime` | integration | http:real | +| C7 | preserves a custom registered host and port with absent overrides at runtime | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#preserves a custom registered host and port with absent overrides at runtime` | integration | http:real | +| C8 | preserves a custom registered port with a host-only override at runtime | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#preserves a custom registered port with a host-only override at runtime` | integration | http:real | +| C9 | preserves a custom registered host with a port-only override at runtime | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#preserves a custom registered host with a port-only override at runtime` | integration | http:real | +| C10 | accepts the intended Application and excludes another owned interface | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#accepts the intended Application and excludes another owned interface` | integration | http:real | +| C11 | a wildcard listener defeats the owned-interface bind probe | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#a wildcard listener defeats the owned-interface bind probe` | integration | http:real | +| C12 | rejects an unrelated catch-all 200 after the intended Application bind fails | `hspec:nhcore-test-service:core/test/Service/Transport/Web/BindSpec.hs#rejects an unrelated catch-all 200 after the intended Application bind fails` | integration | http:real | ### Remaining executable criteria before implementation diff --git a/docs/changes/test-surfaces.json b/docs/changes/test-surfaces.json index 24ac406af..4efb1c4f9 100644 --- a/docs/changes/test-surfaces.json +++ b/docs/changes/test-surfaces.json @@ -38,6 +38,78 @@ } }, "boundaries": [ + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "rejects an unrelated catch-all 200 after the intended Application bind fails", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "a wildcard listener defeats the owned-interface bind probe", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "accepts the intended Application and excludes another owned interface", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "preserves a custom registered host with a port-only override at runtime", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "preserves a custom registered port with a host-only override at runtime", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "preserves a custom registered host and port with absent overrides at runtime", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "applies host and port set after withTransport at runtime", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, + { + "kind": "hspec", + "suite": "nhcore-test-service", + "path": "core/test/Service/Transport/Web/BindSpec.hs", + "match": "applies host and port set before withTransport at runtime", + "boundary": "http:real", + "expected_examples": 1, + "fixture": "Actual Application.runWith WebTransport, per-instance query-handler acknowledgment and nonce, owned local sockets and explicit interface preflight" + }, { "kind": "hspec", "suite": "nhcore-test-service",