store: read expiry and lapse in order answers

apps/simplex-store-service/src/StoreService/Web/Http.hs

@@ -36,6 +36,8 @@ module StoreService.Web.Http
     nameBodyBytes,
     parseCodeHash,
     invoicePairs,
+    invoiceAt,
+    expiryMoment,
     destinationPairs,
     amountJSON,
     confirmationsFor,
@@ -71,7 +73,7 @@ import Simplex.Chat.PaymentService.Types (CardProvider (..), CurrencyAmount (..)
 import Simplex.Messaging.Util (safeDecodeUtf8)
 import StoreService.Config (BTCPayConfig (..), ListenerConfig (..), ServiceConfig (..), SpeedPolicy (..), StripeConfig (..), defaultExpiryMinutes, defaultSessionMinutes)
 import StoreService.Providers (Provider (..))
-import StoreService.Store.Invoices (InvoicePayment (..), InvoiceRow (..), cryptoCurrencyText, invoiceStatusText)
+import StoreService.Store.Invoices (InvoicePayment (..), InvoiceRow (..), cryptoCurrencyText, invoiceStatusText, paymentHolds)
 import Text.Read (readMaybe)
 
 data HttpEnv = HttpEnv
@@ -301,6 +303,18 @@ parseCodeHash t
   where
     canonical = T.filter (/= '=') . safeDecodeUtf8 . B64U.encode
 
+-- | An open name invoice past its expiry with no money received reads expired before the sweep marks it.
+invoiceAt :: UTCTime -> InvoiceRow -> InvoiceRow
+invoiceAt now row = case expiryMoment row of
+  Just expiry | now > expiry -> row {irStatus = ISExpired}
+  _ -> row
+
+-- | A funded open invoice stays open until it settles.
+expiryMoment :: InvoiceRow -> Maybe UTCTime
+expiryMoment InvoiceRow {irStatus, irExpiresAt, irPayment}
+  | irStatus == ISOpen && not (maybe False paymentHolds irPayment) = Just irExpiresAt
+  | otherwise = Nothing
+
 -- | The fields every invoice view has, a badge's and a name's.
 invoicePairs :: Maybe Int -> InvoiceRow -> [Pair]
 invoicePairs confirmations InvoiceRow {irAmount, irCurrency, irDestination, irExpiresAt, irStatus, irPayment} =

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

@@ -35,8 +35,9 @@ import StoreService.Orders (publishRegistration)
 import StoreService.Providers (OrderDraft (..), Provider (..), ProviderError (..), ProviderInvoice (..), expiresItself)
 import StoreService.Store.Invoices (InvoiceRow (..), NewNameInvoice (..), getInvoice, insertNameInvoice, newInvoiceId, truncateToSecond)
 import StoreService.Waiters (Waiters, publish)
-import StoreService.Web.Http (Respond, badRequest, confirmationsFor, internalError, invalidName, invoicePairs, invoiceWindow, jsonError, jsonResponse, nameBodyBytes, notFound, providerFor, providerNamed, providerUnavailable, readBoundedBody)
+import StoreService.Web.Http (Respond, badRequest, confirmationsFor, internalError, invalidName, invoiceAt, invoicePairs, invoiceWindow, jsonError, jsonResponse, nameBodyBytes, notFound, providerFor, providerNamed, providerUnavailable, readBoundedBody)
 import StoreService.Web.Names.Codes (codeRefusalResponse)
+import StoreService.Web.Names.Registration (registrationAt)
 
 data InvoiceOrder = InvoiceOrder
   { ioRequest :: OrderRequest,
@@ -76,15 +77,15 @@ nameInvoiceHandler env@OrdersEnv {oeStore, oeTurns, oeNow} cfg providers waiters
           now <- oeNow
           let hash = orderHash orOwner orFields (OTInvoice ioMethod $ fromIntegral ioPrice)
           withTransaction oeStore (\db -> existingOrder db req hash now) >>= \case
-            EOResent r -> answerResend r
+            EOResent r -> answerResend now r
             EOMeets -> refuse OROrderExists
             EONew _ -> newOrder order
   where
     refuse refusal = do
       logInfo ("POST /api/invoice (name) refused: " <> tshow refusal)
       pure $ answerNow $ orderRefusalResponse refusal
-    answerResend r@NameRegistration {nrPayment} = case nrPayment of
-      RPInvoice _ invId -> getInvoice oeStore invId >>= maybe (refuse OROrderExists) (fmap answerNow . viewOf r)
+    answerResend now r@NameRegistration {nrPayment} = case nrPayment of
+      RPInvoice _ invId -> getInvoice oeStore invId >>= maybe (refuse OROrderExists) (fmap answerNow . viewOf (registrationAt now r) . invoiceAt now)
       RPCode _ -> refuse OROrderExists
     viewOf r row = jsonResponse status200 <$> nameInvoiceView env (confirmationsFor cfg) row r
     newOrder order@InvoiceOrder {ioRequest = OrderRequest {orFields = OrderFields {ofLabelHash, ofLength, ofDuration}, orTimestamp}, ioMethod, ioPrice} = do
@@ -222,11 +223,12 @@ nameInvoiceView OrdersEnv {oeStore, oeConfig, oeContracts} confirmations row@Inv
 
 -- | The registration's current view, for a request that lost the race to change it.
 registrationChangedResponse :: OrdersEnv -> RegistrationId -> IO Response
-registrationChangedResponse OrdersEnv {oeStore, oeConfig, oeContracts} rid =
+registrationChangedResponse OrdersEnv {oeStore, oeConfig, oeContracts, oeNow} rid =
   withTransaction oeStore (`getRegistration` rid) >>= \case
     Nothing -> pure notFound
     Just r -> do
-      view <- registrationView oeStore oeConfig oeContracts r
+      now <- oeNow
+      view <- registrationView oeStore oeConfig oeContracts (registrationAt now r)
       pure $ jsonResponse status409 $ J.object ["error" .= ("registration_changed" :: Text), "registration" .= view]
 
 orderRefusalResponse :: OrderRefusal -> Response

apps/simplex-store-service/src/StoreService/Web/Server.hs

@@ -268,18 +268,6 @@ readName OrdersEnv {oeStore, oeNow} row rid = do
   now <- oeNow
   fmap (\r -> (now, invoiceAt now row, registrationAt now r)) <$> withTransaction oeStore (`getRegistration` rid)
 
--- | An open name invoice past its expiry with no money received reads expired before the sweep marks it.
-invoiceAt :: UTCTime -> InvoiceRow -> InvoiceRow
-invoiceAt now row = case expiryMoment row of
-  Just expiry | now > expiry -> row {irStatus = ISExpired}
-  _ -> row
-
--- | A funded open invoice stays open until it settles.
-expiryMoment :: InvoiceRow -> Maybe UTCTime
-expiryMoment InvoiceRow {irStatus, irExpiresAt, irPayment}
-  | irStatus == ISOpen && not (maybe False paymentHolds irPayment) = Just irExpiresAt
-  | otherwise = Nothing
-
 -- | The counter a hold watches starts at zero, so a payment recorded before this request arrived cannot wake it.
 samePayment :: Request -> InvoiceRow -> Bool
 samePayment req row = maybe True (== paymentMark row) (paidParam req)

tests/Bots/StoreService/NamesOrdersTests.hs

@@ -101,6 +101,7 @@ namesOrdersTests = describe "StoreService names: orders" $ do
     it "answers an exact resend with its invoice, also with a new timestamp and signature, and after the timestamp window" testExactResend
     it "answers an exact resend after its order went past unpaid, before any chain read" testResendPastUnpaid
     it "answers an exact resend of an expired order with its expired invoice" testResendExpired
+    it "reads an exact resend's unpaid invoice past its expiry as expired, and its lapsed commitment as failed, writing neither" testResendReadsTime
     it "refuses a resend differing in any one field, or a new commitment, with a bare order_exists" testOneFieldDiffers
     it "refuses an order carrying another wallet's commitment without disclosing anything" testForeignCommitment
     it "refuses a bad signature, or another signer's" testBadSignature
@@ -450,7 +451,7 @@ testExactResend = withOrders $ \ctx -> do
   advance ctx 60
   resigned <- placed ctx aliceOrder {oTimestamp = seconds orderTime + 60}
   resigned `shouldBe` (invId, first')
-  advance ctx 3600
+  advance ctx 600
   postOrder ctx body `shouldReturn` (200, Just first')
   length <$> stubCalls (cStub ctx) `shouldReturn` 1
   length <$> registrationsOf ctx ownerA `shouldReturn` 1
@@ -475,6 +476,28 @@ testResendExpired = withOrders $ \ctx -> do
   (field "invoiceId" =<< v) `shouldBe` Just (J.String invId)
   (field "status" =<< v) `shouldBe` Just "expired"
 
+testResendReadsTime :: IO ()
+testResendReadsTime = do
+  withOrders $ \ctx -> do
+    (invId, _) <- placed ctx aliceOrder
+    advance ctx (45 * 60 + 1)
+    (status, v) <- placeOrder ctx aliceOrder
+    (status, field "status" =<< v, field "phase" . registrationOf =<< v) `shouldBe` (200, Just "expired", Just "unpaid")
+    fmap irStatus <$> getInvoice (cStore ctx) invId `shouldReturn` Just ISOpen
+  withOrders $ \ctx@Ctx {cStore, cClock} -> do
+    (invId, _) <- placed ctx aliceOrder
+    settleNow ctx invId settled `shouldReturn` Right ISPaid
+    r <- invoiceRegistration ctx invId
+    now <- readIORef cClock
+    let lapse = seconds now + 600
+    Written version <- withTransaction cStore $ \db ->
+      updateRegistration db r {nrPhase = PCommitted, nrRevealAfter = Just (lapse - 3600), nrRevealBefore = Just lapse} now
+    let resend = (\(status, v) -> (status, field "status" =<< v, (field "phase" &&& field "error") . registrationOf <$> v)) <$> placeOrder ctx aliceOrder
+    resend `shouldReturn` (200, Just "paid", Just (Just "committed", Just J.Null))
+    advance ctx 601
+    resend `shouldReturn` (200, Just "paid", Just (Just "failed", Just "The name was not signed in time"))
+    (nrPhase &&& nrVersion) <$> invoiceRegistration ctx invId `shouldReturn` (PCommitted, version)
+
 testOneFieldDiffers :: IO ()
 testOneFieldDiffers = withOrders $ \ctx -> do
   void $ placed ctx aliceOrder