diff --git a/apps/simplex-store-service/src/StoreService/Names/Codes.hs b/apps/simplex-store-service/src/StoreService/Names/Codes.hs index 8097716c87..bacd833beb 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Codes.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Codes.hs @@ -72,9 +72,10 @@ codeRefusalTag = \case CRNotCovering -> "code_not_covering" -- | Why the code cannot pay for the registration's name of this length. A code the registration --- already holds stays good for it, even if revoked or expired since. +-- already holds stays good for it until spent, even if revoked or expired since. codeRefusal :: UTCTime -> RegistrationId -> Int -> PrepaidCode -> Maybe CodeRefusal -codeRefusal now rid len code@PrepaidCode {pcReservedBy, pcMinLength} +codeRefusal now rid len code@PrepaidCode {pcReservedBy, pcSpentAt, pcMinLength} + | isJust pcSpentAt = Just CRUsed | pcReservedBy == Just rid = covering | otherwise = stateRefusal (codeState now code) <|> covering where diff --git a/tests/Bots/StoreService/NamesCodesTests.hs b/tests/Bots/StoreService/NamesCodesTests.hs index f84de7a083..f9cf0f26ba 100644 --- a/tests/Bots/StoreService/NamesCodesTests.hs +++ b/tests/Bots/StoreService/NamesCodesTests.hs @@ -56,6 +56,7 @@ namesCodesTests = describe "StoreService names: prepaid codes" $ do it "reserves an unused code in the transaction of the registration's write" testReserve it "refuses each unusable code with its tag, before the write runs" testReserveRefusals it "keeps a code its registration holds even if revoked or expired since, still checking the length" testReserveHeld + it "refuses a spent code to its own registration with code_used, before the write runs" testReserveSpent it "gives the code back when the write refuses" testReserveWriteRefused it "lets one of two concurrent reservations of a code win, the other answered code_reserved" testConcurrentReserve it "releases and spends a code only after the write, and only for its holder" testReleaseSpend @@ -284,6 +285,19 @@ testReserveHeld = withOrders $ \turns st -> do reserveCode turns st tNow pcCodeHash r1 9 writeOk `shouldReturn` Left CRInvalid readCode st row `shouldReturn` held +testReserveSpent :: IO () +testReserveSpent = withOrders $ \turns st -> do + code <- newCode 8 + row@PrepaidCode {pcCodeHash} <- issueAs st code usable + placeCode st "r3" ownerB (order "carolsbakery" 3) row `shouldReturn` Right () + let r3 = RegistrationId "r3" + withTransaction st (\db -> spendPrepaidCode db (pcId row) r3 tNow) `shouldReturn` True + spent <- readCode st row + wrote <- newIORef False + reserveCode turns st tNow pcCodeHash r3 8 (\_ -> Right () <$ writeIORef wrote True :: IO (Either Text ())) `shouldReturn` Left CRUsed + readIORef wrote `shouldReturn` False + readCode st row `shouldReturn` spent + testReserveWriteRefused :: IO () testReserveWriteRefused = withOrders $ \turns st -> do code <- newCode 8