From fe27c56c354e1a58ab9e5d4f2532dfda420c3626 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Mon, 23 Jan 2023 07:16:09 +0300 Subject: [PATCH] super slow --- hbs2-core/hbs2-core.cabal | 1 + hbs2-core/lib/HBS2/Actors.hs | 1 + hbs2-core/lib/HBS2/Actors/ChunkWriter.hs | 3 +++ hbs2-core/lib/HBS2/Data/Detect.hs | 26 +++++++++++++++++++ hbs2-core/lib/HBS2/Defaults.hs | 6 ++--- .../lib/HBS2/Storage/Simple.hs | 4 +-- hbs2-tests/test/Peer2Main.hs | 7 ++--- 7 files changed, 40 insertions(+), 8 deletions(-) create mode 100644 hbs2-core/lib/HBS2/Data/Detect.hs diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal index 55c6ccd0..4879e7d9 100644 --- a/hbs2-core/hbs2-core.cabal +++ b/hbs2-core/hbs2-core.cabal @@ -120,6 +120,7 @@ library , stm-chans , text , transformers + , temporary , uniplate , unordered-containers diff --git a/hbs2-core/lib/HBS2/Actors.hs b/hbs2-core/lib/HBS2/Actors.hs index de151fde..90222ce4 100644 --- a/hbs2-core/lib/HBS2/Actors.hs +++ b/hbs2-core/lib/HBS2/Actors.hs @@ -14,6 +14,7 @@ import Control.Concurrent.STM.TBMQueue qualified as TBMQ import Control.Concurrent.STM.TBMQueue (TBMQueue) import Control.Concurrent.STM.TVar qualified as TVar import Control.Monad +import Control.Concurrent.Async import Data.Function import Data.Functor import Data.Kind diff --git a/hbs2-core/lib/HBS2/Actors/ChunkWriter.hs b/hbs2-core/lib/HBS2/Actors/ChunkWriter.hs index 5ec9bc1c..b3e2148d 100644 --- a/hbs2-core/lib/HBS2/Actors/ChunkWriter.hs +++ b/hbs2-core/lib/HBS2/Actors/ChunkWriter.hs @@ -30,6 +30,9 @@ import System.Directory import System.FilePath import System.IO.Error import System.IO +import System.IO.Temp + +import Control.Concurrent.Async import Control.Concurrent.STM import Control.Concurrent.STM.TBQueue qualified as Q diff --git a/hbs2-core/lib/HBS2/Data/Detect.hs b/hbs2-core/lib/HBS2/Data/Detect.hs new file mode 100644 index 00000000..5e463cf8 --- /dev/null +++ b/hbs2-core/lib/HBS2/Data/Detect.hs @@ -0,0 +1,26 @@ +module HBS2.Data.Detect where + +import HBS2.Prelude.Plated +import HBS2.Hash +import HBS2.Data.Types +import HBS2.Merkle + +import Codec.Serialise (deserialiseOrFail) +import Data.ByteString.Lazy (ByteString) +import Data.Either +import Data.Function + +data BlobType = Merkle (Hash HbSync) + | AnnRef (Hash HbSync) + | Blob (Hash HbSync) + deriving (Show,Data) + + +tryDetect :: Hash HbSync -> ByteString -> BlobType +tryDetect hash obj = rights [mbLink, mbMerkle] & headDef orBlob + + where + mbLink = deserialiseOrFail @AnnotatedHashRef obj >> pure (AnnRef hash) + mbMerkle = deserialiseOrFail @(MTree [HashRef]) obj >> pure (Merkle hash) + orBlob = Blob hash + diff --git a/hbs2-core/lib/HBS2/Defaults.hs b/hbs2-core/lib/HBS2/Defaults.hs index 67a8b8ab..c88ff895 100644 --- a/hbs2-core/lib/HBS2/Defaults.hs +++ b/hbs2-core/lib/HBS2/Defaults.hs @@ -14,13 +14,13 @@ defStorePath :: IsString a => a defStorePath = "hbs2" defPipelineSize :: Int -defPipelineSize = 1000 +defPipelineSize = 2000 defChunkWriterQ :: Integral a => a -defChunkWriterQ = 1000 +defChunkWriterQ = 2000 defBlockDownloadQ :: Integral a => a -defBlockDownloadQ = 65536*4 +defBlockDownloadQ = 65536*128 defBlockDownloadThreshold :: Integral a => a defBlockDownloadThreshold = 2 diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index c8bc85f9..3fff72d6 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs @@ -80,7 +80,7 @@ storageRefs = to f simpleStorageInit :: (MonadIO m, Data opts) => opts -> m (SimpleStorage h) simpleStorageInit opts = liftIO $ do let prefix = uniLastDef "." opts :: StoragePrefix - let qSize = uniLastDef 500 opts :: StorageQueueSize + let qSize = uniLastDef 20000 opts :: StorageQueueSize pdir <- canonicalizePath (fromPrefix prefix) @@ -88,7 +88,7 @@ simpleStorageInit opts = liftIO $ do tstop <- TV.newTVarIO False - hcache <- Cache.newCache (Just (toTimeSpec @'Seconds 1)) -- FIXME: real setting + hcache <- Cache.newCache (Just (toTimeSpec @'Seconds 30)) -- FIXME: real setting let stor = SimpleStorage { _storageDir = pdir diff --git a/hbs2-tests/test/Peer2Main.hs b/hbs2-tests/test/Peer2Main.hs index 9d87b602..6ef23bbc 100644 --- a/hbs2-tests/test/Peer2Main.hs +++ b/hbs2-tests/test/Peer2Main.hs @@ -146,7 +146,7 @@ runTestPeer p zu = do stor <- simpleStorageInit opts cww <- newChunkWriterIO stor (Just chDir) - sw <- liftIO $ replicateM 1 $ async $ simpleStorageWorker stor + sw <- liftIO $ replicateM 8 $ async $ simpleStorageWorker stor cw <- liftIO $ replicateM 1 $ async $ runChunkWriter cww zu stor cww @@ -196,7 +196,7 @@ blockDownloadLoop = do let blks = [ "5KP4vM6RuEX6RA1ywthBMqZV5UJDLANC17UrF6zuWdRt" , "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ" , "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ" - , "ECWYwWXiLgNvCkN1EFpSYqsPcWfnL4bAQADsyZgy1Cbr" + , "GTtQp6QjK7G9Sh5Aq4koGSpMX398WRWn3DV28NUAYARg" ] blq <- liftIO $ Q.newTBQueueIO defBlockDownloadQ @@ -260,11 +260,12 @@ blockDownloadLoop = do env <- ask pip <- asks (view envDeferred) + debug "process block!" liftIO $ addJob pip $ withPeerM env $ do -- void $ liftIO $ async $ withPeerM env $ do sto <- getStorage - debug $ "GOT BLOCK!" <+> pretty h + liftIO $ async $ debug $ "GOT BLOCK!" <+> pretty h bt <- liftIO $ getBlock sto h <&> fmap (tryDetect h) -- debug $ pretty (show bt)