This commit is contained in:
Dmitry Zuikov 2024-08-08 19:18:25 +03:00
parent 6b87966e2a
commit 0053a95f27
1 changed files with 22 additions and 19 deletions

View File

@ -65,6 +65,7 @@ import Data.ByteString.Lazy qualified as LBS
import Data.ByteString (ByteString)
import Data.Coerce
import Data.Either
import Data.Fixed
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
import Data.List qualified as L
@ -81,6 +82,7 @@ import Streaming.Prelude qualified as S
import System.Directory (getModificationTime,setModificationTime,doesFileExist,listDirectory)
import System.Directory (XdgDirectory(..),getXdgDirectory)
import System.Exit qualified as Exit
import System.TimeIt
import Text.InterpolatedString.Perl6 (qc)
import UnliftIO.IO.File qualified as UIO
@ -1011,13 +1013,14 @@ getStateFromRefChan rchan = do
pure $ headMay r
-- let check hx = pure True
hseen <- withDB db (select_ [qc|select txhash from seen|])
<&> fmap ((fromStringMay @HashRef) . fromOnly)
<&> HS.fromList . catMaybes
let check hx = do
withDB db do
r <- select @(Only Int) [qc|select 1 from seen where txhash = ? limit 1|] (Only (show $ pretty $ hx))
pure $ L.null r
let check hx = pure $ not $ HS.member hx hseen
-- FIXME: may-be-slow
(a, _) <- timeItT do
lift $ walkRefChanTx @UNIX check rchan $ \txh u -> do
atomically $ writeTQueue seen txh
@ -1038,7 +1041,7 @@ getStateFromRefChan rchan = do
runExceptT (extractMetaData @'HBS2Basic findKey sto href)
>>= either (const none) ( \meta -> atomically $ writeTQueue outq (orig, ((href, meta), txh)) )
notice $ "walkRefChanTx complete in" <+> pretty (realToFrac a :: Fixed E6)
trees <- atomically (flushTQueue outq)
@ -1078,7 +1081,7 @@ getStateFromRefChan rchan = do
seenTx <- atomically $ flushTQueue seen
for_ seenTx $ \txh -> do
insert [qc|insert into seen (txhash) values(?)|] (Only (show $ pretty $ txh))
insert [qc|insert into seen (txhash) values(?) on conflict do nothing|] (Only (show $ pretty $ txh))
ess0 <- withDB db do
select_ [qc|select s from entry|]