diff --git a/hbs2-storage-ncq/hbs2-storage-ncq.cabal b/hbs2-storage-ncq/hbs2-storage-ncq.cabal index 78dff6be..477292ba 100644 --- a/hbs2-storage-ncq/hbs2-storage-ncq.cabal +++ b/hbs2-storage-ncq/hbs2-storage-ncq.cabal @@ -60,6 +60,7 @@ library exposed-modules: HBS2.Storage.NCQ HBS2.Storage.NCQ2 + HBS2.Storage.NCQ.Types -- other-modules: -- other-extensions: build-depends: base, hbs2-core, hbs2-log-structured, suckless-conf diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs index bf57bd8f..dd6a30e7 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs @@ -1,6 +1,9 @@ {-# Language MultiWayIf #-} {-# Language RecordWildCards #-} -module HBS2.Storage.NCQ where +module HBS2.Storage.NCQ + ( module HBS2.Storage.NCQ + , module HBS2.Storage.NCQ.Types + ) where import HBS2.Prelude.Plated import HBS2.Hash @@ -9,9 +12,11 @@ import HBS2.Data.Types.Refs import HBS2.Base58 import HBS2.Net.Auth.Credentials import HBS2.Storage +import HBS2.Storage.NCQ.Types import HBS2.Misc.PrettyStuff import HBS2.System.Logger.Simple.ANSI + import HBS2.Data.Log.Structured.NCQ import HBS2.Data.Log.Structured.SD @@ -180,40 +185,6 @@ data NCQStorage = } --- Log structure: --- (SD)* --- S ::= word32be, section prefix --- D ::= HASH PREFIX DATA --- HASH ::= BYTESTRING(32) --- PREFIX ::= BYTESTRING(4) --- DATA ::= BYTESTRING(n) | n == S - LEN(WORD32) - LEN(HASH) - LEN(PREFIX) - -newtype NCQFullRecordLen a = - NCQFullRecordLen a - deriving newtype (Num,Enum,Integral,Real,Ord,Eq) - --- including prefix -ncqFullDataLen :: forall a . Integral a => NCQFullRecordLen a -> a -ncqFullDataLen full = fromIntegral full - ncqKeyLen -{-# INLINE ncqFullDataLen #-} - -ncqKeyLen :: forall a . Integral a => a -ncqKeyLen = 32 -{-# INLINE ncqKeyLen #-} - --- 'S' in SD, i.e size, i.e section header -ncqSLen:: forall a . Integral a => a -ncqSLen = 4 -{-# INLINE ncqSLen #-} - -ncqDataOffset :: forall a b . (Integral a, Integral b) => a -> b -ncqDataOffset base = fromIntegral base + ncqSLen + ncqKeyLen -{-# INLINE ncqDataOffset #-} - - -ncqFullTombLen :: forall a . Integral a => a -ncqFullTombLen = ncqSLen + ncqKeyLen + ncqPrefixLen + 0 -{-# INLINE ncqFullTombLen #-} instance MonadUnliftIO m => Storage NCQStorage HbSync LBS.ByteString m where putBlock ncq lbs = fmap coerce <$> ncqStoragePutBlock ncq lbs @@ -848,27 +819,6 @@ ncqStorageGetBlock ncq h = do Just lbs | not (ncqIsTomb lbs) -> pure (Just $ LBS.drop ncqPrefixLen lbs) _ -> pure Nothing -data NCQSectionType = B | R | T - deriving stock (Eq,Ord,Show) - -instance Pretty NCQSectionType where - pretty = \case - B -> "B" - T -> "T" - R -> "R" - -ncqPrefixLen :: Integral a => a -ncqPrefixLen = 4 -{-# INLINE ncqPrefixLen #-} - -ncqRefPrefix :: ByteString -ncqRefPrefix = "R;;\x00" - -ncqBlockPrefix :: ByteString -ncqBlockPrefix = "B;;\x00" - -ncqTombPrefix :: ByteString -ncqTombPrefix = "T;;\x00" ncqLocatedSize :: Location -> Integer ncqLocatedSize = \case diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs new file mode 100644 index 00000000..739a3d12 --- /dev/null +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs @@ -0,0 +1,90 @@ +module HBS2.Storage.NCQ.Types where + +import HBS2.Prelude +import HBS2.Data.Types.Refs +import HBS2.Hash + +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Network.ByteOrder qualified as N +import Data.Coerce + +-- Log structure: +-- (SD)* +-- S ::= word32be, section prefix +-- D ::= HASH PREFIX DATA +-- HASH ::= BYTESTRING(32) +-- PREFIX ::= BYTESTRING(4) +-- DATA ::= BYTESTRING(n) | n == S - LEN(WORD32) - LEN(HASH) - LEN(PREFIX) + +newtype NCQFullRecordLen a = + NCQFullRecordLen a + deriving newtype (Num,Enum,Integral,Real,Ord,Eq) + +-- including prefix +ncqFullDataLen :: forall a . Integral a => NCQFullRecordLen a -> a +ncqFullDataLen full = fromIntegral full - ncqKeyLen +{-# INLINE ncqFullDataLen #-} + +ncqKeyLen :: forall a . Integral a => a +ncqKeyLen = 32 +{-# INLINE ncqKeyLen #-} + +-- 'S' in SD, i.e size, i.e section header +ncqSLen:: forall a . Integral a => a +ncqSLen = 4 +{-# INLINE ncqSLen #-} + +ncqDataOffset :: forall a b . (Integral a, Integral b) => a -> b +ncqDataOffset base = fromIntegral base + ncqSLen + ncqKeyLen +{-# INLINE ncqDataOffset #-} + + +ncqFullTombLen :: forall a . Integral a => a +ncqFullTombLen = ncqSLen + ncqKeyLen + ncqPrefixLen + 0 +{-# INLINE ncqFullTombLen #-} + + +data NCQSectionType = B | R | T + deriving stock (Eq,Ord,Show) + +instance Pretty NCQSectionType where + pretty = \case + B -> "B" + T -> "T" + R -> "R" + +ncqPrefixLen :: Integral a => a +ncqPrefixLen = 4 +{-# INLINE ncqPrefixLen #-} + +ncqRefPrefix :: ByteString +ncqRefPrefix = "R;;\x00" + +ncqBlockPrefix :: ByteString +ncqBlockPrefix = "B;;\x00" + +ncqTombPrefix :: ByteString +ncqTombPrefix = "T;;\x00" + +ncqMakeSectionBS :: Maybe NCQSectionType + -> HashRef + -> ByteString + -> ByteString +ncqMakeSectionBS t h bs = do + let slen = ncqKeyLen + prefLen + fromIntegral (BS.length bs) + let ss = N.bytestring32 slen + let section = ss <> coerce h <> prefix <> bs + section + + where + (prefLen, prefix) = + case t of + Nothing -> (0, mempty) + Just B -> (ncqPrefixLen, ncqBlockPrefix) + Just T -> (ncqPrefixLen, ncqTombPrefix) + Just R -> (ncqPrefixLen, ncqRefPrefix) + +{-# INLINE ncqMakeSectionBS #-} + + diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs index b329750b..c70b8962 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs @@ -1,6 +1,10 @@ {-# Language MultiWayIf #-} {-# Language RecordWildCards #-} -module HBS2.Storage.NCQ2 where +module HBS2.Storage.NCQ2 + ( module HBS2.Storage.NCQ2 + , module HBS2.Storage.NCQ.Types + ) + where import HBS2.Prelude.Plated import HBS2.Hash @@ -15,6 +19,8 @@ import HBS2.System.Logger.Simple.ANSI import HBS2.Data.Log.Structured.NCQ import HBS2.Data.Log.Structured.SD +import HBS2.Storage.NCQ.Types + import Data.Config.Suckless.System import Data.Config.Suckless.Script hiding (void) @@ -214,6 +220,7 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure $ callCC \exit -> do sync <- readTVarIO ncqStorageSyncReq when (w > ncqFsync || sync) do + liftIO (appendEntry fh undefined (NCQEntryNew 0 "")) liftIO (fileSynchronise fh) atomically do writeTVar ncqStorageSyncReq False @@ -241,11 +248,14 @@ ncqStorageRun2 ncq@NCQStorage2{..} = flip runContT pure $ callCC \exit -> do where - appendEntry :: Fd -> HashRef -> NCQEntry -> m Int + appendEntry :: forall m . MonadUnliftIO m + => Fd + -> HashRef + -> NCQEntry + -> m Int appendEntry fh h (NCQEntryNew _ bs) = do - let ss = N.bytestring32 (32 + fromIntegral (BS.length bs)) - let section = ss <> coerce h <> bs + let section = ncqMakeSectionBS Nothing h bs liftIO (Posix.fdWrite fh section) <&> fromIntegral appendEntry fh h _ = do