badge service: name a funding's state by whether it was credited, not claimed

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

@@ -443,7 +443,7 @@ redeemCode key cc purchaseKey masterKey codeText = case parseBadgeCode codeText
           -- Redeeming an unpaid code would issue a free badge, so unpaid is refused.
           | CPSUnpaid <- paymentStatus -> pure $ Left $ errorResponse BSEPaymentPending
           | otherwise ->
-              claimedResponse db BSECodeUsed purchaseKey redemption >>= \case
+              creditedResponse db BSECodeUsed purchaseKey redemption >>= \case
                 Left resp -> pure $ Left resp
                 Right ()
                   | maybe False (now >=) expiresAt -> pure $ Left $ errorResponse BSECodeExpired
@@ -453,11 +453,11 @@ redeemCode key cc purchaseKey masterKey codeText = case parseBadgeCode codeText
 -- nothing is written until the credential is signed.
 purchaseWithReceipt :: BadgeIssuerKey -> ChatController -> C.PublicKeyEd25519 -> BadgeMasterKey -> StoreReceipt -> IO BadgeServiceResponse
 purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTransactionRef {provider, transactionRef = providerRef}, verifyReceipt} =
-  withDB' "getStorePayment" cc (\db -> getStorePaymentClaim db provider providerRef) >>= \case
+  withDB' "getStorePayment" cc (\db -> getStorePaymentCredit db provider providerRef) >>= \case
     Left _ -> pure $ errorResponse BSEInternal
-    Right claim
+    Right credit
       -- only the key it credited can ask, and it is told only what it was given, so the store is not asked
-      | claimedBy claim -> answerClaim claim
+      | creditedBy credit -> answerCredit credit
       | otherwise ->
           verifyReceipt >>= \case
             Left refusal -> storeRefusalResponse refusal
@@ -467,16 +467,16 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTran
             Right VerifiedStoreTransaction {quantity}
               | quantity /= 1 -> storeRefusalResponse $ SRVerifierFailed $ "verified a quantity of " <> tshow quantity
             Right VerifiedStoreTransaction {testPurchase = True} -> storeRefusalResponse $ SRInvalid "test purchase"
-            -- another key's claim is told only once the store vouched for the receipt, or it would reveal which transactions were credited
-            Right tx -> case claim of
-              Unclaimed -> newPurchase tx
-              _ -> answerClaim claim
+            -- another key's credit is told only once the store vouched for the receipt, or it would reveal which transactions were credited
+            Right tx -> case credit of
+              Uncredited -> newPurchase tx
+              _ -> answerCredit credit
   where
-    claimedBy = \case
-      Claimed ClaimedPurchase {purchaseKey = k} -> k == purchaseKey
+    creditedBy = \case
+      Credited CreditedPurchase {purchaseKey = k} -> k == purchaseKey
       _ -> False
-    answerClaim claim =
-      withDB' "answerStoreClaim" cc (\db -> claimedResponse db BSEReceiptUsed purchaseKey claim) <&> \case
+    answerCredit credit =
+      withDB' "answerStoreCredit" cc (\db -> creditedResponse db BSEReceiptUsed purchaseKey credit) <&> \case
         Right (Left resp) -> resp
         _ -> errorResponse BSEInternal
     -- the product is read only for a receipt not yet credited, so retiring it leaves its replays answered
