badges: rework tracker and reply texts

apps/simplex-badge-service/README.md

@@ -255,7 +255,8 @@ and above, `/revoke <code>` for admins and owners. `months` is 1 to 255, `uses`
 `count` 1 to 100; a value outside these gets the usage reply. A member's role is checked as the
 service last saw it, so a command sent by a moderator just demoted or removed can still run if it
 reaches the service first; revoke any code the service posts for them after the change. `uses`
-above 1 makes a multi-use code, tracked by a group message counting what is left of it. Every reply carrying a code is read by every member,
+above 1 makes a multi-use code, tracked by a group message showing its remaining uses and the time
+of the last one; when every use is redeemed, the same message says so. Every reply carrying a code is read by every member,
 since the group has no private lane, so a code issued there is only as private as its least trusted
 member.
 Those replies are also kept as plain text in the service's chat database, so a copy of the database
@@ -265,9 +266,9 @@ carries the code, and every redemption edits it or, after a day, posts it again;
 current member receives it, so a member who joined after the code was issued gets the code while it
 still has uses left. A message replaced by a new post stays in the group with its old count. Keep
 disappearing messages off in the group and set no message TTL for the service's chats: a code's
-message that expires is treated as deleted and never posted again, so its counter and its "fully
-redeemed" notice stop.
-Every member can see when a multi-use code's message was edited, which is when each use was redeemed.
+message that expires is treated as deleted and never posted again, so its counter stops.
+Every member can see when each use of a multi-use code was redeemed: the message shows the time of
+the last one, and its edit times show the rest.
 `/revoke <code>` names the code in an ordinary group message, so every member holds it before the
 service reads the command, and the code stays redeemable until the service acts on it — for the
 whole of any downtime. Revoke a code that is not already public in the group, a refunded one above

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

@@ -30,7 +30,7 @@ revokeBadgeCode cc code = do
 
 -- | The group is joined through a bearer link, so this reply names no database error.
 issueFailedText :: Text
-issueFailedText = "issuing the code failed"
+issueFailedText = "The code could not be issued."
 
 -- | The code table keeps only the hash, so the caller must deliver the code.
 issueOneCode :: ChatController -> BadgeType -> Int -> BadgeCodePaymentStatus -> Int -> IO (Either String (BadgeCode, Int64))

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

@@ -31,7 +31,7 @@ import BadgeService.Log (logError, logInfo, logWarn)
 import BadgeService.Store (CodeTracker (..), ManagedGroup (..), RevokeResult (..), clearCodeGroupItems, getCodeTracker, getEditableTrackers, getManagedGroup, insertManagedGroup, markOwnerBootstrapped, setCodeGroupItem)
 import BadgeService.Store.Invoices (truncateToSecond)
 import Control.Concurrent.STM (TQueue, atomically, flushTQueue, readTQueue, readTVarIO, writeTQueue)
-import Control.Monad (forM_, forever, mfilter, replicateM, unless, void, when)
+import Control.Monad (forM_, forever, mfilter, replicateM, unless, void)
 import Control.Monad.Except (runExceptT)
 import Data.Either (partitionEithers)
 import Data.Functor (($>), (<&>))
