From 0335c3903a9dd1d2e02e6a5c10ad45388be68344 Mon Sep 17 00:00:00 2001 From: shum Date: Sat, 22 Aug 2026 12:58:56 +0000 Subject: [PATCH] core: badge service web order schema --- .../BadgeService/Store/Postgres/Migrations.hs | 76 ++++++++++++++++++- .../BadgeService/Store/SQLite/Migrations.hs | 76 ++++++++++++++++++- plans/2026-08-21-badges-web-checkout.md | 2 +- tests/Bots/BadgeServiceTests.hs | 57 +++++++++++++- 4 files changed, 207 insertions(+), 4 deletions(-) diff --git a/apps/simplex-badge-service/src/BadgeService/Store/Postgres/Migrations.hs b/apps/simplex-badge-service/src/BadgeService/Store/Postgres/Migrations.hs index 04b7674cec..e96665bf96 100644 --- a/apps/simplex-badge-service/src/BadgeService/Store/Postgres/Migrations.hs +++ b/apps/simplex-badge-service/src/BadgeService/Store/Postgres/Migrations.hs @@ -17,7 +17,8 @@ badgeServiceSchemaMigrations = sortOn name $ map migration schemaMigrations schemaMigrations :: [(String, Text, Maybe Text)] schemaMigrations = - [ ("20260806_badge_service_schema", m20260806_badge_service_schema, Just down_m20260806_badge_service_schema) + [ ("20260806_badge_service_schema", m20260806_badge_service_schema, Just down_m20260806_badge_service_schema), + ("20260821_badge_service_web", m20260821_badge_service_web, Just down_m20260821_badge_service_web) ] -- the client tables are in the same database, so the service tables are the same names with this prefix @@ -35,3 +36,76 @@ ALTER TABLE @payments ADD COLUMN receipt_hash BYTEA; down_m20260806_badge_service_schema :: Text down_m20260806_badge_service_schema = badgeSchemaDown servicePrefix + +m20260821_badge_service_web :: Text +m20260821_badge_service_web = + withPrefix + servicePrefix + [r| +CREATE TABLE @web_orders( + order_id TEXT NOT NULL PRIMARY KEY, -- 128-bit random, base64url; a bearer capability, see E4 + invoice_id TEXT REFERENCES @invoices, -- money side reuses the existing invoices table + -- provider invoice / session / payment-intent id; order-side only, never a code or purchase + -- reference. Unique across providers: a collision must fail loudly rather than resolve a + -- charge to the wrong order. + provider_ref TEXT, + method TEXT NOT NULL CHECK (method IN ('card','btc','xmr')), + short_ref TEXT NOT NULL, -- 5 Crockford chars, generated per order (D6); the reference + -- support resolves by, shown on card statements (F1) and on + -- the crypto payment and result screens (E5, E6) + badge_type TEXT NOT NULL CHECK (badge_type IN ('supporter','legend')), + price_id TEXT REFERENCES @badge_prices, + offer_id TEXT REFERENCES @badge_offers, + months SMALLINT NOT NULL, + -- invoiced (created, unpaid) -> pending (partial or unconfirmed) -> paid (terminal). + -- invoiced|pending -> expired|failed; both remain recoverable to paid (E3). + status TEXT NOT NULL CHECK (status IN ('invoiced','pending','paid','expired','failed')), + -- amount received, in minor units of the invoice currency, at the rate the provider locked + amount_paid BIGINT, + settled_at TIMESTAMPTZ, + created_at TIMESTAMPTZ NOT NULL, + updated_at TIMESTAMPTZ NOT NULL +); + +CREATE INDEX @idx_web_orders_invoice ON @web_orders(invoice_id); + +CREATE UNIQUE INDEX @idx_web_orders_provider_ref ON @web_orders(provider_ref); + +CREATE UNIQUE INDEX @idx_web_orders_short_ref ON @web_orders(short_ref); + +-- No order reference, and no code_hash on @web_orders: no row may hold both an order +-- reference and a purchase reference (§3 Linkage). An order's code row is found by +-- deriving the code from orderId and hashing it. +CREATE TABLE @codes( + code_hash BYTEA NOT NULL PRIMARY KEY, + badge_type TEXT NOT NULL CHECK (badge_type IN ('supporter','legend')), + months SMALLINT NOT NULL CHECK (months > 0), -- lifetime codes are out of scope, see §6 + batch TEXT NOT NULL, -- 'web' for web orders, else an operator batch name + expires_at TIMESTAMPTZ NOT NULL, -- redemption deadline -> code_expired + redeemed_purchase_id BIGINT REFERENCES @badge_purchases, + redeemed_at TIMESTAMPTZ, + unredeemed_at TIMESTAMPTZ, -- set by B1's unredeemCode; reopens E4's window + revoked_at TIMESTAMPTZ, + created_at TIMESTAMPTZ NOT NULL +); + +CREATE INDEX @idx_codes_batch ON @codes(batch); + +CREATE TABLE @provider_events( + provider TEXT NOT NULL, + event_id TEXT NOT NULL, + received_at TIMESTAMPTZ NOT NULL, + processed_at TIMESTAMPTZ, -- NULL means the previous attempt did not complete (E3) + PRIMARY KEY(provider, event_id) +); +|] + +down_m20260821_badge_service_web :: Text +down_m20260821_badge_service_web = + withPrefix + servicePrefix + [r| +DROP TABLE @provider_events; +DROP TABLE @codes; +DROP TABLE @web_orders; +|] diff --git a/apps/simplex-badge-service/src/BadgeService/Store/SQLite/Migrations.hs b/apps/simplex-badge-service/src/BadgeService/Store/SQLite/Migrations.hs index b0974f177d..c8f6b5939f 100644 --- a/apps/simplex-badge-service/src/BadgeService/Store/SQLite/Migrations.hs +++ b/apps/simplex-badge-service/src/BadgeService/Store/SQLite/Migrations.hs @@ -18,7 +18,8 @@ badgeServiceSchemaMigrations = sortOn name $ map migration schemaMigrations schemaMigrations :: [(String, Query, Maybe Query)] schemaMigrations = - [ ("20260806_badge_service_schema", m20260806_badge_service_schema, Just down_m20260806_badge_service_schema) + [ ("20260806_badge_service_schema", m20260806_badge_service_schema, Just down_m20260806_badge_service_schema), + ("20260821_badge_service_web", m20260821_badge_service_web, Just down_m20260821_badge_service_web) ] -- the client tables are in the same database, so the service tables are the same names with this prefix @@ -36,3 +37,76 @@ ALTER TABLE @payments ADD COLUMN receipt_hash BLOB; down_m20260806_badge_service_schema :: Query down_m20260806_badge_service_schema = badgeSchemaDown servicePrefix + +m20260821_badge_service_web :: Query +m20260821_badge_service_web = + withPrefix + servicePrefix + [sql| +CREATE TABLE @web_orders( + order_id TEXT NOT NULL PRIMARY KEY, -- 128-bit random, base64url; a bearer capability, see E4 + invoice_id TEXT REFERENCES @invoices, -- money side reuses the existing invoices table + -- provider invoice / session / payment-intent id; order-side only, never a code or purchase + -- reference. Unique across providers: a collision must fail loudly rather than resolve a + -- charge to the wrong order. + provider_ref TEXT, + method TEXT NOT NULL CHECK (method IN ('card','btc','xmr')), + short_ref TEXT NOT NULL, -- 5 Crockford chars, generated per order (D6); the reference + -- support resolves by, shown on card statements (F1) and on + -- the crypto payment and result screens (E5, E6) + badge_type TEXT NOT NULL CHECK (badge_type IN ('supporter','legend')), + price_id TEXT REFERENCES @badge_prices, + offer_id TEXT REFERENCES @badge_offers, + months INTEGER NOT NULL, + -- invoiced (created, unpaid) -> pending (partial or unconfirmed) -> paid (terminal). + -- invoiced|pending -> expired|failed; both remain recoverable to paid (E3). + status TEXT NOT NULL CHECK (status IN ('invoiced','pending','paid','expired','failed')), + -- amount received, in minor units of the invoice currency, at the rate the provider locked + amount_paid INTEGER, + settled_at TEXT, + created_at TEXT NOT NULL, + updated_at TEXT NOT NULL +) STRICT; + +CREATE INDEX @idx_web_orders_invoice ON @web_orders(invoice_id); + +CREATE UNIQUE INDEX @idx_web_orders_provider_ref ON @web_orders(provider_ref); + +CREATE UNIQUE INDEX @idx_web_orders_short_ref ON @web_orders(short_ref); + +-- No order reference, and no code_hash on @web_orders: no row may hold both an order +-- reference and a purchase reference (§3 Linkage). An order's code row is found by +-- deriving the code from orderId and hashing it. +CREATE TABLE @codes( + code_hash BLOB NOT NULL PRIMARY KEY, + badge_type TEXT NOT NULL CHECK (badge_type IN ('supporter','legend')), + months INTEGER NOT NULL CHECK (months > 0), -- lifetime codes are out of scope, see §6 + batch TEXT NOT NULL, -- 'web' for web orders, else an operator batch name + expires_at TEXT NOT NULL, -- redemption deadline -> code_expired + redeemed_purchase_id INTEGER REFERENCES @badge_purchases, + redeemed_at TEXT, + unredeemed_at TEXT, -- set by B1's unredeemCode; reopens E4's window + revoked_at TEXT, + created_at TEXT NOT NULL +) STRICT; + +CREATE INDEX @idx_codes_batch ON @codes(batch); + +CREATE TABLE @provider_events( + provider TEXT NOT NULL, + event_id TEXT NOT NULL, + received_at TEXT NOT NULL, + processed_at TEXT, -- NULL means the previous attempt did not complete (E3) + PRIMARY KEY(provider, event_id) +) STRICT; +|] + +down_m20260821_badge_service_web :: Query +down_m20260821_badge_service_web = + withPrefix + servicePrefix + [sql| +DROP TABLE @provider_events; +DROP TABLE @codes; +DROP TABLE @web_orders; +|] diff --git a/plans/2026-08-21-badges-web-checkout.md b/plans/2026-08-21-badges-web-checkout.md index f5e39b0db2..8420c0cda1 100644 --- a/plans/2026-08-21-badges-web-checkout.md +++ b/plans/2026-08-21-badges-web-checkout.md @@ -129,7 +129,7 @@ The two `-m` filters are needed because the badge tests live under two hspec pat |---|---|---|---| | A1 | Register the client badge migration, add `STRICT` | — | ☑ | | A2 | JSON instances for badge protocol types, and the offer `total` | — | ☑ | -| A3 | Service schema: `web_orders`, `codes`, `provider_events` | — | ☐ | +| A3 | Service schema: `web_orders`, `codes`, `provider_events` | — | ☑ | | A4 | `Catalog.hs`: internal pricing, totals, seeding | A2, A5 | ☐ | | A5 | Cabal dependencies for the service | — | ☐ | | A6 | `badge_service.ini`: configuration file | A3, A4, A5 | ☐ | diff --git a/tests/Bots/BadgeServiceTests.hs b/tests/Bots/BadgeServiceTests.hs index 896c603d7f..69ecae717b 100644 --- a/tests/Bots/BadgeServiceTests.hs +++ b/tests/Bots/BadgeServiceTests.hs @@ -10,17 +10,34 @@ import ChatClient import ChatTests.DBUtils import ChatTests.Utils import Control.Concurrent (forkIO, killThread, threadDelay) -import Control.Exception (finally) +import Control.Exception (SomeException, finally, try) +import Data.List (find) +import Data.Maybe (fromJust) +import Data.String (fromString) import Simplex.Chat.Controller (ChatConfig) import Simplex.Chat.Options (CoreChatOpts (..)) import Simplex.Chat.Options.DB import Simplex.Chat.Types (ChatPeerType (..), Profile (..)) +import Simplex.Messaging.Agent.Store.Common (DBStore, withConnection) +import qualified Simplex.Messaging.Agent.Store.DB as DB +import Simplex.Messaging.Agent.Store.Interface (closeDBStore, createDBStore) +import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration) import System.FilePath (()) import Test.Hspec hiding (it) +#if defined(dbPostgres) +import BadgeService.Store.Postgres.Migrations (badgeServiceSchemaMigrations) +import Database.PostgreSQL.Simple (Only (..)) +import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations +#else +import BadgeService.Store.SQLite.Migrations (badgeServiceSchemaMigrations) +import Database.SQLite.Simple (Only (..)) +import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations +#endif badgeServiceTests :: SpecWith TestParams badgeServiceTests = do it "should respond with unsupported_version to redeem" testBadgeServiceRedeemUnsupported + it "should migrate web_orders, codes and provider_events up and down" testBadgeServiceWebOrderSchemaMigration badgeProfile :: Profile badgeProfile = Profile {displayName = "SimpleX Badges", fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing, badge = Nothing, contactDomain = Nothing} @@ -79,3 +96,41 @@ testBadgeServiceRedeemUnsupported ps = "{\"version\":1,\"request\":{\"type\":\"purchaseBadge\",\"payment\":{\"type\":\"code\",\"code\":\"TEST-CODE\"}}}" client ##> ("/_service_request 1 " <> bsLink <> " " <> redeemReq) client <## "service response: {\"code\":\"unsupported_version\",\"type\":\"error\"}" + +-- Applies every migration except 20260821_badge_service_web, then exercises that one +-- migration's up/down/up cycle directly, checking the three new tables appear and +-- disappear as expected. +testBadgeServiceWebOrderSchemaMigration :: HasCallStack => TestParams -> IO () +testBadgeServiceWebOrderSchemaMigration ps = do + let dbOpts = toDBOpts (dbOptions $ coreOptions $ mkBadgeServiceOpts ps) chatSuffix False chatDBFunctions + priorMigrations = filter ((/= migrationName) . name) badgeServiceSchemaMigrations + webOrderMigration = fromJust $ find ((== migrationName) . name) badgeServiceSchemaMigrations + downMigration = fromJust $ toDownMigration webOrderMigration + Right st <- createDBStore dbOpts priorMigrations (MigrationConfig MCError Nothing) + mapM_ (assertTableMissing st) newTables + runMigrationsToRun st $ MTRUp [webOrderMigration] + mapM_ (assertTableExists st) newTables + runMigrationsToRun st $ MTRDown [downMigration] + mapM_ (assertTableMissing st) newTables + runMigrationsToRun st $ MTRUp [webOrderMigration] + mapM_ (assertTableExists st) newTables + closeDBStore st + where + migrationName = "20260821_badge_service_web" + newTables = ["sx_badge_service_web_orders", "sx_badge_service_codes", "sx_badge_service_provider_events"] + assertTableExists st tbl = + withConnection st (\db -> DB.query_ db (tableCountQuery tbl)) `shouldReturn` [Only (0 :: Int)] + assertTableMissing st tbl = do + r <- try (withConnection st (\db -> DB.query_ db (tableCountQuery tbl))) :: IO (Either SomeException [Only Int]) + case r of + Left _ -> pure () + Right rows -> expectationFailure $ tbl <> " should not exist after down migration, got: " <> show rows + tableCountQuery tbl = fromString ("SELECT count(*) FROM " <> tbl) + +#if defined(dbPostgres) +runMigrationsToRun :: DBStore -> MigrationsToRun -> IO () +runMigrationsToRun st = Migrations.run st Nothing +#else +runMigrationsToRun :: DBStore -> MigrationsToRun -> IO () +runMigrationsToRun st = Migrations.run st Nothing True +#endif