wip

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

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 HBS2.Data.Types.Refs
-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
 

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
+
+

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
 

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 {
+newtype OptInit = OptInit { fromOptInit :: Bool }
-    storeInputFile :: Maybe OptInputFile
+                  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