mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-11-11 16:07:49 +00:00
badge-service: name the rule for when a subscription is due a store check
The issue path's purchase read becomes getIssuePurchase and its "ask the store now" test becomes subscriptionCheckDue, so the request router can read the same rows by the same rule. No behaviour change. Run: 005-subscriptions-load-timing, slice 1
This commit is contained in:
1 parent
b84d031bad
commit
0d74c149bb
1 file changed
+12
-5
@@ -640,9 +640,7 @@ firstMonthResponse db purchaseId creditPaymentId_ subscription (rows, issuance@(
|
||||
issueBadgeCmd :: BadgeIssuerKey -> ChatController -> StoreVerifier -> C.PublicKeyEd25519 -> BadgeBalance -> IO BadgeServiceResponse
|
||||
issueBadgeCmd key cc verifier purchaseKey BadgeBalance {lastEntry} = do
|
||||
now <- badgeNow cc
|
||||
purchase_ <- withDB' "getBadgePurchase" cc $ \db -> do
|
||||
p_ <- getPurchaseByKey db purchaseKey
|
||||
forM p_ $ \p@ServicePurchase {badgePurchaseId} -> (p,,) <$> getLedgerTip db badgePurchaseId <*> getPurchaseSubscription db badgePurchaseId
|
||||
purchase_ <- withDB' "getBadgePurchase" cc (\db -> getIssuePurchase db purchaseKey)
|
||||
case purchase_ of
|
||||
Left _ -> pure $ errorResponse BSEInternal
|
||||
Right Nothing -> pure $ errorResponse BSEUnknownPurchaseKey
|
||||
@@ -672,8 +670,8 @@ issueBadgeCmd key cc verifier purchaseKey BadgeBalance {lastEntry} = do
|
||||
pure $ fromRight (errorResponse BSEInternal) r
|
||||
-- Nothing but the store's answer is written until a charge is granted: a lapse at now would be dated
|
||||
-- after a grant a later check may make at an earlier period start, and the client would read it as a pass that issued.
|
||||
renewSubscription ServicePurchase {badgePurchaseId, masterKey, badgeType} tip PurchaseSubscription {paymentId, provider, subscriptionRef, storedState, checkedAt} now
|
||||
| maybe False (\t -> diffUTCTime now t < subscriptionCheckInterval) checkedAt = answered "answerStoredSubscription" $ \db -> issueResponse db badgePurchaseId now (Just storedState)
|
||||
renewSubscription ServicePurchase {badgePurchaseId, masterKey, badgeType} tip subscription@PurchaseSubscription {paymentId, provider, subscriptionRef, storedState} now
|
||||
| not (subscriptionCheckDue now tip subscription) = answered "answerStoredSubscription" $ \db -> issueResponse db badgePurchaseId now (Just storedState)
|
||||
| otherwise =
|
||||
withDB' "stampSubscriptionCheck" cc (\db -> stampSubscriptionCheck db paymentId now) >>= \case
|
||||
Left _ -> pure $ errorResponse BSEInternal
|
||||
@@ -732,6 +730,15 @@ issueBadgeCmd key cc verifier purchaseKey BadgeBalance {lastEntry} = do
|
||||
credential_ <- getCurrentIssuance db purchaseId t
|
||||
pure $ maybe (errorResponse BSEInternal) (credentialResponse credential_ (assertedUuid <$ assertedId) subscription) entries_
|
||||
|
||||
getIssuePurchase :: DB.Connection -> C.PublicKeyEd25519 -> IO (Maybe (ServicePurchase, Maybe StatementEntry, Maybe PurchaseSubscription))
|
||||
getIssuePurchase db purchaseKey = do
|
||||
p_ <- getPurchaseByKey db purchaseKey
|
||||
forM p_ $ \p@ServicePurchase {badgePurchaseId} -> (p,,) <$> getLedgerTip db badgePurchaseId <*> getPurchaseSubscription db badgePurchaseId
|
||||
|
||||
subscriptionCheckDue :: UTCTime -> StatementEntry -> PurchaseSubscription -> Bool
|
||||
subscriptionCheckDue now tip PurchaseSubscription {checkedAt} =
|
||||
paidThrough tip <= now && maybe True (\t -> diffUTCTime now t >= subscriptionCheckInterval) checkedAt
|
||||
|
||||
-- | Each subscription asks its store at most this often, failed attempts included, so a client
|
||||
-- repeating its requests cannot spend the store quota every subscriber shares.
|
||||
subscriptionCheckInterval :: NominalDiffTime
|
||||
|
||||
Reference in new issue
Block a user