From 56a60b2251be9233a9c600b61cc91482a4b07f61 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Sat, 28 Jan 2023 06:55:34 +0300 Subject: [PATCH] limits lowered --- hbs2-core/lib/HBS2/Defaults.hs | 12 +++---- .../lib/HBS2/Storage/Simple.hs | 35 +++++++++---------- hbs2-tests/test/Peer2Main.hs | 29 ++++++++------- 3 files changed, 36 insertions(+), 40 deletions(-) diff --git a/hbs2-core/lib/HBS2/Defaults.hs b/hbs2-core/lib/HBS2/Defaults.hs index be3e162b..8b0d56bf 100644 --- a/hbs2-core/lib/HBS2/Defaults.hs +++ b/hbs2-core/lib/HBS2/Defaults.hs @@ -14,26 +14,26 @@ defStorePath :: IsString a => a defStorePath = "hbs2" defPipelineSize :: Int -defPipelineSize = 16000*4 +defPipelineSize = 16000 defChunkWriterQ :: Integral a => a -defChunkWriterQ = 32000 +defChunkWriterQ = 16000 defBlockDownloadQ :: Integral a => a -defBlockDownloadQ = 65536*128 +defBlockDownloadQ = 2000 defBlockDownloadThreshold :: Integral a => a defBlockDownloadThreshold = 2 -- typical block hash 530+ chunks * parallel wip blocks amount defProtoPipelineSize :: Int -defProtoPipelineSize = 65536*4 +defProtoPipelineSize = 2000 defCookieTimeout :: TimeSpec -defCookieTimeout = toTimeSpec ( 300 :: Timeout 'Minutes) +defCookieTimeout = toTimeSpec ( 120 :: Timeout 'Minutes) defBlockInfoTimeout :: TimeSpec -defBlockInfoTimeout = toTimeSpec ( 300 :: Timeout 'Minutes) +defBlockInfoTimeout = toTimeSpec ( 120 :: Timeout 'Minutes) -- how much time wait for block from peer? defBlockWaitMax :: Timeout 'Seconds diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index 3925248a..2416df46 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs @@ -85,22 +85,19 @@ storageRefs = to f touchForRead :: (MonadIO m, IsSimpleStorageKey h) => SimpleStorage h -> Key h -> m ByteString touchForRead ss k = liftIO $ do - bsmm <- unsafeMMapFile (simpleBlockFileName ss k) - tick <- getTime MonotonicCoarse + mbs <- readTVarIO mmaped <&> HashMap.lookup k - atomically $ do + case mbs of + Just bs -> pure bs + Nothing -> do - mbs <- readTVar mmaped <&> HashMap.lookup k + bsmm <- unsafeMMapFile (simpleBlockFileName ss k) + tick <- getTime MonotonicCoarse - r <- case mbs of - Just bs -> pure bs - Nothing -> do - modifyTVar' mmaped (HashMap.insert k bsmm) - pure bsmm - - modifyTVar' (ss ^. storageMMapedLRU) (HashMap.insert k tick) - - pure r + atomically $ do + modifyTVar' mmaped (HashMap.insert k bsmm) + modifyTVar' (ss ^. storageMMapedLRU) (HashMap.insert k tick) + pure bsmm where mmaped = ss ^. storageMMaped @@ -109,7 +106,7 @@ touchForRead ss k = liftIO $ do simpleStorageInit :: (MonadIO m, Data opts, IsSimpleStorageKey h) => opts -> m (SimpleStorage h) simpleStorageInit opts = liftIO $ do let prefix = uniLastDef "." opts :: StoragePrefix - let qSize = uniLastDef 20000 opts :: StorageQueueSize + let qSize = uniLastDef 2000 opts :: StorageQueueSize stor <- SimpleStorage <$> canonicalizePath (fromPrefix prefix) @@ -155,8 +152,8 @@ simpleStorageWorker ss = do Nothing -> pure () Just a -> a >> next - killer30 <- async $ forever $ do - pause ( 30 :: Timeout 'Seconds ) -- FIXME: setting + killer <- async $ forever $ do + pause ( 10 :: Timeout 'Seconds ) -- FIXME: setting atomically $ do @@ -167,11 +164,11 @@ simpleStorageWorker ss = do writeTVar ( ss ^. storageMMaped ) survived - killer5 <- async $ forever $ do - pause ( 5 :: Timeout 'Seconds ) -- FIXME: setting + killerLRU <- async $ forever $ do + pause ( 2 :: Timeout 'Seconds ) -- FIXME: setting atomically $ writeTVar ( ss ^. storageMMapedLRU ) mempty - (_, e) <- waitAnyCatchCancel [ops,killer30, killer5] + (_, e) <- waitAnyCatchCancel [ops,killer, killerLRU] pure () diff --git a/hbs2-tests/test/Peer2Main.hs b/hbs2-tests/test/Peer2Main.hs index 39870537..caf474bb 100644 --- a/hbs2-tests/test/Peer2Main.hs +++ b/hbs2-tests/test/Peer2Main.hs @@ -597,29 +597,28 @@ main = do let findBlk = hasBlock s -- let size = 1024*1024*1 - let size = 1024*1024*30 - g <- initialize $ U.fromList [fromIntegral p, fromIntegral size] + -- let size = 1024*1024*30 + -- g <- initialize $ U.fromList [fromIntegral p, fromIntegral size] - bytes <- replicateM size $ uniformM g :: IO [Char] + -- bytes <- replicateM size $ uniformM g :: IO [Char] - let blk = B8.pack bytes + -- let blk = B8.pack bytes - root <- putAsMerkle s blk + -- root <- putAsMerkle s blk - rootSz <- hasBlock s (fromMerkleHash root) + -- rootSz <- hasBlock s (fromMerkleHash root) - debug $ "I'm" <+> pretty p <+> pretty root + -- debug $ "I'm" <+> pretty p <+> pretty root runPeerM (AnyStorage s) fake p $ do adapter <- mkAdapter cw - - env <- ask - liftIO $ async $ withPeerM env $ do - maybe1 rootSz (pure ()) $ \rsz -> do - pause ( 0.001 :: Timeout 'Seconds ) - let info = BlockAnnounceInfo 0 NoBlockInfoMeta rsz (fromMerkleHash root) - let ann = BlockAnnounce @Fake info - request @Fake p0 ann + -- env <- ask + -- liftIO $ async $ withPeerM env $ do + -- maybe1 rootSz (pure ()) $ \rsz -> do + -- pause ( 0.001 :: Timeout 'Seconds ) + -- let info = BlockAnnounceInfo 0 NoBlockInfoMeta rsz (fromMerkleHash root) + -- let ann = BlockAnnounce @Fake info + -- request @Fake p0 ann runProto @Fake [ makeResponse (blockSizeProto findBlk dontHandle)