wip

tests/Bots/BadgeServiceTests.hs

@@ -11,6 +11,7 @@ import ChatTests.DBUtils
 import ChatTests.Utils
 import Control.Concurrent (forkIO, killThread, threadDelay)
 import Control.Exception (finally)
+import Data.List (isInfixOf)
 import Simplex.Chat.Controller (ChatConfig)
 import Simplex.Chat.Options (CoreChatOpts (..))
 import Simplex.Chat.Options.DB
@@ -20,6 +21,7 @@ import Test.Hspec hiding (it)
 
 badgeServiceTests :: SpecWith TestParams
 badgeServiceTests = do
+  it "creates a DR address when none exists" testBadgeServiceCreatesDRAddress
   it "should respond with unsupported_version to redeem" testBadgeServiceRedeemUnsupported
 
 badgeProfile :: Profile
@@ -66,10 +68,36 @@ runBadgeService cfg opts action = do
   threadDelay 500000
   action `finally` killThread t
 
+-- Exercises the address-creation branch of initializeBotAddress' that withBadgeService bypasses
+-- (it pre-creates the address to keep the RPC round-trip focused). This is the only test that
+-- covers what a fresh deployment produces.
+--
+-- Assertion is on the full link's "rk=" query parameter: simplexmq
+-- Simplex/Messaging/Agent/Protocol.hs:1174 appends "rk=" only when the ratchet keys are Just,
+-- so its presence proves the address is double-ratchet. A non-DR address would still parse and
+-- look valid, but every service request to it would fail with ASENotDRAddress (Agent.hs:1739).
+testBadgeServiceCreatesDRAddress :: HasCallStack => TestParams -> IO ()
+testBadgeServiceCreatesDRAddress ps = do
+  withNewTestChatCfg ps testCfg serviceDbPrefix badgeProfile $ \_bs -> pure ()
+  let opts = mkBadgeServiceOpts ps
+  runBadgeService testCfg opts (pure ())
+  withTestChat ps serviceDbPrefix $ \bs -> do
+    bs <## "subscribed 1 connections on server localhost"
+    bs ##> "/sa"
+    (_, fullLink) <- getContactLinks bs False
+    bs <## "auto_accept off"
+    ("rk=" `isInfixOf` fullLink) `shouldBe` True
+
 testBadgeServiceRedeemUnsupported :: HasCallStack => TestParams -> IO ()
 testBadgeServiceRedeemUnsupported ps =
   withBadgeService ps $ \client bsLink -> do
     let redeemReq =
           "{\"version\":1,\"request\":{\"type\":\"purchaseBadge\",\"payment\":{\"type\":\"code\",\"code\":\"TEST-CODE\"}}}"
     client ##> ("/_service_request 1 " <> bsLink <> " " <> redeemReq)
+    -- The exact serialized string is deterministic today: the aeson fork's KeyMap is Map-backed
+    -- with flag `ordered-keymap` defaulted to True (aeson.cabal:52; KeyMap.hs:143), so keys sort
+    -- alphabetically. If the future typed handler switches to deriveJSON/enumJSON on the
+    -- response, the encoder will emit declaration order and this assertion will need to be
+    -- updated (and BadgeServiceErrorCode's snake_case ToJSON in src/Simplex/Chat/Badges/Service.hs
+    -- - which this test transitively depends on - reviewed at the same time).
     client <## "service response: {\"code\":\"unsupported_version\",\"type\":\"error\"}"