diff --git a/apps/simplex-store-service/src/StoreService/Names/View.hs b/apps/simplex-store-service/src/StoreService/Names/View.hs index 96de0f3847..fda9cf2519 100644 --- a/apps/simplex-store-service/src/StoreService/Names/View.hs +++ b/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 diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs index 6848a4d418..8e545c38d8 100644 --- a/apps/simplex-store-service/src/StoreService/Web/Names/Orders.hs +++ b/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, diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs index aa571c957a..efcc7723e6 100644 --- a/apps/simplex-store-service/src/StoreService/Web/Names/Owner.hs +++ b/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, diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Registration.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Registration.hs index 83b8ce943d..3e986e2391 100644 --- a/apps/simplex-store-service/src/StoreService/Web/Names/Registration.hs +++ b/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] diff --git a/apps/simplex-store-service/src/StoreService/Web/Server.hs b/apps/simplex-store-service/src/StoreService/Web/Server.hs index 85714104e7..884d77f3bc 100644 --- a/apps/simplex-store-service/src/StoreService/Web/Server.hs +++ b/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)