@@ -492,7 +492,7 @@ purchaseWithReceipt key cc purchaseKey masterKey StoreReceipt {txRef = StoreTran
               liftIO (createStorePurchase db NewStorePurchase {paymentId, provider, providerRef, paid, purchaseKey, masterKey, badgeType} now) >>= \case
                 -- Credited to another key, or to this one by a request that ran alongside it, while signing.
                 Nothing ->
-                  liftIO (getStorePaymentClaim db provider providerRef >>= claimedResponse db BSEReceiptUsed purchaseKey) >>= \case
+                  liftIO (getStorePaymentCredit db provider providerRef >>= creditedResponse db BSEReceiptUsed purchaseKey) >>= \case
                     Left resp -> pure resp
                     Right () -> logError "badge service: claiming a store payment failed, but it funds no purchase" $> errorResponse BSEInternal
                 Just purchaseId -> liftIO $ firstMonthResponse db purchaseId (Just paymentId) firstMonth
@@ -507,11 +507,11 @@ storeRefusalResponse = \case
   SRVerifierFailed reason -> logError ("store receipt not verified: " <> reason) $> errorResponse BSEInternal
   SRNotConfigured -> logWarn "store receipt refused: no verifier for this store is configured" $> errorResponse BSEProviderNotConfigured
 
-claimedResponse :: DB.Connection -> BadgeServiceErrorCode -> C.PublicKeyEd25519 -> FundingClaim -> IO (Either BadgeServiceResponse ())
-claimedResponse db usedCode purchaseKey = \case
-  Unclaimed -> pure $ Right ()
-  ClaimedUnreadable -> pure $ Left $ errorResponse BSEInternal
-  Claimed ClaimedPurchase {purchaseKey = k, badgePurchaseId, credential}
+creditedResponse :: DB.Connection -> BadgeServiceErrorCode -> C.PublicKeyEd25519 -> FundingCredit -> IO (Either BadgeServiceResponse ())
+creditedResponse db usedCode purchaseKey = \case
+  Uncredited -> pure $ Right ()
+  CreditedUnreadable -> pure $ Left $ errorResponse BSEInternal
+  Credited CreditedPurchase {purchaseKey = k, badgePurchaseId, credential}
     | k /= purchaseKey -> pure $ Left $ errorResponse usedCode
     | otherwise ->
         maybe (Left $ errorResponse BSEInternal) (Left . credentialResponse (Just credential) Nothing)

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

@@ -8,13 +8,13 @@
 
 module BadgeService.Store
   ( IssuedCode (..),
-    FundingClaim (..),
-    ClaimedPurchase (..),
+    FundingCredit (..),
+    CreditedPurchase (..),
     NewCodePurchase (..),
     NewStorePurchase (..),
     ServicePurchase (..),
     getBadgeCode,
-    getStorePaymentClaim,
+    getStorePaymentCredit,
     purchaseKeyExists,
     getPurchaseByKey,
     getLedgerTip,
@@ -64,15 +64,15 @@ data IssuedCode = IssuedCode
     paymentStatus :: BadgeCodePaymentStatus,
     revokedAt :: Maybe UTCTime,
     expiresAt :: Maybe UTCTime,
-    redemption :: FundingClaim
+    redemption :: FundingCredit
   }
 
-data FundingClaim
-  = Unclaimed
-  | Claimed ClaimedPurchase
-  | ClaimedUnreadable
+data FundingCredit
+  = Uncredited
+  | Credited CreditedPurchase
+  | CreditedUnreadable
 
-data ClaimedPurchase = ClaimedPurchase
+data CreditedPurchase = CreditedPurchase
   { badgePurchaseId :: Int64,
     purchaseKey :: C.PublicKeyEd25519,
     credential :: BadgeCredential
@@ -119,11 +119,11 @@ getBadgeCode db codeHash =
       (Only (Binary codeHash))
   where
     toCode (badgeCodeId, badgeType, months, paymentStatus, revokedAt, expiresAt, purchaseId_, purchaseKey_, credential_) =
-      IssuedCode {badgeCodeId, badgeType, months, paymentStatus, revokedAt, expiresAt, redemption = fundingClaim purchaseId_ purchaseKey_ credential_}
+      IssuedCode {badgeCodeId, badgeType, months, paymentStatus, revokedAt, expiresAt, redemption = fundingCredit purchaseId_ purchaseKey_ credential_}
 
-getStorePaymentClaim :: DB.Connection -> PaymentProvider -> Text -> IO FundingClaim
-getStorePaymentClaim db provider providerRef =
-  maybeFirstRow' Unclaimed (\(purchaseId, purchaseKey, credential_) -> fundingClaim (Just purchaseId) (Just purchaseKey) credential_) $
+getStorePaymentCredit :: DB.Connection -> PaymentProvider -> Text -> IO FundingCredit
+getStorePaymentCredit db provider providerRef =
+  maybeFirstRow' Uncredited (\(purchaseId, purchaseKey, credential_) -> fundingCredit (Just purchaseId) (Just purchaseKey) credential_) $
     DB.query
       db
       [sql|
@@ -137,12 +137,12 @@ getStorePaymentClaim db provider providerRef =
       |]
       (textEncode provider, providerRef)
 
-fundingClaim :: Maybe Int64 -> Maybe C.PublicKeyEd25519 -> Maybe (Binary ByteString) -> FundingClaim
-fundingClaim purchaseId_ purchaseKey_ credential_ = case (purchaseId_, purchaseKey_) of
+fundingCredit :: Maybe Int64 -> Maybe C.PublicKeyEd25519 -> Maybe (Binary ByteString) -> FundingCredit
+fundingCredit purchaseId_ purchaseKey_ credential_ = case (purchaseId_, purchaseKey_) of
   (Just badgePurchaseId, Just purchaseKey) -> case decodeCredential =<< credential_ of
-    Just credential -> Claimed ClaimedPurchase {badgePurchaseId, purchaseKey, credential}
-    Nothing -> ClaimedUnreadable
-  _ -> Unclaimed
+    Just credential -> Credited CreditedPurchase {badgePurchaseId, purchaseKey, credential}
+    Nothing -> CreditedUnreadable
+  _ -> Uncredited
   where
     decodeCredential (Binary bs) = J.decodeStrict' bs
 

tests/Bots/BadgeService/WebTests.hs

@@ -14,7 +14,7 @@ import BadgeService.Poller
 import BadgeService.Providers
 import BadgeService.Providers.BTCPay (btcpayProvider, listPageSize, maxListPages)
 import BadgeService.Providers.Stripe (stripeProvider)
-import BadgeService.Store (FundingClaim (..), IssuedCode (..), NewCodePurchase (..), RevokeResult (..), createCodePurchase, getBadgeCode, insertBadgeCode, revokeCode)
+import BadgeService.Store (FundingCredit (..), IssuedCode (..), NewCodePurchase (..), RevokeResult (..), createCodePurchase, getBadgeCode, insertBadgeCode, revokeCode)
 import BadgeService.Store.Invoices
 import BadgeService.Waiters (awaitStatus, newWaiters, publish, waitingCount)
 import BadgeService.Web.Server
@@ -471,7 +471,7 @@ testRevokeAndRedeemExcludeEachOther = withServiceStore $ \st -> do
       revoke codeHash = withTransaction st $ \db -> revokeCode db codeHash now
       unredeemed codeHash =
         withTransaction st (`getBadgeCode` codeHash) >>= \case
-          Just IssuedCode {redemption = Unclaimed} -> pure True
+          Just IssuedCode {redemption = Uncredited} -> pure True
           _ -> pure False
   revokedFirst <- newCode "revoked-first"
   revoke "revoked-first" `shouldReturn` Revoked