From 67cd94d66c6d2f76e559f01b4c5dd16ba7140c57 Mon Sep 17 00:00:00 2001 From: Stuart Popejoy <8353613+sirlensalot@users.noreply.github.com> Date: Mon, 27 Mar 2023 15:55:01 -0400 Subject: [PATCH] Search related continuations in tx search (#66) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This PR extends the transaction endpoints to gather the history of continuation transactions. It extends the following endpoints and adds the `initialCode` and `previousSteps` fields to them: * Single transaction details: `/txs/tx` * Multiple transaction details: `/txs/txs` * Transaction search: `/txs/search` * Recent transactions: `/txs/recent` In addition to attaching this continuation history to the response, this PR also extends the search logic of `/txs/search` so that if the given search term appears in the `initialCode` of a continuation transaction, the search still finds it. This PR supports https://github.com/kadena-io/block-explorer/issues/64 and https://github.com/kadena-io/block-explorer/issues/63 * Search related continuations in tx search * Retreive continuation history recursively * Explain the continuation histor custom expression * Deduplicate tx summary plumbing * Deduplicate dbToApi tx detail conversion * Deduplicate txs query execution * Add transaction continuation histories * Delete dead code Left over from https://github.com/kadena-io/chainweb-data/pull/140 --------- Co-authored-by: Stuart Popejoy Co-authored-by: Enis Bayramoğlu --- cabal.project | 4 +- haskell-src/chainweb-data.cabal | 1 + haskell-src/exec/Chainweb/Lookups.hs | 2 +- haskell-src/exec/Chainweb/Server.hs | 176 ++++++------------ haskell-src/lib/ChainwebDb/Queries.hs | 57 +++++- .../lib/ChainwebDb/Types/Transaction.hs | 2 +- 6 files changed, 113 insertions(+), 129 deletions(-) diff --git a/cabal.project b/cabal.project index 50ba7041..0ba9b103 100644 --- a/cabal.project +++ b/cabal.project @@ -18,8 +18,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/chainweb-api.git - tag: c877d32b46175917d9df9521d0c4e7ec47ebd5cd - --sha256: sha256-X6fQTcV46lHT3vifSDO0exnoYBr7Tx2YEpK8EyEFgBA= + tag: 6725d8490fcf43fd5f6b8b0ca731565a58f9c8e6 + --sha256: sha256-B3swFmWuEajZ42gpdvHsF2MpWxHU4YiIx/nV+1ZCx30= source-repository-package type: git diff --git a/haskell-src/chainweb-data.cabal b/haskell-src/chainweb-data.cabal index 496bfffb..c5406f66 100644 --- a/haskell-src/chainweb-data.cabal +++ b/haskell-src/chainweb-data.cabal @@ -90,6 +90,7 @@ library , postgresql-simple-migration , servant-client , servant-openapi3 + , vector , yet-another-logger if flag(ghc-flags) diff --git a/haskell-src/exec/Chainweb/Lookups.hs b/haskell-src/exec/Chainweb/Lookups.hs index 55687c21..1261eaab 100644 --- a/haskell-src/exec/Chainweb/Lookups.hs +++ b/haskell-src/exec/Chainweb/Lookups.hs @@ -316,7 +316,7 @@ mkTransaction b (tx,txo) = Transaction , _tx_sender = _chainwebMeta_sender mta , _tx_nonce = _pactCommand_nonce cmd , _tx_code = _exec_code <$> exc - , _tx_pactId = _cont_pactId <$> cnt + , _tx_pactId = DbHash . _cont_pactId <$> cnt , _tx_rollback = _cont_rollback <$> cnt , _tx_step = fromIntegral . _cont_step <$> cnt , _tx_data = (PgJSONB . _cont_data <$> cnt) diff --git a/haskell-src/exec/Chainweb/Server.hs b/haskell-src/exec/Chainweb/Server.hs index 23abf973..200039d9 100644 --- a/haskell-src/exec/Chainweb/Server.hs +++ b/haskell-src/exec/Chainweb/Server.hs @@ -4,7 +4,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NumericUnderscores #-} @@ -32,12 +31,10 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.URL as B64 import Data.ByteString.Lazy (ByteString) import Data.Decimal -import Data.Foldable import Data.Int import Data.IORef import qualified Data.Pool as P import Data.Proxy -import Data.Sequence (Seq) import qualified Data.Sequence as S import Data.String import Data.String.Conv (toS) @@ -46,6 +43,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Time import Data.Tuple.Strict (T2(..)) +import qualified Data.Vector as V import Database.Beam hiding (insert) import Database.Beam.Backend.SQL import Database.Beam.Postgres @@ -349,6 +347,21 @@ mkContinuation readTkn mbOffset mbNext = case (mbNext, mbOffset) of (Nothing, Just (Offset offset)) -> return $ Left $ offset <$ guard (offset > 0) (Nothing, Nothing) -> return $ Left Nothing +dbToApiTxSummary :: DbTxSummary -> ContinuationHistory -> TxSummary +dbToApiTxSummary s contHist = TxSummary + { _txSummary_chain = fromIntegral $ dtsChainId s + , _txSummary_height = fromIntegral $ dtsHeight s + , _txSummary_blockHash = unDbHash $ dtsBlock s + , _txSummary_creationTime = dtsCreationTime s + , _txSummary_requestKey = unDbHash $ dtsReqKey s + , _txSummary_sender = dtsSender s + , _txSummary_code = dtsCode s + , _txSummary_continuation = unPgJsonb <$> dtsContinuation s + , _txSummary_result = maybe TxFailed (const TxSucceeded) $ dtsGoodResult s + , _txSummary_initialCode = chCode contHist + , _txSummary_previousSteps = V.toList (chSteps contHist) <$ chCode contHist + } + searchTxs :: LogFunctionIO Text -> M.Managed ConnectionWithThrottling @@ -378,23 +391,13 @@ searchTxs logger pool req givenMbLim mbOffset (Just search) minheight maxheight PG.withTransactionLevel PG.RepeatableRead c $ do (mbCont, results) <- performBoundedScan strategy (runBeamPostgresDebug (logger Debug . T.pack) c) - toTxSearchCursor + (toTxSearchCursor . txwhSummary) (txSearchSource search $ HeightRangeParams minheight maxheight) noDecoration continuation resultLimit return $ maybe noHeader (addHeader . mkTxToken) mbCont $ - results <&> \(s,_) -> TxSummary - { _txSummary_chain = fromIntegral $ dtsChainId s - , _txSummary_height = fromIntegral $ dtsHeight s - , _txSummary_blockHash = unDbHash $ dtsBlock s - , _txSummary_creationTime = dtsCreationTime s - , _txSummary_requestKey = unDbHash $ dtsReqKey s - , _txSummary_sender = dtsSender s - , _txSummary_code = dtsCode s - , _txSummary_continuation = unPgJsonb <$> dtsContinuation s - , _txSummary_result = maybe TxFailed (const TxSucceeded) $ dtsGoodResult s - } + results <&> \(txwh,_) -> dbToApiTxSummary (txwhSummary txwh) (txwhContHistory txwh) throw404 :: MonadError ServerError m => ByteString -> m a throw404 msg = throwError $ err404 { errBody = msg } @@ -402,31 +405,13 @@ throw404 msg = throwError $ err404 { errBody = msg } throw400 :: MonadError ServerError m => ByteString -> m a throw400 msg = throwError $ err400 { errBody = msg } -txHandler - :: LogFunctionIO Text - -> M.Managed Connection - -> Maybe RequestKey - -> Handler TxDetail -txHandler _ _ Nothing = throw404 "You must specify a search string" -txHandler logger pool (Just (RequestKey rk)) = - may404 $ liftIO $ M.with pool $ \c -> - runBeamPostgresDebug (logger Debug . T.pack) c $ do - r <- runSelectReturningOne $ select $ do - tx <- all_ (_cddb_transactions database) - blk <- all_ (_cddb_blocks database) - guard_ (_tx_block tx `references_` blk) - guard_ (_tx_requestKey tx ==. val_ (DbHash rk)) - return (tx,blk) - evs <- runSelectReturningList $ select $ do - ev <- all_ (_cddb_events database) - guard_ (_ev_requestkey ev ==. val_ (RKCB_RequestKey $ DbHash rk)) - return ev - return $ (`fmap` r) $ \(tx,blk) -> TxDetail +toApiTxDetail :: Transaction -> ContinuationHistory -> Block -> [Event] -> TxDetail +toApiTxDetail tx contHist blk evs = TxDetail { _txDetail_ttl = fromIntegral $ _tx_ttl tx , _txDetail_gasLimit = fromIntegral $ _tx_gasLimit tx , _txDetail_gasPrice = _tx_gasPrice tx , _txDetail_nonce = _tx_nonce tx - , _txDetail_pactId = _tx_pactId tx + , _txDetail_pactId = unDbHash <$> _tx_pactId tx , _txDetail_rollback = _tx_rollback tx , _txDetail_step = fromIntegral <$> _tx_step tx , _txDetail_data = unMaybeValue $ _tx_data tx @@ -447,74 +432,53 @@ txHandler logger pool (Just (RequestKey rk)) = , _txDetail_requestKey = unDbHash $ _tx_requestKey tx , _txDetail_sender = _tx_sender tx , _txDetail_code = _tx_code tx - , _txDetail_success = - maybe False (const True) $ _tx_goodResult tx + , _txDetail_success = isJust $ _tx_goodResult tx , _txDetail_events = map toTxEvent evs + , _txDetail_initialCode = chCode contHist + , _txDetail_previousSteps = V.toList (chSteps contHist) <$ chCode contHist } - where unMaybeValue = maybe Null unPgJsonb toTxEvent ev = TxEvent (_ev_qualName ev) (unPgJsonb $ _ev_params ev) - may404 a = a >>= maybe (throw404 "Tx not found") return -txsHandler - :: LogFunctionIO Text - -> M.Managed Connection - -> Maybe RequestKey - -> Handler [TxDetail] -txsHandler _ _ Nothing = throw404 "You must specify a search string" -txsHandler logger pool (Just (RequestKey rk)) = - emptyList404 $ liftIO $ M.with pool $ \c -> +queryTxsByKey :: LogFunctionIO Text -> Text -> Connection -> IO [TxDetail] +queryTxsByKey logger rk c = runBeamPostgresDebug (logger Debug . T.pack) c $ do r <- runSelectReturningList $ select $ do tx <- all_ (_cddb_transactions database) + contHist <- joinContinuationHistory (_tx_pactId tx) blk <- all_ (_cddb_blocks database) guard_ (_tx_block tx `references_` blk) guard_ (_tx_requestKey tx ==. val_ (DbHash rk)) - return (tx,blk) + return (tx,contHist, blk) evs <- runSelectReturningList $ select $ do ev <- all_ (_cddb_events database) guard_ (_ev_requestkey ev ==. val_ (RKCB_RequestKey $ DbHash rk)) return ev - return $ (`fmap` r) $ \(tx,blk) -> TxDetail - { _txDetail_ttl = fromIntegral $ _tx_ttl tx - , _txDetail_gasLimit = fromIntegral $ _tx_gasLimit tx - , _txDetail_gasPrice = _tx_gasPrice tx - , _txDetail_nonce = _tx_nonce tx - , _txDetail_pactId = _tx_pactId tx - , _txDetail_rollback = _tx_rollback tx - , _txDetail_step = fromIntegral <$> _tx_step tx - , _txDetail_data = unMaybeValue $ _tx_data tx - , _txDetail_proof = _tx_proof tx - , _txDetail_gas = fromIntegral $ _tx_gas tx - , _txDetail_result = - maybe (unMaybeValue $ _tx_badResult tx) unPgJsonb $ - _tx_goodResult tx - , _txDetail_logs = fromMaybe "" $ _tx_logs tx - , _txDetail_metadata = unMaybeValue $ _tx_metadata tx - , _txDetail_continuation = unPgJsonb <$> _tx_continuation tx - , _txDetail_txid = maybe 0 fromIntegral $ _tx_txid tx - , _txDetail_chain = fromIntegral $ _tx_chainId tx - , _txDetail_height = fromIntegral $ _block_height blk - , _txDetail_blockTime = _block_creationTime blk - , _txDetail_blockHash = unDbHash $ unBlockId $ _tx_block tx - , _txDetail_creationTime = _tx_creationTime tx - , _txDetail_requestKey = unDbHash $ _tx_requestKey tx - , _txDetail_sender = _tx_sender tx - , _txDetail_code = _tx_code tx - , _txDetail_success = - maybe False (const True) $ _tx_goodResult tx - , _txDetail_events = map toTxEvent evs - } + return $ (`fmap` r) $ \(tx,contHist, blk) -> toApiTxDetail tx contHist blk evs - where - emptyList404 xs = xs >>= \case - [] -> throw404 "no txs not found" - ys -> return ys - unMaybeValue = maybe Null unPgJsonb - toTxEvent ev = - TxEvent (_ev_qualName ev) (unPgJsonb $ _ev_params ev) +txHandler + :: LogFunctionIO Text + -> M.Managed Connection + -> Maybe RequestKey + -> Handler TxDetail +txHandler _ _ Nothing = throw404 "You must specify a search string" +txHandler logger pool (Just (RequestKey rk)) = + liftIO (M.with pool $ queryTxsByKey logger rk) >>= \case + [x] -> return x + _ -> throw404 "Tx not found" + +txsHandler + :: LogFunctionIO Text + -> M.Managed Connection + -> Maybe RequestKey + -> Handler [TxDetail] +txsHandler _ _ Nothing = throw404 "You must specify a search string" +txsHandler logger pool (Just (RequestKey rk)) = + liftIO (M.with pool $ queryTxsByKey logger rk) >>= \case + [] -> throw404 "Tx not found" + xs -> return xs type AccountNextToken = (Int64, T.Text, Int64) @@ -653,36 +617,17 @@ evHandler logger pool req limit mbOffset qSearch qParam qName qModuleName minhei , _evDetail_idx = fromIntegral $ _ev_idx ev } -data h :. t = h :. t deriving (Eq,Ord,Show,Read,Typeable) -infixr 3 :. - -type instance QExprToIdentity (a :. b) = (QExprToIdentity a) :. (QExprToIdentity b) -type instance QExprToField (a :. b) = (QExprToField a) :. (QExprToField b) - - recentTxsHandler :: LogFunctionIO Text -> M.Managed Connection -> Handler [TxSummary] recentTxsHandler logger pool = liftIO $ do logger Info "Getting recent transactions" M.with pool $ \c -> do res <- runBeamPostgresDebug (logger Debug . T.pack) c $ runSelectReturningList $ select $ do - limit_ 20 $ orderBy_ (desc_ . getHeight) $ do + limit_ 10 $ orderBy_ (desc_ . dtsHeight . fst) $ do tx <- all_ (_cddb_transactions database) - return - ( (_tx_chainId tx) - , (_tx_height tx) - , (unBlockId $ _tx_block tx) - , (_tx_creationTime tx) - , (_tx_requestKey tx) - , (_tx_sender tx) - , ((_tx_code tx) - , (_tx_continuation tx) - , (_tx_goodResult tx) - )) - return $ mkSummary <$> res - where - getHeight (_,a,_,_,_,_,_) = a - mkSummary (a,b,c,d,e,f,(g,h,i)) = TxSummary (fromIntegral a) (fromIntegral b) (unDbHash c) d (unDbHash e) f g (unPgJsonb <$> h) (maybe TxFailed (const TxSucceeded) i) + contHist <- joinContinuationHistory (_tx_pactId tx) + return $ (toDbTxSummary tx, contHist) + return $ uncurry dbToApiTxSummary <$> res getTransactionCount :: LogFunctionIO Text -> P.Pool Connection -> IO (Maybe Int64) getTransactionCount logger pool = do @@ -690,19 +635,6 @@ getTransactionCount logger pool = do runBeamPostgresDebug (logger Debug . T.pack) c $ runSelectReturningOne $ select $ aggregate_ (\_ -> as_ @Int64 countAll_) (all_ (_cddb_transactions database)) -data RecentTxs = RecentTxs - { _recentTxs_txs :: Seq TxSummary - } deriving (Eq,Show) - -getSummaries :: RecentTxs -> [TxSummary] -getSummaries (RecentTxs s) = toList s - -addNewTransactions :: Seq TxSummary -> RecentTxs -> RecentTxs -addNewTransactions txs (RecentTxs s1) = RecentTxs s2 - where - maxTransactions = 10 - s2 = S.take maxTransactions $ txs <> s1 - unPgJsonb :: PgJSONB a -> a unPgJsonb (PgJSONB v) = v diff --git a/haskell-src/lib/ChainwebDb/Queries.hs b/haskell-src/lib/ChainwebDb/Queries.hs index a949a67e..8918c6da 100644 --- a/haskell-src/lib/ChainwebDb/Queries.hs +++ b/haskell-src/lib/ChainwebDb/Queries.hs @@ -22,6 +22,7 @@ import Data.Functor ((<&>)) import Data.Maybe (maybeToList) import Data.Text (Text) import Data.Time +import Data.Vector (Vector) import Database.Beam hiding (insert) import Database.Beam.Postgres import Database.Beam.Postgres.Syntax @@ -97,16 +98,66 @@ toDbTxSummary Transaction{..} = DbTxSummary , dtsGoodResult = _tx_goodResult } +data ContinuationHistoryT f = ContinuationHistory + { chCode :: C f (Maybe Text) + , chSteps :: C f (Vector Text) + } deriving (Generic, Beamable) + +type ContinuationHistory = ContinuationHistoryT Identity + +deriving instance Show ContinuationHistory + +joinContinuationHistory :: PgExpr s (Maybe (DbHash TxHash)) -> + Q Postgres ChainwebDataDb s (ContinuationHistoryT (PgExpr s)) +joinContinuationHistory pactIdExp = pgUnnest $ (customExpr_ $ \pactId -> + -- We need the following LATERAL keyword so that it can be used liberally + -- in any Q context despite the fact that it refers to the `pactIdExp` coming + -- from the outside scope. The LATERAL helps, because when the expression below + -- appears after a XXXX JOIN, this LATERAL prefix will turn it into a lateral + -- join. This is very hacky, but Postgres allows the LATERAL keyword after FROM + -- as well, so I can't think of a case that would cause the hack to blow up. + -- Either way, once we have migrations going, we should replace this body with + -- a Postgres function call, which the pgUnnest + customExpr_ combination was + -- designed for. + "LATERAL ( " <> + "WITH RECURSIVE transactionSteps AS ( " <> + "SELECT DISTINCT ON (depth) tInner.code, tInner.pactid, 1 AS depth, tInner.requestkey " <> + "FROM transactions AS tInner " <> + "WHERE (tInner.requestkey) = " <> pactId <> + "UNION ALL " <> + "SELECT DISTINCT ON (depth) tInner.code, tInner.pactid, tRec.depth + 1, tInner.requestkey " <> + "FROM transactions AS tInner " <> + "INNER JOIN transactionSteps AS tRec ON tRec.pactid = tInner.requestkey " <> + ")" <> + "SELECT (array_agg(code) FILTER (WHERE code IS NOT NULL))[1] as code " <> + ", array_agg(requestkey ORDER BY depth) as steps " <> + "FROM transactionSteps " <> + ")") pactIdExp + +data TxSummaryWithHistoryT f = TxSummaryWithHistory + { txwhSummary :: DbTxSummaryT f + , txwhContHistory :: ContinuationHistoryT f + } deriving (Generic, Beamable) + +type TxSummaryWithHistory = TxSummaryWithHistoryT Identity + txSearchSource :: Text -> HeightRangeParams -> - Q Postgres ChainwebDataDb s (FilterMarked DbTxSummaryT (PgExpr s)) + Q Postgres ChainwebDataDb s (FilterMarked TxSummaryWithHistoryT (PgExpr s)) txSearchSource search hgtRange = do tx <- all_ $ _cddb_transactions database + contHist <- joinContinuationHistory (_tx_pactId tx) + let codeMerged = coalesce_ + [ just_ $ _tx_code tx + , just_ $ chCode contHist + ] + nothing_ guardInRange hgtRange (_tx_height tx) let searchExp = val_ ("%" <> search <> "%") - isMatch = fromMaybe_ (val_ "") (_tx_code tx) `like_` searchExp - return $ FilterMarked isMatch $ toDbTxSummary tx + isMatch = fromMaybe_ (val_ "") codeMerged `like_` searchExp + return $ FilterMarked isMatch $ + TxSummaryWithHistory (toDbTxSummary tx) contHist data EventSearchParams = EventSearchParams { espSearch :: Maybe Text diff --git a/haskell-src/lib/ChainwebDb/Types/Transaction.hs b/haskell-src/lib/ChainwebDb/Types/Transaction.hs index 64f98b85..493306f5 100644 --- a/haskell-src/lib/ChainwebDb/Types/Transaction.hs +++ b/haskell-src/lib/ChainwebDb/Types/Transaction.hs @@ -40,7 +40,7 @@ data TransactionT f = Transaction , _tx_sender :: C f Text , _tx_nonce :: C f Text , _tx_code :: C f (Maybe Text) - , _tx_pactId :: C f (Maybe Text) + , _tx_pactId :: C f (Maybe (DbHash TxHash)) , _tx_rollback :: C f (Maybe Bool) , _tx_step :: C f (Maybe Int64) , _tx_data :: C f (Maybe (PgJSONB Value))