better, but wtf

cabal.project

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

flake.lock

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

flake.nix

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

hbs2-core/hbs2-core.cabal

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

hbs2-core/lib/HBS2/Actors/Peer.hs

@@ -301,7 +301,7 @@ runPeerM s bus p f  = do
                             <*> liftIO (newTVarIO mempty)
 
   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
           pause defSweepTimeout

hbs2-core/lib/HBS2/Net/Proto/BlockChunks.hs

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

hbs2-core/test/Main.hs

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

hbs2-tests/hbs2-tests.cabal

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

hbs2-tests/test/Peer2Main.hs

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

hbs2-tests/test/TestChunkWriter.hs

@@ -46,11 +46,11 @@ main = do
 
     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"))
 
-    w2 <- replicateM 2 $ async $ runChunkWriter cw
+    w2 <- replicateM 8 $ async $ runChunkWriter cw
 
     let times = 100
 

hbs2/Main.hs

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