From 791b1789bdde6e61ea79ce471fefb52d7fa97b35 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Tue, 17 Jan 2023 11:42:34 +0300
Subject: [PATCH] wip

---
 hbs2-core/lib/HBS2/Data/Types/Refs.hs         |  2 +-
 .../lib/HBS2/Storage/Simple.hs                |  1 -
 .../lib/HBS2/Storage/Simple/Extra.hs          | 33 ++++++++++++++++---
 hbs2-tests/test/Main.hs                       | 24 ++++++++++----
 4 files changed, 48 insertions(+), 12 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Data/Types/Refs.hs b/hbs2-core/lib/HBS2/Data/Types/Refs.hs
index f43f19c5..119f1e84 100644
--- a/hbs2-core/lib/HBS2/Data/Types/Refs.hs
+++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs
@@ -13,7 +13,7 @@ import Prettyprinter
 
 newtype HashRef = HashRef (Hash HbSync)
                   deriving newtype (Eq,Ord,IsString,Pretty)
-                  deriving stock (Data,Generic)
+                  deriving stock (Data,Generic,Show)
 
 
 
diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
index ce255293..37211958 100644
--- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
+++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
@@ -365,7 +365,6 @@ instance Hashed hash LBS.ByteString => Hashed hash (Raw LBS.ByteString) where
   hashObject (Raw s) = hashObject s
 
 instance ( MonadIO m, IsKey hash
-         , Hashed hash (Raw LBS.ByteString)
          , Hashed hash LBS.ByteString
          , Key hash ~ Hash hash
          )
diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
index 22802c7c..3de4db52 100644
--- a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
+++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
@@ -8,15 +8,24 @@ import HBS2.Storage.Simple
 import HBS2.Data.Types.Refs
 import HBS2.Defaults
 
+import Data.Bifunctor
+import Data.Functor
 import Control.Monad
 import Data.ByteString.Lazy (ByteString)
 import Data.ByteString.Lazy qualified as B
 import Data.Function
+
 import Streaming.Prelude qualified as S
+import Streaming qualified as S
+
+import Prettyprinter
 import System.IO
 
-class IsKey h => SimpleStorageExtra h a  where
-  putAsMerkle :: SimpleStorage h -> a -> IO MerkleHash
+pieces :: Integral a => a
+pieces = 8192
+
+class SimpleStorageExtra a  where
+  putAsMerkle :: forall h . (IsKey h, Hash h ~ Key h, Hashed h ByteString) => SimpleStorage h -> a -> IO MerkleHash
 
 readChunked :: MonadIO m => Handle -> Int -> S.Stream (S.Of ByteString) m ()
 readChunked handle size = fuu
@@ -28,7 +37,7 @@ readChunked handle size = fuu
       S.yield chunk
       next
 
-instance (IsKey h, Key h ~ Hash h, Hashed h ByteString) => SimpleStorageExtra h Handle where
+instance SimpleStorageExtra Handle where
   putAsMerkle ss handle = do
 
     hashes <- readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings!
@@ -36,9 +45,25 @@ instance (IsKey h, Key h ~ Hash h, Hashed h ByteString) => SimpleStorageExtra h
                   & S.map (HashRef . hashObject)
                   & S.toList_
 
-    let pt = toPTree (MaxSize 8192) (MaxNum 8192) hashes -- FIXME: settings
+    let pt = toPTree (MaxSize pieces) (MaxNum pieces) hashes -- FIXME: settings
 
     root <- makeMerkle 0 pt $ \(_,_,bs) -> void $ putBlock ss bs
 
     pure (MerkleHash root)
 
+instance SimpleStorageExtra ByteString where
+  putAsMerkle ss bs = do
+
+    hashes <- S.each (B.unpack bs)
+                & S.chunksOf (fromIntegral defBlockSize)
+                & S.mapped (fmap (first B.pack) . S.toList)
+                & S.mapM (\blk -> enqueueBlock ss blk >> pure blk)
+                & S.map (HashRef . hashObject)
+                & S.toList_
+
+    let pt = toPTree (MaxSize pieces) (MaxNum pieces) hashes -- FIXME: settings
+
+    root <- makeMerkle 0 pt $ \(_,_,bss) -> void $ putBlock ss bss
+
+    pure (MerkleHash root)
+
diff --git a/hbs2-tests/test/Main.hs b/hbs2-tests/test/Main.hs
index 14c97d2a..c8afc1d0 100644
--- a/hbs2-tests/test/Main.hs
+++ b/hbs2-tests/test/Main.hs
@@ -1,13 +1,15 @@
 module Main where
 
-import HBS2.Prelude
+import HBS2.Clock
 import HBS2.Hash
-import HBS2.Net.Proto
 import HBS2.Net.Messaging
+import HBS2.Net.Proto
+import HBS2.Prelude
 import HBS2.Storage.Simple
+import HBS2.Storage.Simple.Extra
 
-import Test.Tasty
-import Test.Tasty.HUnit
+import Test.Tasty hiding (Timeout)
+import Test.Tasty.HUnit hiding (Timeout)
 
 import Control.Concurrent.Async
 import Data.Hashable
@@ -62,18 +64,28 @@ runFakePeer p = do
 
   storage <- simpleStorageInit opts :: IO (SimpleStorage HbSync)
 
+  w <- async $ simpleStorageWorker storage
+
   let size = 1024*1024
 
   let blk = B8.concat [ fromString (show x) | x <- replicate size (fromIntegral p :: Int) ]
 
-  debug $ pretty $ show (B8.take 10 blk)
+  debug $ pretty $ B8.length blk
+
+  root <- putAsMerkle storage blk
+
+  pause ( 0.1 :: Timeout 'Seconds)
+
+  simpleStorageStop storage
+
+  debug $ pretty root
 
   pure ()
 
 test1 :: IO ()
 test1 = do
 
-  let peers = [0..2] :: [Peer Fake]
+  let peers = [0..0] :: [Peer Fake]
 
   peerz <- mapM (async . runFakePeer) peers