diff --git a/hbs2-storage-simple/hbs2-storage-simple.cabal b/hbs2-storage-simple/hbs2-storage-simple.cabal index 657279c7..05842ad1 100644 --- a/hbs2-storage-simple/hbs2-storage-simple.cabal +++ b/hbs2-storage-simple/hbs2-storage-simple.cabal @@ -72,6 +72,7 @@ library , containers , directory , filepath + , memory , microlens-platform , mtl , mmap diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs b/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs index 76ac78d2..dc0cb5e6 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs @@ -7,8 +7,9 @@ import HBS2.Clock import HBS2.Hash import HBS2.Storage - import Data.Word +import Data.ByteArray qualified as BA +import Data.ByteArray (MemView(..)) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS @@ -40,10 +41,6 @@ import UnliftIO import Foreign.Ptr import System.IO.MMap --- import System.Posix.IO --- import System.Posix.Fcntl -import System.Posix.Types - import Debug.Trace -- compact storage @@ -119,7 +116,7 @@ isFresh e = case e of type Bucket = TVar (HashMap ByteString Entry) -type MMaped = (Ptr (), Int, Int, Int) +type MMaped = (Ptr Word8, Int, Int, Int) data CompactStorage k = CompactStorage @@ -173,7 +170,7 @@ compactStorageOpen _ fp = do ss <- newTVarIO 0 - mmapped <- liftIO (mmapFilePtr fp ReadOnly (Just (0, fromIntegral sz))) + mmapped <- liftIO (mmapFilePtr fp ReadOnly Nothing) >>= newTVarIO if sz == 0 then @@ -301,7 +298,7 @@ compactStorageCommit sto = liftIO do sz <- hFileSize ha - remapFile sz + remapFile atomically do writeTVar (csHeaderOff sto) (offLast - headerSize 1) @@ -325,11 +322,11 @@ compactStorageCommit sto = liftIO do getSeq = \case Entry i _ -> i - remapFile :: ForCompactStorage m => Integer -> m () - remapFile sz = do + remapFile :: ForCompactStorage m => m () + remapFile = do let fp = csFile sto unmapFile sto - mmapped <- liftIO (mmapFilePtr fp ReadOnly (Just (0, fromIntegral sz))) + mmapped <- liftIO (mmapFilePtr fp ReadOnly Nothing) atomically (writeTVar (csMMapped sto) mmapped) compactStorageDel :: ForCompactStorage m => CompactStorage k -> ByteString -> m () @@ -373,17 +370,6 @@ compactStoragePut sto k v = do c <- newSequenceSTM sto modifyTVar tvar (HM.insert k (Entry c (New v))) --- TODO: slow-parallel-read-access --- будет тормозить на конкурентном считывании уже --- существующих (не новых), значений --- так как будет в эксклюзивном режиме елозить --- указателем по файлу. --- Возможные варианты: маппить файл при доступе --- на чтение (а что делать, если он растёт?) --- Собирать операции чтения в батчи и читать батч --- последовательно (будут некие задержки, и --- чтение становится хитрожопой операцией, а не --- просто из файла считать) compactStorageGet :: ForCompactStorage m => CompactStorage k -> ByteString -> m (Maybe ByteString) compactStorageGet sto key = do let tvar = getBucket sto key @@ -395,12 +381,10 @@ compactStorageGet sto key = do Just (Entry _ (Del _)) -> pure Nothing Just (Entry _ (New s)) -> pure (Just s) Just (Entry _ (Off e)) -> liftIO do - r <- withMVar (csHandle sto) $ \ha -> do - try @_ @IOException do - hSeek ha AbsoluteSeek (fromIntegral $ idxEntryOffset e) - BS.hGet ha (fromIntegral $ idxEntrySize e) - either throwIO (pure . Just) r - + ma <- readTVarIO (csMMapped sto) + let ptr = plusPtr (view _1 ma) (fromIntegral $ idxEntryOffset e) + let mview = MemView ptr (fromIntegral $ idxEntrySize e) + pure $ Just $ BA.convert @_ @ByteString mview compactStorageExists :: ForCompactStorage m => CompactStorage k -> ByteString -> m (Maybe Integer) compactStorageExists sto key = do