compiles

hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs

@@ -1,8 +1,12 @@
+{-# Language UndecidableInstances #-}
 module HBS2.Storage.Simple.Extra where
 
 import HBS2.Merkle
+import HBS2.Hash
 import HBS2.Prelude
 import HBS2.Storage.Simple
+import HBS2.Data.Types.Refs
+import HBS2.Defaults
 
 import Control.Monad
 import Data.ByteString.Lazy (ByteString)
@@ -11,8 +15,8 @@ import Data.Function
 import Streaming.Prelude qualified as S
 import System.IO
 
-class SimpleStorageExtra a where
-  putAsMerkle :: SimpleStorage h -> a -> MerkleHash
+class IsKey h => SimpleStorageExtra h a  where
+  putAsMerkle :: SimpleStorage h -> a -> IO MerkleHash
 
 readChunked :: MonadIO m => Handle -> Int -> S.Stream (S.Of ByteString) m ()
 readChunked handle size = fuu
@@ -24,6 +28,17 @@ readChunked handle size = fuu
       S.yield chunk
       next
 
--- instance SimpleStorageExtra Handle where
---   putAsMerkle ss handle = undefined
+instance (IsKey h, Key h ~ Hash h, Hashed h ByteString) => SimpleStorageExtra h Handle where
+  putAsMerkle ss handle = do
+
+    hashes <- readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings!
+                  & S.mapM (\blk -> enqueueBlock ss blk >> pure blk)
+                  & S.map (HashRef . hashObject)
+                  & S.toList_
+
+    let pt = toPTree (MaxSize 8192) (MaxNum 8192) hashes -- FIXME: settings
+
+    root <- makeMerkle 0 pt $ \(_,_,bs) -> void $ putBlock ss bs
+
+    pure (MerkleHash root)
 

hbs2/Main.hs

@@ -110,14 +110,7 @@ runStore opts ss = do
 
   handle <- maybe (pure stdin) (flip openFile ReadMode . unOptFile) fname
 
-  hashes <- readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings!
-                & S.mapM (\blk -> enqueueBlock ss blk >> pure blk)
-                & S.map (HashRef . hashObject)
-                & S.toList_
-
-  let pt = toPTree (MaxSize 8192) (MaxNum 8192) hashes -- FIXME: settings
-
-  root <- makeMerkle 0 pt $ \(h,_,bs) -> void $ putBlock ss bs
+  root <- putAsMerkle ss handle
 
   print $ "merkle-root: " <+> pretty root