store: read a registration's lapse in the view

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

@@ -2,13 +2,27 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module StoreService.Names.View (ViewReads (..), registrationView, readViewChain, viewJSON, addressText, tldText) where
+module StoreService.Names.View
+  ( ViewReads (..),
+    registrationView,
+    readViewChain,
+    viewJSON,
+    addressText,
+    tldText,
+    registrationAt,
+    lapseMoment,
+    registrationVersion,
+  )
+where
 
 import Data.Aeson ((.=))
 import qualified Data.Aeson as J
+import Data.Int (Int64)
 import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Time.Clock (UTCTime)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Data.Word (Word64)
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
 import Simplex.Messaging.Encoding.String (strEncode, textEncode)
@@ -20,7 +34,7 @@ import StoreService.Names.Abi (hex)
 import StoreService.Names.Chain (TxHash (..))
 import StoreService.Names.Contracts (Contracts, codeLengthFor, sponsorNonce)
 import StoreService.Names.Phases (RegistrationId (..))
-import StoreService.Names.Store (NamePhase (..), NameRegistration (..), NameReveal (..), PrepaidCode (..), RegistrationPayment (..), getPrepaidCodeById)
+import StoreService.Names.Store (NamePhase (..), NameRegistration (..), NameReveal (..), PrepaidCode (..), RegistrationPayment (..), getPrepaidCodeById, getRegistration)
 
 -- | The view's chain reads; a field whose read failed is null and named in vrUnread.
 data ViewReads = ViewReads
@@ -91,3 +105,21 @@ addressText = safeDecodeUtf8 . strEncode
 -- | The TLD as the page shows it after the name's dot.
 tldText :: SimplexTLD -> Text
 tldText = T.dropWhile (== '.') . safeDecodeUtf8 . strEncode
+
+-- | Versions start at 1, so a registration deleted during a hold reads as changed.
+registrationVersion :: DBStore -> RegistrationId -> IO Int64
+registrationVersion st rid = maybe 0 nrVersion <$> withTransaction st (`getRegistration` rid)
+
+notSignedInTime :: Text
+notSignedInTime = "The name was not signed in time"
+
+-- | Past revealBefore with no reveal, the commitment can no longer register, so it reads failed.
+registrationAt :: UTCTime -> NameRegistration -> NameRegistration
+registrationAt now r = case lapseMoment r of
+  Just lapse | now > lapse -> r {nrPhase = PFailed, nrError = Just notSignedInTime}
+  _ -> r
+
+lapseMoment :: NameRegistration -> Maybe UTCTime
+lapseMoment = \case
+  NameRegistration {nrPhase = PCommitted, nrReveal = Nothing, nrRevealBefore = Just before} -> Just $ posixSecondsToUTCTime $ fromIntegral before
+  _ -> Nothing

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

@@ -40,14 +40,13 @@ import StoreService.Names.Phases (RegistrationId (..))
 import StoreService.Names.Signatures (OrderFields (..))
 import StoreService.Names.Store (NameRegistration (..), NewRegistration (..), OrderTerms (..), PaidOrder (..), PrepaidCode (..), RegistrationPayment (..), createPaidRegistration, getRegistration, newRegistrationId, orderHash, textMethod)
 import StoreService.Names.Turns (withLabelTurn)
-import StoreService.Names.View (registrationView)
+import StoreService.Names.View (registrationAt, registrationView)
 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, codeConflict, confirmationsFor, internalError, invalidName, invoiceAt, invoicePairs, invoiceWindow, jsonError, jsonResponse, nameBodyBytes, providerFor, providerNamed, providerUnavailable, readBoundedBody)
 import StoreService.Web.Names.Codes (codeRefusalResponse)
-import StoreService.Web.Names.Registration (registrationAt)
 
 data InvoiceOrder = InvoiceOrder
   { ioRequest :: OrderRequest,

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

@@ -30,10 +30,10 @@ import StoreService.Names.Phases (RegistrationId (..), publish)
 import StoreService.Names.Signatures (OrderFields (..), findMessage, parseAnyCaseAddress, parseSignature, retargetMessage, takenCodeMessage)
 import StoreService.Names.Store (NamePhase (..), NameRegistration (..), RegistrationPayment (..), findRegistrations, getRegistration)
 import StoreService.Names.Turns (withLabelTurn, withLabelTurns)
-import StoreService.Names.View (registrationView)
+import StoreService.Names.View (registrationAt, registrationView)
 import StoreService.Web.Http (Respond, internalError, jsonResponse, maxBodyBytes, nameBodyBytes, notFound, parseCodeHash, readBoundedBody)
 import StoreService.Web.Names.Orders (Answer (..), answerNow, firstRefusal, orderRefusalResponse, sendAnswer)
-import StoreService.Web.Names.Registration (registrationAt, registrationChangedResponse, registrationRefusalResponse)
+import StoreService.Web.Names.Registration (registrationChangedResponse, registrationRefusalResponse)
 
 data FindRequest = FindRequest
   { frOwner :: Address,

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

@@ -8,9 +8,6 @@ module StoreService.Web.Names.Registration
     revealHandler,
     registrationChangedResponse,
     registrationRefusalResponse,
-    registrationAt,
-    registrationVersion,
-    lapseMoment,
     heldFor,
     versionParam,
   )
@@ -26,10 +23,9 @@ import Data.Int (Int64)
 import Data.Maybe (isJust, maybeToList)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime, diffUTCTime)
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Network.HTTP.Types (status200, status409)
 import Network.Wai (Request, Response, ResponseReceived, queryString)
