diff --git a/apps/simplex-store-service/src/StoreService/Names/Env.hs b/apps/simplex-store-service/src/StoreService/Names/Env.hs index 75fbc47914..d437096018 100644 --- a/apps/simplex-store-service/src/StoreService/Names/Env.hs +++ b/apps/simplex-store-service/src/StoreService/Names/Env.hs @@ -11,6 +11,7 @@ import StoreService.Names.Chain (ChainClient, newChainClient) import StoreService.Names.Contracts (Contracts, newContracts) import StoreService.Names.Phases (Phases, newPhases) import StoreService.Names.Profiles (Profiles, chatProfile, defaultProfileLimits, monotonicSeconds, newProfiles, systemResolver) +import StoreService.Names.Records (Records, newRecords) import StoreService.Names.Sender (Sender, newSender) import StoreService.Names.Turns (Turns) @@ -24,7 +25,8 @@ data NamesEnv = NamesEnv neChain :: ChainClient, neContracts :: Contracts, neProfiles :: Profiles, - neSender :: Sender + neSender :: Sender, + neRecords :: Records } newNamesEnv :: ChatController -> UserId -> NamesConfig -> DBStore -> Turns -> IO NamesEnv @@ -34,4 +36,5 @@ newNamesEnv neChat@ChatController {random} neUserId neConfig@NamesConfig {nTLD, neContracts <- newContracts nTLD neChain neProfiles <- newProfiles defaultProfileLimits monotonicSeconds (chatProfile neChat neUserId) systemResolver neSender <- newSender random neChain neStore getCurrentTime - pure NamesEnv {neChat, neUserId, neConfig, neStore, nePhases, neTurns, neChain, neContracts, neProfiles, neSender} + neRecords <- newRecords neStore neTurns neContracts neChain neSender nTLD getCurrentTime + pure NamesEnv {neChat, neUserId, neConfig, neStore, nePhases, neTurns, neChain, neContracts, neProfiles, neSender, neRecords} diff --git a/apps/simplex-store-service/src/StoreService/Names/Records.hs b/apps/simplex-store-service/src/StoreService/Names/Records.hs new file mode 100644 index 0000000000..177959f02c --- /dev/null +++ b/apps/simplex-store-service/src/StoreService/Names/Records.hs @@ -0,0 +1,362 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +-- | Record edits signed by a name's owner, relayed through the registrar key's sender and followed to their outcome. +module StoreService.Names.Records + ( Records (rsPendingAfter), + EditRequest (..), + EditAnswer (..), + newRecords, + relayEdit, + runRecordEdits, + recordsRound, + ) +where + +import Control.Concurrent (threadDelay) +import Control.Concurrent.STM +import Control.Exception (bracket) +import Control.Monad (forM, forever, unless, void, when) +import Control.Monad.Except (ExceptT (..), runExceptT) +import Control.Monad.IO.Class (liftIO) +import Data.ByteString (ByteString) +import Data.Int (Int64) +import Data.Set (Set) +import qualified Data.Set as S +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime) +import Data.Word (Word64) +import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction) +import qualified Simplex.Messaging.Agent.Store.DB as DB +import Simplex.Messaging.Crypto (sha256Hash) +import Simplex.Messaging.Crypto.Secp256k1 (RecoverableSignature) +import Simplex.Messaging.Eth.Address (Address, recoverAddress) +import Simplex.Messaging.Eth.EIP712 (Eip712Domain, serializeSignature) +import Simplex.Messaging.SimplexName (LabelHash, SimplexTLD) +import Simplex.Messaging.Util (tshow) +import StoreService.Config (ChainConfig (..)) +import StoreService.Log (logWarn, safely) +import StoreService.Names.Chain +import StoreService.Names.Contracts (Contracts, NameStatus (..), RegisteredName (..), nameStatus, resolverNonce, textRecord) +import StoreService.Names.Registration (Node, channelRecordKey, clearRecordsDigest, clearRecordsWithSigCalldata, contactRecordKey, labelNode, resolverDomain, setTextDigest, setTextWithSigCalldata) +import StoreService.Names.Revert (RevertName (..), revertText) +import StoreService.Names.Sender (SendError (..), Sender, submitTransaction) +import StoreService.Names.Store +import StoreService.Names.Turns (Turns, withLabelTurn) + +#if defined(dbPostgres) +import Database.PostgreSQL.Simple (Only (..)) +#else +import Database.SQLite.Simple (Only (..)) +#endif + +data Records = Records + { rsStore :: DBStore, + rsTurns :: Turns, + rsContracts :: Contracts, + rsChain :: ChainClient, + rsSender :: Sender, + rsTLD :: SimplexTLD, + rsNow :: IO UTCTime, + -- | microseconds a request waits for its edit's outcome + rsPendingAfter :: Int, + -- | the edits a request or the lane is sending or judging, so no edit is sent twice + rsClaimed :: TVar (Set Int64), + -- | the pending edits whose last chain read failed + rsStalled :: TVar (Set Int64), + -- | grows on every settlement and stall, waking the requests that wait for an edit + rsChanges :: TVar Int + } + +data EditRequest = EditRequest + { erLabelHash :: LabelHash, + erChange :: RecordChange, + erNonce :: Word64, + erDeadline :: Word64, + erSignature :: RecoverableSignature + } + deriving (Eq, Show) + +data EditAnswer + = -- | mined, Nothing when found applied with the applying transaction unknown + EAApplied (Maybe TxHash) + | -- | the revert's name when known; the nonce is free again + EAReverted (Maybe Text) + | -- | not settled within the wait, or the chain stopped answering after the send; the edit goes on + EAPending + | -- | the signer, the deadline, the owner or the nonce + EARefused + | -- | the chain failed before anything was sent, and nothing is stored + EAUnavailable + | -- | the per-name cap, with the seconds until another edit fits + EACapped Int + deriving (Eq, Show) + +-- | What the chain shows of an edit none of whose transactions mined. +data Judgment + = -- | one of its own hashes, or Nothing when the nonce passed with the record holding its value + Applied (Maybe TxHash) + | -- | the nonce passed with the record holding another value + NonceTaken + | NonceFree + +-- | Below a proxy's idle timeout; the edit goes on after it. +editPendingAfter :: Int +editPendingAfter = 90000000 + +-- | Relayed edits per name in 'editCapWindow'. +editCap :: Int +editCap = 10 + +editCapWindow :: NominalDiffTime +editCapWindow = 3600 + +recordsInterval :: Int +recordsInterval = 4000000 + +newRecords :: DBStore -> Turns -> Contracts -> ChainClient -> Sender -> SimplexTLD -> IO UTCTime -> IO Records +newRecords rsStore rsTurns rsContracts rsChain rsSender rsTLD rsNow = do + rsClaimed <- newTVarIO S.empty + rsStalled <- newTVarIO S.empty + rsChanges <- newTVarIO 0 + pure Records {rsStore, rsTurns, rsContracts, rsChain, rsSender, rsTLD, rsNow, rsPendingAfter = editPendingAfter, rsClaimed, rsStalled, rsChanges} + +-- | An identical repeat of a sent edit is answered from it, before any chain read. +relayEdit :: Records -> EditRequest -> IO EditAnswer +relayEdit rs req@EditRequest {erSignature} = + recoverAddress erSignature digest >>= \case + Left _ -> pure EARefused + Right signer -> + withStore rs (`getRecordEditByBody` bodyHash) >>= \case + Just RecordEdit {reId} -> awaitEdit rs reId + Nothing -> newEdit rs req signer bodyHash + where + digest = editDigest rs req + bodyHash = sha256Hash $ digest <> serializeSignature erSignature + +newEdit :: Records -> EditRequest -> Address -> ByteString -> IO EditAnswer +newEdit rs req signer bodyHash = + chainAccepts rs req signer >>= \case + Left _ -> pure EAUnavailable + Right False -> pure EARefused + Right True -> + insertEdit rs req signer bodyHash >>= \case + Left wait -> pure $ EACapped wait + Right (Just editId) -> sendNew rs editId + -- a pending or mined edit holds the nonce: the identical twin is waited for, any other body refused + Right Nothing -> withStore rs (`getRecordEditByBody` bodyHash) >>= maybe (pure EARefused) (awaitEdit rs . reId) + +-- | The deadline after the latest block's time, the signer the registry's owner on the default resolver, the nonce the owner's next. +chainAccepts :: Records -> EditRequest -> Address -> IO (Either ChainError Bool) +chainAccepts Records {rsChain, rsContracts} EditRequest {erLabelHash, erNonce, erDeadline} signer = runExceptT $ do + Block {blockTimestamp} <- ExceptT $ latestBlock rsChain + if erDeadline <= blockTimestamp + then pure False + else + ExceptT (nameStatus rsContracts erLabelHash) >>= \case + NSRegistered RegisteredName {rnOwner, rnResolver} + | rnOwner == signer && rnResolver == cResolver (ccConfig rsChain) -> (== erNonce) <$> ExceptT (resolverNonce rsContracts signer) + _ -> pure False + +-- | Left with the seconds to wait when the name's cap is used up; Right Nothing when a pending or mined edit holds the nonce. +insertEdit :: Records -> EditRequest -> Address -> ByteString -> IO (Either Int (Maybe Int64)) +insertEdit Records {rsStore, rsTurns, rsNow} EditRequest {erLabelHash, erChange, erNonce, erDeadline, erSignature} signer bodyHash = + withLabelTurn rsTurns erLabelHash $ do + now <- rsNow + withTransaction rsStore $ \db -> do + times <- relayedEditTimes db erLabelHash (addUTCTime (negate editCapWindow) now) + let relayed = length times + if relayed >= editCap + then pure $ Left $ max 1 $ ceiling $ diffUTCTime (addUTCTime editCapWindow $ times !! (relayed - editCap)) now + else Right <$> insertRecordEdit db edit now + where + edit = NewRecordEdit {nreLabelHash = erLabelHash, nreOwner = signer, nreNonce = erNonce, nreChange = erChange, nreDeadline = erDeadline, nreSignature = erSignature, nreBodyHash = bodyHash} + +-- | An edit the chain failed to take is deleted while still claimed, so the lane cannot send it after. +sendNew :: Records -> Int64 -> IO EditAnswer +sendNew rs editId = do + sent <- withClaim rs editId True $ withStore rs (`getRecordEdit` editId) >>= maybe (pure True) send + if sent then awaitEdit rs editId else EAUnavailable <$ settled rs editId + where + send edit = + sendEdit rs edit >>= \case + Right () -> pure True + Left e -> do + logWarn $ "names records: edit " <> tshow editId <> " not sent: " <> tshow e + False <$ withStore rs (`deleteUnsentEdit` editId) + +-- | A dry run's revert is judged at once; Left when nothing was sent and the chain did not refuse the edit. +sendEdit :: Records -> RecordEdit -> IO (Either SendError ()) +sendEdit rs@Records {rsSender} edit@RecordEdit {reId} = + submitTransaction rsSender (TxEdit reId) (resolver rs) (editCalldata rs edit) >>= \case + Right _ -> Right () <$ unstall rs reId + Left SEInFlight -> pure $ Right () + Left (SEChain (ChainReverted name)) -> Right () <$ judged rs edit (settle rs reId $ ESReverted $ revertText =<< name) + Left e -> pure $ Left e + +-- | Waits until the edit settles, the chain stops answering for it, or 'rsPendingAfter' passes. +awaitEdit :: Records -> Int64 -> IO EditAnswer +awaitEdit rs@Records {rsChanges, rsStalled, rsPendingAfter} editId = registerDelay rsPendingAfter >>= loop + where + loop timer = do + -- read before the row, so a change committed after the read still wakes this request + seen <- readTVarIO rsChanges + withStore rs (`getRecordEdit` editId) >>= \case + Nothing -> pure EAUnavailable + Just RecordEdit {reState = ESMined tx} -> pure $ EAApplied tx + Just RecordEdit {reState = ESReverted revert} -> pure $ EAReverted revert + Just RecordEdit {reState = ESPending} -> do + stalled <- S.member editId <$> readTVarIO rsStalled + if stalled + then pure EAPending + else do + changed <- atomically $ (True <$ (readTVar rsChanges >>= check . (/= seen))) `orElse` (False <$ (readTVar timer >>= check)) + if changed then loop timer else pure EAPending + +runRecordEdits :: Records -> IO () +runRecordEdits rs = forever $ recordsRound rs >> threadDelay recordsInterval + +-- | One pass over the pending edits that no request is sending. A pass that fails is logged, and the lane goes on. +recordsRound :: Records -> IO () +recordsRound rs@Records {rsChain} = void $ safely "names records: the round" $ do + editIds <- withStore rs pendingEditIds + unless (null editIds) $ + runExceptT (ExceptT (latestBlock rsChain) >>= \tip -> (tip,) <$> ExceptT (deepBlock rsChain tip)) >>= \case + Left e -> mapM_ (\editId -> stall rs editId e) editIds + Right (tip, deep) -> mapM_ (\editId -> withClaim rs editId () $ withStore rs (`getRecordEdit` editId) >>= mapM_ (follow rs tip deep)) editIds + +-- | The newest block at the configured confirmation depth, as the sender counts it. +deepBlock :: ChainClient -> Block -> IO (Either ChainError Block) +deepBlock c@ChainClient {ccConfig = ChainConfig {cConfirmations}} tip@Block {blockNumber} + | depth == 0 = pure $ Right tip + | otherwise = blockAt c $ if blockNumber >= depth then blockNumber - depth else 0 + where + depth = fromIntegral (max 1 cConfirmations) - 1 + +-- | One step for a pending edit, from its transactions' statuses as the sender settled them. +follow :: Records -> Block -> Block -> RecordEdit -> IO () +follow rs@Records {rsChain} Block {blockTimestamp} Block {blockTimestamp = deepTime} edit@RecordEdit {reId, reDeadline} = do + txs <- withStore rs (`editTransactions` reId) + case txs of + [] -> if ahead then resend else expire + _ + | mined : _ <- [ntHash | NameTransaction {ntHash, ntStatus = TSMined} <- txs] -> settle rs reId $ ESMined $ Just mined + | any ((== TSPending) . ntStatus) txs -> if deepTime > reDeadline then expire else unstall rs reId + -- a mined revert carries no data: past the deadline it is SignatureExpired, else unnamed + | block : _ <- [b | NameTransaction {ntStatus = TSReverted, ntMinedBlock = Just b} <- txs] -> + blockAt rsChain block >>= \case + Left e -> stall rs reId e + Right Block {blockTimestamp = minedTime} -> judged rs edit $ settle rs reId $ ESReverted $ if minedTime > reDeadline then signatureExpired else Nothing + -- every transaction dropped: its registrar nonce went to another one + | otherwise -> judged rs edit $ if ahead then resend else expire + where + ahead = reDeadline > blockTimestamp + expire = judged rs edit $ settle rs reId $ ESReverted signatureExpired + resend = sendEdit rs edit >>= either (stall rs reId) pure + +-- | Settles the edit as the chain shows it, or runs the action when its nonce is still free. +judged :: Records -> RecordEdit -> IO () -> IO () +judged rs edit@RecordEdit {reId} whenFree = + judge rs edit >>= \case + Left e -> stall rs reId e + Right (Applied tx) -> settle rs reId $ ESMined tx + Right NonceTaken -> settle rs reId $ ESReverted $ revertText RNInvalidNonce + Right NonceFree -> whenFree + +-- | Its own transactions first: a status-1 receipt answers its hash. Without one, the owner's nonce and the record. +judge :: Records -> RecordEdit -> IO (Either ChainError Judgment) +judge rs@Records {rsChain, rsContracts} RecordEdit {reId, reLabelHash, reOwner, reNonce, reChange} = runExceptT $ do + txs <- liftIO $ withStore rs (`editTransactions` reId) + receipts <- forM txs $ \NameTransaction {ntHash} -> (ntHash,) <$> ExceptT (transactionReceipt rsChain ntHash) + case [h | (h, Just Receipt {receiptSuccess = True}) <- receipts] of + h : _ -> pure $ Applied $ Just h + [] -> do + nonce <- ExceptT $ resolverNonce rsContracts reOwner + if nonce <= reNonce + then pure NonceFree + else do + holds <- case reChange of + RCSetText key value -> (== value) <$> record (encodeUtf8 key) + RCClear -> (&&) <$> (unset <$> record contactRecordKey) <*> (unset <$> record channelRecordKey) + pure $ if holds then Applied Nothing else NonceTaken + where + record = ExceptT . textRecord rsContracts reLabelHash + unset = (== "") + +settle :: Records -> Int64 -> EditState -> IO () +settle rs editId state = do + void $ withStore rs $ \db -> settleRecordEdit db editId state + settled rs editId + +-- | Wakes the requests waiting for the edit, which read it again. +settled :: Records -> Int64 -> IO () +settled Records {rsStalled, rsChanges} editId = atomically $ modifyTVar' rsStalled (S.delete editId) >> modifyTVar' rsChanges (+ 1) + +-- | Logged once until the edit's next successful step. +stall :: Show e => Records -> Int64 -> e -> IO () +stall Records {rsStalled, rsChanges} editId e = do + new <- atomically $ do + stalled <- readTVar rsStalled + let new = not $ S.member editId stalled + when new $ writeTVar rsStalled (S.insert editId stalled) >> modifyTVar' rsChanges (+ 1) + pure new + when new $ logWarn $ "names records: edit " <> tshow editId <> " waits for the chain: " <> tshow e + +unstall :: Records -> Int64 -> IO () +unstall Records {rsStalled} editId = atomically $ modifyTVar' rsStalled $ S.delete editId + +-- | Runs the action only when nobody else holds the edit, else answers the fallback. +withClaim :: Records -> Int64 -> a -> IO a -> IO a +withClaim Records {rsClaimed} editId fallback action = + bracket claim (\claimed -> when claimed release) $ \claimed -> if claimed then action else pure fallback + where + claim = atomically $ do + held <- readTVar rsClaimed + if S.member editId held then pure False else True <$ writeTVar rsClaimed (S.insert editId held) + release = atomically $ modifyTVar' rsClaimed $ S.delete editId + +editDigest :: Records -> EditRequest -> ByteString +editDigest rs EditRequest {erLabelHash, erChange, erNonce, erDeadline} = case erChange of + RCSetText key value -> setTextDigest (domain rs) node key value erNonce erDeadline + RCClear -> clearRecordsDigest (domain rs) node erNonce erDeadline + where + node = nodeOf rs erLabelHash + +editCalldata :: Records -> RecordEdit -> ByteString +editCalldata rs RecordEdit {reLabelHash, reChange, reNonce, reDeadline, reSignature} = case reChange of + RCSetText key value -> setTextWithSigCalldata node key value reNonce reDeadline reSignature + RCClear -> clearRecordsWithSigCalldata node reNonce reDeadline reSignature + where + node = nodeOf rs reLabelHash + +nodeOf :: Records -> LabelHash -> Node +nodeOf Records {rsTLD} = labelNode rsTLD + +domain :: Records -> Eip712Domain +domain rs@Records {rsChain} = resolverDomain (cChainId $ ccConfig rsChain) (resolver rs) + +resolver :: Records -> Address +resolver = cResolver . ccConfig . rsChain + +signatureExpired :: Maybe Text +signatureExpired = revertText RNSignatureExpired + +withStore :: Records -> (DB.Connection -> IO a) -> IO a +withStore Records {rsStore} = withTransaction rsStore + +pendingEditIds :: DB.Connection -> IO [Int64] +pendingEditIds db = map fromOnly <$> DB.query db "SELECT name_record_edit_id FROM sx_badge_service_name_record_edits WHERE state = ? ORDER BY name_record_edit_id" (Only pendingState) + +deleteUnsentEdit :: DB.Connection -> Int64 -> IO () +deleteUnsentEdit db editId = + DB.execute + db + "DELETE FROM sx_badge_service_name_record_edits WHERE name_record_edit_id = ? AND state = ? AND NOT EXISTS (SELECT 1 FROM sx_badge_service_name_transactions WHERE name_record_edit_id = ?)" + (editId, pendingState, editId) + +pendingState :: Text +pendingState = "pending" diff --git a/apps/simplex-store-service/src/StoreService/Web/Names.hs b/apps/simplex-store-service/src/StoreService/Web/Names.hs index 0d2e57617c..1f5400212b 100644 --- a/apps/simplex-store-service/src/StoreService/Web/Names.hs +++ b/apps/simplex-store-service/src/StoreService/Web/Names.hs @@ -8,8 +8,9 @@ import Data.Text (Text) import Network.HTTP.Types (Method) import Network.Wai (Request, ResponseReceived, pathInfo) import StoreService.Names.Env (NamesEnv (..)) -import StoreService.Web.Http (HttpEnv, Limit, Respond, codeLimit, limited, only) +import StoreService.Web.Http (HttpEnv, Limit, Respond, codeLimit, limited, only, recordsLimit) import StoreService.Web.Names.Codes (codeCheckHandler) +import StoreService.Web.Names.Records (recordsHandler) data Route = Route { rMethod :: Method, @@ -18,7 +19,8 @@ data Route = Route } namesRoutes :: NamesEnv -> [Text] -> Maybe Route -namesRoutes NamesEnv {neStore} = \case +namesRoutes NamesEnv {neStore, neRecords} = \case + ["api", "name", "records"] -> Just Route {rMethod = "POST", rLimit = recordsLimit, rHandler = recordsHandler neRecords} ["api", "code", "check"] -> Just Route {rMethod = "POST", rLimit = codeLimit, rHandler = codeCheckHandler neStore} _ -> Nothing diff --git a/apps/simplex-store-service/src/StoreService/Web/Names/Records.hs b/apps/simplex-store-service/src/StoreService/Web/Names/Records.hs new file mode 100644 index 0000000000..a5c2bd4404 --- /dev/null +++ b/apps/simplex-store-service/src/StoreService/Web/Names/Records.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module StoreService.Web.Names.Records (EditInvalid (..), recordsHandler, editRequest) where + +import Control.Monad (unless) +import Data.Aeson ((.:), (.:?), (.=)) +import qualified Data.Aeson as J +import qualified Data.Aeson.Types as JT +import Data.Text (Text) +import Data.Text.Encoding (decodeLatin1) +import Network.HTTP.Types (status200, status400, status409, status504) +import Network.Wai (Request, Response, ResponseReceived) +import Simplex.Messaging.SimplexName (LabelHash (..)) +import StoreService.Names.Abi (bytes32FromHex, hex) +import StoreService.Names.Chain (TxHash (..)) +import StoreService.Names.Links (LinkKind (..), linkKindOf) +import StoreService.Names.Records (EditAnswer (..), EditRequest (..), Records, relayEdit) +import StoreService.Names.Registration (channelRecordKey, contactRecordKey) +import StoreService.Names.Signatures (parseSignature) +import StoreService.Names.Store (RecordChange (..)) +import StoreService.Web.Http (Respond, badRequest, jsonError, jsonResponse, maxBodyBytes, providerUnavailable, rateLimited, readBoundedBody) + +data EditInvalid = EIBadRequest | EIInvalidLink + deriving (Eq, Show) + +recordsHandler :: Records -> Request -> Respond -> IO ResponseReceived +recordsHandler rs req respond = + readBoundedBody maxBodyBytes req >>= \case + Just body | Just o <- J.decode body -> case editRequest o of + Right edit -> relayEdit rs edit >>= respond . editResponse + Left EIInvalidLink -> respond invalidLink + Left EIBadRequest -> respond badRequest + _ -> respond badRequest + +-- | The formats and the key, then the link, then the signature's format and low s, as the page's checks run. +editRequest :: J.Object -> Either EditInvalid EditRequest +editRequest o = do + (labelHash, change, erNonce, erDeadline, signature) <- maybe (Left EIBadRequest) Right $ JT.parseMaybe fields o + erLabelHash <- maybe (Left EIBadRequest) (Right . LabelHash) $ bytes32FromHex labelHash + erChange <- case change of + Nothing -> Right RCClear + Just (key, value) -> do + kind <- maybe (Left EIBadRequest) Right $ lookup key recordKinds + unless (value == "" || linkKindOf value == Just kind) $ Left EIInvalidLink + Right $ RCSetText key value + erSignature <- either (const $ Left EIBadRequest) Right $ parseSignature signature + pure EditRequest {erLabelHash, erChange, erNonce, erDeadline, erSignature} + where + fields v = do + clear <- v .:? "clear" + change <- if clear == Just True then pure Nothing else Just <$> ((,) <$> v .: "key" <*> v .: "value") + (,,,,) <$> v .: "labelHash" <*> pure change <*> v .: "nonce" <*> v .: "deadline" <*> v .: "signature" + +recordKinds :: [(Text, LinkKind)] +recordKinds = [(decodeLatin1 contactRecordKey, LKContact), (decodeLatin1 channelRecordKey, LKChannel)] + +editResponse :: EditAnswer -> Response +editResponse = \case + EAApplied tx -> jsonResponse status200 $ J.object ["tx" .= ((\(TxHash h) -> hex h) <$> tx)] + EAReverted revert -> jsonResponse status409 $ J.object ["error" .= ("record_reverted" :: Text), "revert" .= revert] + EAPending -> jsonError status504 "edit_pending" + EARefused -> badRequest + EAUnavailable -> providerUnavailable + EACapped seconds -> rateLimited seconds + +invalidLink :: Response +invalidLink = jsonError status400 "invalid_link" diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 5ba60a2f2b..7fd2b6e741 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -451,6 +451,7 @@ executable simplex-store-service StoreService.Names.Links StoreService.Names.Phases StoreService.Names.Profiles + StoreService.Names.Records StoreService.Names.Registration StoreService.Names.Revert StoreService.Names.Sender @@ -471,6 +472,7 @@ executable simplex-store-service StoreService.Web.Http StoreService.Web.Names StoreService.Web.Names.Codes + StoreService.Web.Names.Records StoreService.Web.Server Paths_simplex_chat ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -Werror=name-shadowing -threaded -rtsopts @@ -763,6 +765,7 @@ test-suite simplex-chat-test Bots.StoreService.NamesLabelTests Bots.StoreService.NamesLinksTests Bots.StoreService.NamesProfilesTests + Bots.StoreService.NamesRecordsTests Bots.StoreService.NamesSenderTests Bots.StoreService.NamesSignatureTests Bots.StoreService.NamesStoreTests @@ -797,6 +800,7 @@ test-suite simplex-chat-test StoreService.Names.Links StoreService.Names.Phases StoreService.Names.Profiles + StoreService.Names.Records StoreService.Names.Registration StoreService.Names.Revert StoreService.Names.Sender @@ -817,6 +821,7 @@ test-suite simplex-chat-test StoreService.Web.Http StoreService.Web.Names StoreService.Web.Names.Codes + StoreService.Web.Names.Records StoreService.Web.Server Paths_simplex_chat if flag(client_postgres) diff --git a/tests/Bots/StoreService/NamesRecordsTests.hs b/tests/Bots/StoreService/NamesRecordsTests.hs new file mode 100644 index 0000000000..6e8c569fe2 --- /dev/null +++ b/tests/Bots/StoreService/NamesRecordsTests.hs @@ -0,0 +1,601 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Bots.StoreService.NamesRecordsTests (namesRecordsTests) where + +import Bots.StoreService.FakeEthNode +import Bots.StoreService.NamesStoreTests (t0) +import Bots.StoreService.WebTests (withServiceStore) +import Bots.StoreService.WebUIMock (EphemeralWallet (..), newEphemeralWallet, walletFromCode) +import Control.Concurrent.Async (Async, async, concurrently, wait) +import Control.Concurrent.STM +import Control.Monad (forM_) +import Crypto.Number.Serialize (i2ospOf_, os2ip) +import qualified Crypto.PubKey.ECC.Types as ECC +import Crypto.Random (ChaChaDRG) +import Data.Aeson ((.=)) +import qualified Data.Aeson as J +import qualified Data.Aeson.KeyMap as KM +import Data.ByteArray.Encoding (Base (Base16), convertFromBase) +import Data.ByteString (ByteString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime) +import Data.Word (Word64) +import Network.HTTP.Client (RequestBody (..), defaultManagerSettings, httpLbs, method, newManager, parseRequest, requestBody, requestHeaders, responseBody, responseStatus) +import Network.HTTP.Types (hContentType, statusCode) +import qualified Network.Wai.Handler.Warp as Warp +import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction) +import qualified Simplex.Messaging.Agent.Store.DB as DB +import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Secp256k1 (RecoverableSignature (..), signRecoverable) +import Simplex.Messaging.Encoding.String (strDecode) +import Simplex.Messaging.Eth.Address (Address, recoverAddress) +import Simplex.Messaging.Eth.EIP712 (Eip712Domain, serializeSignature) +import Simplex.Messaging.SimplexName (LabelHash (..), SimplexTLD (..), labelHash) +import StoreService.Config (ChainConfig (..)) +import StoreService.Names.Abi +import StoreService.Names.Chain +import StoreService.Names.Contracts (newContracts) +import StoreService.Names.Records +import StoreService.Names.Registration (Node, clearRecordsDigest, clearRecordsWithSigCalldata, labelNode, nodeBytes, resolverDomain, setTextDigest, setTextWithSigCalldata) +import StoreService.Names.Sender (Sender, followTransactions, newSender) +import StoreService.Names.Signatures (parseSignature) +import StoreService.Names.Store (EditState (..), NewRecordEdit (..), RecordChange (..), RecordEdit (..), getRecordEditByBody, insertRecordEdit) +import StoreService.Names.Turns (newTurns) +import StoreService.Web.Names.Records (EditInvalid (..), editRequest, recordsHandler) +import System.Timeout (timeout) +import Test.Hspec +#if defined(dbPostgres) +import Database.PostgreSQL.Simple (Only (..)) +#else +import Database.SQLite.Simple (Only (..)) +#endif + +namesRecordsTests :: Spec +namesRecordsTests = describe "StoreService names: records" $ do + -- the signatures and calldata marked viem are viem 2.57.5's, by the wallet of "abandon ... about" (account 0), + -- with the SimplexResolver ABI of ens-contracts PR #36 at 23892cc + g <- runIO C.newRandom + describe "requests" $ do + it "signs and encodes SetText and ClearRecords edits as viem does" $ testViemVectors g + it "reads a request's formats, then its link, then its signature" testRequestOrder + it "bounds a link at 4096 bytes and takes only a link of the key's kind" testLinkBound + it "refuses a high s, though recovery accepts it" testHighS + describe "relay" $ do + it "relays an edit with viem's calldata and answers its hash once mined" $ testRelayMined g + it "refuses a wrong signer or a passed deadline before any row or gas" $ testRefusedBeforeRow g + it "leaves the owner's cap untouched by ten edits a non-owner signs" $ testNonOwnerCap g + it "checks a refused edit's repeat anew" $ testRefusedRepeat g + it "refuses the eleventh relayed edit of a name within an hour, with the real wait" $ testCap g + it "answers provider_unavailable and stores nothing when the chain fails before the send" $ testUnavailableBeforeSend g + it "lets a concurrent twin lose the unique insert before any signing, and answers both" $ testConcurrentTwin g + it "answers edit_pending after the wait, and its repeat with the hash once mined" $ testPendingThenMined g + it "answers edit_pending at once when the chain stops answering after the send" $ testChainStopsAfterSend g + describe "outcomes" $ do + it "answers an InvalidNonce revert of an edit another relayer applied as mined with no hash, and its repeat too" $ testAppliedByAnother g + it "answers a SignatureExpired revert of an edit another relayer applied as mined with no hash" $ testExpiredAppliedByAnother g + it "answers record_reverted InvalidNonce when another body used the nonce with another value" $ testNonceTakenByAnother g + it "frees a reverted edit's nonce for a new body, and answers the reverted edit's repeat while the new one is pending" $ testRevertFreesNonce g + it "keeps an edit pending when the re-read after a dry run's revert fails, and settles it in a later round" $ testFailedReRead g + describe "restarts" $ do + it "sends a saved edit that was never sent, and follows a sent one to its receipt" $ testResume g + it "answers an identical repeat after a restart from the stored edit, with no chain read" $ testRepeatAfterRestart g + it "finds an edit that expired across a restart applied, and makes it mined" $ testRestartExpiredApplied g + it "frees an edit past its deadline while its transaction is still rebroadcast" $ testExpiryFreesNonce g + describe "http" $ + it "answers the contract's statuses and bodies" $ testHttp g + +data Setup = Setup + { node :: FakeEthNode, + store :: DBStore, + clock :: TVar UTCTime, + chain :: ChainClient, + random :: TVar ChaChaDRG, + sender :: Sender, + records :: Records, + owner :: EphemeralWallet + } + +-- | A registered alicebakery on the default resolver, held by the viem wallet, its nonce 0 and no records; two confirmations. +withSetup :: TVar ChaChaDRG -> (Setup -> IO a) -> IO a +withSetup random action = withFakeEthNode $ \node -> withServiceStore $ \store -> do + clock <- newTVarIO t0 + chain <- newChainClient random (fakeChainConfig node) {cConfirmations = 2} + owner <- walletFromCode random viemCode + (sender, records) <- start store clock chain random + let s = Setup {node, store, clock, chain, random, sender, records, owner} + answerName s + action s + +start :: DBStore -> TVar UTCTime -> ChainClient -> TVar ChaChaDRG -> IO (Sender, Records) +start store clock chain random = do + sender <- newSender random chain store (readTVarIO clock) + contracts <- newContracts TLDSimplex chain + turns <- newTurns + rs <- newRecords store turns contracts chain sender TLDSimplex (readTVarIO clock) + pure (sender, rs {rsPendingAfter = longWait}) + +-- | A new sender and lane over the same store and node, as after the service restarts. +restart :: Setup -> IO Setup +restart s@Setup {store, clock, chain, random} = do + (sender, records) <- start store clock chain random + pure s {sender, records} + +answerName :: Setup -> IO () +answerName s@Setup {node, owner = EphemeralWallet {ewAddress}} = do + answerCall node fakeBaseRegistrar (selector "ens()") $ Returns $ addressWord registry + answerCall node fakeBaseRegistrar (selector "GRACE_PERIOD()") $ Returns $ uint256 gracePeriod + answerCall node fakeBaseRegistrar (selector "nameExpires(uint256)" <> unLabel alice) $ Returns $ uint256 nameExpiry + answerCall node registry (selector "owner(bytes32)" <> nodeBytes aliceNode) $ Returns $ addressWord ewAddress + answerCall node registry (selector "resolver(bytes32)" <> nodeBytes aliceNode) $ Returns $ addressWord fakeResolver + setNonce s 0 + setRecord s contactKey "" + setRecord s channelKey "" + +setNonce :: Setup -> Word64 -> IO () +setNonce Setup {node, owner = EphemeralWallet {ewAddress}} n = + answerCall node fakeResolver (selector "nonces(address)" <> addressWord ewAddress) $ Returns $ uint256 n + +setRecord :: Setup -> Text -> Text -> IO () +setRecord Setup {node} key value = + answerCall node fakeResolver (selector "text(bytes32,string)" <> abiTuple [Static $ nodeBytes aliceNode, Dynamic $ abiBytes $ encodeUtf8 key]) $ + Returns $ abiTuple [Dynamic $ abiBytes $ encodeUtf8 value] + +signEdit :: Setup -> EphemeralWallet -> RecordChange -> Word64 -> Word64 -> IO EditRequest +signEdit Setup {random} EphemeralWallet {ewKey} change nonce erDeadline = do + sig <- signRecoverable random ewKey (digestOf change nonce erDeadline) >>= either fail pure + pure EditRequest {erLabelHash = alice, erChange = change, erNonce = nonce, erDeadline, erSignature = sig} + +channel :: Text -> RecordChange +channel = RCSetText channelKey + +-- | The owner's channel edit with nonce 0 and the default deadline. +ownerEdit :: Setup -> Text -> IO EditRequest +ownerEdit s@Setup {owner} value = signEdit s owner (channel value) 0 deadline + +relay :: Setup -> EditRequest -> IO (Async EditAnswer) +relay Setup {records} = async . relayEdit records + +-- | Mines the n-th transaction sent with this status, one block deeper, then runs the sender's round and the lane's. +mineSent :: Setup -> Int -> Bool -> IO TxHash +mineSent Setup {node, sender, records} n ok = do + raws <- within $ awaitSent node n + let h = C.keccak256 $ raws !! (n - 1) + _ <- mine node [(h, ok)] + _ <- mine node [] + followTransactions sender + recordsRound records + pure $ TxHash h + +answerOf :: Async EditAnswer -> IO EditAnswer +answerOf = within . wait + +within :: IO a -> IO a +within action = timeout 5000000 action >>= maybe (fail "timed out") pure + +stateOf :: Setup -> EditRequest -> IO (Maybe EditState) +stateOf Setup {store} req = withTransaction store $ \db -> fmap reState <$> getRecordEditByBody db (bodyHashOf req) + +editRows :: Setup -> IO Int +editRows Setup {store} = withTransaction store $ \db -> do + [Only n] <- DB.query_ db "SELECT count(*) FROM sx_badge_service_name_record_edits" + pure n + +-- | As the relay keys a sent edit: the signed digest and the signature. +bodyHashOf :: EditRequest -> ByteString +bodyHashOf EditRequest {erChange, erNonce, erDeadline, erSignature} = C.sha256Hash $ digestOf erChange erNonce erDeadline <> serializeSignature erSignature + +-- | Saves an edit as a request does before it joins the sender, as if the service stopped right after. +saveUnsent :: Setup -> EditRequest -> IO () +saveUnsent Setup {store, clock, owner = EphemeralWallet {ewAddress}} req@EditRequest {erChange, erNonce, erDeadline, erSignature} = do + now <- readTVarIO clock + Just _ <- withTransaction store $ \db -> + insertRecordEdit db NewRecordEdit {nreLabelHash = alice, nreOwner = ewAddress, nreNonce = erNonce, nreChange = erChange, nreDeadline = erDeadline, nreSignature = erSignature, nreBodyHash = bodyHashOf req} now + pure () + +passTime :: Setup -> NominalDiffTime -> IO () +passTime Setup {clock} t = atomically $ modifyTVar' clock (addUTCTime t) + +-- requests + +testViemVectors :: TVar ChaChaDRG -> IO () +testViemVectors g = withSetup g $ \s@Setup {owner = EphemeralWallet {ewAddress}} -> do + ewAddress `shouldBe` viemAddress + EditRequest {erSignature = setSig} <- ownerEdit s viemChannelLink + setSig `shouldBe` viemSetSignature + recoverAddress setSig (digestOf (channel viemChannelLink) 0 deadline) `shouldReturn` Right viemAddress + setTextWithSigCalldata aliceNode channelKey viemChannelLink 0 deadline setSig `shouldBe` viemSetCall + EditRequest {erSignature = clearSig} <- signEdit s (owner s) RCClear 1 deadline + clearSig `shouldBe` viemClearSignature + clearRecordsWithSigCalldata aliceNode 1 deadline clearSig `shouldBe` viemClearCall + +testRequestOrder :: IO () +testRequestOrder = do + let valid = requestJson [("key", J.String channelKey), ("value", J.String viemChannelLink)] + fmap erChange (editRequest valid) `shouldBe` Right (channel viemChannelLink) + fmap erChange (editRequest $ requestJson [("clear", J.Bool True)]) `shouldBe` Right RCClear + fmap erChange (editRequest $ requestJson [("key", J.String contactKey), ("value", "")]) `shouldBe` Right (RCSetText contactKey "") + -- formats first: a bad label hash or key is bad_request even with a bad link + editRequest (KM.insert "labelHash" (J.String $ "0x" <> T.toUpper (T.drop 2 aliceHashText)) $ withLink "https://x/a") `shouldBe` Left EIBadRequest + editRequest (requestJson [("key", "simplex.other"), ("value", J.String viemChannelLink)]) `shouldBe` Left EIBadRequest + editRequest (KM.insert "nonce" (J.Number (-1)) valid) `shouldBe` Left EIBadRequest + editRequest (KM.insert "deadline" (J.String "1767229200") valid) `shouldBe` Left EIBadRequest + editRequest (KM.delete "value" valid) `shouldBe` Left EIBadRequest + -- the link before the signature + editRequest (KM.insert "signature" "0x00" $ withLink "https://x/a") `shouldBe` Left EIInvalidLink + editRequest (KM.insert "signature" "0x00" valid) `shouldBe` Left EIBadRequest + where + withLink link = requestJson [("key", J.String channelKey), ("value", J.String link)] + +testLinkBound :: IO () +testLinkBound = do + let prefix = "https://smp8.simplex.im/c#" + linkOf n = prefix <> T.replicate (n - T.length prefix) "a" + edit key value = editRequest $ requestJson [("key", J.String key), ("value", J.String value)] + fmap erChange (edit channelKey $ linkOf 4096) `shouldBe` Right (channel $ linkOf 4096) + edit channelKey (linkOf 4097) `shouldBe` Left EIInvalidLink + edit contactKey viemChannelLink `shouldBe` Left EIInvalidLink + edit channelKey "https://smp8.simplex.im/c#Y8m3;https://smp9.simplex.im/c#Z1" `shouldBe` Left EIInvalidLink + +testHighS :: IO () +testHighS = do + let RecoverableSignature {rsR, rsS, rsRecId} = viemSetSignature + highS = i2ospOf_ 32 $ curveOrder - os2ip rsS + flipped = RecoverableSignature {rsR, rsS = highS, rsRecId = 1 - rsRecId} + recoverAddress flipped (digestOf (channel viemChannelLink) 0 deadline) `shouldReturn` Right viemAddress + editRequest (KM.insert "signature" (J.String $ hex $ serializeSignature flipped) $ requestJson [("key", J.String channelKey), ("value", J.String viemChannelLink)]) + `shouldBe` Left EIBadRequest + where + curveOrder = ECC.ecc_n $ ECC.common_curve $ ECC.getCurveByName ECC.SEC_p256k1 + +-- relay + +testRelayMined :: TVar ChaChaDRG -> IO () +testRelayMined g = withSetup g $ \s@Setup {node} -> do + req <- ownerEdit s viemChannelLink + r <- relay s req + [raw] <- within $ awaitSent node 1 + fmap (\TxRequest {trTo, trData} -> (trTo, trData)) (decodeSignedTx raw) `shouldBe` Right (fakeResolver, viemSetCall) + h <- mineSent s 1 True + answerOf r `shouldReturn` EAApplied (Just h) + stateOf s req `shouldReturn` Just (ESMined $ Just h) + +testRefusedBeforeRow :: TVar ChaChaDRG -> IO () +testRefusedBeforeRow g = withSetup g $ \s@Setup {node, records} -> do + other <- newEphemeralWallet g + (relayEdit records =<< signEdit s other (channel viemChannelLink) 0 deadline) `shouldReturn` EARefused + setBlock node 2 deadline + (relayEdit records =<< ownerEdit s viemChannelLink) `shouldReturn` EARefused + editRows s `shouldReturn` 0 + sentTransactions node `shouldReturn` [] + +testNonOwnerCap :: TVar ChaChaDRG -> IO () +testNonOwnerCap g = withSetup g $ \s@Setup {node, records} -> do + other <- newEphemeralWallet g + forM_ [0 .. 9] $ \n -> (relayEdit records =<< signEdit s other (channel viemChannelLink) n deadline) `shouldReturn` EARefused + editRows s `shouldReturn` 0 + r <- relay s =<< ownerEdit s viemChannelLink + _ <- within $ awaitSent node 1 + h <- mineSent s 1 True + answerOf r `shouldReturn` EAApplied (Just h) + +testRefusedRepeat :: TVar ChaChaDRG -> IO () +testRefusedRepeat g = withSetup g $ \s@Setup {owner} -> do + req <- signEdit s owner (channel viemChannelLink) 1 deadline + relayEdit (records s) req `shouldReturn` EARefused + stateOf s req `shouldReturn` Nothing + setNonce s 1 + r <- relay s req + h <- mineSent s 1 True + answerOf r `shouldReturn` EAApplied (Just h) + +testCap :: TVar ChaChaDRG -> IO () +testCap g = withSetup g $ \s@Setup {owner} -> do + let quick = s {records = (records s) {rsPendingAfter = shortWait}} + forM_ [0 .. 9] $ \n -> do + setNonce s n + (relayEdit (records quick) =<< signEdit s owner (channel viemChannelLink) n deadline) `shouldReturn` EAPending + setNonce s 10 + eleventh <- signEdit s owner (channel viemChannelLink) 10 deadline + passTime s 1000 + relayEdit (records s) eleventh `shouldReturn` EACapped 2600 + editRows s `shouldReturn` 10 + passTime s 2601 + relayEdit (records quick) eleventh `shouldReturn` EAPending + editRows s `shouldReturn` 11 + +testUnavailableBeforeSend :: TVar ChaChaDRG -> IO () +testUnavailableBeforeSend g = withSetup g $ \s@Setup {node, records} -> do + req <- ownerEdit s viemChannelLink + setFault node "eth_call" HttpFailure + relayEdit records req `shouldReturn` EAUnavailable + clearFault node "eth_call" + setFault node "eth_maxPriorityFeePerGas" HttpFailure + relayEdit records req `shouldReturn` EAUnavailable + editRows s `shouldReturn` 0 + sentTransactions node `shouldReturn` [] + clearFault node "eth_maxPriorityFeePerGas" + r <- relay s req + h <- mineSent s 1 True + answerOf r `shouldReturn` EAApplied (Just h) + +testConcurrentTwin :: TVar ChaChaDRG -> IO () +testConcurrentTwin g = withSetup g $ \s@Setup {node, records} -> do + req <- ownerEdit s viemChannelLink + -- both pass the repeat lookup before either inserts + setFault node "eth_getBlockByNumber" $ Slow 300000 + answers <- async $ concurrently (relayEdit records req) (relayEdit records req) + _ <- within $ awaitSent node 1 + clearFault node "eth_getBlockByNumber" + h <- mineSent s 1 True + within (wait answers) `shouldReturn` (EAApplied (Just h), EAApplied (Just h)) + length <$> sentTransactions node `shouldReturn` 1 + editRows s `shouldReturn` 1 + +testPendingThenMined :: TVar ChaChaDRG -> IO () +testPendingThenMined g = withSetup g $ \s@Setup {records} -> do + req <- ownerEdit s viemChannelLink + relayEdit records {rsPendingAfter = shortWait} req `shouldReturn` EAPending + h <- mineSent s 1 True + relayEdit records req `shouldReturn` EAApplied (Just h) + +testChainStopsAfterSend :: TVar ChaChaDRG -> IO () +testChainStopsAfterSend g = withSetup g $ \s@Setup {node, records} -> do + req <- ownerEdit s viemChannelLink + r <- relay s req + _ <- within $ awaitSent node 1 + setFault node "eth_getBlockByNumber" HttpFailure + recordsRound records + answerOf r `shouldReturn` EAPending + relayEdit records req `shouldReturn` EAPending + clearFault node "eth_getBlockByNumber" + h <- mineSent s 1 True + relayEdit records req `shouldReturn` EAApplied (Just h) + +-- outcomes + +testAppliedByAnother :: TVar ChaChaDRG -> IO () +testAppliedByAnother g = withSetup g $ \s@Setup {node} -> do + req <- ownerEdit s viemChannelLink + saveUnsent s req + -- another relayer applied it while the service was down + setNonce s 1 + setRecord s channelKey viemChannelLink + revertDryRun node viemSetCall $ Just $ selector "InvalidNonce()" + s' <- restart s + recordsRound (records s') + stateOf s req `shouldReturn` Just (ESMined Nothing) + sentTransactions node `shouldReturn` [] + relayEdit (records s') req `shouldReturn` EAApplied Nothing + +testExpiredAppliedByAnother :: TVar ChaChaDRG -> IO () +testExpiredAppliedByAnother g = withSetup g $ \s@Setup {node} -> do + req <- ownerEdit s viemChannelLink + r <- relay s req + _ <- within $ awaitSent node 1 + setBlock node 300 deadline + setNonce s 1 + setRecord s channelKey viemChannelLink + -- mined in the block after the deadline, so it reverted SignatureExpired + _ <- mineSent s 1 False + answerOf r `shouldReturn` EAApplied Nothing + stateOf s req `shouldReturn` Just (ESMined Nothing) + +testNonceTakenByAnother :: TVar ChaChaDRG -> IO () +testNonceTakenByAnother g = withSetup g $ \s@Setup {node} -> do + req <- ownerEdit s viemChannelLink + r <- relay s req + _ <- within $ awaitSent node 1 + setNonce s 1 + setRecord s channelKey "https://smp9.simplex.im/c#other" + _ <- mineSent s 1 False + answerOf r `shouldReturn` EAReverted (Just "InvalidNonce") + stateOf s req `shouldReturn` Just (ESReverted $ Just "InvalidNonce") + +testRevertFreesNonce :: TVar ChaChaDRG -> IO () +testRevertFreesNonce g = withSetup g $ \s@Setup {node, records} -> do + first <- ownerEdit s viemChannelLink + r <- relay s first + -- reverted before the deadline with the nonce unused, so the revert has no name + _ <- mineSent s 1 False + answerOf r `shouldReturn` EAReverted Nothing + second <- ownerEdit s "https://smp9.simplex.im/c#second" + r' <- relay s second + _ <- within $ awaitSent node 2 + relayEdit records first `shouldReturn` EAReverted Nothing + stateOf s second `shouldReturn` Just ESPending + h <- mineSent s 2 True + answerOf r' `shouldReturn` EAApplied (Just h) + +testFailedReRead :: TVar ChaChaDRG -> IO () +testFailedReRead g = withSetup g $ \s@Setup {node} -> do + req <- ownerEdit s viemChannelLink + saveUnsent s req + revertDryRun node viemSetCall $ Just $ selector "InvalidSignature()" + s' <- restart s + setFault node "eth_call" HttpFailure + recordsRound (records s') + stateOf s req `shouldReturn` Just ESPending + relayEdit (records s') req `shouldReturn` EAPending + clearFault node "eth_call" + recordsRound (records s') + stateOf s req `shouldReturn` Just (ESReverted $ Just "InvalidSignature") + relayEdit (records s') req `shouldReturn` EAReverted (Just "InvalidSignature") + sentTransactions node `shouldReturn` [] + +-- restarts + +testResume :: TVar ChaChaDRG -> IO () +testResume g = withSetup g $ \s@Setup {node, owner} -> do + unsent <- ownerEdit s viemChannelLink + saveUnsent s unsent + s' <- restart s + recordsRound (records s') + h <- mineSent s' 1 True + stateOf s unsent `shouldReturn` Just (ESMined $ Just h) + -- a sent edit whose transaction the node forgot while the service was down + setNonce s 1 + sent <- signEdit s owner (channel "https://smp9.simplex.im/c#next") 1 deadline + _ <- relayEdit (records s') {rsPendingAfter = shortWait} sent + [_, raw] <- within $ awaitSent node 2 + dropTransaction node $ C.keccak256 raw + s'' <- restart s' + followTransactions (sender s'') + (!! 2) <$> sentTransactions node `shouldReturn` raw + h' <- mineSent s'' 3 True + stateOf s sent `shouldReturn` Just (ESMined $ Just h') + TxHash (C.keccak256 raw) `shouldBe` h' + +testRepeatAfterRestart :: TVar ChaChaDRG -> IO () +testRepeatAfterRestart g = withSetup g $ \s@Setup {node} -> do + req <- ownerEdit s viemChannelLink + r <- relay s req + h <- mineSent s 1 True + answerOf r `shouldReturn` EAApplied (Just h) + s' <- restart s + setFault node "eth_call" HttpFailure + setFault node "eth_getBlockByNumber" HttpFailure + relayEdit (records s') req `shouldReturn` EAApplied (Just h) + length <$> sentTransactions node `shouldReturn` 1 + +testRestartExpiredApplied :: TVar ChaChaDRG -> IO () +testRestartExpiredApplied g = withSetup g $ \s@Setup {node} -> do + req <- ownerEdit s viemChannelLink + saveUnsent s req + setBlock node 300 $ deadline + 1 + setNonce s 1 + setRecord s channelKey viemChannelLink + s' <- restart s + recordsRound (records s') + stateOf s req `shouldReturn` Just (ESMined Nothing) + sentTransactions node `shouldReturn` [] + +testExpiryFreesNonce :: TVar ChaChaDRG -> IO () +testExpiryFreesNonce g = withSetup g $ \s@Setup {node, records, sender} -> do + req <- ownerEdit s viemChannelLink + relayEdit records {rsPendingAfter = shortWait} req `shouldReturn` EAPending + [raw] <- within $ awaitSent node 1 + -- the latest block is past the deadline, but not yet the block two confirmations deep + setBlock node 300 deadline + setBlock node 301 $ deadline + 1 + recordsRound records + stateOf s req `shouldReturn` Just ESPending + setBlock node 302 $ deadline + 2 + recordsRound records + stateOf s req `shouldReturn` Just (ESReverted $ Just "SignatureExpired") + relayEdit records req `shouldReturn` EAReverted (Just "SignatureExpired") + dropTransaction node $ C.keccak256 raw + followTransactions sender + sentTransactions node `shouldReturn` [raw, raw] + +-- http + +testHttp :: TVar ChaChaDRG -> IO () +testHttp g = withSetup g $ \s@Setup {records} -> Warp.testWithApplication (pure $ recordsHandler records) $ \port -> do + manager <- newManager defaultManagerSettings + let post body = do + req <- parseRequest $ "http://127.0.0.1:" <> show port <> "/api/name/records" + resp <- httpLbs req {method = "POST", requestHeaders = [(hContentType, "application/json")], requestBody = RequestBodyLBS body} manager + pure (statusCode $ responseStatus resp, J.decode $ responseBody resp :: Maybe J.Value) + editBody value = J.encode $ KM.insert "value" (J.String value) $ requestJson [("key", J.String channelKey)] + post "[]" `shouldReturn` (400, Just $ J.object ["error" .= ("bad_request" :: Text)]) + post (editBody "https://x/a") `shouldReturn` (400, Just $ J.object ["error" .= ("invalid_link" :: Text)]) + answer <- async $ post $ editBody viemChannelLink + TxHash h <- mineSent s 1 True + within (wait answer) `shouldReturn` (200, Just $ J.object ["tx" .= hex h]) + setNonce s 1 + next <- async . post . J.encode . editJson =<< signEdit s (owner s) (channel "https://smp9.simplex.im/c#next") 1 deadline + _ <- mineSent s 2 False + within (wait next) `shouldReturn` (409, Just $ J.object ["error" .= ("record_reverted" :: Text), "revert" .= J.Null]) + +-- fixtures + +editJson :: EditRequest -> J.Object +editJson EditRequest {erChange, erNonce, erDeadline, erSignature} = + KM.fromList $ + [ ("labelHash", J.String aliceHashText), + ("nonce", J.toJSON erNonce), + ("deadline", J.toJSON erDeadline), + ("signature", J.String $ hex $ serializeSignature erSignature) + ] + <> case erChange of + RCSetText key value -> [("key", J.String key), ("value", J.String value)] + RCClear -> [("clear", J.Bool True)] + +longWait, shortWait :: Int +longWait = 4000000 +shortWait = 200000 + +-- | The fields of viem's SetText edit but its key and value, with these added or replaced. +requestJson :: [(J.Key, J.Value)] -> J.Object +requestJson extra = KM.union (KM.fromList extra) $ KM.delete "key" $ KM.delete "value" $ editJson viemEdit + +viemEdit :: EditRequest +viemEdit = EditRequest {erLabelHash = alice, erChange = channel viemChannelLink, erNonce = 0, erDeadline = deadline, erSignature = viemSetSignature} + +digestOf :: RecordChange -> Word64 -> Word64 -> ByteString +digestOf change nonce dl = case change of + RCSetText key value -> setTextDigest resolverDomain' aliceNode key value nonce dl + RCClear -> clearRecordsDigest resolverDomain' aliceNode nonce dl + +resolverDomain' :: Eip712Domain +resolverDomain' = resolverDomain fakeChainId fakeResolver + +alice :: LabelHash +alice = labelHash "alicebakery" + +aliceNode :: Node +aliceNode = labelNode TLDSimplex alice + +aliceHashText :: Text +aliceHashText = hex $ unLabel alice + +unLabel :: LabelHash -> ByteString +unLabel (LabelHash h) = h + +contactKey, channelKey :: Text +contactKey = "simplex.contact" +channelKey = "simplex.channel" + +-- | An hour after the fake node's first block. +deadline :: Word64 +deadline = 1767229200 + +nameExpiry, gracePeriod :: Word64 +nameExpiry = 1861833600 +gracePeriod = 7776000 + +registry :: Address +registry = address "0x5fbdb2315678afecb367f032d93f642f64180aa3" + +-- | The name code of BIP-39 entropy zero, the wallet of "abandon ... about". +viemCode :: Text +viemCode = "SN-00000-00000-00000-00000-00000-0VME2" + +viemAddress :: Address +viemAddress = address "0x9858effd232b4033e47d90003d41ec34ecaeda94" + +viemChannelLink :: Text +viemChannelLink = "https://smp8.simplex.im/c#Y8m3" + +-- | viem: SetText(alicebakery.simplex, simplex.channel, viemChannelLink, 0, deadline) +viemSetSignature :: RecoverableSignature +viemSetSignature = either (error . show) id $ parseSignature "0xfce4c6865591609c07ef3d94f376187d8a20cd9d94b4affcb60b55e999038fbd4e45c42b5fafe66a8d4f756e99398602eacef777b4dce4afd0a767cddadf3ca91c" + +-- | viem: ClearRecords(alicebakery.simplex, 1, deadline) +viemClearSignature :: RecoverableSignature +viemClearSignature = either (error . show) id $ parseSignature "0x0565f7e5a591c200fcc358c1d9e9293721d0b99f0285b589211203e311e8e6167ee822d664048870bdd8552263d25bbf45e7f4985fd3b8c3a19cfced44ef9d561c" + +viemSetCall, viemClearCall :: ByteString +viemSetCall = unhex "71a218a70f4104919a21c22f566d9c7947c7c7d8addbf546c973851a7e449276ea54ec1a00000000000000000000000000000000000000000000000000000000000000c000000000000000000000000000000000000000000000000000000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000006955c7100000000000000000000000000000000000000000000000000000000000000140000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e6368616e6e656c0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e68747470733a2f2f736d70382e73696d706c65782e696d2f632359386d3300000000000000000000000000000000000000000000000000000000000000000041fce4c6865591609c07ef3d94f376187d8a20cd9d94b4affcb60b55e999038fbd4e45c42b5fafe66a8d4f756e99398602eacef777b4dce4afd0a767cddadf3ca91c00000000000000000000000000000000000000000000000000000000000000" +viemClearCall = unhex "6463e6140f4104919a21c22f566d9c7947c7c7d8addbf546c973851a7e449276ea54ec1a0000000000000000000000000000000000000000000000000000000000000001000000000000000000000000000000000000000000000000000000006955c710000000000000000000000000000000000000000000000000000000000000008000000000000000000000000000000000000000000000000000000000000000410565f7e5a591c200fcc358c1d9e9293721d0b99f0285b589211203e311e8e6167ee822d664048870bdd8552263d25bbf45e7f4985fd3b8c3a19cfced44ef9d561c00000000000000000000000000000000000000000000000000000000000000" + +unhex :: ByteString -> ByteString +unhex = either error id . convertFromBase Base16 + +address :: ByteString -> Address +address = either error id . strDecode diff --git a/tests/Test.hs b/tests/Test.hs index 50853e54e0..45ee4397fc 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -16,6 +16,7 @@ import Bots.StoreService.NamesContractsTests import Bots.StoreService.NamesLabelTests import Bots.StoreService.NamesLinksTests import Bots.StoreService.NamesProfilesTests +import Bots.StoreService.NamesRecordsTests import Bots.StoreService.NamesSenderTests import Bots.StoreService.NamesSignatureTests import Bots.StoreService.NamesStoreTests @@ -103,6 +104,7 @@ main = do namesLabelTests namesLinksTests namesProfilesTests + namesRecordsTests namesSenderTests namesSignatureTests namesStoreTests