Search related continuations in tx search (#66)

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 kadena-io/block-explorer#64 and kadena-io/block-explorer#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 #140

---------

Co-authored-by: Stuart Popejoy <[email protected]>
Co-authored-by: Enis Bayramoğlu <[email protected]>

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

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)

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)

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,55 +391,27 @@ 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 }
 
 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,56 +617,24 @@ 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
     P.withResource pool $ \c -> 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
 

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

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))