voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

better, but wtf

This commit is contained in:
Dmitry Zuikov 2023-01-26 17:38:57 +03:00
parent f528b5d888
commit c50b91ff47
11 changed files with 26 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
cabal.project
View File

@ -1,2 +1,5 @@
packages: **/*.cabal packages: **/*.cabal
-- executable-static: True
-- profiling: True
-- library-profiling: False

6
flake.lock
View File

@ -91,11 +91,11 @@
}, },
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1673800717, "lastModified": 1674407282,
"narHash": "sha256-SFHraUqLSu5cC6IxTprex/nTsI81ZQAtDvlBvGDWfnA=", "narHash": "sha256-2qwc8mrPINSFdWffPK+ji6nQ9aGnnZyHSItVcYDZDlk=",
"owner": "nixos", "owner": "nixos",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "2f9fd351ec37f5d479556cd48be4ca340da59b8f", "rev": "ab1254087f4cdf4af74b552d7fc95175d9bdbb49",
"type": "github" "type": "github"
}, },
"original": { "original": {

10
flake.nix
View File

@ -15,28 +15,32 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs:
haskell-flake-utils.lib.simpleCabalProject2flake { haskell-flake-utils.lib.simpleCabalProject2flake {
inherit self nixpkgs; inherit self nixpkgs;
systems = [ "x86_64-linux" ]; systems = [ "x86_64-linux" ];
name = "hbs2-core"; name = "hbs2";
packageNames = [ packageNames = [
"hbs2"
"hbs2-core" "hbs2-core"
"hbs2-storage-simple" "hbs2-storage-simple"
"hbs2-tests"
]; ];
packageDirs = { packageDirs = {
"hbs2" = "./hbs2";
"hbs2-tests" = "./hbs2-tests";
"hbs2-core" = "./hbs2-core"; "hbs2-core" = "./hbs2-core";
"hbs2-storage-simple" = "./hbs2-storage-simple"; "hbs2-storage-simple" = "./hbs2-storage-simple";
}; };
packagePostOverrides = { pkgs }: with pkgs; with haskell.lib; [ packagePostOverrides = { pkgs }: with pkgs; with haskell.lib; [
disableExecutableProfiling enableExecutableProfiling
disableLibraryProfiling disableLibraryProfiling
dontBenchmark dontBenchmark
dontCoverage dontCoverage
dontDistribute dontDistribute
dontHaddock dontHaddock
dontHyperlinkSource dontHyperlinkSource
doStrip # doStrip
enableDeadCodeElimination enableDeadCodeElimination
justStaticExecutables justStaticExecutables

2
hbs2-core/hbs2-core.cabal
View File

@ -135,7 +135,7 @@ test-suite test
other-modules: TestFakeMessaging other-modules: TestFakeMessaging
, TestActors , TestActors
, TestUniqProtoId -- , TestUniqProtoId
, FakeMessaging , FakeMessaging
, HasProtocol , HasProtocol

2
hbs2-core/lib/HBS2/Actors/Peer.hs
View File

@ -301,7 +301,7 @@ runPeerM s bus p f = do
<*> liftIO (newTVarIO mempty) <*> liftIO (newTVarIO mempty)
let de = view envDeferred env let de = view envDeferred env
as <- liftIO $ replicateM 4 $ async $ runPipeline de as <- liftIO $ replicateM 32 $ async $ runPipeline de
sw <- liftIO $ async $ forever $ withPeerM env $ do sw <- liftIO $ async $ forever $ withPeerM env $ do
pause defSweepTimeout pause defSweepTimeout

1
hbs2-core/lib/HBS2/Net/Proto/BlockChunks.hs
View File

@ -98,6 +98,7 @@ blockChunksProto adapter (BlockChunks c p) =
for_ offsets $ \((o,sz),i) -> deferred proto do for_ offsets $ \((o,sz),i) -> deferred proto do
chunk <- blkChunk adapter h o sz chunk <- blkChunk adapter h o sz
-- liftIO $ print $ "sending chunk for block" <+> pretty h
maybe (pure ()) (response_ . BlockChunk @e i) chunk maybe (pure ()) (response_ . BlockChunk @e i) chunk
BlockChunk n bs -> deferred proto do BlockChunk n bs -> deferred proto do

4
hbs2-core/test/Main.hs
View File

@ -2,7 +2,7 @@ module Main where
import TestFakeMessaging import TestFakeMessaging
import TestActors import TestActors
import TestUniqProtoId -- import TestUniqProtoId
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
@ -14,7 +14,7 @@ main =
[ [
testCase "testFakeMessaging1" testFakeMessaging1 testCase "testFakeMessaging1" testFakeMessaging1
, testCase "testActorsBasic" testActorsBasic , testCase "testActorsBasic" testActorsBasic
, testCase "testUniqProtoId" testUniqProtoId -- , testCase "testUniqProtoId" testUniqProtoId
] ]

4
hbs2-tests/hbs2-tests.cabal
View File

@ -124,6 +124,10 @@ executable test-peer-run
import: common-deps import: common-deps
default-language: Haskell2010 default-language: Haskell2010
ghc-options:
-- -prof
-- -fprof-auto
other-modules: other-modules:
-- other-extensions: -- other-extensions:

2
hbs2-tests/test/Peer2Main.hs
View File

@ -159,7 +159,7 @@ runTestPeer p zu = do
cww <- newChunkWriterIO stor (Just chDir) cww <- newChunkWriterIO stor (Just chDir)
sw <- liftIO $ replicateM 4 $ async $ simpleStorageWorker stor sw <- liftIO $ replicateM 4 $ async $ simpleStorageWorker stor
cw <- liftIO $ replicateM 4 $ async $ runChunkWriter cww cw <- liftIO $ replicateM 2 $ async $ runChunkWriter cww
zu stor cww zu stor cww

4
hbs2-tests/test/TestChunkWriter.hs
View File

@ -46,11 +46,11 @@ main = do
storage <- simpleStorageInit opts :: IO (SimpleStorage HbSync) storage <- simpleStorageInit opts :: IO (SimpleStorage HbSync)
w1 <- replicateM 2 $ async (simpleStorageWorker storage) w1 <- replicateM 4 $ async (simpleStorageWorker storage)
cw <- newChunkWriterIO @HbSync storage (Just (dir </> ".qqq")) cw <- newChunkWriterIO @HbSync storage (Just (dir </> ".qqq"))
w2 <- replicateM 2 $ async $ runChunkWriter cw w2 <- replicateM 8 $ async $ runChunkWriter cw
let times = 100 let times = 100

1
hbs2/Main.hs
View File

@ -11,6 +11,7 @@ import HBS2.Data.Detect
import HBS2.Defaults import HBS2.Defaults
import Data.ByteString.Lazy (ByteString)
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class