core: badge service address publication

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

@@ -18,9 +18,10 @@ where
 import BadgeService.Catalog (catalogTotals, seedCatalog)
 import BadgeService.Codes (RedeemOutcome (..), classifyRedemption, codeHash, normalizeCode)
 import BadgeService.Config
-  ( BadgeServiceConfig (issuer),
+  ( BadgeServiceConfig (issuer, service),
     BadgeServiceEnv (..),
     IssuerConfig (issuerKeyIdx),
+    ServiceConfig (serviceAddressFile),
     checkFailureBuckets,
     debitFailureBuckets,
     newBadgeServiceEnv,
@@ -54,7 +55,7 @@ import BadgeService.Store
 import BadgeService.Store.Migrate (runBadgeServiceMigrations)
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.STM
-import Control.Exception (SomeAsyncException (..), SomeException, catch, evaluate, fromException, throwIO)
+import Control.Exception (IOException, SomeAsyncException (..), SomeException, catch, evaluate, fromException, throwIO)
 import Control.Monad.Except (ExceptT (..), runExceptT, throwError)
 import Control.Monad.IO.Class (liftIO)
 import Control.Logger.Simple
@@ -66,6 +67,7 @@ import Data.Int (Int64)
 import Data.Maybe (isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
 import Data.Time.Clock (UTCTime)
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as UUID
@@ -104,9 +106,11 @@ import Simplex.Chat.Controller
 import Simplex.Chat.Core (sendChatCmd, simplexChatCore)
 import Simplex.Chat.Options (printDbOpts)
 import Simplex.Chat.PaymentService (ServicePayment (..))
+import Simplex.Chat.Store.Profiles (UserContactLink (..))
 import Simplex.Chat.Terminal (terminalChatConfig)
 import Simplex.Chat.Terminal.Main (simplexChatCLI')
 import Simplex.Chat.Types (AgentInvId (..), User (..))
+import Simplex.Messaging.Agent.Protocol (CreatedConnLink (..))
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String (strEncode)
@@ -255,9 +259,50 @@ badgePostStartHook BadgeServiceOpts {noAddress, testing} env cc = do
     Nothing -> putStrLn "No current user" >> exitFailure
     -- DR required for service RPC; autoAccept off because badge service ignores contact events.
     Just _ -> do
-      unless noAddress $ initializeBotAddress' (not testing) (Just True) False cc
+      unless noAddress $ do
+        initializeBotAddress' (not testing) (Just True) False cc
+        publishServiceAddress env cc
       void $ atomically $ tryPutTMVar (serviceCC env) cc
 
+-- | Persists the bot's contact address to '[service] address_file' (A6 parses that key; this
+-- adds no configuration field), so an operator can publish it without scraping the startup log.
+-- No-op when the key is unset.
+--
+-- Re-reads the address with a second 'ShowMyAddress' rather than threading the value
+-- 'initializeBotAddress'' already resolved: that function is shared with three other bots
+-- (broadcast, bot-advanced, the directory service) and changing its signature to return the
+-- link would touch all of them for a need only this one has.
+--
+-- The file is always OVERWRITTEN with the address just read from the store: an operator who
+-- restarts the service must never find a file left over from a previous run whose address has
+-- since changed (e.g. the profile was reset) -- a stale file is worse than a briefly-missing
+-- one. If the file already held a different address, that is logged as a warning before the
+-- overwrite, since it should not happen in normal operation.
+--
+-- A write failure -- an unwritable path or a parent directory that does not exist, neither of
+-- which this creates -- is logged and does NOT stop the service: 'initializeBotAddress'' already
+-- put the same address on stdout (unless 'testing'), so the operator still has it, and nothing
+-- about serving RPC requests depends on this file.
+publishServiceAddress :: ServiceState -> ChatController -> IO ()
+publishServiceAddress ServiceState {serviceEnv} cc = do
+  BadgeServiceEnv {config = bsConfig} <- atomically $ readTMVar serviceEnv
+  case serviceAddressFile =<< service bsConfig of
+    Nothing -> pure ()
+    Just path ->
+      sendChatCmd cc ShowMyAddress >>= \case
+        Right (CRUserContactLink _ UserContactLink {connLinkContact = CCLink {connFullLink, connShortLink}}) ->
+          writeAddressFile path (safeDecodeUtf8 (maybe (strEncode connFullLink) strEncode connShortLink))
+        _ -> logError $ "badge service: could not read contact address to write to address_file " <> T.pack path
+
+writeAddressFile :: FilePath -> Text -> IO ()
+writeAddressFile path address = do
+  previous <- (Just <$> TIO.readFile path) `catch` \(_ :: IOException) -> pure Nothing
+  case previous of
+    Just old | T.strip old /= address -> logWarn $ "badge service address_file " <> T.pack path <> " held a different address; overwriting"
+    _ -> pure ()
+  (TIO.writeFile path (address <> "\n") >> logInfo ("badge service address written to " <> T.pack path))
+    `catch` \(e :: IOException) -> logError $ "badge service: failed to write address_file " <> T.pack path <> ": " <> tshow e
+
 handleServiceRequest :: BadgeServiceEnv -> ChatController -> User -> AgentInvId -> Maybe C.PublicKeyEd25519 -> J.Object -> IO ()
 handleServiceRequest bsEnv cc User {userId} reqId signerKey reqData = do
   let reqIdT = safeDecodeUtf8 (strEncode reqId)

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

@@ -142,7 +142,7 @@ The two `-m` filters are needed because the badge tests live under two hspec pat
 | B6 | `getBadgeCatalog` | A4, B1, B2, B5 | ☑ |
 | B7 | `purchaseBadge{code}` and `issueBadge` | B1, B2, B3, B4, B5 | ☑ |
 | B8 | `codes` operator subcommand | A4, B1, B3 | ☑ |
-| B9 | Service address publication | A6, B5 | ☐ |
+| B9 | Service address publication | A6, B5 | ☑ |
 | B10 | Service integration tests | B7, B8 | ☐ |
 | C1 | `Store/Badges.hs`: client badge store | A1, A2 | ☐ |
 | C2 | Commands, responses, events, parsers, View | A2, B2, C1 | ☐ |
@@ -595,7 +595,7 @@ simplex-badge-service codes status --code SXB-…
 
 #### B9 — Service address publication
 
-**Files:** `apps/simplex-badge-service/src/BadgeService/Service.hs`
+**Files:** `apps/simplex-badge-service/src/BadgeService/Service.hs`, `tests/Bots/BadgeServiceTests.hs`
 
 **Do:** The RPC path depends on clients knowing the bot's contact address. `initializeBotAddress'` (`Service.hs:110`) already creates it and prints it at startup via `showBotAddress` (`src/Simplex/Chat/Bot.hs:65-68`, gated on `logAddress = not testing`), but nothing persists it. Write the address to the path in `[service] address_file` when that key is set. A6 parses that key already, so this step adds no configuration field and does not touch `Config.hs`.
 
@@ -603,7 +603,7 @@ No address-file pattern exists in the repo to copy: the directory service (`Dire
 
 The operator publishes this address; it reaches clients through `ChatConfig.badgeServiceAddress` (C2), which defaults to `Nothing` and is set in release builds. H5 documents the procedure.
 
-**Verify:** Manual: starting the service twice prints the same address, and the file named by `address_file` contains a link a client accepts with `/c`.
+**Verify:** `testBadgeServicePublishesAddressFile` (`BadgeServiceTests.hs`): starts the real `badgeService` entry point twice against a config carrying `[service] address_file`, asserts the file's contents are byte-identical after both starts and match the address the client is actually given, then has a second client run `/c` against exactly those contents and gets back "connection request sent!" rather than a parse rejection. See §9 for why this replaces the manual run originally specified.
 
 #### B10 — Service integration tests
 
@@ -1366,6 +1366,9 @@ Append here when a step contradicts this plan: the step id, what was wrong, and
 - **B7 — two transactions per command, not one.** "One transaction per command" is kept for *writing*: the classification and the plan are read in a transaction that writes nothing, signing happens with no transaction open (which the step requires), and one further transaction does every write and reads the statement back inside it. `IssueCached` adds a third, read-only, to fetch the cached credential. A command with nothing to write opens exactly one, and writes nothing in it.
 - **B7 — an existing B5 test's expected code changed.** `testBadgeServicePurchaseBadgeUnknownKeyIsNotUnknownPurchaseKey` asserted `internal` because `purchaseBadge` was unimplemented; `"UNKNOWN-CODE"` now reaches the classifier, normalizes to 11 characters and fails the check character, so it is `code_invalid`. Its load-bearing assertion — never `unknown_purchase_key` — is unchanged. B10 replaces the surrounding suite.
 - **A1 — `chat_lint.sql` gains 5 fkey-index advisories, left unfixed by design.** The badge migration introduces unindexed foreign keys: `badge_invoices.offer_id`, `badge_invoices.price_id`, `badge_offers.price_id`, `badge_issuances.entry_id`, `users.shown_badge_id`. The lint output is committed literally rather than adding indexes, since index design is outside A1's scope and the repo has precedent for this (`9e000d6bc`). The first three point at rarely-mutated reference tables. The last two are the ones likely to matter under load — `badge_issuances.entry_id` for issuance lookup by ledger entry, and `users.shown_badge_id` for per-user badge display (C1's `getShownPurchase`). Decide on indexes for those two before release.
+- **B9 — the step's Verify line said "Manual"; an automated test was added instead, and a genuinely standalone manual run (two separate OS processes, hand-typed `/c`) could not be completed in this environment.** A real two-process run needs a live SMP server: this sandbox has no network egress (a direct connection to a public relay times out), and building `simplexmq`'s own `smp-server` executable from the checked-out dependency source fails independently of this step — `apps/common/Web/Embedded.hs`'s `embedDir "apps/common/Web/static/.well-known/"` Template Haskell splice reports the directory missing at compile time even though it is present on disk in the checkout, an environment-specific defect unrelated to the badge service. In its place, `testBadgeServicePublishesAddressFile` calls the real, unmodified `badgeService` entry point (not a stand-in) twice via the existing harness's `withBadgeServiceConfig`/`runBadgeService`, against the harness's own local in-memory SMP server, and adds a real second client issuing `/c` against the file's own contents — proving both halves of the original Verify line (same address across two starts; the file's link is accepted, not rejected as malformed) end to end, just not via two hand-launched OS processes. `initializeBotAddress'`'s `doAutoAccept = False` for the badge service means the client-side assertion stops at "connection request sent!" rather than a full connection, which is as far as `/c` accepting the address goes for this bot. Whoever next has real network access in this environment should still do one standalone two-process run before H5 documents the operator procedure, to catch anything this substitution cannot (e.g. a real terminal's stdout formatting of the printed address).
+- **B9 — the address is re-read via a second `ShowMyAddress`, not threaded from `initializeBotAddress'`'s own result.** `initializeBotAddress'` (`src/Simplex/Chat/Bot.hs`) is shared by four callers (this service, the directory service, the broadcast bot, `bot-advanced`) and returns nothing; changing its signature to hand back the resolved link would touch all four for a need only this step has. `badgePostStartHook` instead calls `sendChatCmd cc ShowMyAddress` again immediately after, which is cheap (a local store read, no network) and already proven safe by the existing two-phase test harness relying on the same command.
+- **B9 — `writeAddressFile`'s three deliberate failure modes.** No address-file pattern existed anywhere in the repo to copy (the step's own **Do** section says so), so these were decided here, not inherited: (1) an unwritable path (including a parent directory that does not exist — nothing here creates one) is logged as an error and does **not** stop the service, since `initializeBotAddress'` already put the same address on stdout and nothing about serving RPC requests depends on this file; (2) same as (1) — a missing parent directory is treated as any other write failure, not auto-created, since silently creating directories from an operator-supplied config path is more surprising than helpful for a deployment file; (3) a file that already holds a *different* address is always overwritten (logging a warning first) rather than left alone, so an operator who restarts the service can never be looking at a stale address — the file is unconditionally rewritten with whatever `ShowMyAddress` reports on every start where `address_file` is configured.
 
 ## 10. End-to-end verification
 

tests/Bots/BadgeServiceTests.hs

@@ -51,6 +51,7 @@ import Data.Maybe (fromJust, isJust)
 import Data.String (fromString)
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
 import Data.Time.Calendar (fromGregorian)
 import Data.Time.Calendar.WeekDate (toWeekDate)
 import Data.Time.Clock (DiffTime, UTCTime (..), addUTCTime, diffUTCTime, getCurrentTime, nominalDay, secondsToDiffTime)
@@ -148,6 +149,7 @@ badgeServiceTests = do
   it "should fail to start when a provider is configured without [web]" testBadgeServiceConfigProviderRequiresWeb
   it "should start with just [issuer] and [codes], no provider section" testBadgeServiceConfigMinimalStarts
   it "should start the service from a complete config with web and both providers" testBadgeServiceCompleteConfigStarts
+  it "should publish the same address to address_file across two starts, matching the client's address" testBadgeServicePublishesAddressFile
   it "should omit a disabled price and its offers from getBadgeCatalog, and keep a deprecated one" testBadgeServiceGetCatalogDisabledDeprecated
   it "should respond unknown_purchase_key to a signed getBadgeCatalog from an unknown key" testBadgeServiceGetCatalogUnknownSignerKey
   it "should heal the ledger on a signed getBadgeCatalog, appending exactly one debit(lapse), and heal nothing on a repeat" testBadgeServiceGetCatalogHealsLedger
@@ -849,6 +851,42 @@ testBadgeServiceCompleteConfigStarts ps@TestParams {tmpPath} =
                  "webhook_secret_file = " <> stripeWebhookFile
                ]
 
+-- B9 service address publication -----------------------------------------------------------
+
+-- Proves both facts the brief's manual Verify line asks for: 'address_file' holds the SAME
+-- address after the first start (before 'betweenPhases') as after the second, and that address
+-- -- read straight out of the file, not from 'bsLink' -- is one a client's @/c@ accepts (sends a
+-- connection request for, rather than rejecting as malformed). The badge service disables
+-- auto-accept ('badgePostStartHook' passes 'False' to 'initializeBotAddress''), so "connection
+-- request sent!" is as far as this goes and is the right stopping point -- 'BroadcastTests.hs'
+-- (an auto-accepting bot) is the pattern this borrows the client side of.
+--
+-- Read strictly: Prelude's lazy 'readFile' would leave 'addressFile' open (a thunk holding the
+-- handle) across 'betweenPhases' into the second start, and the second start's own write --
+-- exclusive against any still-open handle, even a reader's -- would then fail with "resource
+-- busy (file is locked)".
+testBadgeServicePublishesAddressFile :: HasCallStack => TestParams -> IO ()
+testBadgeServicePublishesAddressFile ps@TestParams {tmpPath} = do
+  let addressFile = tmpPath </> "bot_address.txt"
+      writeConfig = do
+        (issuerKeyFile, codeSecretFile) <- writeTestBadgeServiceSecrets tmpPath
+        writeFile (badgeServiceConfigPath tmpPath) $
+          unlines $
+            issuerCodesIniLines issuerKeyFile codeSecretFile
+              ++ ["", "[service]", "address_file = " <> addressFile]
+  firstContentsRef <- newIORef T.empty
+  withBadgeServiceConfig
+    ps
+    writeConfig
+    (TIO.readFile addressFile >>= writeIORef firstContentsRef)
+    $ \client bsLink -> do
+      firstContents <- readIORef firstContentsRef
+      secondContents <- TIO.readFile addressFile
+      firstContents `shouldBe` secondContents
+      T.strip secondContents `shouldBe` T.pack bsLink
+      client ##> ("/c " <> T.unpack (T.strip secondContents))
+      client <## "connection request sent!"
+
 -- B6 getBadgeCatalog -----------------------------------------------------------
 
 -- A disabled price (and every offer pinned to it) must be absent from the RPC catalog, while