@@ -40,6 +40,7 @@ import Data.List (sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
+import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime, nominalDay)
@@ -161,10 +162,9 @@ groupLinkText (CCLink cReq sLnk_) = maybe (strEncodeTxt (simplexChatContact cReq
 strEncodeTxt :: StrEncoding a => a -> Text
 strEncodeTxt = safeDecodeUtf8 . strEncode
 
--- GETracker carries the redeem count its claim reached.
 data GroupEvent
   = GEInGroup GroupId GroupAction
-  | GETracker Int64 BadgeCode Int
+  | GETracker Int64 BadgeCode
   deriving (Eq, Show)
 
 data GroupAction
@@ -181,16 +181,15 @@ groupEvent = \case
     | isNothing scope && isNothing itemDeleted && itemLive /= Just True -> Just $ GEInGroup groupId (GACommand (memberRole' m) t)
   _ -> Nothing
 
+-- A refresh reads the code's count when it runs, so the last one queued shows every claim before it.
 coalesceTrackerRefreshes :: [GroupEvent] -> [GroupEvent]
-coalesceTrackerRefreshes evs = snd $ foldr keepOne (highestClaims, []) evs
+coalesceTrackerRefreshes = snd . foldr keepLast (S.empty, [])
   where
-    -- The highest claim decides the exhaustion notice, whatever order the claims were queued in.
-    highestClaims = M.fromListWith max [(badgeCodeId, n) | GETracker badgeCodeId _ n <- evs]
-    keepOne ev (todo, kept) = case ev of
-      GETracker badgeCodeId code _ -> case M.lookup badgeCodeId todo of
-        Just n -> (M.delete badgeCodeId todo, GETracker badgeCodeId code n : kept)
-        Nothing -> (todo, kept)
-      _ -> (todo, ev : kept)
+    keepLast ev (seen, kept) = case ev of
+      GETracker badgeCodeId _
+        | badgeCodeId `S.member` seen -> (seen, kept)
+        | otherwise -> (S.insert badgeCodeId seen, ev : kept)
+      _ -> (seen, ev : kept)
 
 logUncaught :: HasCallStack => IO () -> IO ()
 logUncaught a = a `catchOwn'` withFrozenCallStack (logError . tshow)
@@ -207,7 +206,7 @@ handleGroupEvent cc groupId ev = logUncaught (handle ev)
               RunCmd cmd -> runGroupCmd cc groupId cmd
               ReplyText txt -> void $ sendGroupText cc groupId "command reply" txt
               IgnoreMsg -> pure ()
-      GETracker badgeCodeId code claimedCount -> updateTracker cc groupId badgeCodeId code claimedCount
+      GETracker badgeCodeId code -> updateTracker cc groupId badgeCodeId code
 
 promoteFirstOwner :: ChatController -> GroupInfo -> GroupMember -> IO ()
 promoteFirstOwner cc g@GroupInfo {groupId} member =
@@ -262,7 +261,7 @@ runGroupCmd cc groupId = \case
     issueOneCode cc bt months CPSFree uses >>= \case
       Left _ -> reply issueFailedText
       Right (code, badgeCodeId)
-        | not (hasTracker uses) -> reply ("code " <> formatBadgeCode code)
+        | not (hasTracker uses) -> reply ("Code: " <> formatBadgeCode code)
         | otherwise -> do
             now <- truncateToSecond <$> getCurrentTime
             sendGroupText cc groupId ("tracker, code " <> tshow badgeCodeId <> " is lost") (initialTrackerBody code uses)
@@ -273,7 +272,7 @@ runGroupCmd cc groupId = \case
         issued = map (formatBadgeCode . fst) ok
     reply . T.intercalate "\n" $ case errs of
       [] -> issued
-      _ : _ -> issued <> ["issued " <> tshow (length issued) <> " of " <> tshow count <> ", the rest failed"]
+      _ : _ -> issued <> ["Issued " <> tshow (length issued) <> " of " <> tshow count <> " codes. The remaining codes could not be issued."]
   -- Naming the code tells concurrent revokes apart; the command already made it public.
   GCRevoke code -> do
     outcome <- either id id <$> revokeWithTracker cc code
@@ -292,20 +291,19 @@ initialTrackerBody :: BadgeCode -> Int -> Text
 initialTrackerBody code total = trackerBody code total total Nothing
 
 -- The body is dated by the last redemption, not now, because reconcile rewrites it after a restart.
+-- The code is green only while it can still be redeemed.
 trackerBody :: BadgeCode -> Int -> Int -> Maybe UTCTime -> Text
-trackerBody code remaining total redeemedAt =
-  "!2 " <> formatBadgeCode code <> "!\n" <> maybe "" lastRedeemed redeemedAt <> tshow remaining <> "/" <> tshow total <> " remaining"
+trackerBody code remaining total redeemedAt
+  | remaining > 0 = "!2 " <> formatBadgeCode code <> "!\n" <> tshow remaining <> " of " <> tshow total <> " uses remaining" <> lastUsed
+  | otherwise = formatBadgeCode code <> "\nAll " <> tshow total <> " uses redeemed" <> lastUsed
   where
-    lastRedeemed ts = "Last redeemed: " <> fmtDay ts <> " — "
-
-exhaustedBody :: BadgeCode -> Int -> Text
-exhaustedBody code total = formatBadgeCode code <> " fully redeemed — all " <> tshow total <> " used"
+    lastUsed = maybe "" ((", last used " <>) . fmtTime) redeemedAt
 
 revokedBody :: BadgeCode -> Text
-revokedBody code = formatBadgeCode code <> " revoked — no longer redeemable"
+revokedBody code = formatBadgeCode code <> "\nRevoked, can no longer be redeemed"
 
-fmtDay :: UTCTime -> Text
-fmtDay = T.pack . formatTime defaultTimeLocale "%Y-%m-%d"
+fmtTime :: UTCTime -> Text
+fmtTime = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC"
 
 data TrackerAction = Edit | Repost
   deriving (Eq, Show)
@@ -323,45 +321,34 @@ trackerDecision now sentAt
 data RepostPolicy = MayRepost | EditOnly
 
 -- A deleted or moderated tracker is not reposted, because deleting it does not revoke the code.
--- With MayRepost the result is Nothing when there is nothing to write or the message is gone, so no notice follows.
-setTrackerBody :: ChatController -> GroupId -> Int64 -> RepostPolicy -> (CodeTracker -> Maybe Text) -> IO (Maybe CodeTracker)
+setTrackerBody :: ChatController -> GroupId -> Int64 -> RepostPolicy -> (CodeTracker -> Maybe Text) -> IO ()
 setTrackerBody cc groupId badgeCodeId policy mkBody =
   withDB' "getCodeTracker" cc (`getCodeTracker` badgeCodeId) >>= \case
     Right (Just tracker@CodeTracker {trackerItemId, trackerSentAt}) ->
-      pure (mkBody tracker) $>>= \body -> do
+      forM_ (mkBody tracker) $ \body -> do
         now <- truncateToSecond <$> getCurrentTime
-        let handled = pure (Just tracker)
-            repost =
+        let repost =
               trackerItemText cc groupId trackerItemId >>= \case
-                Nothing -> do
-                  logWarn $ "badge group tracker not reposted, code " <> tshow badgeCodeId <> " is no longer published"
-                  pure Nothing
+                Nothing -> logWarn $ "badge group tracker not reposted, code " <> tshow badgeCodeId <> " is no longer published"
                 -- Past the window every write reposts, so an unchanged body is not posted again.
-                Just current
-                  | current == body -> handled
-                  | otherwise -> do
-                      sendGroupText cc groupId ("tracker repost, code " <> tshow badgeCodeId <> " keeps its old message") body
-                        >>= mapM_ (\i -> withDB' "setCodeGroupItem" cc (\db -> setCodeGroupItem db badgeCodeId i now))
-                      handled
+                Just current ->
+                  unless (current == body) $
+                    sendGroupText cc groupId ("tracker repost, code " <> tshow badgeCodeId <> " keeps its old message") body
+                      >>= mapM_ (\i -> withDB' "setCodeGroupItem" cc (\db -> setCodeGroupItem db badgeCodeId i now))
             -- The core can also refuse an edit inside the window, because it uses the message's own timestamp.
             uneditable = case policy of
               MayRepost -> repost
-              EditOnly -> do
-                logWarn $ "badge group tracker left uncorrected, code " <> tshow badgeCodeId <> " can no longer be edited"
-                handled
+              EditOnly -> logWarn $ "badge group tracker left uncorrected, code " <> tshow badgeCodeId <> " can no longer be edited"
         case trackerDecision now trackerSentAt of
           Edit ->
             sendChatCmd cc (APIUpdateChatItem (ChatRef CTGroup groupId Nothing) trackerItemId False (UpdatedMessage (MCText body) M.empty)) >>= \case
-              Right CRChatItemUpdated {} -> handled
-              Right CRChatItemNotChanged {} -> handled
+              Right CRChatItemUpdated {} -> pure ()
+              Right CRChatItemNotChanged {} -> pure ()
               Left (ChatError CEInvalidChatItemUpdate) -> uneditable
               -- Any other failure may still have applied the edit, so a repost could publish the code twice.
-              -- The notice still follows the claim while the tracker is published.
-              r -> do
-                logError $ "badge group tracker not updated, code " <> tshow badgeCodeId <> ": " <> tshow r
-                ($> tracker) <$> trackerItemText cc groupId trackerItemId
+              r -> logError $ "badge group tracker not updated, code " <> tshow badgeCodeId <> ": " <> tshow r
           Repost -> uneditable
-    _ -> pure Nothing
+    _ -> pure ()
 
 -- A revoke and a redemption can arrive in either order, so a revoked tracker is left alone.
 counterBody :: BadgeCode -> CodeTracker -> Maybe Text
@@ -374,33 +361,28 @@ hasTracker redeemLimit = redeemLimit > singleUse
 
 -- The tracker edit reaches every member, so the group lane runs it off the request path.
 -- Without a lane (--run-cli, or no [group]) it runs here, before the response.
-refreshTracker :: ChatController -> Maybe (TQueue GroupEvent) -> Int64 -> BadgeCode -> Int -> IO ()
-refreshTracker cc trackerQ_ badgeCodeId code claimedCount = case trackerQ_ of
-  Just q -> atomically $ writeTQueue q (GETracker badgeCodeId code claimedCount)
-  Nothing -> logUncaught $ withManagedGroup cc $ \groupId -> updateTracker cc groupId badgeCodeId code claimedCount
+refreshTracker :: ChatController -> Maybe (TQueue GroupEvent) -> Int64 -> BadgeCode -> IO ()
+refreshTracker cc trackerQ_ badgeCodeId code = case trackerQ_ of
+  Just q -> atomically $ writeTQueue q (GETracker badgeCodeId code)
+  Nothing -> logUncaught $ withManagedGroup cc $ \groupId -> updateTracker cc groupId badgeCodeId code
 
--- The notice follows the claim, not the count read now, so queued refreshes post it once.
-updateTracker :: ChatController -> GroupId -> Int64 -> BadgeCode -> Int -> IO ()
-updateTracker cc groupId badgeCodeId code claimedCount =
-  setTrackerBody cc groupId badgeCodeId MayRepost (counterBody code)
-    >>= mapM_ (\CodeTracker {redeemLimit} -> when (claimedCount == redeemLimit) $ postNotice redeemLimit)
-  where
-    postNotice redeemLimit = void $ sendGroupText cc groupId ("notice, code " <> tshow badgeCodeId) (exhaustedBody code redeemLimit)
+updateTracker :: ChatController -> GroupId -> Int64 -> BadgeCode -> IO ()
+updateTracker cc groupId badgeCodeId code = setTrackerBody cc groupId badgeCodeId MayRepost (counterBody code)
 
 -- | Left is a refusal or a failure; both sides are the text to show whoever sent the revoke.
 revokeWithTracker :: ChatController -> BadgeCode -> IO (Either Text Text)
 revokeWithTracker cc code =
   revokeBadgeCode cc code >>= \case
-    -- The message is retired before the answer, so "revoked" never sits beside a live counter.
-    Right (Revoked badgeCodeId) -> Right "revoked" <$ retire badgeCodeId
+    -- The message is retired before the answer, so the answer never sits beside a live counter.
+    Right (Revoked badgeCodeId) -> Right "Revoked." <$ retire badgeCodeId
     -- A repeated revoke repairs a message that an earlier revoke failed to update.
-    Right (AlreadyRevoked badgeCodeId) -> Right "already revoked" <$ retire badgeCodeId
-    Right AlreadyRedeemed -> pure $ Left "code was redeemed already, so it cannot be revoked"
-    Right NoSuchCode -> pure $ Left "no such code"
-    Left _ -> pure $ Left "revoking the code failed"
+    Right (AlreadyRevoked badgeCodeId) -> Right "Already revoked." <$ retire badgeCodeId
+    Right AlreadyRedeemed -> pure $ Left "Fully redeemed. It cannot be revoked."
+    Right NoSuchCode -> pure $ Left "No such code."
+    Left _ -> pure $ Left "The code could not be revoked."
   where
     retire badgeCodeId = logUncaught $ withManagedGroup cc $ \groupId ->
-      void $ setTrackerBody cc groupId badgeCodeId MayRepost (const $ Just $ revokedBody code)
+      setTrackerBody cc groupId badgeCodeId MayRepost (const $ Just $ revokedBody code)
 
 withManagedGroup :: ChatController -> (GroupId -> IO ()) -> IO ()
 withManagedGroup cc action =
@@ -421,7 +403,7 @@ reconcileTracker :: ChatController -> GroupId -> Int64 -> ChatItemId -> IO ()
 reconcileTracker cc groupId badgeCodeId itemId =
   readTrackerCode cc groupId badgeCodeId itemId >>= mapM_ reconcile
   where
-    reconcile (code, current) = void $ setTrackerBody cc groupId badgeCodeId EditOnly (correctedBody code current)
+    reconcile (code, current) = setTrackerBody cc groupId badgeCodeId EditOnly (correctedBody code current)
     -- A crash after a revoke committed can leave its tracker still counting, so a revoked code is retired here.
     correctedBody code current tracker@CodeTracker {revokedAt} =
       mfilter (/= current) $ if isJust revokedAt then Just (revokedBody code) else counterBody code tracker

apps/simplex-badge-service/src/BadgeService/Group/Command.hs

@@ -64,7 +64,7 @@ cmdActionP = A.choice (map cmdP [minBound .. maxBound])
     fullArgsP tag = A.char ' ' *> cmdArgsP tag <* A.endOfInput
     -- Without the space check "/issued" would get a usage reply.
     usageEndP = void A.space <|> A.endOfInput
-    usage tag = "use: /" <> cmdName tag <> " " <> cmdParams tag
+    usage tag = "Usage: /" <> cmdName tag <> " " <> cmdParams tag
 
 cmdArgsP :: CmdTag -> A.Parser GroupCmd
 cmdArgsP = \case
@@ -139,4 +139,4 @@ cmdRefusal = \case
   CTIssue -> Nothing
   CTBulk -> Nothing
   -- The sender has just published a code that stays redeemable, so they must learn it was not revoked.
-  CTRevoke -> Just "only admins can revoke codes, and this code is now visible to the group - ask an admin to revoke it"
+  CTRevoke -> Just "Only admins can revoke codes. This code is now visible to all members."

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

@@ -203,13 +203,13 @@ runBadgeCmd :: ChatController -> ByteString -> IO (Either ChatError ChatResponse
 runBadgeCmd cc cmd
   | Right issueOpts <- A.parseOnly issueCmdP cmd =
       issueBadgeCode cc issueOpts >>= \case
-        Right code -> pure $ Right CRCustomChatResponse {user_ = Nothing, response = "code " <> formatBadgeCode code}
+        Right code -> pure $ Right CRCustomChatResponse {user_ = Nothing, response = "Code: " <> formatBadgeCode code}
         Left _ -> pure $ chatCmdError (T.unpack issueFailedText)
   | Right code <- A.parseOnly revokeCmdP cmd =
       revokeWithTracker cc code <&> \case
         Right response -> Right CRCustomChatResponse {user_ = Nothing, response}
         Left e -> chatCmdError (T.unpack e)
-  | otherwise = pure $ chatCmdError $ "use: //issue supporter|legend|investor [months 1-" <> show maxMonths <> "] [paid|unpaid|free], or //revoke <code>"
+  | otherwise = pure $ chatCmdError $ "Usage: //issue supporter|legend|investor [months 1-" <> show maxMonths <> "] [paid|unpaid|free], or //revoke <code>"
 
 revokeCmdP :: A.Parser BadgeCode
 revokeCmdP = "revoke " *> codeP <* (A.skipSpace *> A.endOfInput)
@@ -355,14 +355,14 @@ redeemCode key cc trackerQ_ purchaseKey masterKey codeText = case parseBadgeCode
                 liftIO (createCodePurchase db NewCodePurchase {badgeCodeId, purchaseKey, masterKey, badgeType} now) >>= \case
                   Nothing ->
                     readCode now code db >>= \case
-                      Left resp -> pure (resp, Nothing)
-                      Right _ -> logError "badge service: redeeming a code failed, but the code has uses left and is not revoked" $> (errorResponse BSEInternal, Nothing)
-                  Just (purchaseId, claimedCount) -> liftIO $ do
+                      Left resp -> pure (resp, False)
+                      Right _ -> logError "badge service: redeeming a code failed, but the code has uses left and is not revoked" $> (errorResponse BSEInternal, False)
+                  Just purchaseId -> liftIO $ do
                     appendLedgerPlan db purchaseId [granted] $ Just $ issuanceAfter granted signed
                     entries_ <- getLedgerEntries db purchaseId 0
-                    pure (maybe (errorResponse BSEInternal) (credentialResponse (Just $ snd signed) Nothing) entries_, Just claimedCount)
-              let (resp, claimedCount_) = fromRight (errorResponse BSEInternal, Nothing) r
-              when (hasTracker redeemLimit) $ forM_ claimedCount_ $ refreshTracker cc trackerQ_ badgeCodeId code
+                    pure (maybe (errorResponse BSEInternal) (credentialResponse (Just $ snd signed) Nothing) entries_, True)
+              let (resp, claimed) = fromRight (errorResponse BSEInternal, False) r
+              when (claimed && hasTracker redeemLimit) $ refreshTracker cc trackerQ_ badgeCodeId code
               pure resp
   where
     readCode now code db = liftIO $

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

@@ -4,7 +4,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 
 module BadgeService.Store
   ( IssuedCode (..),
@@ -38,7 +37,6 @@ module BadgeService.Store
 where
 
 import BadgeService.Store.Invoices (executeChanging)
-import Control.Monad (forM)
 import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -287,25 +285,26 @@ appendLedgerPlan db purchaseId rows issuance_ = do
       insertedRowId db
 
 -- The claim takes one use before adding the purchase, so a concurrent revoke or redemption waits on this row and sees the new count.
--- Run it in the credential's transaction. It returns the use count this claim reached.
-createCodePurchase :: DB.Connection -> NewCodePurchase -> UTCTime -> IO (Maybe (Int64, Int))
+-- Run it in the credential's transaction.
+createCodePurchase :: DB.Connection -> NewCodePurchase -> UTCTime -> IO (Maybe Int64)
 createCodePurchase db NewCodePurchase {badgeCodeId, purchaseKey, masterKey = BadgeMasterKey mk, badgeType} now = do
-  claimed_ <-
-    maybeFirstRow fromOnly $
-      DB.query
-        db
-        "UPDATE sx_badge_service_badge_codes SET redeem_count = redeem_count + 1, redeemed_at = ? WHERE badge_code_id = ? AND redeem_count < redeem_limit AND revoked_at IS NULL RETURNING redeem_count"
-        (now, badgeCodeId)
-  forM claimed_ $ \claimedCount -> do
-    DB.execute
+  claimed <-
+    executeChanging
       db
-      [sql|
-        INSERT INTO sx_badge_service_badge_purchases
-          (purchase_key, master_key, initial_badge_type, current_badge_type, status, badge_code_id, created_at, updated_at)
-        VALUES (?,?,?,?,?,?,?,?)
-      |]
-      (purchaseKey, Binary mk, badgeType, badgeType, PSIssued, badgeCodeId, now, now)
-    (,claimedCount) <$> insertedRowId db
+      "UPDATE sx_badge_service_badge_codes SET redeem_count = redeem_count + 1, redeemed_at = ? WHERE badge_code_id = ? AND redeem_count < redeem_limit AND revoked_at IS NULL"
+      (now, badgeCodeId)
+  if claimed == 0
+    then pure Nothing
+    else do
+      DB.execute
+        db
+        [sql|
+          INSERT INTO sx_badge_service_badge_purchases
+            (purchase_key, master_key, initial_badge_type, current_badge_type, status, badge_code_id, created_at, updated_at)
+          VALUES (?,?,?,?,?,?,?,?)
+        |]
+        (purchaseKey, Binary mk, badgeType, badgeType, PSIssued, badgeCodeId, now, now)
+      Just <$> insertedRowId db
 
 -- | Revoked and AlreadyRevoked carry the code id, so the caller can retire the code's group tracker,
 -- or repair one an earlier revoke left live.

tests/Bots/BadgeService/BotTests.hs

@@ -222,7 +222,7 @@ revokeRaw cc args =
 issueCodeAs :: HasCallStack => ChatController -> BadgeType -> Int -> String -> IO BadgeCode
 issueCodeAs cc badgeType months status =
   sendChatCmdStr cc ("//issue " <> T.unpack (textEncode badgeType) <> " " <> show months <> " " <> status) >>= \case
-    Right (CRCustomChatResponse _ response) -> case T.stripPrefix "code " response of
+    Right (CRCustomChatResponse _ response) -> case T.stripPrefix "Code: " response of
       Just c | Just code <- parseBadgeCode c -> pure code
       _ -> error $ "unexpected issue response: " <> T.unpack response
     r -> error $ "issue failed: " <> show (() <$ r)
@@ -831,7 +831,7 @@ testRevokedMultiUseHolderRenews ps =
       code <- issueMultiUseCode cc BTSupporter 3 2
       redeemFirstBadge alice code
       redeemed <- ledgerRows (chatController alice) "badge_ledger"
-      revokeCodeAs cc code `shouldReturn` Right "revoked"
+      revokeCodeAs cc code `shouldReturn` Right "Revoked."
       redeemAsNewPurchase env code >>= (`shouldAnswerError` BSECodeInvalid)
       codeUses cc code `shouldReturn` Just (2, 1)
       -- A holder whose reply was lost retries with the same key and still gets its badge.
@@ -1518,7 +1518,7 @@ testRevokeRedeemedCode ps =
       alice <## "supporter badge - active"
       alice <##. "expires "
       refused <- revokeCodeAs cc code
-      refused `shouldBe` Left "code was redeemed already, so it cannot be revoked"
+      refused `shouldBe` Left "Fully redeemed. It cannot be revoked."
       alice ##> ("/_redeem_badge_code 1 " <> codeArg code)
       alice <## "badge already redeemed"
 
@@ -1528,23 +1528,23 @@ testRevokeUnknownCode ps =
     g <- C.newRandom
     code <- randomBadgeCode g
     unknown <- revokeCodeAs cc code
-    unknown `shouldBe` Left "no such code"
+    unknown `shouldBe` Left "No such code."
 
 testRevokedCode :: HasCallStack => TestParams -> IO ()
 testRevokedCode ps =
   withBadgeService ps $ \clientCfg _ cc ->
     withNewTestChatCfg ps clientCfg "alice" aliceProfile $ \alice -> do
       paid <- issueCodeAs cc BTSupporter 1 "paid"
-      revokeCodeAs cc paid `shouldReturn` Right "revoked"
+      revokeCodeAs cc paid `shouldReturn` Right "Revoked."
       alice ##> ("/_redeem_badge_code 1 " <> codeArg paid)
       alice <## "cannot redeem badge code: badge service error: code_invalid"
-      revokeCodeAs cc paid `shouldReturn` Right "already revoked"
+      revokeCodeAs cc paid `shouldReturn` Right "Already revoked."
 
 testRevokedUnpaidCode :: HasCallStack => TestParams -> IO ()
 testRevokedUnpaidCode ps =
   withBadgeServiceEnv ps $ \env@BadgeServiceEnv {bsController = cc} -> do
     code <- issueCodeAs cc BTSupporter 1 "unpaid"
-    revokeCodeAs cc code `shouldReturn` Right "revoked"
+    revokeCodeAs cc code `shouldReturn` Right "Revoked."
     redeemAsNewPurchase env code >>= (`shouldAnswerError` BSECodeInvalid)
 
 testRevokeRejectsTrailingInput :: HasCallStack => TestParams -> IO ()
@@ -1552,10 +1552,10 @@ testRevokeRejectsTrailingInput ps =
   withBadgeService ps $ \_ _ cc -> do
     code <- issueCodeAs cc BTSupporter 1 "paid"
     refused <- revokeRaw cc (formatBadgeCode code <> " junk")
-    -- If the refused call revoked the code anyway, this fails with "already revoked".
-    revokeCodeAs cc code `shouldReturn` Right "revoked"
+    -- If the refused call revoked the code anyway, this fails with "Already revoked.".
+    revokeCodeAs cc code `shouldReturn` Right "Revoked."
     refused `shouldBe` Left badgeCmdUsage
 
 -- The text is spelled out rather than taken from the service, so a change there fails here.
 badgeCmdUsage :: Text
-badgeCmdUsage = "use: //issue supporter|legend|investor [months 1-255] [paid|unpaid|free], or //revoke <code>"
+badgeCmdUsage = "Usage: //issue supporter|legend|investor [months 1-255] [paid|unpaid|free], or //revoke <code>"

tests/Bots/BadgeService/GroupIntegrationTests.hs

@@ -93,9 +93,9 @@ badgeGroupIntegrationTests = do
   it "answers a failed /issue or //issue without naming what failed in the store" testIssueFailureIsOpaque
   it "lists the codes a /bulk issued before an insert failed" testBulkPartialFailureListsIssued
   it "answers a failed /revoke without naming what failed in the store" testRevokeFailureIsOpaque
-  it "tracks a multi-use code across redemptions and refuses it when used up" testMultiUseTracker
-  it "keeps the counter and posts no second notice for a stale refresh of a used-up code" testStaleRefreshIgnored
-  it "announces a second multi-use code used up on the claim that uses it up" testSecondMultiUseCodeExhausted
+  it "tracks a multi-use code in one message across redemptions and refuses it when used up" testMultiUseTracker
+  it "leaves a used-up code's tracker as it is on a stale refresh" testStaleRefreshIgnored
+  it "keeps each multi-use code's counter to its own claims" testCountersKeptApart
   it "refreshes the tracker for a redemption served with no group lane" testLanelessRedeemRefreshesTracker
   it "refreshes the tracker for a redemption from the service's request queue" testQueuedRequestRefreshesTracker
   it "refreshes the tracker inline for a queued redemption after a restart without [group]" testQueuedRequestWithoutGroupConfig
@@ -105,7 +105,7 @@ badgeGroupIntegrationTests = do
   it "never reposts a tracker deleted on the service's side, publishing the code no further" testDeletedTrackerNotReposted
   it "never reposts a tracker an owner deleted for everyone" testModeratedTrackerNotReposted
   it "revokes a code whose tracker was deleted on the service's side without reposting it" testDeletedTrackerNotRepostedOnRevoke
-  it "posts no notice when a code whose tracker was deleted is used up" testDeletedTrackerNoNotice
+  it "publishes nothing when a code whose tracker was deleted is used up" testDeletedTrackerUsedUp
   it "revokes a code whose tracker an owner deleted for everyone without reposting it" testModeratedTrackerNotRepostedOnRevoke
   it "revokes a code on /revoke, answers a repeat as already revoked and an unknown code as no such code" testGroupRevoke
   it "retires the tracker message when a multi-use code is revoked" testRevokeRetiresTracker
@@ -113,7 +113,7 @@ badgeGroupIntegrationTests = do
   it "retires a tracker left behind when the code is revoked again" testGroupRevokeRepairsTracker
   it "retires a tracker left behind when the service command revokes again" testServiceRevokeRepairsTracker
   it "posts one retired tracker however often a revoke past the window repeats" testRevokeRepeatPastWindow
-  it "reconciles an exhausted tracker whose refresh was lost, posting no notice" testExhaustedTrackerReconciledOnRestart
+  it "reconciles a used-up tracker whose refresh was lost, in place" testUsedUpTrackerReconciledOnRestart
   it "reconciles a tracker with uses left whose refresh was lost" testStalledTrackerReconciledOnRestart
   it "retires on restart a tracker whose revoke never reached it" testRevokedTrackerReconciledOnRestart
   it "reconciles every stalled tracker on restart, not only the first" testEveryStalledTrackerReconciled
@@ -443,7 +443,7 @@ testFirstJoinerPromoted ps = do
       sendGroupCmd alice "/issue supporter"
       waitCodeOfType cc "supporter"
       memberRoles cc gid `shouldReturn` [("alice", "owner"), ("bob", "member")]
-      let codeReply = "#" <> groupName <> " " <> botName <> "> code SB-"
+      let codeReply = "#" <> groupName <> " " <> botName <> "> Code: SB-"
       drainUntil alice [codeReply]
       drainUntil bob [codeReply, "#" <> groupName <> ": member alice"]
 
@@ -471,7 +471,7 @@ testRoleGatedIssue ps = do
         let announced name = "#" <> groupName <> ": " <> botName <> " added " <> name
             preMember name = "#" <> groupName <> ": member " <> name
             newMember name = "#" <> groupName <> ": new member " <> name <> " is connected"
-            usageReply = "#" <> groupName <> " " <> botName <> "> use: /issue <type>"
+            usageReply = "#" <> groupName <> " " <> botName <> "> Usage: /issue <type>"
         joinGroup cc bob
         waitMemberRole cc gid "bob" "member"
         -- cath joins only after alice sees bob announced, or cath's console shows a different line.
@@ -485,14 +485,14 @@ testRoleGatedIssue ps = do
           dropTime
           cath
           [ StartsWith ("#" <> groupName <> " alice> /issue supporter"),
-            StartsWith ("#" <> groupName <> " " <> botName <> "> code SB-")
+            StartsWith ("#" <> groupName <> " " <> botName <> "> Code: SB-")
           ]
         codeCount cc `shouldReturn` 1
         sendGroupCmd bob "/issue legend"
         waitStoredItem cc "/issue legend"
         ownerIssuesNext cc alice 2
         sendGroupCmd alice "/issue supporter uses 0"
-        waitStoredItem cc "use: /issue <type> [months <M>] [uses <N>]"
+        waitStoredItem cc "Usage: /issue <type> [months <M>] [uses <N>]"
         codeCount cc `shouldReturn` 2
         drainUntil alice [usageReply, newMember "bob", newMember "cath"]
         drainUntil bob [usageReply, preMember "alice", newMember "cath"]
@@ -578,7 +578,7 @@ testBulkPartialFailureListsIssued ps =
   withGroupOwner ps $ \gsKey cc env alice -> do
     codeLines <- withCodeTableCapped cc 2 $ do
       (codeLines, summary) <- splitAt 2 . T.lines <$> replyTo cc alice "/bulk supporter count 3"
-      summary `shouldBe` ["issued 2 of 3, the rest failed"]
+      summary `shouldBe` ["Issued 2 of 3 codes. The remaining codes could not be issued."]
       pure codeLines
     codeCount cc `shouldReturn` 2
     forM_ codeLines $ redeemOk gsKey cc env . extractCode
@@ -587,8 +587,8 @@ testIssueFailureIsOpaque :: HasCallStack => TestParams -> IO ()
 testIssueFailureIsOpaque ps =
   withGroupOwner ps $ \_ cc _ alice -> do
     withCodeTableHidden cc $ do
-      replyTo cc alice "/issue supporter" `shouldReturn` "issuing the code failed"
-      issueRaw cc "supporter" `shouldReturn` Left "issuing the code failed"
+      replyTo cc alice "/issue supporter" `shouldReturn` "The code could not be issued."
+      issueRaw cc "supporter" `shouldReturn` Left "The code could not be issued."
     void $ replyTo cc alice "/issue supporter"
     codeCount cc `shouldReturn` 1
 
@@ -597,8 +597,8 @@ testRevokeFailureIsOpaque ps =
   withGroupOwner ps $ \_ cc _ alice -> do
     code <- extractCode <$> replyTo cc alice "/issue supporter"
     withCodeTableHidden cc $
-      replyTo cc alice (revokeCmd code) `shouldReturn` revokeReply code "revoking the code failed"
-    revokeInGroup cc alice code "revoked"
+      replyTo cc alice (revokeCmd code) `shouldReturn` revokeReply code "The code could not be revoked."
+    revokeInGroup cc alice code "Revoked."
 
 withCodeTableHidden :: ChatController -> IO a -> IO a
 withCodeTableHidden cc action = rename codeTable hidden >> (action `finally` rename hidden codeTable)
@@ -632,13 +632,13 @@ testMultiUseTracker :: HasCallStack => TestParams -> IO ()
 testMultiUseTracker ps =
   withGroupOwner ps $ \gsKey cc env alice -> do
     (trackerItemId, tracker0, code) <- issueTracked cc alice "supporter" 2
-    tracker0 `shouldSatisfy` T.isInfixOf "2/2 remaining"
+    tracker0 `shouldSatisfy` T.isInfixOf "2 of 2 uses remaining"
     redeemOk gsKey cc env code
-    t1 <- waitItemText cc trackerItemId "1/2 remaining"
-    t1 `shouldSatisfy` T.isInfixOf "Last redeemed"
+    t1 <- waitItemText cc trackerItemId "1 of 2 uses remaining"
+    t1 `shouldSatisfy` T.isInfixOf "last used"
     redeemOk gsKey cc env code
-    void $ waitItemText cc trackerItemId "0/2 remaining"
-    waitExhausted cc `shouldReturn` exhaustedText code 2
+    usedUp <- waitItemText cc trackerItemId "All 2 uses redeemed"
+    sentItemsWithCode cc code `shouldReturn` [usedUp]
     redeemViaService gsKey cc env code >>= (`shouldAnswerError` BSECodeUsed)
 
 testStaleRefreshIgnored :: HasCallStack => TestParams -> IO ()
@@ -647,35 +647,21 @@ testStaleRefreshIgnored ps =
     (trackerItemId, _, code) <- issueTracked cc alice "supporter" 2
     redeemOk gsKey cc env code
     redeemOk gsKey cc env code
-    void $ waitItemText cc trackerItemId "0/2 remaining"
-    notice <- waitExhausted cc
-    replayRefresh cc env code 2 1
+    usedUp <- waitItemText cc trackerItemId "All 2 uses redeemed"
+    replayRefresh cc env code 2
     awaitLane cc env
-    exhaustedNotices cc `shouldReturn` [notice]
-    readItemText cc trackerItemId >>= (`shouldSatisfy` T.isInfixOf "0/2 remaining")
-    redeemedTrackerCount cc `shouldReturn` 1
+    sentItemsWithCode cc code `shouldReturn` [usedUp]
 
-testSecondMultiUseCodeExhausted :: HasCallStack => TestParams -> IO ()
-testSecondMultiUseCodeExhausted ps =
+testCountersKeptApart :: HasCallStack => TestParams -> IO ()
+testCountersKeptApart ps =
   withGroupOwner ps $ \gsKey cc env alice -> do
-    -- The first code gets 3 claims, the second code's limit, so reading the wrong count would post the notice early.
     (firstItemId, _, firstCode) <- issueTracked cc alice "supporter" 5
     replicateM_ 3 (redeemOk gsKey cc env firstCode)
-    void $ waitItemText cc firstItemId "2/5 remaining"
-    awaitLane cc env
-    exhaustedNotices cc `shouldReturn` []
+    void $ waitItemText cc firstItemId "2 of 5 uses remaining"
     (secondItemId, _, secondCode) <- issueTracked cc alice "legend" 3
-    -- Each claim is awaited because the lane coalesces refreshes queued together.
-    redeemOk gsKey cc env secondCode
-    void $ waitItemText cc secondItemId "2/3 remaining"
-    redeemOk gsKey cc env secondCode
-    void $ waitItemText cc secondItemId "1/3 remaining"
-    awaitLane cc env
-    exhaustedNotices cc `shouldReturn` []
-    redeemOk gsKey cc env secondCode
-    void $ waitItemText cc secondItemId "0/3 remaining"
-    waitExhausted cc `shouldReturn` exhaustedText secondCode 3
-    readItemText cc firstItemId >>= (`shouldSatisfy` T.isInfixOf "2/5 remaining")
+    replicateM_ 3 (redeemOk gsKey cc env secondCode)
+    void $ waitItemText cc secondItemId "All 3 uses redeemed"
+    readItemText cc firstItemId >>= (`shouldSatisfy` T.isInfixOf "2 of 5 uses remaining")
 
 testLanelessRedeemRefreshesTracker :: HasCallStack => TestParams -> IO ()
 testLanelessRedeemRefreshesTracker ps =
@@ -685,12 +671,10 @@ testLanelessRedeemRefreshesTracker ps =
     redeemOkWith gsKey cc Nothing code
     -- The refresh runs before the response, so the counter is already written here.
     t1 <- readItemText cc trackerItemId
-    t1 `shouldSatisfy` T.isInfixOf "1/2 remaining"
-    t1 `shouldSatisfy` T.isInfixOf "Last redeemed"
-    exhaustedNotices cc `shouldReturn` []
+    t1 `shouldSatisfy` T.isInfixOf "1 of 2 uses remaining"
+    t1 `shouldSatisfy` T.isInfixOf "last used"
     redeemOkWith gsKey cc Nothing code
-    readItemText cc trackerItemId >>= (`shouldSatisfy` T.isInfixOf "0/2 remaining")
-    exhaustedNotices cc `shouldReturn` [exhaustedText code 2]
+    readItemText cc trackerItemId >>= (`shouldSatisfy` T.isInfixOf "All 2 uses redeemed")
     redeemedTrackerCount cc `shouldReturn` 1
 
 testQueuedRequestRefreshesTracker :: HasCallStack => TestParams -> IO ()
@@ -698,7 +682,7 @@ testQueuedRequestRefreshesTracker ps =
   withGroupOwner ps $ \_ cc env alice -> do
     (trackerItemId, _, code) <- issueTracked cc alice "supporter" 2
     queueRedemption cc env code
-    void $ waitItemText cc trackerItemId "1/2 remaining"
+    void $ waitItemText cc trackerItemId "1 of 2 uses remaining"
 
 testQueuedRequestWithoutGroupConfig :: HasCallStack => TestParams -> IO ()
 testQueuedRequestWithoutGroupConfig ps = do
@@ -707,7 +691,7 @@ testQueuedRequestWithoutGroupConfig ps = do
     (\(i, _, c) -> (i, c)) <$> issueTracked cc alice "supporter" 2
   runGroupServiceAs svc Nothing $ \cc env _ -> do
     queueRedemption cc env code
-    void $ waitItemText cc trackerItemId "1/2 remaining"
+    void $ waitItemText cc trackerItemId "1 of 2 uses remaining"
 
 testTrackerRepost :: HasCallStack => TestParams -> IO ()
 testTrackerRepost ps =
@@ -716,7 +700,7 @@ testTrackerRepost ps =
     backdated <- backdateTracker cc 2
     redeemOk gsKey cc env code
     (_, tracker1) <- waitTrackerRepost cc 2 itemId0
-    tracker1 `shouldSatisfy` T.isInfixOf "1/2 remaining"
+    tracker1 `shouldSatisfy` T.isInfixOf "1 of 2 uses remaining"
     readItemText cc itemId0 `shouldReturn` tracker0
     sentAt <- trackerSentAt cc 2
     sentAt `shouldSatisfy` (> backdated)
@@ -728,11 +712,10 @@ testRefusedEditReposted ps =
     backdateTrackerItem cc itemId0
     redeemOk gsKey cc env code
     (itemId1, tracker1) <- waitTrackerRepost cc 2 itemId0
-    tracker1 `shouldSatisfy` T.isInfixOf "1/2 remaining"
+    tracker1 `shouldSatisfy` T.isInfixOf "1 of 2 uses remaining"
     redeemOk gsKey cc env code
-    void $ waitItemText cc itemId1 "0/2 remaining"
-    waitExhausted cc `shouldReturn` exhaustedText code 2
-    readItemText cc itemId0 `shouldReturn` tracker0
+    usedUp <- waitItemText cc itemId1 "All 2 uses redeemed"
+    sentItemsWithCode cc code `shouldReturn` [tracker0, usedUp]
 
 testFailedRepostDropped :: HasCallStack => TestParams -> IO ()
 testFailedRepostDropped ps =
@@ -748,8 +731,7 @@ testFailedRepostDropped ps =
     setBotRole cc "owner"
     redeemOk gsKey cc env code
     (_, tracker1) <- waitTrackerRepost cc 2 itemId0
-    tracker1 `shouldSatisfy` T.isInfixOf "0/2 remaining"
-    waitExhausted cc `shouldReturn` exhaustedText code 2
+    tracker1 `shouldSatisfy` T.isInfixOf "All 2 uses redeemed"
 
 testDeletedTrackerNotReposted :: HasCallStack => TestParams -> IO ()
 testDeletedTrackerNotReposted ps =
@@ -769,14 +751,13 @@ testDeletedTrackerNotRepostedOnRevoke ps =
     revokeNeverReposts cc alice code []
 
 -- Both claims fall inside the edit window, so each edit fails because the message is gone.
-testDeletedTrackerNoNotice :: HasCallStack => TestParams -> IO ()
-testDeletedTrackerNoNotice ps =
+testDeletedTrackerUsedUp :: HasCallStack => TestParams -> IO ()
+testDeletedTrackerUsedUp ps =
   withGroupOwner ps $ \gsKey cc env alice -> do
     (itemId0, _, code) <- issueTracked cc alice "supporter" 2
     deleteItem cc itemId0
     replicateM_ 2 $ redeemOk gsKey cc env code
     awaitLane cc env
-    exhaustedNotices cc `shouldReturn` []
     sentItemsWithCode cc code `shouldReturn` []
 
 testModeratedTrackerNotRepostedOnRevoke :: HasCallStack => TestParams -> IO ()
@@ -815,13 +796,12 @@ trackerNeverReposted key cc env code itemId0 codeItems = do
   redeemOk key cc env code
   awaitLane cc env
   sentItemsWithCode cc code `shouldReturn` codeItems
-  exhaustedNotices cc `shouldReturn` []
   trackerAnchor cc 2 `shouldReturn` Just itemId0
 
 revokeNeverReposts :: HasCallStack => ChatController -> TestCC -> Text -> [Text] -> IO ()
 revokeNeverReposts cc member code codeItems = do
-  revokeInGroup cc member code "revoked"
-  sentItemsWithCode cc code `shouldReturn` codeItems <> [revokeReply code "revoked"]
+  revokeInGroup cc member code "Revoked."
+  sentItemsWithCode cc code `shouldReturn` codeItems <> [revokeReply code "Revoked."]
   revokedTrackerCount cc `shouldReturn` 0
 
 testGroupRevoke :: HasCallStack => TestParams -> IO ()
@@ -829,14 +809,14 @@ testGroupRevoke ps =
   withGroupOwner ps $ \gsKey cc env alice -> do
     code <- extractCode <$> replyTo cc alice "/issue supporter"
     other <- extractCode <$> replyTo cc alice "/issue legend"
-    revokeInGroup cc alice code "revoked"
+    revokeInGroup cc alice code "Revoked."
     redeemViaService gsKey cc env code >>= (`shouldAnswerError` BSECodeInvalid)
     redeemOk gsKey cc env other
-    revokeInGroup cc alice code "already revoked"
+    revokeInGroup cc alice code "Already revoked."
     -- The reply follows the tracker step, so the revoke has already passed it here.
     revokedTrackerCount cc `shouldReturn` 0
     unissued <- formatBadgeCode <$> randomBadgeCode (random cc)
-    revokeInGroup cc alice unissued "no such code"
+    revokeInGroup cc alice unissued "No such code."
 
 testGroupRevokeRepairsTracker :: HasCallStack => TestParams -> IO ()
 testGroupRevokeRepairsTracker ps =
@@ -846,9 +826,9 @@ testGroupRevokeRepairsTracker ps =
     revokeInStore cc 2
     readItemText cc trackerItemId `shouldReturn` tracker0
     sendGroupCmd alice (revokeCmd code)
-    retired <- waitItemText cc trackerItemId "revoked"
+    retired <- waitItemText cc trackerItemId "Revoked"
     retired `shouldBe` retiredText code
-    waitStoredItem cc (revokeReply code "already revoked")
+    waitStoredItem cc (revokeReply code "Already revoked.")
     revokedTrackerCount cc `shouldReturn` 1
 
 testRevokeRepeatPastWindow :: HasCallStack => TestParams -> IO ()
@@ -857,36 +837,36 @@ testRevokeRepeatPastWindow ps =
     offsetCodeIds cc
     (itemId0, tracker0, code) <- issueTracked cc alice "supporter" 2
     void $ backdateTracker cc 2
-    revokeInGroup cc alice code "revoked"
+    revokeInGroup cc alice code "Revoked."
     (itemId1, retired) <- waitTrackerRepost cc 2 itemId0
     retired `shouldBe` retiredText code
     revokedTrackerCount cc `shouldReturn` 1
     void $ backdateTracker cc 2
-    revokeInGroup cc alice code "already revoked"
+    revokeInGroup cc alice code "Already revoked."
     revokedTrackerCount cc `shouldReturn` 1
     trackerAnchor cc 2 `shouldReturn` Just itemId1
     readItemText cc itemId1 `shouldReturn` retiredText code
     readItemText cc itemId0 `shouldReturn` tracker0
 
-testExhaustedTrackerReconciledOnRestart :: HasCallStack => TestParams -> IO ()
-testExhaustedTrackerReconciledOnRestart ps = do
+testUsedUpTrackerReconciledOnRestart :: HasCallStack => TestParams -> IO ()
+testUsedUpTrackerReconciledOnRestart ps = do
   svc@GroupSvc {gsKey} <- prepareGroupService ps
-  (lostItemId, notice, lostCode) <- runWithOwner svc $ \cc env _ alice -> do
+  (lostItemId, lostCode) <- runWithOwner svc $ \cc env _ alice -> do
     (doneItemId, _, doneCode) <- issueTracked cc alice "supporter" 2
     redeemOk gsKey cc env doneCode
     redeemOk gsKey cc env doneCode
-    notice <- waitExhausted cc
+    void $ waitItemText cc doneItemId "All 2 uses redeemed"
     (lostItemId, lost0, lostCode) <- issueTracked cc alice "legend" 3
     replicateM_ 3 (redeemLosingRefresh gsKey cc lostCode)
     readItemText cc lostItemId `shouldReturn` lost0
     trackerAnchor cc 2 `shouldReturn` Just doneItemId
     dateRedemption cc 3 lostRedeemedAt
-    pure (lostItemId, notice, lostCode)
+    pure (lostItemId, lostCode)
   runGroupService svc $ \cc env _ -> do
-    corrected <- waitItemText cc lostItemId "0/3 remaining"
-    corrected `shouldBe` ("!2 " <> lostCode <> "!\nLast redeemed: 2026-02-28 — 0/3 remaining")
+    corrected <- waitItemText cc lostItemId "All 3 uses redeemed"
+    corrected `shouldBe` (lostCode <> "\nAll 3 uses redeemed, last used 2026-02-28 23:50 UTC")
     awaitLane cc env
-    exhaustedNotices cc `shouldReturn` [notice]
+    sentItemsWithCode cc lostCode `shouldReturn` [corrected]
     redeemedTrackerCount cc `shouldReturn` 2
 
 -- This date is far from any day the test runs on, so a body dated now cannot match it.
@@ -896,21 +876,21 @@ lostRedeemedAt = UTCTime (fromGregorian 2026 2 28) (23 * 3600 + 50 * 60)
 testStalledTrackerReconciledOnRestart :: HasCallStack => TestParams -> IO ()
 testStalledTrackerReconciledOnRestart ps = do
   svc@GroupSvc {gsKey} <- prepareGroupService ps
-  stalledItemId <- runWithOwner svc $ \cc env _ alice -> do
+  (stalledItemId, code) <- runWithOwner svc $ \cc env _ alice -> do
     (stalledItemId, _, code) <- issueTracked cc alice "supporter" 5
     redeemOk gsKey cc env code
     redeemOk gsKey cc env code
     awaitLane cc env
-    stalled <- waitItemText cc stalledItemId "3/5 remaining"
+    stalled <- waitItemText cc stalledItemId "3 of 5 uses remaining"
     redeemLosingRefresh gsKey cc code
     readItemText cc stalledItemId `shouldReturn` stalled
-    pure stalledItemId
+    dateRedemption cc 5 lostRedeemedAt
+    pure (stalledItemId, code)
   runGroupService svc $ \cc env _ -> do
-    corrected <- waitItemText cc stalledItemId "2/5 remaining"
-    corrected `shouldSatisfy` T.isInfixOf "Last redeemed: "
+    corrected <- waitItemText cc stalledItemId "2 of 5 uses remaining"
+    corrected `shouldBe` ("!2 " <> code <> "!\n2 of 5 uses remaining, last used 2026-02-28 23:50 UTC")
     awaitLane cc env
-    exhaustedNotices cc `shouldReturn` []
-    redeemedTrackerCount cc `shouldReturn` 1
+    sentItemsWithCode cc code `shouldReturn` [corrected]
 
 testRevokedTrackerReconciledOnRestart :: HasCallStack => TestParams -> IO ()
 testRevokedTrackerReconciledOnRestart ps = do
@@ -921,7 +901,7 @@ testRevokedTrackerReconciledOnRestart ps = do
     readItemText cc trackerItemId `shouldReturn` tracker0
     pure (trackerItemId, code)
   runGroupService svc $ \cc env _ -> do
-    retired <- waitItemText cc trackerItemId "revoked"
+    retired <- waitItemText cc trackerItemId "Revoked"
     retired `shouldBe` retiredText code
     awaitLane cc env
     revokedTrackerCount cc `shouldReturn` 1
@@ -938,12 +918,11 @@ testEveryStalledTrackerReconciled ps = do
     readItemText cc secondItemId `shouldReturn` second0
     pure (firstItemId, secondItemId)
   runGroupService svc $ \cc env _ -> do
-    first1 <- waitItemText cc firstItemId "3/5 remaining"
-    first1 `shouldSatisfy` T.isInfixOf "Last redeemed: "
-    second1 <- waitItemText cc secondItemId "2/3 remaining"
-    second1 `shouldSatisfy` T.isInfixOf "Last redeemed: "
+    first1 <- waitItemText cc firstItemId "3 of 5 uses remaining"
+    first1 `shouldSatisfy` T.isInfixOf "last used "
+    second1 <- waitItemText cc secondItemId "2 of 3 uses remaining"
+    second1 `shouldSatisfy` T.isInfixOf "last used "
     awaitLane cc env
-    exhaustedNotices cc `shouldReturn` []
     redeemedTrackerCount cc `shouldReturn` 2
 
 testUneditableTrackerLeftAlone :: HasCallStack => TestParams -> IO ()
@@ -959,7 +938,7 @@ testUneditableTrackerLeftAlone ps = do
     pure (staleItemId, stale0, staleCode, liveItemId, liveCode)
   runGroupService svc $ \cc env _ -> do
     redeemOk gsKey cc env liveCode
-    void $ waitItemText cc liveItemId "2/3 remaining"
+    void $ waitItemText cc liveItemId "2 of 3 uses remaining"
     readItemText cc staleItemId `shouldReturn` stale0
     sentItemsWithCode cc staleCode `shouldReturn` [stale0]
     trackerAnchor cc 2 `shouldReturn` Just staleItemId
@@ -970,15 +949,14 @@ testRevokeRetiresTracker ps =
     offsetCodeIds cc
     (trackerItemId, _, code) <- issueTracked cc alice "supporter" 2
     redeemOk gsKey cc env code
-    void $ waitItemText cc trackerItemId "1/2 remaining"
-    revokeInGroup cc alice code "revoked"
-    retired <- waitItemText cc trackerItemId "revoked"
+    void $ waitItemText cc trackerItemId "1 of 2 uses remaining"
+    revokeInGroup cc alice code "Revoked."
+    retired <- waitItemText cc trackerItemId "Revoked"
     retired `shouldBe` retiredText code
     revokedTrackerCount cc `shouldReturn` 1
-    replayRefresh cc env code 2 2
+    replayRefresh cc env code 2
     awaitLane cc env
     readItemText cc trackerItemId `shouldReturn` retired
-    exhaustedNotices cc `shouldReturn` []
     revokedTrackerCount cc `shouldReturn` 1
     redeemViaService gsKey cc env code >>= (`shouldAnswerError` BSECodeInvalid)
 
@@ -988,14 +966,14 @@ testServiceRevokeRetiresTracker ps =
     offsetCodeIds cc
     (trackerItemId, _, code) <- issueTracked cc alice "supporter" 2
     redeemOk gsKey cc env code
-    void $ waitItemText cc trackerItemId "1/2 remaining"
-    revokeRaw cc code `shouldReturn` Right "revoked"
+    void $ waitItemText cc trackerItemId "1 of 2 uses remaining"
+    revokeRaw cc code `shouldReturn` Right "Revoked."
     readItemText cc trackerItemId `shouldReturn` retiredText code
     revokedTrackerCount cc `shouldReturn` 1
-    revokeRaw cc code `shouldReturn` Right "already revoked"
+    revokeRaw cc code `shouldReturn` Right "Already revoked."
     revokedTrackerCount cc `shouldReturn` 1
     single <- extractCode <$> replyTo cc alice "/issue legend"
-    revokeRaw cc single `shouldReturn` Right "revoked"
+    revokeRaw cc single `shouldReturn` Right "Revoked."
     revokedTrackerCount cc `shouldReturn` 1
 
 testServiceRevokeRepairsTracker :: HasCallStack => TestParams -> IO ()
@@ -1005,7 +983,7 @@ testServiceRevokeRepairsTracker ps =
     (trackerItemId, tracker0, code) <- issueTracked cc alice "supporter" 2
     revokeInStore cc 2
     readItemText cc trackerItemId `shouldReturn` tracker0
-    revokeRaw cc code `shouldReturn` Right "already revoked"
+    revokeRaw cc code `shouldReturn` Right "Already revoked."
     readItemText cc trackerItemId `shouldReturn` retiredText code
     revokedTrackerCount cc `shouldReturn` 1
 
@@ -1035,12 +1013,12 @@ queueRedemption cc env codeText = do
 redeemLosingRefresh :: HasCallStack => BadgeIssuerKey -> ChatController -> Text -> IO ()
 redeemLosingRefresh key cc codeText = newTQueueIO >>= \q -> redeemOkWith key cc (Just q) codeText
 
-replayRefresh :: HasCallStack => ChatController -> ServiceState -> Text -> Int -> Int -> IO ()
-replayRefresh cc env codeText uses claim = case parseBadgeCode codeText of
+replayRefresh :: HasCallStack => ChatController -> ServiceState -> Text -> Int -> IO ()
+replayRefresh cc env codeText uses = case parseBadgeCode codeText of
   Nothing -> error $ "not a badge code: " <> T.unpack codeText
   Just code -> do
     badgeCodeId <- trackedCodeId cc uses
-    atomically $ writeTQueue (groupEventQ env) (GETracker badgeCodeId code claim)
+    atomically $ writeTQueue (groupEventQ env) (GETracker badgeCodeId code)
 
 getStoredGroup :: ChatController -> IO (Maybe ManagedGroup)
 getStoredGroup cc = withTransaction (chatStore cc) getManagedGroup
@@ -1386,26 +1364,13 @@ waitTrackerRepost :: HasCallStack => ChatController -> Int -> Int64 -> IO (Int64
 waitTrackerRepost cc uses itemId0 = pollUntil $ mfilter ((/= itemId0) . fst) <$> trackerItem cc uses
 
 redeemedTrackerCount :: ChatController -> IO Int
-redeemedTrackerCount cc = countRows cc "chat_items WHERE item_text LIKE '%Last redeemed%'"
+redeemedTrackerCount cc = countRows cc "chat_items WHERE item_text LIKE '%last used%'"
 
 revokedTrackerCount :: ChatController -> IO Int
 revokedTrackerCount cc = countRows cc ("chat_items WHERE item_text LIKE '" <> T.unpack (retiredText "SB-%") <> "'")
 
 retiredText :: Text -> Text
-retiredText code = code <> " revoked — no longer redeemable"
-
-exhaustedText :: Text -> Int -> Text
-exhaustedText code uses = code <> " fully redeemed — all " <> tshow uses <> " used"
-
--- Notices are not filtered by code or total, so a wrong one still shows up.
-exhaustedNotices :: ChatController -> IO [Text]
-exhaustedNotices cc = queryColumn cc "SELECT item_text FROM chat_items WHERE item_text LIKE '%fully redeemed%' ORDER BY chat_item_id"
-
-waitExhausted :: HasCallStack => ChatController -> IO Text
-waitExhausted cc =
-  pollUntil (mfilter (not . null) . Just <$> exhaustedNotices cc) >>= \case
-    [t] -> pure t
-    ts -> error $ "expected one exhaustion notice, got " <> show (length ts)
+retiredText code = code <> "\nRevoked, can no longer be redeemed"
 
 extractCode :: HasCallStack => Text -> Text
 extractCode t = maybe (error ("no badge code in: " <> T.unpack t)) formatBadgeCode (codeInTracker t)

tests/Bots/BadgeService/GroupTests.hs

@@ -22,9 +22,9 @@ import Test.Hspec
 badgeGroupTests :: Spec
 badgeGroupTests = describe "badge group" $ do
   let p = groupCmdAction GROwner
-      issueUsage = ReplyText "use: /issue <type> [months <M>] [uses <N>]"
-      bulkUsage = ReplyText "use: /bulk <type> [months <M>] count <B>"
-      revokeUsage = ReplyText "use: /revoke <code>"
+      issueUsage = ReplyText "Usage: /issue <type> [months <M>] [uses <N>]"
+      bulkUsage = ReplyText "Usage: /bulk <type> [months <M>] count <B>"
+      revokeUsage = ReplyText "Usage: /revoke <code>"
   it "issue defaults" $ p "/issue supporter" `shouldBe` RunCmd (GCIssue BTSupporter 1 1)
   it "issue with months and uses" $ p "/issue legend months 6 uses 50" `shouldBe` RunCmd (GCIssue BTLegend 6 50)
   it "bulk with count" $ p "/bulk supporter count 20" `shouldBe` RunCmd (GCBulk BTSupporter 1 20)
@@ -111,7 +111,7 @@ badgeGroupTests = describe "badge group" $ do
     it "tells a sender below admin that their revoke did not happen" $ do
       code <- newCode
       map (`groupCmdAction` ("/revoke " <> badgeCodeText code)) [GRMember, GRModerator]
-        `shouldBe` replicate 2 (ReplyText "only admins can revoke codes, and this code is now visible to the group - ask an admin to revoke it")
+        `shouldBe` replicate 2 (ReplyText "Only admins can revoke codes. This code is now visible to all members.")
   describe "configured group name and description" $ do
     let cfg name descr = GroupConfig {gDisplayName = name, gDescription = descr}
         profile name descr =
@@ -156,22 +156,20 @@ badgeGroupTests = describe "badge group" $ do
       trackerDecision within t0 `shouldBe` Edit
       trackerDecision past t0 `shouldBe` Repost
   describe "coalescing tracker refreshes" $ do
-    it "keeps one refresh per code, carrying the highest claim" $ do
-      code <- newCode
-      coalesceTrackerRefreshes [GETracker 1 code 1, GETracker 1 code 3, GETracker 2 code 1]
-        `shouldBe` [GETracker 1 code 3, GETracker 2 code 1]
-    it "keeps the highest claim whichever order it queued in" $ do
-      code <- newCode
-      coalesceTrackerRefreshes [GETracker 1 code 3, GETracker 1 code 1] `shouldBe` [GETracker 1 code 3]
+    it "keeps the last refresh of each code" $ do
+      code1 <- newCode
+      code2 <- newCode
+      coalesceTrackerRefreshes [GETracker 1 code1, GETracker 2 code2, GETracker 1 code1]
+        `shouldBe` [GETracker 2 code2, GETracker 1 code1]
     it "keeps every other event, in order" $ do
       code <- newCode
       coalesceTrackerRefreshes
         [ GEInGroup 7 (GACommand GRAdmin "a"),
-          GETracker 1 code 1,
+          GETracker 1 code,
           GEInGroup 7 GAJoined,
-          GETracker 1 code 2
+          GETracker 1 code
         ]
-        `shouldBe` [GEInGroup 7 (GACommand GRAdmin "a"), GEInGroup 7 GAJoined, GETracker 1 code 2]
+        `shouldBe` [GEInGroup 7 (GACommand GRAdmin "a"), GEInGroup 7 GAJoined, GETracker 1 code]
 
 newCode :: IO BadgeCode
 newCode = C.newRandom >>= randomBadgeCode

tests/Bots/BadgeService/WebTests.hs

@@ -159,7 +159,7 @@ badgeWebTests = do
     it "refuses a second row and burns the flag per group" testManagedGroupIsSingleRow
   describe "multi-use" $ do
     it "finds a key's own purchase with its newest credential, and none for another key" testKeyPurchaseLookup
-    it "gives concurrent claims exactly the code's uses, each a distinct count" testMultiUseConcurrentClaimsUpToLimit
+    it "gives concurrent claims exactly the code's uses" testMultiUseConcurrentClaimsUpToLimit
     it "refuses a second claim by the same key without using up a use" testSameKeyClaimsOnce
   describe "badge service catalog seed" $ do
     it "writes the compiled-in catalog into an empty database" testSeedWritesTheCatalog
@@ -728,7 +728,7 @@ insertCode :: DBStore -> ByteString -> BadgeCodePaymentStatus -> Int -> UTCTime
 insertCode st codeHash paymentStatus redeemLimit now =
   withTransaction st $ \db -> insertBadgeCode db codeHash BTSupporter 1 paymentStatus redeemLimit now
 
-claimUse :: DBStore -> Int64 -> UTCTime -> (C.PublicKeyEd25519, BadgeMasterKey) -> IO (Maybe (Int64, Int))
+claimUse :: DBStore -> Int64 -> UTCTime -> (C.PublicKeyEd25519, BadgeMasterKey) -> IO (Maybe Int64)
 claimUse st badgeCodeId now (purchaseKey, masterKey) =
   withTransaction st $ \db ->
     createCodePurchase db NewCodePurchase {badgeCodeId, purchaseKey, masterKey, badgeType = BTSupporter} now
@@ -752,7 +752,7 @@ testKeyPurchaseLookup = withServiceStore $ \st -> do
   let codeHash = digestFixture 41
   badgeCodeId <- insertCode st codeHash CPSFree 2 now
   keys@(k1, mk1) <- newPurchaseKeys
-  Just (purchaseId, _) <- claimUse st badgeCodeId now keys
+  Just purchaseId <- claimUse st badgeCodeId now keys
   withTransaction st (\db -> getCodePurchaseForKey db badgeCodeId k1) >>= \case
     KeyRedeemedUnreadable -> pure ()
     _ -> expectationFailure "expected a purchase with no issuance to be unreadable"
@@ -789,7 +789,7 @@ testMultiUseConcurrentClaimsUpToLimit = withServiceStore $ \st -> do
   badgeCodeId <- insertCode st codeHash CPSFree 3 now
   contenders <- replicateM 6 newPurchaseKeys
   results <- Async.mapConcurrently (claimUse st badgeCodeId now) contenders
-  sort (map snd $ catMaybes results) `shouldBe` [1, 2, 3]
+  length (catMaybes results) `shouldBe` 3
   codeCounts st codeHash `shouldReturn` Just (3, 3)
 
 data StubCall