store: spend a landed order's released code

apps/simplex-store-service/src/StoreService/Names/Codes.hs

@@ -15,6 +15,7 @@ module StoreService.Names.Codes
     reserveCode,
     releaseCode,
     spendCode,
+    spendLandedCode,
     issueNameCode,
     revokeNameCode,
   )
@@ -37,7 +38,7 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
 import StoreService.Config (minNameYears)
 import StoreService.Group.Command (maxNameYears)
 import StoreService.Names.Phases (RegistrationId)
-import StoreService.Names.Store (CodeHashTaken (..), NewPrepaidCode (..), PrepaidCode (..), getPrepaidCode, getPrepaidCodeById, insertPrepaidCode, releasePrepaidCode, reservePrepaidCode, revokePrepaidCode, spendPrepaidCode)
+import StoreService.Names.Store (CodeHashTaken (..), NewPrepaidCode (..), PrepaidCode (..), getPrepaidCode, getPrepaidCodeById, insertPrepaidCode, releasePrepaidCode, reservePrepaidCode, revokePrepaidCode, spendLandedPrepaidCode, spendPrepaidCode)
 import StoreService.Names.Turns (Turns, withCodeTurn)
 import StoreService.Store (RevokeResult (..))
 
@@ -137,6 +138,11 @@ releaseCode turns st codeId rid = afterWrite turns st codeId (\db -> releasePrep
 spendCode :: Turns -> DBStore -> UTCTime -> Int64 -> RegistrationId -> (DB.Connection -> IO (Either e a)) -> IO (Either e (a, Bool))
 spendCode turns st now codeId rid = afterWrite turns st codeId (\db -> spendPrepaidCode db codeId rid now)
 
+-- | As spendCode, for a registration whose register went through: a code it no longer holds is spent too while still usable.
+-- False when the code was released and then spent, revoked or expired meanwhile.
+spendLandedCode :: Turns -> DBStore -> UTCTime -> Int64 -> RegistrationId -> (DB.Connection -> IO (Either e a)) -> IO (Either e (a, Bool))
+spendLandedCode turns st now codeId rid = afterWrite turns st codeId (\db -> spendLandedPrepaidCode db codeId rid now)
+
 afterWrite :: Turns -> DBStore -> Int64 -> (DB.Connection -> IO Bool) -> (DB.Connection -> IO (Either e a)) -> IO (Either e (a, Bool))
 afterWrite turns st codeId change write = do
   codeHash_ <- withTransaction st $ \db -> fmap pcCodeHash <$> getPrepaidCodeById db codeId

apps/simplex-store-service/src/StoreService/Names/Orders.hs

@@ -68,12 +68,12 @@ import Simplex.Messaging.Eth.Address (Address, recoverAddress)
 import Simplex.Messaging.SimplexName (LabelHash (..))
 import Simplex.Messaging.Util (tshow)
 import StoreService.Config (NamesConfig (..))
-import StoreService.Log (logWarn)
-import StoreService.Names.Codes (CodeRefusal (..), codeRefusal, reserveCode, reserveRefusal, spendCode)
+import StoreService.Log (logError, logWarn)
+import StoreService.Names.Codes (CodeRefusal (..), codeRefusal, reserveCode, reserveRefusal, spendLandedCode)
 import StoreService.Names.Contracts (Contracts, NameStatus (..), chainPriceCents, codeLengthFor, nameExpires, nameStatus, ownerOfToken, secondsPerYear)
 import StoreService.Names.Env (NamesEnv (..))
-import StoreService.Names.Phases (Phases, RegistrationId)
-import StoreService.Names.Abi (bytes32FromHex)
+import StoreService.Names.Phases (Phases, RegistrationId (..))
+import StoreService.Names.Abi (bytes32FromHex, hex)
 import StoreService.Names.Signatures (OrderFields (..), orderMessage, parseChecksumAddress, parseSignature, personalDigest)
 import StoreService.Names.Store (CodeHashTaken, LiveOrder (..), NamePhase (..), NameRegistration (..), NewPrepaidCode (..), NewRegistration (..), PrepaidCode (..), RegistrationPayment (..), RegistrationRefused (..), NameTransaction (..), TxFor (..), TxStatus (..), VersionWrite (..), closeOverdue, createCodeRegistration, getLiveOrders, getPrepaidCode, getPrepaidCodeById, getRegistrationByOrderHash, insertPrepaidCode, isLabelRegistering, registrationTransactions, retargetRegistration, setIssuedCode, updateRegistration)
 import StoreService.Names.Turns (Turns, withCodeTurn)
@@ -360,7 +360,15 @@ confirmLanded OrdersEnv {oeStore, oeContracts, oeTurns, oeNow} r@NameRegistratio
           write db = versionWritten <$> updateRegistration db registered now
       case nrPayment of
         RPInvoice {} -> withTransaction oeStore write
-        RPCode codeId -> fmap fst <$> spendCode oeTurns oeStore now codeId nrId write
+        RPCode codeId -> spendLandedCode oeTurns oeStore now codeId nrId write >>= traverse (paidWith codeId)
+    paidWith codeId (v, spent) = do
+      unless spent $ do
+        code <- withTransaction oeStore (`getPrepaidCodeById` codeId)
+        logError $
+          "names: registration " <> ridText nrId <> " turned out registered with prepaid code " <> maybe (tshow codeId) (hex . pcCodeHash) code
+            <> ", which was released and then spent, revoked or expired: the name was paid with it"
+      pure v
+    ridText (RegistrationId t) = t
 
 -- | The hash of the code a taken order was turned into.
 issuedCodeHash :: DBStore -> NameRegistration -> IO (Maybe ByteString)

apps/simplex-store-service/src/StoreService/Names/Store.hs

@@ -54,6 +54,7 @@ module StoreService.Names.Store
     reservePrepaidCode,
     releasePrepaidCode,
     spendPrepaidCode,
+    spendLandedPrepaidCode,
     revokePrepaidCode,
     insertTransaction,
     recordTransactionOutcome,
@@ -761,6 +762,21 @@ spendPrepaidCode db codeId (RegistrationId rid) now =
       "UPDATE sx_badge_service_name_prepaid_codes SET spent_at = ? WHERE name_prepaid_code_id = ? AND reserved_by = ? AND spent_at IS NULL"
       (truncateToSecond now, codeId, rid)
 
+-- | For a registration whose register went through: spends the code it holds, or one released and still usable; False otherwise.
+spendLandedPrepaidCode :: DB.Connection -> Int64 -> RegistrationId -> UTCTime -> IO Bool
+spendLandedPrepaidCode db codeId (RegistrationId rid) now' =
+  (> 0)
+    <$> executeChanging
+      db
+      [sql|
+        UPDATE sx_badge_service_name_prepaid_codes SET reserved_by = ?, reserved_at = COALESCE(reserved_at, ?), spent_at = ?
+        WHERE name_prepaid_code_id = ? AND spent_at IS NULL
+          AND (reserved_by = ? OR (reserved_by IS NULL AND revoked_at IS NULL AND code_payment_status <> ? AND (expires_at IS NULL OR expires_at > ?)))
+      |]
+      (rid, now, now, codeId, rid, CPSUnpaid, now)
+  where
+    now = truncateToSecond now'
+
 -- | A reserved code can be revoked, and its order keeps it; a spent one cannot.
 revokePrepaidCode :: DB.Connection -> ByteString -> UTCTime -> IO RevokeResult
 revokePrepaidCode db codeHash now = do

tests/Bots/StoreService/NamesOwnerTests.hs

@@ -9,7 +9,7 @@ import Bots.StoreService.FakeEthNode
 import Bots.StoreService.NamesContractsTests (launchPricesAnswer, oracle, pricesAnswer, pricesCall, registrarOf, rentPriceAnswer, rentPriceCall, unhex)
 import Bots.StoreService.NamesOrdersTests
 import Bots.StoreService.NamesStoreTests (order, ownerA, t0)
-import Bots.StoreService.WebTests (digestFixture, jsonObject, statusOf, webGet)
+import Bots.StoreService.WebTests (capturingStderr, digestFixture, jsonObject, statusOf, webGet)
 import Control.Applicative ((<|>))
 import Control.Arrow ((&&&))
 import Control.Concurrent (threadDelay)
@@ -74,6 +74,7 @@ namesOwnerTests = describe "StoreService names: owner" $ do
     it "runs the order checks on the new fields: invalid_name, the duration, name_taken, name_check_unavailable" testMoveOrderChecks
     it "registers a failed order whose register went through, by its mined register or by ownerOf, answering registration_changed and spending a code" testMoveLanded
     it "answers name_check_unavailable when the register check cannot read the chain, changing nothing" testMoveLandedUnread
+    it "spends a released code still unused when its failed order turns out registered, and alerts once when it was spent elsewhere meanwhile" testMoveLandedReleasedCode
     it "answers a dearer name price_too_high with its price, and moves to a cheaper one at its price" testMovePrice
     it "checks a code order's code again: code_not_covering for a shorter name, a held code kept though revoked and expired since" testMoveCodeOrder
     it "reserves a released code again while unused, else answers code_used, code_reserved, code_invalid or code_expired" testMoveReleasedCode
@@ -536,6 +537,36 @@ testMoveLanded = withOwner $ \ctx -> do
   v <- moved ctx keyB notLanded to
   fieldsIn v [("phase", "queued"), ("moves", J.Number 1)]
 
+testMoveLandedReleasedCode :: IO ()
+testMoveLandedReleasedCode = withOwner $ \ctx@Ctx {cStore} -> do
+  answerFree ctx "alicebakers"
+  spender <- paidIn ctx (byB aliceOrder) {oCommitment = commitmentOf 20} id
+  (unused, unusedCode) <- codeIn ctx 7 dynamisOrder failedPhase
+  (spentElsewhere, spentCode) <- codeIn ctx 8 aliceOrder failedPhase
+  let expiry = seconds orderTime + 2 * 31536000
+  forM_ [("dynamis", unused), ("alicebakery", spentElsewhere)] $ \(label, r) -> do
+    answerExpiry ctx label expiry
+    answerOwner ctx label (nrOwner r)
+  forM_ [(unused, unusedCode), (spentElsewhere, spentCode)] $ \(r, code) ->
+    withTransaction cStore (\db -> releasePrepaidCode db (pcId code) (nrId r)) `shouldReturn` True
+  withTransaction cStore $ \db -> do
+    reservePrepaidCode db (pcId spentCode) (nrId spender) orderTime `shouldReturn` True
+    spendPrepaidCode db (pcId spentCode) (nrId spender) orderTime `shouldReturn` True
+  spenderBefore <- stored ctx spender
+  spentBefore <- codeRow ctx spentCode
+  to <- moveTo ctx "alicebakers" 10
+  fst <$> move ctx keyA unused to `shouldReturn` 409
+  nrPhase <$> stored ctx unused `shouldReturn` PRegistered
+  (pcReservedBy &&& pcSpentAt) <$> codeRow ctx unusedCode `shouldReturn` (Just (nrId unused), Just orderTime)
+  to' <- moveTo ctx "alicebakers" 11
+  logs <- capturingStderr $ fst <$> move ctx keyA spentElsewhere to' `shouldReturn` 409
+  nrPhase <$> stored ctx spentElsewhere `shouldReturn` PRegistered
+  length (filter (\l -> "[ERROR " `T.isInfixOf` l && hex (pcCodeHash spentCode) `T.isInfixOf` l && idText (nrId spentElsewhere) `T.isInfixOf` l) $ T.lines logs) `shouldBe` 1
+  codeRow ctx spentCode `shouldReturn` spentBefore
+  stored ctx spender `shouldReturn` spenderBefore
+  where
+    idText (RegistrationId t) = t
+
 testMoveLandedUnread :: IO ()
 testMoveLandedUnread = withOwner $ \ctx@Ctx {cNode} -> do
   answerFree ctx "alicebakers"