core, tests, plan: harden the badge site listener

apps/simplex-badge-service/src/BadgeService/Catalog.hs

@@ -11,10 +11,13 @@ module BadgeService.Catalog
   ( defaultCatalog,
     offerTotal,
     catalogTotals,
+    logUnpricedOffers,
     seedCatalog,
   )
 where
 
+import Control.Logger.Simple (logWarn)
+import Control.Monad (forM_)
 import Data.List (find)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -120,6 +123,25 @@ defaultCatalog createdAt =
           total = Nothing
         }
 
+-- | An offer that is pinned to a price the catalog also returned, yet still has no total, is a
+-- malformed offer (@freeMonths >= months@, or a discount over 100): the client renders it as
+-- unavailable, and nothing else in the system would ever say why. 'chargeableMonths' stopped
+-- saying so with 'error' precisely so that a request thread survives it (\'9), so this is the
+-- only place it gets named.
+--
+-- It lives here, beside the function that produces the 'Nothing', rather than in one caller:
+-- BOTH readers of a database catalog must log it -- 'BadgeService.Service''s RPC handler and
+-- 'BadgeService.Web.Server''s @\/api\/catalog@ -- and the site is the path most buyers take, so
+-- a version that logged only over RPC would stay silent for exactly the users who hit it.
+logUnpricedOffers :: BadgeCatalog -> IO ()
+logUnpricedOffers BadgeCatalog {prices, offers} =
+  forM_ offers $ \BadgeOffer {offerId = BadgeOfferId oid, priceId, total} ->
+    case (priceId, total) of
+      (Just pid, Nothing)
+        | any (\BadgePrice {priceId = pid'} -> pid' == pid) prices ->
+            logWarn $ "catalog offer " <> oid <> " has a pinned price but no chargeable total"
+      _ -> pure ()
+
 -- | The only place a total is computed. 'CurrencyAmount' has no 'Num' instance, so every step
 -- unwraps to 'Word32', computes in 'Word64' and re-wraps through 'minorUnits', which refuses a
 -- product that no longer fits. 'Nothing' for the offer means exactly one month (there is no

apps/simplex-badge-service/src/BadgeService/Config.hs

@@ -46,7 +46,7 @@ import Simplex.Messaging.Agent.Store.Common (DBStore)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS (BBSSecretKey)
 import Simplex.Messaging.Encoding.String (strEncode)
-import Simplex.Messaging.Util (eitherToMaybe)
+import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
 import System.Directory (doesFileExist)
 import Text.Read (readMaybe)
 
@@ -211,6 +211,7 @@ parseWeb path ini
       baseUrl <- requiredValue path "web" "base_url" ini
       validateBaseUrl path baseUrl
       supportContact <- requiredValue path "web" "support_contact" ini
+      validateSupportContact path supportContact
       let host = optionalValue "127.0.0.1" "web" "host" ini
           dir = T.unpack <$> optionalMaybeValue "web" "web_dir" ini
       behindProxy <- optionalBool path "web" "behind_proxy" False ini
@@ -225,22 +226,49 @@ parseWeb path ini
               webDir = dir
             }
 
+-- | The hosts '[web] base_url' may be reached at over plaintext http: the local mock stack (plan
+-- \'10) runs everything on one of these. Compared case-insensitively, and with the brackets an
+-- IPv6 literal carries in a URL stripped, because @[::1]@, @[::1]:8080@ and @LOCALHOST@ are the
+-- same three hosts written differently and an operator should not have to guess the spelling.
+loopbackHosts :: [Text]
+loopbackHosts = ["localhost", "127.0.0.1", "::1"]
+
+isLoopbackHost :: ByteString -> Bool
+isLoopbackHost h = T.dropAround (\c -> c == '[' || c == ']') (T.toLower (safeDecodeUtf8 h)) `elem` loopbackHosts
+
 -- | '[web] base_url' is the origin the site is reached at: it goes into a provider's return and
 -- webhook URLs (E2, F1) and into the app's browser hand-off (G1), so a relative or scheme-less
 -- value is not something to discover at the first payment. 'https' is required, because a card
--- return URL over plaintext is a real downgrade, EXCEPT on the loopback hosts, where the local
--- mock stack (plan \'10) runs everything over http.
+-- return URL over plaintext is a real downgrade, EXCEPT on the loopback hosts.
 validateBaseUrl :: FilePath -> Text -> Either String ()
 validateBaseUrl path url = case HTTP.parseRequest (T.unpack url) :: Maybe HTTP.Request of
   Nothing -> bad "must be an absolute http:// or https:// URL"
   Just req
     | HTTP.host req == "" -> bad "must name a host"
     | HTTP.secure req -> Right ()
-    | HTTP.host req `elem` ["localhost", "127.0.0.1"] -> Right ()
-    | otherwise -> bad "must use https unless its host is localhost or 127.0.0.1"
+    | isLoopbackHost (HTTP.host req) -> Right ()
+    | otherwise -> bad ("must use https unless its host is one of " <> T.unpack (T.intercalate ", " loopbackHosts))
   where
     bad why = configError path ("key 'base_url' in section [web] " <> why <> ", got: " <> T.unpack url)
 
+-- | '[web] support_contact' is substituted into the page's one outbound link (D4). It is escaped
+-- on the way in, which stops an operator's typo from breaking out of the @href@ attribute, but
+-- escaping says nothing about the SCHEME: @javascript:@ survives it intact and becomes a live
+-- link. The operator's own ini is inside the trust boundary, so this is a typo guard rather than
+-- a defence -- but 'base_url' in this same section is validated and leaving its neighbour
+-- unchecked is an arbitrary asymmetry. Allowed: an absolute @https@\/@http@ URL with a host, or a
+-- @mailto:@ address, which is the one non-web way an operator plausibly publishes support.
+validateSupportContact :: FilePath -> Text -> Either String ()
+validateSupportContact path url
+  | "mailto:" `T.isPrefixOf` T.toLower url = if T.length url > 7 then Right () else bad "names no address after mailto:"
+  | otherwise = case HTTP.parseRequest (T.unpack url) :: Maybe HTTP.Request of
+      Nothing -> bad "must be an absolute https:// or http:// URL, or a mailto: address"
+      Just req
+        | HTTP.host req == "" -> bad "must name a host"
+        | otherwise -> Right ()
+  where
+    bad why = configError path ("key 'support_contact' in section [web] " <> why <> ", got: " <> T.unpack url)
+
 btcPayKeys :: [Text]
 btcPayKeys = ["url", "store_id", "api_key_file", "webhook_secret_file", "xmr_method_id", "btc_expiry_minutes", "xmr_expiry_minutes"]
 

apps/simplex-badge-service/src/BadgeService/Service.hs

@@ -15,7 +15,7 @@ module BadgeService.Service
   )
 where
 
-import BadgeService.Catalog (catalogTotals, seedCatalog)
+import BadgeService.Catalog (catalogTotals, logUnpricedOffers, seedCatalog)
 import BadgeService.Codes (RedeemOutcome (..), classifyRedemption, codeHash, normalizeCode)
 import BadgeService.Config
   ( BadgeServiceConfig (issuer, service),
@@ -76,9 +76,6 @@ import Data.Word (Word32)
 import Simplex.Chat.Badges (BadgeCredential (..), BadgeInfo (..), BadgeMasterKey, BadgeRequest (..), BadgeType)
 import Simplex.Chat.Badges.Service
   ( BadgeBalance (..),
-    BadgeCatalog (..),
-    BadgeOffer (..),
-    BadgePrice (..),
     BadgeServiceCommand (..),
     BadgeServiceErrorCode (..),
     BadgeServiceRequest (..),
@@ -97,7 +94,6 @@ import Simplex.Chat.Badges.Service
 import Simplex.Chat.Badges.Types
   ( BadgeIssuance (..),
     BadgeLedgerEntry (..),
-    BadgeOfferId (..),
     LedgerCreditType (..),
     LedgerDebitType (..),
     LedgerEntryType (LECredit, LEDebit),
@@ -532,20 +528,6 @@ handleGetBadgeCatalog bsEnv@BadgeServiceEnv {store, now} purchaseRow = case purc
       statement <- mapM (\BadgePurchaseRow {badgePurchaseId} -> purchaseStatement now' db Nothing badgePurchaseId) row
       pure (catalog, statement)
 
--- | An offer that is pinned to a price the catalog also returned, yet still has no total,
--- is a malformed offer (@freeMonths >= months@): the client will render it as unavailable,
--- and nothing else in the system would ever say why. 'chargeableMonths' stopped saying so
--- with 'error' precisely so a request thread survives it (§9), so this is the only place it
--- gets named.
-logUnpricedOffers :: BadgeCatalog -> IO ()
-logUnpricedOffers BadgeCatalog {prices, offers} =
-  forM_ offers $ \BadgeOffer {offerId = BadgeOfferId oid, priceId, total} ->
-    case (priceId, total) of
-      (Just pid, Nothing)
-        | any (\BadgePrice {priceId = pid'} -> pid' == pid) prices ->
-            logWarn $ "catalog offer " <> oid <> " has a pinned price but no chargeable total"
-      _ -> pure ()
-
 -- | A resolved statement cursor: the wire @entryId@ the client asserted, and the local
 -- @entry_id@ it resolved to. The two travel together so 'previousEntryId' always echoes the
 -- value the client actually sent, and is never spelled independently of the id the query runs

apps/simplex-badge-service/src/BadgeService/Web/Assets.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -14,9 +15,12 @@
 -- * a file is named by its path relative to the root of the built output -- @main.js@, and
 --   @img\/x.svg@ if an asset is ever nested -- and the two files that stay at @web\/@
 --   (@index.html@ and @styles.css@) by their bare name;
--- * a token name is @[A-Za-z0-9_.-]+@, JavaScript's @[\\w.-]+@. That charset cannot contain a
---   @\/@, so no token can name a nested asset at all. Harmless while every asset is flat, and
---   deliberately identical to @build.mjs@'s pattern rather than quietly wider here.
+-- * a token name is @[A-Za-z0-9_.-]+@, JavaScript's @[\\w.-]+@ (written out because Haskell's
+--   'Data.Char.isAlphaNum' is Unicode-wide and JavaScript's @\\w@ is not). That charset cannot
+--   contain a @\/@, so no token can name a nested asset at all. Harmless while every asset is
+--   flat, and deliberately identical to @build.mjs@'s pattern rather than quietly wider here.
+--   Scanning agrees too, down to where it resumes after a @\@\@@ that begins no token -- see
+--   'substituteTokens'.
 --
 -- The build hash is ONE SHA-256 over the whole set, not one per file, and every file is served
 -- under that single prefix. @tsc@ does not rewrite import specifiers (decision 7), so @main.js@
@@ -33,6 +37,7 @@ module BadgeService.Web.Assets
   )
 where
 
+import qualified Control.Exception as E
 import Control.Monad (foldM, forM)
 import qualified Data.ByteArray.Encoding as BA
 import Data.ByteString (ByteString)
@@ -162,10 +167,21 @@ readServedAssets dir = do
       roots <- forM [indexHtmlName, stylesheetName] $ \name -> do
         let path = dir </> T.unpack name
         exists <- doesFileExist path
-        if exists then Right . (name,) <$> BS.readFile path else pure . Left $ "[web] web_dir " <> dir <> ": no " <> path
+        if exists then readAsset name path else pure . Left $ "[web] web_dir " <> dir <> ": no " <> path
       names <- listAssetNames distDir
-      dist <- forM (filter (/= devHtmlName) names) $ \name -> (name,) <$> BS.readFile (distDir </> T.unpack name)
-      pure $ (\rs -> mkServedAssets (rs <> dist)) =<< sequence roots
+      dist <- forM (filter (/= devHtmlName) names) $ \name -> readAsset name (distDir </> T.unpack name)
+      pure $ mkServedAssets =<< sequence (roots <> dist)
+
+-- | A file the directory listing (or 'doesFileExist') just said was there can still fail to open:
+-- a dangling symlink, a permission bit, a file deleted between the walk and the read. In a mode
+-- whose whole point is that the directory changes under a running service, that is ordinary rather
+-- than exceptional, so it becomes the same 'Left' every other web_dir problem is -- a 500 naming
+-- the file in the log -- instead of an exception escaping into Warp.
+readAsset :: Text -> FilePath -> IO (Either String (Text, ByteString))
+readAsset name path =
+  E.try (BS.readFile path) >>= \case
+    Right bs -> pure $ Right (name, bs)
+    Left (e :: E.IOException) -> pure . Left $ "[web] web_dir: cannot read " <> path <> ": " <> show e
 
 -- | Every file under @dir@, as a name relative to it. Hidden files are skipped, matching both
 -- 'embedDir' (which skips them too) and @build.mjs@, so @.gitkeep@ and an editor's swap file are
@@ -208,10 +224,13 @@ substituteTokens supportContact assets = go
                     after <- go (T.drop 2 rest')
                     pure $ before <> value <> after
                   else do
-                    -- not a token: emit the "@@" and keep scanning from just after it, which is
-                    -- how build.mjs's regex behaves on the same input
-                    after <- go body
-                    pure $ before <> "@@" <> after
+                    -- Not a token. Resume ONE character on, not two: a JavaScript global regex
+                    -- that fails at an index retries at the next index, so in "@@@x@@"
+                    -- build.mjs matches the "@@x@@" starting at index 1. Skipping both @s here
+                    -- would leave that literal in the page with no startup error, and the two
+                    -- resolvers would disagree on an input build.mjs accepts.
+                    after <- go (T.drop 1 rest)
+                    pure $ before <> "@" <> after
     resolve name
       | name == supportContactToken = Right $ escapeHtml supportContact
       | M.member name (assetFiles assets) = Right $ assetUrlPath assets name

apps/simplex-badge-service/src/BadgeService/Web/Server.hs

@@ -18,14 +18,16 @@ module BadgeService.Web.Server
   )
 where
 
-import BadgeService.Catalog (catalogTotals)
+import BadgeService.Catalog (catalogTotals, logUnpricedOffers)
 import BadgeService.Config (BadgeServiceConfig (web), BadgeServiceEnv (..), WebConfig (..))
 import BadgeService.Store (getActiveCatalog, withServiceTransaction)
 import BadgeService.Web.Assets
 import Control.Logger.Simple
+import Control.Monad (when)
 import qualified Data.Aeson as J
 import Data.Bifunctor (first)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Map.Strict as M
 import Data.Maybe (isJust)
@@ -90,25 +92,47 @@ runWebServer :: WebServer -> IO ()
 runWebServer ws@WebServer {wsConfig = WebConfig {webPort, webHost, webDir}} = do
   logInfo $ "badge service web listener on " <> webHost <> ":" <> tshow webPort <> maybe "" (\d -> " serving " <> T.pack d <> " (web_dir, development only)") webDir
   -- Warp.run takes a port alone and cannot bind a configured host, so runSettings is used.
-  Warp.runSettings (Warp.setPort webPort $ Warp.setHost (fromString $ T.unpack webHost) Warp.defaultSettings) (webApp ws)
-
-webApp :: WebServer -> Application
-webApp ws req respond
-  | requestMethod req `notElem` ["GET", "HEAD"] =
-      respond $ textResponse methodNotAllowed405 [("Allow", "GET, HEAD")] "method not allowed"
-  | otherwise = case pathInfo req of
-      [] -> withPage serveIndex
-      [""] -> withPage serveIndex
-      ["api", "catalog"] -> respond =<< serveCatalog ws
-      ("assets" : buildHash : name : names) -> withPage $ \page -> serveAsset ws page buildHash (T.intercalate "/" (name : names))
-      _ -> respond notFoundResponse
+  Warp.runSettings settings (webApp ws)
   where
+    settings =
+      Warp.setPort webPort
+        . Warp.setHost (fromString $ T.unpack webHost)
+        -- Warp's default 500 is its own bare page, with none of the security headers on it, and
+        -- an uncaught exception is exactly the response an attacker can most easily provoke.
+        -- Every exception surface later steps add -- D6's request decoding, E3's and F2's
+        -- webhooks -- lands on this same listener, and 'withServiceTransaction' already lets a
+        -- database exception through ('serveCatalog'), so this is not hypothetical.
+        . Warp.setOnExceptionResponse (const internalErrorResponse)
+        -- ... and replacing the response would otherwise also silence Warp's own default
+        -- logging of it. 'defaultShouldDisplayException' keeps client disconnects quiet, which
+        -- is the reason Warp's default is not simply "log everything".
+        . Warp.setOnException (\_ e -> when (Warp.defaultShouldDisplayException e) $ logError $ "badge service web request failed: " <> tshow e)
+        -- no "Server: Warp/x.y.z": the version of the server is nobody's business but ours
+        . Warp.setServerName ""
+        $ Warp.defaultSettings
+
+-- | The method is checked PER ROUTE, not once for the whole listener: @POST \/api\/checkout@
+-- (D6) and the provider webhooks (E3, F2) join this table, and a server-wide "GET and HEAD only"
+-- would have to be undone by each of them. It also keeps 405 for a route that exists and 404 for
+-- one that does not, rather than telling an unauthenticated caller which paths are real.
+webApp :: WebServer -> Application
+webApp ws req respond = case pathInfo req of
+  [] -> readOnly $ withPage serveIndex
+  [""] -> readOnly $ withPage serveIndex
+  ["api", "catalog"] -> readOnly $ respond =<< serveCatalog ws
+  ("assets" : buildHash : name : names) -> readOnly $ withPage $ \page -> serveAsset ws page buildHash (T.intercalate "/" (name : names))
+  _ -> respond notFoundResponse
+  where
+    readOnly = withMethods ["GET", "HEAD"]
+    withMethods allowed serve
+      | requestMethod req `elem` allowed = serve
+      | otherwise = respond $ textResponse methodNotAllowed405 [("Allow", B.intercalate ", " allowed)] "method not allowed"
     withPage serve =
       currentPage ws >>= \case
         Right page -> respond $ serve page
         Left e -> do
           logError $ "badge service web assets are unreadable: " <> T.pack e
-          respond $ textResponse internalServerError500 [] "internal error"
+          respond internalErrorResponse
 
 -- | In @web_dir@ mode the whole set, its hash and the substituted index are recomputed per
 -- request, so an edited file is visible on reload; every response in that mode is @no-store@, or
@@ -152,7 +176,10 @@ assetCacheControl WebServer {wsConfig = WebConfig {webDir}}
 serveCatalog :: WebServer -> IO Response
 serveCatalog WebServer {wsService = BadgeServiceEnv {store}} =
   withServiceTransaction store (fmap catalogTotals . getActiveCatalog) >>= \case
-    Right catalog -> pure $ jsonResponse ok200 (J.encode catalog)
+    Right catalog -> do
+      -- the same call the RPC handler makes, for the same reason, on the path most buyers take
+      logUnpricedOffers catalog
+      pure $ jsonResponse ok200 (J.encode catalog)
     Left e -> do
       logError $ "badge service /api/catalog failed: " <> tshow e
       pure $ jsonResponse internalServerError500 "{\"error\":\"internal\"}"
@@ -170,6 +197,11 @@ securityHeaders =
 notFoundResponse :: Response
 notFoundResponse = textResponse notFound404 [] "not found"
 
+-- | Every 500 this listener sends, whether it is one a route decided on or one Warp caught: same
+-- status, same headers, and nothing about what went wrong (the log has that).
+internalErrorResponse :: Response
+internalErrorResponse = textResponse internalServerError500 [] "internal error"
+
 textResponse :: Status -> [Header] -> LBS.ByteString -> Response
 textResponse status headers =
   responseLBS status (securityHeaders <> headers <> [(hContentType, "text/plain; charset=utf-8"), (hCacheControl, "no-store")])

plans/badges-codes/2026-08-21-badges-web-checkout.md

@@ -845,7 +845,7 @@ Phase D ends with a browsable, priced site wizard whose Pay button reaches a rea
 
 - Security headers on every response: `Content-Security-Policy: default-src 'self'`, `X-Content-Type-Options: nosniff`, `Referrer-Policy: no-referrer`, `X-Frame-Options: DENY`. The site loads no cross-origin resource, so `default-src 'self'` blocks nothing it needs.
 
-**Verify:** In `tests/Bots/BadgeServiceTests.hs`, over HTTP against the running service: `GET /` carries no `@@…@@`, resolves `@@support_contact@@` to the value in the ini specifically, and every asset URL it names is fetchable under ONE prefix; every relative specifier in a served module resolves under that module's own prefix (the reason the hash is per build); `GET /dev.html` and `/assets/<hash>/dev.html` are both 404 and carry none of `dev.html`'s bytes; an asset under a stale hash is 404 while the same name under the current one is 200; the four security headers are on every response, including a 404 and a rejected method; `/api/catalog` decodes as the RPC `BadgeCatalog` and reflects a price the fixture disabled and one it deprecated, with each offer's computed `total`; `web_dir` serves from disk with `no-store`, picks up an edited stylesheet with no restart and refuses a path outside its directory, percent-encoded traversal included; a token naming no served file fails `resolveWebPage`, which is what startup calls, naming the token; `base_url` rejects a non-loopback `http` URL and accepts `https` and loopback ones. Not automated: that a browser renders and executes the served page (§9 browser pass). The site wizard itself is reviewable after D3.
+**Verify:** In `tests/Bots/BadgeServiceTests.hs`, over HTTP against the running service: `GET /` carries no `@@…@@`, resolves `@@support_contact@@` to the value in the ini specifically, and every asset URL it names is fetchable under ONE prefix; every relative specifier in a served module resolves under that module's own prefix (the reason the hash is per build); `GET /dev.html` and `/assets/<hash>/dev.html` are both 404 and carry none of `dev.html`'s bytes; an asset under a stale hash is 404 while the same name under the current one is 200; the four security headers are on every response, including a 404, a rejected method and both kinds of 500 (one the application decides on, one Warp catches), and no response names the server; the method is rejected per route, so an unknown path is 404 whatever the method while a known one is 405 with its own `Allow`; `/api/catalog` decodes as the RPC `BadgeCatalog` and reflects a price the fixture disabled and one it deprecated, with each offer's computed `total`; `web_dir` serves from disk with `no-store`, picks up an edited stylesheet with no restart and refuses a path outside its directory, percent-encoded traversal included; a token naming no served file fails `resolveWebPage`, which is what startup calls, naming the token; `base_url` rejects a non-loopback `http` URL and accepts `https` and loopback ones in every spelling; `support_contact` rejects `javascript:`, `data:` and relative values and accepts `https`, `http` and `mailto:`. Not automated: that a browser renders and executes the served page (§9 browser pass). The site wizard itself is reviewable after D3.
 
 #### D5 — URL prefill
 
@@ -1492,7 +1492,7 @@ Append here when a step contradicts this plan: the step id, what was wrong, and
 - **D1 — `index.html` may not use the token syntax in prose, and its charset declaration has a byte budget. Both bind D2 onwards.** The step requires a header comment saying `dist/` is committed, and the first draft of that comment used `@@name@@` to describe the mechanism — which the generic substitution then tried to resolve, correctly failing the build. Under D4 the same stray token fails the *service* at startup. Separately, the comment sits above `<meta charset>`, and HTML5 requires the encoding declaration to be complete within the first 1024 bytes; `dev.html` prepends a generated banner on top of it, so the budget is shared. The comment is short and ASCII-only for that reason, the banner is one line, and `index.html` says so. A step that grows the header comment has to re-check both.
 - **D1 — its Verify line was rewritten from a manual browser check to a mechanical one, and the browser half is now carried by D2's Verify.** The original line was "Manual: `npm ci && npm run build` … `npx tsc --noEmit` is clean", which under rule 4 made D1 unfalsifiable in CI and in any environment without a display. It now specifies the reproducible rebuild (which is what D8 gates), the token resolution in `dev.html`, the emitted relative import, and a `curl` of every URL the page references over `python3 -m http.server`. **Exactly four things were therefore not run when D1 landed, and none of them is claimed to work:** that `dev.html` renders at all; that the browser executes the `main.js` → `ui.js` module graph; that `../styles.css` is applied rather than merely served with a `text/css` header; and that a `file://` open fails where HTTP succeeds, which the step asserts and which was not tested in either direction. Under rule 10 a deferral needs the deferring step to own the assertions, so **D2's Verify line now names the first three explicitly** — D2 replaces `main.ts`, `ui.ts`, `styles.css` and `index.html` wholesale, and without that its implementer would read a blank page as their own markup rather than as D1's mechanism. The `file://` claim is carried untested; nothing in the plan depends on it beyond the instruction not to do it, which `dev.html`'s own banner repeats.
 - **D1/D8 — `git diff --exit-code -- dist` does not see untracked files, so the staleness gate has a blind spot.** The check now sits in D1's Verify line and is what D8 is to gate CI on. `dist/` is wiped and rebuilt every run, so a *deleted* module or asset is caught: the file vanishes from the working tree and the diff reports it. But a *new* asset that was built and never `git add`ed is untracked, and `git diff` ignores untracked paths entirely — CI would run `npm ci && npm run build`, produce a file that is not in the repository, and report the tree clean. The service would then embed a `dist/` missing that asset while `index.html` carries its token, which under D4's rule fails at **startup**, not in CI. **D8 must assert on untracked files too** — `git status --porcelain apps/simplex-badge-service/web/dist` being empty covers both directions, where `git diff --exit-code` covers only one.
-- **D1/D4 — a nested asset gets a served-set key no token can name, and the two resolvers must agree on this.** `dist/` is walked recursively, so an asset at `assets/img/x.svg` enters the served set keyed `img/x.svg`, while the token pattern is `@@([\w.-]+)@@` and does not accept `/`. Nothing can reference such a file, and the mismatch surfaces as the ordinary "token names nothing" build failure rather than as anything explaining itself. No asset is nested today and none is planned — D2's two logos and E5's encoder are all flat — so this is recorded rather than fixed. **D4 implements the same resolver server-side over `embedDir`'s `[(FilePath, ByteString)]`, whose keys are also relative paths**, and must use the same key and the same token charset; if it accepts `/` in a token while the build script does not, or keys its set differently, the two resolvers diverge on the first nested asset and the page that builds cleanly fails at startup. Whichever step first needs a subdirectory decides for both, in one place. **D4 implemented it identically**: the key is the path relative to the built output in POSIX form (`toAssetName` over `embedDir`'s pairs and over the `web_dir` walk), the two files at `web/` keep their bare names as `build.mjs`'s `ROOT_FILES` do, and the token charset is `[A-Za-z0-9_.-]`, JavaScript's `[\w.-]` written out because Haskell's `isAlphaNum` is Unicode-wide and JavaScript's `\w` is not.
+- **D1/D4 — a nested asset gets a served-set key no token can name, and the two resolvers must agree on this.** `dist/` is walked recursively, so an asset at `assets/img/x.svg` enters the served set keyed `img/x.svg`, while the token pattern is `@@([\w.-]+)@@` and does not accept `/`. Nothing can reference such a file, and the mismatch surfaces as the ordinary "token names nothing" build failure rather than as anything explaining itself. No asset is nested today and none is planned — D2's two logos and E5's encoder are all flat — so this is recorded rather than fixed. **D4 implements the same resolver server-side over `embedDir`'s `[(FilePath, ByteString)]`, whose keys are also relative paths**, and must use the same key and the same token charset; if it accepts `/` in a token while the build script does not, or keys its set differently, the two resolvers diverge on the first nested asset and the page that builds cleanly fails at startup. Whichever step first needs a subdirectory decides for both, in one place. **D4 implemented it identically**: the key is the path relative to the built output in POSIX form (`toAssetName` over `embedDir`'s pairs and over the `web_dir` walk), the two files at `web/` keep their bare names as `build.mjs`'s `ROOT_FILES` do, and the token charset is `[A-Za-z0-9_.-]`, JavaScript's `[\w.-]` written out because Haskell's `isAlphaNum` is Unicode-wide and JavaScript's `\w` is not. **One divergence was found in review and fixed, after D4's own report had claimed exact agreement:** on a `@@` that begins no token, a JavaScript global regex retries at the NEXT index, while D4's scanner resumed two characters on. Verified with node against `build.mjs`'s own regex: `@@@styles.css@@` resolves to `@./styles.css` there, and the service left it literal **with no startup error** — the one failure mode the whole invariant exists to prevent. The scanner now emits one `@` and resumes one character on, which reproduces the regex on every input tried (`@@@x@@`, `@@@@x@@`, `a@@b@@x@@`, `@@ x@@`), and a web_dir fixture pins it.
 - **D8 — the step text's `git diff --exit-code` was implemented as `git status --porcelain`, per the D1/D8 entry above.** The blind spot was already recorded but the step text still named the blind command; it now names the porcelain one. This is not theoretical: in the clean clone used to verify the job, building a new asset into `dist/` without `git add`ing it leaves `git diff --exit-code -- dist` **exiting 0** while the porcelain check exits 1 — the gate as the plan first wrote it would have gone green on precisely the failure it exists to catch, and that failure surfaces at D4 as a *startup* error in the service. The untracked case includes a nested asset, whose whole directory `git status` collapses to one `?? …/dist/img/` line — still non-empty, so still a failure.
 - **D8 — "a job gated on `apps/simplex-badge-service/web/**`" is not expressible; the job runs on every trigger of `build.yml` instead.** GitHub Actions `paths:` filters are a *workflow* trigger, not a per-job condition, so the only ways to gate a single job are a separate workflow file with its own `paths:` or a third-party changed-files action. Neither was taken. `build.yml` is this repository's one PR gate and its `pull_request` paths already list `apps/simplex-badge-service/**` (`:19`), so a PR touching `web/` already runs this workflow and the gating would buy nothing there; `web.yml`, the only `paths:`-triggered workflow here, is a gh-pages *deploy* pipeline, not a check, so following its shape would be copying a different kind of thing. On pushes to `master`/`stable` and on tags, where `build.yml` has no `paths` filter, running unconditionally is what is wanted — a merge can leave `dist/` inconsistent with `src/` while touching neither, and a path-filtered workflow would skip exactly that commit. The cost is `npm ci` of one package plus `tsc`, seconds, in parallel with builds that take tens of minutes. A separate workflow would also add a second path list to keep in step with the first and a second required-check name; a `paths`-filtered check that is marked required leaves PRs that do not touch those paths pending forever.
 - **D8 — the step's Verify was manual and unrunnable before merge; it is now the same command sequence run locally.** "Edit a `.ts` and confirm the job fails" cannot be executed before the workflow is on the default branch. The line now specifies a clean clone of HEAD, the job's own commands in it, and both failure modes with the exact output each produces — which is what was run. What remains unverified is only what no local run can cover: that GitHub resolves `actions/checkout@v6` and `actions/setup-node@v6` and provisions node 24 on `ubuntu-latest`. The first CI run on this branch confirms that.
@@ -1520,6 +1520,13 @@ Append here when a step contradicts this plan: the step id, what was wrong, and
 - **D4 — `index.html` is itself in the served set, and is reachable under the asset prefix.** The step lists it as embedded but does not say whether a token may name it. `build.mjs` resolves `@@index.html@@` (it is in `ROOT_FILES`), so the service must too, or a token would resolve in the development build and fail at startup in production. It is served under the prefix with the same substituted bytes and the same `no-cache` as `/`, so a resolved `@@index.html@@` is a URL that works rather than a 404.
 - **D4 — `@@support_contact@@` is HTML-escaped on the way into the page; `build.mjs` does not escape its placeholder.** The value is operator-controlled and lands inside an `href` attribute, so a quote in it would end the attribute. The asset URLs are not escaped and need no escaping: they are built from a hex digest and a name in the token charset. This is a deliberate divergence from `build.mjs`, which substitutes a fixed development placeholder that contains nothing to escape; the token *resolution rule* — which names resolve, and to what — is identical in both.
 
+- **D4 fix round 1 — Warp's default exception response carried none of the security headers, and that is production-reachable.** `runWebServer` set no `setOnExceptionResponse`, so any exception escaping the application produced Warp's own bare page: `500` with no CSP, no `nosniff`, nothing. Not a `web_dir` curiosity — `withServiceTransaction` catches only `ServiceRollback`, so a database exception in `/api/catalog` leaves the same way, and D6's request decoding plus E3's and F2's webhook verification all add exception surface to this same listener. Fixed with `setOnExceptionResponse` returning the same internal-error response every route uses, and `setOnException` logging through `defaultShouldDisplayException` so replacing the response does not also silence Warp's own report of it. A test drives both halves of the 500 path — a dangling symlink (which the application turns into its own `Left`) and a permission-less directory inside `dist/` (which nothing catches) — and the mutation removing `setOnExceptionResponse` fails only the second, which is the proof that the second was ever reaching Warp.
+- **D4 fix round 1 — the method guard is per route, not server-wide.** Every non-`GET`/`HEAD` request was answered `405` with a server-wide `Allow: GET, HEAD` before `pathInfo` was looked at, which D6 (`POST /api/checkout`), E3 and F2 (`POST /webhooks/*`) would each have had to undo. The routing table now checks the method per route, so a route that exists answers `405` with its own `Allow` and a path that does not exist answers `404` whatever the method — which also stops an unauthenticated caller from mapping which paths are real by method alone.
+- **D4 fix round 1 — `logUnpricedOffers` lives in `Catalog.hs`, beside the function that produces the `Nothing`.** D4's report claimed a module cycle prevented sharing it with `Web/Server.hs`. That was wrong: the function needs only `BadgeCatalog`/`BadgeOffer`/`BadgePrice` and `logWarn`, and `Catalog.hs` is already imported by both `Service.hs` and `Web/Server.hs`. As D4 shipped it, a malformed offer was logged over RPC and read as "unavailable" on the site with nothing said anywhere — on the path most buyers take. Both readers of a database catalog now call it.
+- **D4 fix round 1 — `[web] support_contact` is validated as an absolute `https`/`http` URL with a host, or a `mailto:` address.** D4 escaped the value into the page's `href`, which stops a quote from ending the attribute but says nothing about the scheme: `javascript:…` survives escaping intact and becomes a live link. The operator's own ini is inside the trust boundary, so this is a typo guard rather than a defence — but `base_url` in the same section was validated and its neighbour was not, and that asymmetry was arbitrary. `mailto:` is allowed because it is the one non-web way an operator plausibly publishes support. The loopback list `base_url` accepts is now also case-insensitive and accepts `[::1]`.
+- **D4 — the symlink-inside-`web_dir` vector is measured, not assumed.** A symlink under the `web_dir` directory pointing outside it IS followed and its contents ARE served (200), because the served set is enumerated by walking the directory and a symlink is an ordinary entry of it. Development-only mode, operator's own directory, and the alternative (resolving every path and comparing prefixes on every request, in the mode whose point is that the directory changes underneath) buys nothing against an operator who can equally well copy the file in. Recorded so the next reader does not have to rediscover it: the traversal refusal D4 tests is about REQUEST paths, which cannot escape at all, not about what the directory itself points at.
+- **D4 — a `dist/index.html` is a startup error in the service and a silent override in `build.mjs`.** The service refuses a served set with two files of one name (`index.html` from `web/` and one copied into `dist/`), naming the collision; `build.mjs`'s `writeDevHtml` would simply let the `dist/` one win its `ROOT_FILES` entry. A divergence in the safe direction — the service fails loudly where the build script would quietly serve the wrong file — and unreachable unless someone adds `assets/index.html`, which `copyAssets` already refuses when it collides with a compiled module.
+
 ## 10. End-to-end verification
 
 After F5:

tests/Bots/BadgeServiceTests.hs

@@ -137,7 +137,7 @@ import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS (BBSPublicKey (..), BBSSecretKey (..), bbsKeyGen)
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
-import System.Directory (createDirectoryIfMissing)
+import System.Directory (Permissions, createDirectoryIfMissing, createFileLink, emptyPermissions, removeDirectoryRecursive, removeFile, setOwnerReadable, setOwnerSearchable, setOwnerWritable, setPermissions)
 import System.Exit (ExitCode (..))
 import System.FilePath ((</>))
 import System.IO (IOMode (..), hClose, hFlush, openFile, stdout)
@@ -203,8 +203,10 @@ badgeServiceTests = do
   it "should set the four security headers on every response, including a 404 and a rejected method" testBadgeServiceWebSecurityHeadersEverywhere
   it "should serve the database catalog with computed totals from /api/catalog" testBadgeServiceWebCatalogEndpoint
   it "should serve web_dir from disk with no-store, pick up an edit without a restart and refuse a path outside it" testBadgeServiceWebDirServesFromDisk
+  it "should answer 500 with the security headers for a web_dir file it cannot read and for an uncaught exception" testBadgeServiceWebInternalErrorsCarryHeaders
   it "should fail before the service starts when a token names no served file, naming the token" testBadgeServiceWebUnresolvableTokenFails
   it "should reject a non-loopback http base_url and accept https and loopback ones" testBadgeServiceConfigBaseUrlValidated
+  it "should reject a support_contact that is not an http(s) or mailto URL" testBadgeServiceConfigSupportContactValidated
   it "should create a purchase and append ledger entries readable back in order" testBadgeStorePurchaseAndLedger
   it "should disable a price out of the active catalog while both stay reachable by id" testBadgeStoreSetPriceStatusDisabled
   it "should return the redeeming purchase key from getCodeByHash" testBadgeStoreGetCodeByHashRedeemer
@@ -3805,6 +3807,18 @@ webGet mgr url = do
         wrBody = LBC.unpack (HTTP.responseBody r)
       }
 
+-- The same with a method of the caller's choosing, for the per-route method assertions.
+webRequest :: BC.ByteString -> HTTP.Manager -> String -> IO WebResponse
+webRequest method mgr url = do
+  req <- HTTP.parseRequest url
+  r <- HTTP.httpLbs req {HTTP.method = method} mgr
+  pure
+    WebResponse
+      { wrStatus = statusCode (HTTP.responseStatus r),
+        wrHeaders = HTTP.responseHeaders r,
+        wrBody = LBC.unpack (HTTP.responseBody r)
+      }
+
 webHeader :: WebResponse -> BC.ByteString -> String
 webHeader r name = maybe "" BC.unpack $ lookup (CI.mk name) (wrHeaders r)
 
@@ -3817,10 +3831,11 @@ assertSecurityHeaders what r = do
   (what, webHeader r "referrer-policy") `shouldBe` (what, "no-referrer")
   (what, webHeader r "x-frame-options") `shouldBe` (what, "DENY")
 
--- Every asset URL the served page references, in document order: the tokens resolve into quoted
--- attributes and an asset URL contains no quote, so this reads what the browser would follow.
+-- Every asset URL the served page references, in document order: a resolved token ends at the
+-- quote closing its attribute (or at the next tag, for one substituted into text), and an asset
+-- URL contains neither character, so this reads what the browser would follow.
 webAssetUrls :: String -> [String]
-webAssetUrls body = map (T.unpack . ("/assets/" <>) . T.takeWhile (/= '"')) . drop 1 $ T.splitOn "/assets/" (T.pack body)
+webAssetUrls body = map (T.unpack . ("/assets/" <>) . T.takeWhile (\c -> c /= '"' && c /= '<')) . drop 1 $ T.splitOn "/assets/" (T.pack body)
 
 -- "/assets/<buildHash>/main.js" -> "<buildHash>"
 webAssetHash :: HasCallStack => String -> String
@@ -3925,11 +3940,21 @@ testBadgeServiceWebSecurityHeadersEverywhere ps =
     forM_ ["", "/api/catalog", "/no-such-path", "/assets", "/assets/deadbeef/main.js"] $ \path -> do
       r <- webGet mgr (webUrl <> path)
       assertSecurityHeaders path r
-    postReq <- HTTP.parseRequest (webUrl <> "/api/catalog")
-    postResp <- HTTP.httpLbs postReq {HTTP.method = "POST"} mgr
-    let post = WebResponse {wrStatus = statusCode (HTTP.responseStatus postResp), wrHeaders = HTTP.responseHeaders postResp, wrBody = LBC.unpack (HTTP.responseBody postResp)}
+      -- and nothing tells the caller which server, or which version of it, is answering
+      (path, webHeader r "server") `shouldBe` (path, "")
+    -- The method is rejected PER ROUTE: a route that exists answers 405 and says what it takes,
+    -- a path that does not exist answers 404 whatever the method. A server-wide method guard
+    -- gets this second one wrong, and D6's POST /api/checkout would have to undo it.
+    post <- webRequest "POST" mgr (webUrl <> "/api/catalog")
     wrStatus post `shouldBe` 405
+    webHeader post "allow" `shouldBe` "GET, HEAD"
     assertSecurityHeaders "POST /api/catalog" post
+    postUnknown <- webRequest "POST" mgr (webUrl <> "/no-such-path")
+    wrStatus postUnknown `shouldBe` 404
+    assertSecurityHeaders "POST /no-such-path" postUnknown
+    -- HEAD is allowed on every route GET is
+    headIndex <- webRequest "HEAD" mgr webUrl
+    wrStatus headIndex `shouldBe` 200
 
 -- /api/catalog answers from the DATABASE through catalogTotals, never from Catalog.hs's
 -- defaults: the fixture disables one seeded price and deprecates the other, so the default
@@ -3976,6 +4001,10 @@ writeTestWebDir dir = do
   writeFile (dir </> "index.html") $
     "<!doctype html><html><head><link rel=\"stylesheet\" href=\"@@styles.css@@\" /></head>"
       <> "<body><a href=\"@@support_contact@@\">support</a>"
+      -- one literal @ in front of a token: build.mjs's regex fails at the first index, retries at
+      -- the NEXT one and resolves the token, so the service must too (§9). A scanner that skipped
+      -- both @s would leave this in the page as text, with no startup error to say so.
+      <> "<p>@@@styles.css@@</p>"
       <> "<script type=\"module\" src=\"@@main.js@@\"></script></body></html>\n"
   writeFile (dir </> "styles.css") webDirCssBefore
   writeFile (dir </> "dist" </> "main.js") "export const site = \"web_dir\";\n"
@@ -4019,6 +4048,8 @@ testBadgeServiceWebDirServesFromDisk ps@TestParams {tmpPath} = do
     wrBody index `shouldSatisfy` (not . isInfixOf "@@")
     wrBody index `shouldSatisfy` isInfixOf testSupportContact
     let cssUrl = head $ filter ("/styles.css" `isSuffixOf`) (webAssetUrls (wrBody index))
+    -- the "@@@styles.css@@" above resolved, leaving exactly the one literal @ in front of it
+    wrBody index `shouldSatisfy` isInfixOf ("<p>@" <> cssUrl <> "</p>")
     css <- webGet mgr (webUrl <> cssUrl)
     wrStatus css `shouldBe` 200
     wrBody css `shouldBe` webDirCssBefore
@@ -4045,6 +4076,59 @@ testBadgeServiceWebDirServesFromDisk ps@TestParams {tmpPath} = do
   -- refusing, not a missing target
   readFile secretFile `shouldReturn` webDirSecret
 
+-- Every 500 this listener can be made to send must carry the four security headers, and there are
+-- two ways to reach one -- which is the point of the example, since only one of them is the
+-- application's own code:
+--
+--   * a dangling symlink: the walk lists it, the read fails, and 'readServedAssets' turns that
+--     into the Left the route answers with;
+--   * a directory inside dist/ with no permissions: the walk itself throws, and nothing in the
+--     application catches it, so the response is the one Warp's 'setOnExceptionResponse' returns.
+--     Warp's DEFAULT for that case is its own bare "Something went wrong" page with none of these
+--     headers on it -- and it is not a web_dir curiosity: 'withServiceTransaction' catches only
+--     ServiceRollback, so a database exception in /api/catalog leaves the same way, as will D6's
+--     request decoding and E3's and F2's webhooks.
+--
+-- The fixture is asserted to serve a 200 both before the damage and after it is undone, so
+-- neither 500 can be a service that was never working.
+testBadgeServiceWebInternalErrorsCarryHeaders :: HasCallStack => TestParams -> IO ()
+testBadgeServiceWebInternalErrorsCarryHeaders ps@TestParams {tmpPath} = do
+  let dir = tmpPath </> "web_dir_broken"
+      danglingLink = dir </> "dist" </> "dangling.js"
+      unreadableDir = dir </> "dist" </> "unreadable"
+      writeConfig port = do
+        (issuerKeyFile, codeSecretFile) <- writeTestBadgeServiceSecrets tmpPath
+        writeFile (badgeServiceConfigPath tmpPath) $
+          unlines $
+            issuerCodesIniLines issuerKeyFile codeSecretFile
+              ++ ("" : webIniLines port)
+              ++ ["web_dir = " <> dir]
+  writeTestWebDir dir
+  withBadgeServiceWebConfig ps writeConfig (pure ()) $ \_client _bsLink webUrl -> do
+    mgr <- newWebManager
+    healthy <- webGet mgr webUrl
+    wrStatus healthy `shouldBe` 200
+    -- 1. a file the walk finds and the read cannot open
+    createFileLink "no-such-target.js" danglingLink
+    broken <- webGet mgr webUrl
+    wrStatus broken `shouldBe` 500
+    assertSecurityHeaders "dangling symlink" broken
+    webHeader broken "server" `shouldBe` ""
+    removeFile danglingLink
+    -- 2. an exception the application does not catch at all
+    createDirectoryIfMissing True unreadableDir
+    thrown <- (setPermissions unreadableDir emptyPermissions >> webGet mgr webUrl) `finally` setPermissions unreadableDir searchablePermissions
+    wrStatus thrown `shouldBe` 500
+    assertSecurityHeaders "unreadable directory" thrown
+    webHeader thrown "server" `shouldBe` ""
+    removeDirectoryRecursive unreadableDir
+    recovered <- webGet mgr webUrl
+    wrStatus recovered `shouldBe` 200
+
+-- Owner-only rwx, which is what a directory needs to be walked again after 'emptyPermissions'.
+searchablePermissions :: Permissions
+searchablePermissions = setOwnerReadable True $ setOwnerWritable True $ setOwnerSearchable True emptyPermissions
+
 -- A token naming a file that is not served must fail at STARTUP, naming the token, rather than
 -- serving a page with a dead link in it. 'resolveWebPage' is what 'newWebServer' calls from
 -- 'badgePreStartHook', before the bot starts. The same directory without the bad token resolves,
@@ -4090,8 +4174,32 @@ testBadgeServiceConfigBaseUrlValidated TestParams {tmpPath} = do
     readBadgeServiceConfig path >>= \case
       Right _ -> expectationFailure $ "expected " <> baseUrl <> " to be rejected"
       Left err -> (baseUrl, "base_url" `isInfixOf` err) `shouldBe` (baseUrl, True)
-  forM_ ["https://badges.example.org", "http://localhost:8080", "http://127.0.0.1:8080"] $ \baseUrl -> do
+  forM_ ["https://badges.example.org", "http://localhost:8080", "http://127.0.0.1:8080", "http://[::1]:8080", "http://LOCALHOST:8080"] $ \baseUrl -> do
     writeBaseUrl baseUrl
     readBadgeServiceConfig path >>= \case
       Left err -> expectationFailure $ "expected " <> baseUrl <> " to be accepted, got: " <> err
       Right BadgeServiceConfig {web} -> (baseUrl, fmap webBaseUrl web) `shouldBe` (baseUrl, Just (T.pack baseUrl))
+
+-- '[web] support_contact' goes into the page's one outbound link. Escaping it (D4) stops a quote
+-- from breaking out of the href; it does nothing about the scheme, and 'javascript:' survives
+-- escaping intact. The operator's ini is inside the trust boundary, so this is a typo guard --
+-- but 'base_url' in the same section is validated and an unchecked neighbour is arbitrary.
+testBadgeServiceConfigSupportContactValidated :: HasCallStack => TestParams -> IO ()
+testBadgeServiceConfigSupportContactValidated TestParams {tmpPath} = do
+  (issuerKeyFile, codeSecretFile) <- writeTestBadgeServiceSecrets tmpPath
+  let path = tmpPath </> "support-contact.ini"
+      writeSupportContact supportContact =
+        writeFile path $
+          unlines $
+            issuerCodesIniLines issuerKeyFile codeSecretFile
+              ++ ["", "[web]", "port = 8080", "base_url = https://badges.example.org", "support_contact = " <> supportContact]
+  forM_ ["javascript:alert(1)", "JavaScript:alert(1)", "data:text/html,<h1>hi", "/contact", "simplex.chat/contact", "mailto:"] $ \value -> do
+    writeSupportContact value
+    readBadgeServiceConfig path >>= \case
+      Right _ -> expectationFailure $ "expected support_contact " <> value <> " to be rejected"
+      Left err -> (value, "support_contact" `isInfixOf` err) `shouldBe` (value, True)
+  forM_ ["https://simplex.chat/contact", "http://localhost:8080/support", "mailto:support@example.org"] $ \value -> do
+    writeSupportContact value
+    readBadgeServiceConfig path >>= \case
+      Left err -> expectationFailure $ "expected support_contact " <> value <> " to be accepted, got: " <> err
+      Right BadgeServiceConfig {web} -> (value, fmap webSupportContact web) `shouldBe` (value, Just (T.pack value))