From 09d2caaef813c5c155917fe2b1e862ff590e4c22 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Fri, 13 Jan 2023 06:40:51 +0300 Subject: [PATCH] wip --- hbs2-core/hbs2-core.cabal | 1 + hbs2-core/lib/HBS2/Data/Types.hs | 15 +------ hbs2-core/lib/HBS2/Data/Types/Refs.hs | 43 +++++++++++++++++++ .../lib/HBS2/Storage/Simple.hs | 8 +++- hbs2/Main.hs | 30 ++++++++++--- 5 files changed, 76 insertions(+), 21 deletions(-) create mode 100644 hbs2-core/lib/HBS2/Data/Types/Refs.hs diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal index 9b6f6b7b..99db6ab6 100644 --- a/hbs2-core/hbs2-core.cabal +++ b/hbs2-core/hbs2-core.cabal @@ -65,6 +65,7 @@ library exposed-modules: , HBS2.Defaults , HBS2.Data.Types + , HBS2.Data.Types.Refs , HBS2.Hash , HBS2.Merkle , HBS2.Clock diff --git a/hbs2-core/lib/HBS2/Data/Types.hs b/hbs2-core/lib/HBS2/Data/Types.hs index 36be9eb1..627218bf 100644 --- a/hbs2-core/lib/HBS2/Data/Types.hs +++ b/hbs2-core/lib/HBS2/Data/Types.hs @@ -1,20 +1,9 @@ module HBS2.Data.Types ( module HBS2.Hash - , module HBS2.Data.Types + , module HBS2.Data.Types.Refs ) where import HBS2.Hash - -import Codec.Serialise() -import Data.Data -import Data.String(IsString) -import GHC.Generics -import Prettyprinter - -newtype HashRef = HashRef (Hash HbSync) - deriving newtype (Eq,Ord,IsString,Pretty) - deriving stock (Data,Generic) - -instance Serialise HashRef +import HBS2.Data.Types.Refs diff --git a/hbs2-core/lib/HBS2/Data/Types/Refs.hs b/hbs2-core/lib/HBS2/Data/Types/Refs.hs new file mode 100644 index 00000000..94666bce --- /dev/null +++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs @@ -0,0 +1,43 @@ +module HBS2.Data.Types.Refs where + +import HBS2.Hash + +import Codec.Serialise() +import Data.Data +import Data.String(IsString) +import GHC.Generics +import Prettyprinter + +newtype HashRef = HashRef (Hash HbSync) + deriving newtype (Eq,Ord,IsString,Pretty) + deriving stock (Data,Generic) + + + +data HashRefObject = HashRefObject HashRef (Maybe HashRefMetadata) + deriving stock (Data,Generic) + +newtype HashRefMetadata = + HashRefMetadata HashRef + deriving newtype (Eq,Ord,Pretty) + deriving stock (Data,Generic) + +newtype HashRefPrevState = HashRefPrevState HashRef + deriving newtype (Eq,Ord,Pretty,IsString) + deriving stock (Data,Generic) + +data HashRefType = + HashRefMerkle HashRefObject + | HashRefBlob HashRefObject + deriving stock (Data,Generic) + +data AnnotatedHashRef = + AnnotatedHashRef (Maybe HashRefPrevState) HashRefType + deriving stock (Data,Generic) + + +instance Serialise HashRef +instance Serialise HashRefObject +instance Serialise HashRefMetadata + + diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index fe734894..32c0d58e 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs @@ -31,7 +31,6 @@ import Control.Concurrent.STM.TBMQueue (TBMQueue) import Control.Concurrent.STM.TVar (TVar) import Control.Concurrent.STM.TVar qualified as TV -import Debug.Trace import HBS2.Clock import HBS2.Hash @@ -76,6 +75,12 @@ storageBlocks = to f f b = _storageDir b "blocks" +storageRefs :: SimpleGetter (SimpleStorage h) FilePath +storageRefs = to f + where + f b = _storageDir b "refs" + + simpleStorageInit :: (MonadIO m, Data opts) => opts -> m (SimpleStorage h) simpleStorageInit opts = liftIO $ do let prefix = uniLastDef "." opts :: StoragePrefix @@ -102,6 +107,7 @@ simpleStorageInit opts = liftIO $ do for_ alph $ \a -> do createDirectoryIfMissing True ( (stor ^. storageBlocks) L.singleton a ) + createDirectoryIfMissing True ( (stor ^. storageRefs) L.singleton a ) pure stor diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 9e7c0a00..06b5a89d 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -1,17 +1,18 @@ module Main where +import Control.Concurrent.Async import Control.Monad import Control.Monad.IO.Class -import Control.Concurrent.Async +import Control.Monad.Trans.Maybe import Data.ByteString (ByteString) -import Data.ByteString qualified as B 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 -import Control.Monad.Trans.Maybe -- import System.FilePath.Posix import System.IO @@ -40,9 +41,15 @@ newtype CatHashesOnly = CatHashesOnly Bool deriving newtype (Eq,Ord,Pretty) deriving stock (Data,Generic) -newtype StoreOpts = - StoreOpts { - storeInputFile :: Maybe OptInputFile + +newtype OptInit = OptInit { fromOptInit :: Bool } + deriving newtype (Eq,Ord,Pretty) + deriving stock (Data,Generic) + +data StoreOpts = + StoreOpts + { storeInit :: Maybe OptInit + , storeInputFile :: Maybe OptInputFile } deriving stock (Data) @@ -86,6 +93,14 @@ runCat opts ss = do runStore :: Data opts => opts -> SimpleStorage HbSync -> IO () + +runStore opts ss | justInit = do + putStrLn "initialized" + + where + justInit = maybe False fromOptInit (uniLastMay @OptInit opts) + + runStore opts ss = do let fname = uniLastMay @OptInputFile opts @@ -139,7 +154,8 @@ main = join . customExecParser (prefs showHelpOnError) $ pStore = do o <- common file <- optional $ strArgument ( metavar "FILE" ) - pure $ withStore o (runStore ( StoreOpts file )) + init <- optional $ flag' True ( long "init" <> help "just init storage") <&> OptInit + pure $ withStore o (runStore ( StoreOpts init file )) pCat = do o <- common