Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Simplify the handling of the recentTxs #140

Merged
merged 1 commit into from
Mar 24, 2023
Merged

Simplify the handling of the recentTxs #140

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 8 additions & 22 deletions haskell-src/exec/Chainweb/Server.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,20 +97,11 @@ setCors = cors . const . Just $ simpleCorsResourcePolicy
}

data ServerState = ServerState
{ _ssRecentTxs :: RecentTxs
, _ssHighestBlockHeight :: BlockHeight
{ _ssHighestBlockHeight :: BlockHeight
, _ssTransactionCount :: Maybe Int64
, _ssCirculatingCoins :: Decimal
} deriving (Eq,Show)

ssRecentTxs
:: Functor f
=> (RecentTxs -> f RecentTxs)
-> ServerState -> f ServerState
ssRecentTxs = lens _ssRecentTxs setter
where
setter sc v = sc { _ssRecentTxs = v }

ssHighestBlockHeight
:: Functor f
=> (BlockHeight -> f BlockHeight)
Expand Down Expand Up @@ -180,9 +171,8 @@ apiServerCut env senv cutBS = do
let circulatingCoins = getCirculatingCoins (fromIntegral curHeight) t
logg Info $ fromString $ "Total coins in circulation: " <> show circulatingCoins
let pool = _env_dbConnPool env
recentTxs <- RecentTxs . S.fromList <$> queryRecentTxs logg pool
numTxs <- getTransactionCount logg pool
ssRef <- newIORef $ ServerState recentTxs 0 numTxs circulatingCoins
ssRef <- newIORef $ ServerState 0 numTxs circulatingCoins
logg Info $ fromString $ "Total number of transactions: " <> show numTxs
_ <- forkIO $ scheduledUpdates env pool ssRef (_serverEnv_runFill senv) (_serverEnv_fillDelay senv)
_ <- forkIO $ retryingListener env ssRef
Expand All @@ -196,7 +186,7 @@ apiServerCut env senv cutBS = do

let unThrottledPool = fst <$> throttledPool
let serverApp req =
( ( recentTxsHandler ssRef
( ( recentTxsHandler logg unThrottledPool
:<|> searchTxs logg throttledPool req
:<|> evHandler logg throttledPool req
:<|> txHandler logg unThrottledPool
Expand Down Expand Up @@ -283,9 +273,6 @@ statsHandler ssRef = liftIO $ do
mkStats ss = ChainwebDataStats (fromIntegral <$> _ssTransactionCount ss)
(Just $ realToFrac $ _ssCirculatingCoins ss)

recentTxsHandler :: IORef ServerState -> Handler [TxSummary]
recentTxsHandler ss = liftIO $ fmap (toList . _recentTxs_txs . _ssRecentTxs) $ readIORef ss

serverHeaderHandler :: Env -> IORef ServerState -> PowHeader -> IO ()
serverHeaderHandler env ssRef ph@(PowHeader h _) = do
let pool = _env_dbConnPool env
Expand All @@ -303,8 +290,7 @@ serverHeaderHandler env ssRef ph@(PowHeader h _) = do
let hash = _blockHeader_hash h
tos = _blockPayloadWithOutputs_transactionsWithOutputs pl
ts = S.fromList $ map (\(t,tout) -> mkTxSummary chain height hash t tout) tos
f ss = (ss & ssRecentTxs %~ addNewTransactions ts
& ssHighestBlockHeight %~ max height
f ss = (ss & ssHighestBlockHeight %~ max height
& (ssTransactionCount . _Just) +~ (fromIntegral $ S.length ts), ())

let msg = printf "Got new header on chain %d height %d" (unChainId chain) height
Expand Down Expand Up @@ -674,10 +660,10 @@ type instance QExprToIdentity (a :. b) = (QExprToIdentity a) :. (QExprToIdentity
type instance QExprToField (a :. b) = (QExprToField a) :. (QExprToField b)


queryRecentTxs :: LogFunctionIO Text -> P.Pool Connection -> IO [TxSummary]
queryRecentTxs logger pool = do
liftIO $ logger Info "Getting recent transactions"
P.withResource pool $ \c -> do
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
Expand Down