wip

hbs2-core/lib/HBS2/Merkle.hs

@@ -2,6 +2,9 @@
 {-# Language  DeriveFunctor #-}
 module HBS2.Merkle where
 
+import HBS2.Prelude
+import HBS2.Hash
+
 import Codec.Serialise
 import Data.ByteString (ByteString)
 import Data.ByteString.Lazy qualified as LBS
@@ -9,11 +12,13 @@ import Data.ByteString qualified as BS
 import Data.Data
 import Data.Foldable (traverse_)
 import Data.List qualified as List
-import Lens.Micro.Platform
-import Safe
 import GHC.Generics
+import Lens.Micro.Platform
+import Prettyprinter
 
-import HBS2.Hash
+newtype MerkleHash = MerkleHash { fromMerkleHash :: Hash HbSync }
+                     deriving newtype (Eq,Ord,IsString,Pretty)
+                     deriving stock (Data,Generic)
 
 class Foldable t => Chunks t a where
   chunks :: Int -> a -> t a

hbs2-storage-simple/hbs2-storage-simple.cabal

@@ -58,6 +58,7 @@ common shared-properties
 library
     import:           shared-properties
     exposed-modules:  HBS2.Storage.Simple
+                    , HBS2.Storage.Simple.Extra
     -- other-modules:
     -- other-extensions:
     build-depends:    base ^>=4.15.1.0, hbs2-core
@@ -72,6 +73,7 @@ library
                     , prettyprinter
                     , stm
                     , stm-chans
+                    , streaming
                     , transformers
                     , uniplate
 

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

@@ -109,6 +109,8 @@ simpleStorageInit opts = liftIO $ do
 
   pure stor
 
+
+
 catchAny :: IO a -> (SomeException -> IO a) -> IO a
 catchAny = Control.Exception.catch
 
@@ -379,3 +381,6 @@ instance ( MonadIO m, IsKey hash
 
   hasBlock s k = liftIO $ simpleBlockExists s k
 
+
+
+

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

@@ -0,0 +1,29 @@
+module HBS2.Storage.Simple.Extra where
+
+import HBS2.Merkle
+import HBS2.Prelude
+import HBS2.Storage.Simple
+
+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 System.IO
+
+class SimpleStorageExtra a where
+  putAsMerkle :: SimpleStorage h -> a -> MerkleHash
+
+readChunked :: MonadIO m => Handle -> Int -> S.Stream (S.Of ByteString) m ()
+readChunked handle size = fuu
+  where
+  fuu = fix \next -> do
+    chunk <- liftIO do
+      B.hGet handle size
+    unless (B.null chunk) do
+      S.yield chunk
+      next
+
+-- instance SimpleStorageExtra Handle where
+--   putAsMerkle ss handle = undefined
+

hbs2/Main.hs

@@ -4,12 +4,9 @@ import Control.Concurrent.Async
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Maybe
-import Data.ByteString (ByteString)
 import Data.ByteString.Lazy qualified as LBS
-import Data.ByteString qualified as B
 import Data.Function
 import Data.Functor
-import Data.Maybe
 import Options.Applicative
 import Prettyprinter
 import System.Directory
@@ -25,6 +22,7 @@ import Streaming.Prelude qualified as S
 
 import HBS2.Storage
 import HBS2.Storage.Simple
+import HBS2.Storage.Simple.Extra
 import HBS2.Prelude
 import HBS2.Prelude.Plated
 import HBS2.Merkle
@@ -35,11 +33,6 @@ newtype OptInputFile = OptInputFile { unOptFile :: FilePath }
                        deriving newtype (Eq,Ord,IsString)
                        deriving stock (Data)
 
-newtype MerkleHash = MerkleHash { fromMerkleHash :: Hash HbSync }
-                     deriving newtype (Eq,Ord,IsString,Pretty)
-                     deriving stock (Data,Generic)
-
-
 newtype CatHashesOnly = CatHashesOnly Bool
                         deriving newtype (Eq,Ord,Pretty)
                         deriving stock (Data,Generic)
@@ -70,16 +63,6 @@ newtype NewRefOpts =
   }
   deriving stock (Data)
 
-readChunked :: MonadIO m => Handle -> Int -> S.Stream (S.Of ByteString) m ()
-readChunked handle size = fuu
-  where
-  fuu = fix \next -> do
-    chunk <- liftIO do
-      B.hGet handle size
-    unless (B.null chunk) do
-      S.yield chunk
-      next
-
 
 runCat :: Data opts => opts -> SimpleStorage HbSync -> IO ()
 runCat opts ss = do
@@ -128,7 +111,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 (LBS.fromStrict blk) >> pure blk)
+                & S.mapM (\blk -> enqueueBlock ss blk >> pure blk)
                 & S.map (HashRef . hashObject)
                 & S.toList_