wip

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

@@ -67,6 +67,7 @@ library
                     , atomic-write
                     , bytestring
                     , bytestring-mmap
+                    , binary
                     , cache
                     , containers
                     , directory

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

@@ -1,14 +1,20 @@
 module HBS2.Storage.Compact
-  ( CompactStorage
+  (
   ) where
 
 
 import Data.Word
-import Data.ByteString
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Builder as B
+import Data.Binary.Get
 import Data.Coerce
 import Codec.Serialise
 import GHC.Generics
-import System.IO
+-- import System.IO
+import Lens.Micro.Platform
+import Control.Monad.Except
 import UnliftIO
 
 -- compact storage
@@ -34,16 +40,74 @@ data IndexEntry =
   deriving stock Generic
 
 
+data Header =
+  Header
+  { hdrMagic       :: Word16
+  , hdrVersion     :: Word16
+  , hdrIndexOffset :: EntryOffset
+  }
+  deriving stock Generic
 
 data CompactStorage =
   CompactStorage
-  { csHandle :: Handle
+  { csHandle :: MVar Handle
   }
 
 type ForCompactStorage m = MonadIO m
 
+data CompactStorageOpenOpt = Default
+                             deriving stock (Eq,Ord)
 
-compactStorageOpen :: ForCompactStorage m => FilePath -> m CompactStorage
+data CompactStorageOpenError =
-compactStorageOpen fp = undefined
+       InvalidHeader
+  deriving stock (Typeable,Show)
+
+instance Exception CompactStorageOpenError
+
+
+compactStorageOpen :: ForCompactStorage m
+                   => CompactStorageOpenOpt
+                   -> FilePath
+                   -> m CompactStorage
+
+compactStorageOpen _ fp = do
+  ha <- openFile fp ReadWriteMode
+  mha <- newMVar ha
+  header <- readHeader mha >>= maybe (throwIO InvalidHeader) pure
+  pure $ CompactStorage mha
+
+compactStorageCommit :: ForCompactStorage m => CompactStorage -> m ()
+compactStorageCommit sto = do
+  pure ()
+
+appendHeader :: ForCompactStorage m => Handle -> EntryOffset -> m ()
+appendHeader ha offset = do
+  let bs =   word16BE headerMagic
+          <> word16BE headerVersion
+          <> word64BE (coerce offset)
+          <> byteString (BS.replicate 52 0)
+  liftIO $ LBS.hPut ha (B.toLazyByteString bs)
+
+readHeader :: ForCompactStorage m => MVar Handle -> m (Maybe Header)
+readHeader mha = do
+  bs <- liftIO $ withMVar mha $ \ha -> do
+    hSeek ha SeekFromEnd (-64)
+    LBS.hGet ha 64
+
+  let what = flip runGetOrFail bs do
+                Header <$> getWord16be
+                       <*> getWord16be
+                       <*> getOffset
+
+  pure $ either (const Nothing) (Just . view _3) what
+
+  where
+    getOffset = EntryOffset <$> getWord64be
+
+headerMagic :: Word16
+headerMagic = 32264
+
+headerVersion :: Word16
+headerVersion = 1