diff --git a/hbs2-core/lib/HBS2/Merkle.hs b/hbs2-core/lib/HBS2/Merkle.hs index 61cdf168..e240b9fb 100644 --- a/hbs2-core/lib/HBS2/Merkle.hs +++ b/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 diff --git a/hbs2-storage-simple/hbs2-storage-simple.cabal b/hbs2-storage-simple/hbs2-storage-simple.cabal index 8ac51c46..f0e9370e 100644 --- a/hbs2-storage-simple/hbs2-storage-simple.cabal +++ b/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 diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index 5fa4ab23..ce255293 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/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 + + + diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs new file mode 100644 index 00000000..3d2d215a --- /dev/null +++ b/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 + diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 22460c2d..f88f248e 100644 --- a/hbs2/Main.hs +++ b/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_