-import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
+import Simplex.Messaging.Agent.Store.Common (withTransaction)
 import Simplex.Messaging.Util (tshow)
 import StoreService.Log (logInfo)
 import StoreService.Names.Orders (OrdersEnv (..))
@@ -38,7 +34,7 @@ import StoreService.Names.Registration (RegisterIntent (..))
 import StoreService.Names.Reveal (RevealFields (..), RevealRefusal (..), SignedLabel (..), checkIntent, committedRegistration, isRepeat, linksValid, parseRevealFields, parseSignedLabel, revealOf)
 import StoreService.Names.Store (NamePhase (..), NameRegistration (..), VersionWrite (..), getRegistration, updateRegistration)
 import StoreService.Names.Turns (withLabelTurn)
-import StoreService.Names.View (registrationView)
+import StoreService.Names.View (lapseMoment, registrationAt, registrationVersion, registrationView)
 import StoreService.Web.Http (Respond, badRequest, invalidLink, jsonResponse, nameBodyBytes, notFound, providerUnavailable, readBoundedBody)
 import Text.Read (readMaybe)
 
@@ -126,24 +122,6 @@ registrationRefusalResponse OrdersEnv {oeStore, oeConfig, oeContracts, oeNow} ta
       view <- registrationView oeStore oeConfig oeContracts (registrationAt now r)
       pure $ jsonResponse status409 $ J.object ["error" .= tag, "registration" .= view]
 
--- | Versions start at 1, so a registration deleted during a hold reads as changed.
-registrationVersion :: DBStore -> RegistrationId -> IO Int64
-registrationVersion st rid = maybe 0 nrVersion <$> withTransaction st (`getRegistration` rid)
-
-notSignedInTime :: Text
-notSignedInTime = "The name was not signed in time"
-
--- | Past revealBefore with no reveal, the commitment can no longer register, so it reads failed.
-registrationAt :: UTCTime -> NameRegistration -> NameRegistration
-registrationAt now r = case lapseMoment r of
-  Just lapse | now > lapse -> r {nrPhase = PFailed, nrError = Just notSignedInTime}
-  _ -> r
-
-lapseMoment :: NameRegistration -> Maybe UTCTime
-lapseMoment = \case
-  NameRegistration {nrPhase = PCommitted, nrReveal = Nothing, nrRevealBefore = Just before} -> Just $ posixSecondsToUTCTime $ fromIntegral before
-  _ -> Nothing
-
 -- | The hold, cut to end just past the next moment at which the answer changes with time alone.
 heldFor :: Int -> UTCTime -> [UTCTime] -> Int
 heldFor hold now moments = fromInteger $ minimum $ toInteger hold : [ceiling (diffUTCTime moment now * microsPerSecond) + 1 | moment <- moments, moment >= now]

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

@@ -20,6 +20,7 @@ import StoreService.Names.Env (NamesEnv)
 import StoreService.Names.Orders (OrdersEnv (..), ordersEnv)
 import StoreService.Names.Phases (RegistrationId, awaitChange)
 import StoreService.Names.Store (NamePhase (..), NameRegistration (..), getRegistration, textMethod)
+import StoreService.Names.View (lapseMoment, registrationAt, registrationVersion)
 import StoreService.Orders (RegistrationChanged (..), cancelOpenInvoice)
 import StoreService.Poller (ReadHints, queueReadHint)
 import StoreService.Providers (OrderDraft (..), Provider (..), ProviderError (..), ProviderInvoice (..), WebhookError (..))
@@ -28,7 +29,7 @@ import StoreService.Waiters (Seen, Waiters, awaitStatus)
 import StoreService.Web.Http
 import StoreService.Web.Names (namesApp, namesRoutes)
 import StoreService.Web.Names.Orders (nameInvoiceHandler, nameInvoiceView)
-import StoreService.Web.Names.Registration (heldFor, lapseMoment, registrationAt, registrationChangedResponse, registrationVersion, versionParam)
+import StoreService.Web.Names.Registration (heldFor, registrationChangedResponse, versionParam)
 import Control.Concurrent.Async (race)
 import qualified Control.Exception as E
 import StoreService.Log (logError, logInfo, logWarn)