store: one definition of an invoice holding money

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

@@ -97,7 +97,7 @@ import StoreService.Names.Chain (TxHash (..))
 import StoreService.Names.Phases (RegistrationId (..))
 import StoreService.Names.Signatures (OrderFields (..), parseSignature)
 import StoreService.Store (RevokeResult (..))
-import StoreService.Store.Invoices (StoreDecodeError (..), executeChanging, invoiceStatusText, lockInvoice, newInvoiceId, truncateToSecond)
+import StoreService.Store.Invoices (StoreDecodeError (..), executeChanging, invoiceStatusText, lockInvoice, newInvoiceId, truncateToSecond, unfundedQuery)
 
 #if defined(dbPostgres)
 import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
@@ -498,16 +498,9 @@ getLiveOrders db commitment owner (LabelHash lh) now =
   where
     toLiveOrder (row :. Only (BI loOverdue)) = (\loRegistration -> LiveOrder {loRegistration, loOverdue}) <$> toRegistration row
 
--- | A payment holding money, as the sweep's own check reads one, makes the invoice i funded.
+-- | The sweep's own check, on the invoice joined as i.
 unfunded :: Query
-unfunded =
-  " "
-    <> [sql|
-    AND NOT EXISTS (
-      SELECT 1 FROM sx_badge_service_payments p
-      WHERE p.invoice_id = i.invoice_id AND (COALESCE(p.amount, 0) > 0 OR p.crypto_paid IS NOT NULL OR p.paid_in_full = 1)
-    )
-  |]
+unfunded = unfundedQuery "i.invoice_id"
 
 -- | Run in the transaction that inserts the next order, so the unique constraints let it in. The invoice is written before
 -- the registration, as settlement, cancel and the sweep write them; a registration write that loses after it leaves the

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

@@ -27,6 +27,7 @@ module StoreService.Store.Invoices
     overdueInvoices,
     expireOverdueInvoice,
     lockInvoice,
+    unfundedQuery,
     newInvoiceId,
     readCatalogRows,
     seedCatalog,
@@ -233,12 +234,20 @@ qUnpaidRefs =
 qCodeHashExists :: Query
 qCodeHashExists = mkQuery "SELECT 1 FROM @badge_codes WHERE code_hash = ? LIMIT 1"
 
-unfundedOnly :: Text
-unfundedOnly =
+-- | No payment holding money was read for the invoice whose id is in this column, as paymentHolds reads one.
+-- The sweep and the overdue close of a name order must agree on it, so both use this.
+unfundedBy :: Text -> Text
+unfundedBy invoiceId =
   "AND NOT EXISTS (SELECT 1 FROM @payments p "
-    <> "WHERE p.invoice_id = @invoices.invoice_id AND ("
+    <> ("WHERE p.invoice_id = " <> invoiceId <> " AND (")
     <> "COALESCE(p.amount, 0) > 0 OR p.crypto_paid IS NOT NULL OR p.paid_in_full = 1)) "
 
+unfundedQuery :: Text -> Query
+unfundedQuery = mkQuery . (" " <>) . unfundedBy
+
+unfundedOnly :: Text
+unfundedOnly = unfundedBy "@invoices.invoice_id"
+
 qOverdueInvoices :: Query
 qOverdueInvoices =
   mkQuery $

tests/Bots/StoreService/NamesOrdersTests.hs

@@ -110,6 +110,7 @@ namesOrdersTests = describe "StoreService names: orders" $ do
   describe "invoice side" $ do
     it "finds an invoice by provider ref in either table, refusing a ref both hold" testProviderRefs
     it "reads and sweeps name invoices with the badge ones" testPollerQueries
+    it "agrees between the sweep and the overdue close on which invoices hold money" testFundedAgreement
   describe "registration view" $ do
     it "has the contract's fields" testViewFields
     it "reads the intent nonce in committed and the code length in taken and code_issued" testViewReads
@@ -914,6 +915,28 @@ testPollerQueries = withServiceStore $ \st -> do
   map oiProviderRef <$> overdueInvoices st (addUTCTime 7200 t0) `shouldReturn` ["ref-inv-r1"]
   overdueInvoices st t0 `shouldReturn` []
 
+testFundedAgreement :: IO ()
+testFundedAgreement = withServiceStore $ \st -> do
+  waiters <- newWaiters
+  let now = addUTCTime 3600 t0
+      shapes =
+        [ ("amount", Just (SigFunded (rcv 100 Nothing) PaidInPart), True),
+          ("crypto", Just (SigFunded (rcv 0 (Just "0.00001")) PaidInPart), True),
+          ("verdict", Just (SigFunded (rcv 0 Nothing) PaidInFull), True),
+          ("nothing", Nothing, False)
+        ]
+  forM_ (zip [1 ..] shapes) $ \(n, (rid, signal, _)) -> do
+    placePaid st rid ownerA (order ("fundname" <> rid) n) t0 `shouldReturn` Right ()
+    forM_ signal $ \sig -> void $ settleOrder st waiters Nothing (InvoiceId $ "inv-" <> rid) sig t0
+  listed <- map oiInvoiceId <$> overdueInvoices st now
+  forM_ (zip [1 ..] shapes) $ \(n, (rid, _, funded)) -> do
+    let o = order ("fundname" <> rid) n
+    (InvoiceId ("inv-" <> rid) `elem` listed) `shouldBe` not funded
+    [LiveOrder {loRegistration, loOverdue}] <- withTransaction st $ \db -> getLiveOrders db (ofCommitment o) ownerA (ofLabelHash o) now
+    (rid, loOverdue) `shouldBe` (rid, not funded)
+    closed <- withTransaction st $ \db -> closeOverdue db loRegistration now
+    (rid, closed == Written (nrVersion loRegistration + 1)) `shouldBe` (rid, not funded)
+
 testViewFields :: IO ()
 testViewFields = withServiceStore $ \st -> withFakeEthNode $ \node -> do
   Right () <- placePaid st "r1" ownerA (order "alicebakery" 1) (addUTCTime 3600 t0)