From f049f36d42381fc8d806b99d29c0e4a665dd7d48 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Wed, 7 Feb 2024 17:13:29 +0300
Subject: [PATCH] tuning tree params

---
 hbs2-core/lib/HBS2/Defaults.hs                       | 9 +++++++++
 hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs          | 3 ++-
 hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs  | 2 +-
 hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs | 6 +++---
 4 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Defaults.hs b/hbs2-core/lib/HBS2/Defaults.hs
index d75fea41..933fd114 100644
--- a/hbs2-core/lib/HBS2/Defaults.hs
+++ b/hbs2-core/lib/HBS2/Defaults.hs
@@ -111,3 +111,12 @@ defInterBlockDelay :: Timeout 'Seconds
 defInterBlockDelay = 0.0085
 
 
+defHashListChunk :: Integral a => a
+defHashListChunk = 1024
+{-# INLINE defHashListChunk #-}
+
+defTreeChildNum :: Integral a => a
+defTreeChildNum = 256
+{-# INLINE defTreeChildNum #-}
+
+
diff --git a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs b/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs
index a11e0773..16d4a24a 100644
--- a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs
+++ b/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs
@@ -21,6 +21,7 @@ import HBS2.Net.Proto.Types
 import HBS2.Storage.Operations.Class
 import HBS2.Storage.Operations.ByteString
 import HBS2.Storage(Storage(..))
+import HBS2.Defaults
 
 
 import Data.ByteArray.Hash qualified as BA
@@ -255,7 +256,7 @@ instance ( MonadIO m
     let hashes = catMaybes hashes'
 
 --     -- FIXME: handle-hardcode
-    let pt = toPTree (MaxSize 4096) (MaxNum 256) hashes -- FIXME: settings
+    let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) hashes -- FIXME: settings
 
     -- FIXME: this-might-not-be-true
     result <- runWriterT $ makeMerkle 0 pt $ \(hx,mt,bss) -> do
diff --git a/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs b/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs
index 0bfd9c36..7bf3ea07 100644
--- a/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs
+++ b/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs
@@ -41,7 +41,7 @@ instance (MonadIO m, h ~ HbSync, Storage s h ByteString m) => MerkleWriter ByteS
                 & S.toList_
 
     -- FIXME: handle-hardcode
-    let pt = toPTree (MaxSize 4096) (MaxNum 256) hashes -- FIXME: settings
+    let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) hashes -- FIXME: settings
 
     makeMerkle 0 pt $ \(_,_,bss) -> do
       void $ putBlock sto bss
diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
index 2909c948..18cc95ec 100644
--- a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
+++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
@@ -30,7 +30,7 @@ import Streaming qualified as S
 import System.IO
 
 pieces :: Integral a => a
-pieces = 4096
+pieces = defHashListChunk
 
 -- FIXME: to-remove-in-a-sake-of-operations-class
 class MonadIO m => SimpleStorageExtra a m  where
@@ -89,7 +89,7 @@ instance MonadIO m => SimpleStorageExtra (S.Stream (S.Of ByteString) m ()) m whe
 instance MonadIO m => SimpleStorageExtra [HashRef] m where
   putAsMerkle ss hashes = do
 
-    let pt = toPTree (MaxSize pieces) (MaxNum 256) hashes -- FIXME: settings
+    let pt = toPTree (MaxSize pieces) (MaxNum defTreeChildNum) hashes -- FIXME: settings
 
     root <- makeMerkle 0 pt $ \(_,_,bs) -> void $ putBlock ss bs
 
@@ -105,7 +105,7 @@ instance MonadIO m => SimpleStorageExtra ByteString m where
                 & S.map (HashRef . hashObject)
                 & S.toList_
 
-    let pt = toPTree (MaxSize pieces) (MaxNum 256) hashes -- FIXME: settings
+    let pt = toPTree (MaxSize pieces) (MaxNum defTreeChildNum) hashes -- FIXME: settings
 
     root <- makeMerkle 0 pt $ \(_,_,bss) -> void $ putBlock ss bss