summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--main/Test.hs1
-rw-r--r--src/Erebos/Object/Internal.hs29
-rw-r--r--test/storage.et60
3 files changed, 88 insertions, 2 deletions
diff --git a/main/Test.hs b/main/Test.hs
index 220f414..f08d596 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -402,6 +402,7 @@ cmdLoadType = do
Blob {} -> "blob"
Rec {} -> "rec"
OnDemand {} -> "ondemand"
+ Chunked {} -> "chunked"
ZeroObject {} -> "zero"
UnknownObject utype _ -> "unknown " <> decodeUtf8 utype
cmdOut $ "load-type " <> T.unpack otype
diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs
index 45fd924..a785836 100644
--- a/src/Erebos/Object/Internal.hs
+++ b/src/Erebos/Object/Internal.hs
@@ -133,6 +133,7 @@ copyObject' :: forall c c'. (StorageCompleteness c, StorageCompleteness c') => S
copyObject' _ (Blob bs) = return $ return $ Blob bs
copyObject' st (Rec rs) = fmap Rec . sequence <$> mapM (\( n, item ) -> fmap ( n, ) <$> copyRecItem' st item) rs
copyObject' _ (OnDemand size dgst) = return $ return $ OnDemand size dgst
+copyObject' _ (Chunked size dgsts) = return $ return $ Chunked size dgsts
copyObject' _ ZeroObject = return $ return ZeroObject
copyObject' _ (UnknownObject otype content) = return $ return $ UnknownObject otype content
@@ -156,6 +157,7 @@ data Object' c
= Blob ByteString
| Rec [ ( ByteString, RecItem' c ) ]
| OnDemand Word64 RefDigest
+ | Chunked Word64 [ RefDigest ]
| ZeroObject
| UnknownObject ByteString ByteString
deriving (Show)
@@ -187,6 +189,9 @@ serializeObject = \case
OnDemand size dgst ->
let cnt = BC.unlines [ BC.pack (show size), showRefDigest dgst ]
in BL.fromChunks [ BC.pack "ondemand ", BC.pack (show $ B.length cnt), BC.singleton '\n', cnt ]
+ Chunked size dgsts ->
+ let cnt = BC.unlines $ BC.pack (show size) : map showRefDigest dgsts
+ in BL.fromChunks [ BC.pack "chunked ", BC.pack (show $ B.length cnt), BC.singleton '\n', cnt ]
ZeroObject -> BL.empty
UnknownObject otype cnt -> BL.fromChunks [ otype, BC.singleton ' ', BC.pack (show $ B.length cnt), BC.singleton '\n', cnt ]
@@ -260,6 +265,9 @@ unsafeDeserializeObject st bytes =
| otype == BC.pack "ondemand"
, Just ondemand <- parseOnDemand st content
-> return ondemand
+ | otype == BC.pack "chunked"
+ , Just chunked <- parseChunked st content
+ -> return chunked
| otherwise
-> return $ UnknownObject otype content
_ -> throwOtherError $ "malformed object"
@@ -317,6 +325,20 @@ parseOnDemand _ body = do
dgst <- readRefDigest $ B.take newline2 $ B.drop (newline1 + 1) body
return $ OnDemand (fromIntegral size) dgst
+parseChunked :: Storage' c -> ByteString -> Maybe (Object' c)
+parseChunked _ body = do
+ tsize : trefs <- strictLines body
+ ( size, sizeRest ) <- BC.readInt tsize
+ guard (B.null sizeRest)
+ dgsts <- mapM readRefDigest trefs
+ return $ Chunked (fromIntegral size) dgsts
+ where
+ strictLines bs
+ | B.null bs = Just []
+ | otherwise = do
+ newline <- BC.elemIndex '\n' bs
+ (B.take newline bs :) <$> strictLines (B.drop (newline + 1) bs)
+
deserializeObject :: PartialStorage -> BL.ByteString -> Except ErebosError (PartialObject, BL.ByteString)
deserializeObject = unsafeDeserializeObject
@@ -375,8 +397,9 @@ class Storable a => ZeroStorable a where
data Store
= StoreBlob ByteString
- | StoreRec (forall c. StorageCompleteness c => Storage' c -> [IO [(ByteString, RecItem' c)]])
+ | StoreRec (forall c. StorageCompleteness c => Storage' c -> [ IO [ ( ByteString, RecItem' c ) ]])
| StoreOnDemand Word64 RefDigest
+ | StoreChunked Word64 [ RefDigest ]
| StoreZero
| StoreUnknown ByteString ByteString
@@ -387,10 +410,11 @@ evalStoreObject :: StorageCompleteness c => Storage' c -> Store -> IO (Object' c
evalStoreObject _ (StoreBlob x) = return $ Blob x
evalStoreObject s (StoreRec f) = Rec . concat <$> sequence (f s)
evalStoreObject _ (StoreOnDemand size dgst) = return $ OnDemand size dgst
+evalStoreObject _ (StoreChunked size dgsts) = return $ Chunked size dgsts
evalStoreObject _ StoreZero = return ZeroObject
evalStoreObject _ (StoreUnknown otype content) = return $ UnknownObject otype content
-newtype StoreRecM c a = StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a)
+newtype StoreRecM c a = StoreRecM (ReaderT (Storage' c) (Writer [ IO [ ( ByteString, RecItem' c ) ]]) a)
deriving (Functor, Applicative, Monad)
type StoreRec c = StoreRecM c ()
@@ -424,6 +448,7 @@ instance Storable Object where
Rec xs' <- copyObject st (Rec xs)
return xs'
store' (OnDemand size dgst) = StoreOnDemand size dgst
+ store' (Chunked size dgsts) = StoreChunked size dgsts
store' ZeroObject = StoreZero
store' (UnknownObject otype content) = StoreUnknown otype content
diff --git a/test/storage.et b/test/storage.et
index 16b66e2..45e8ce1 100644
--- a/test/storage.et
+++ b/test/storage.et
@@ -625,3 +625,63 @@ test ObjectFormat:
send "load-type $r"
expect /load-type (.*)/ capture type
guard (type == "ondemand")
+
+ # Empty chunked object
+ local:
+ send "store-raw EOF"
+ send "chunked 2\n0\n"
+ send "EOF"
+ expect /store-done ($refpat)/ capture r
+
+ send "load-type $r"
+ expect /load-type (.*)/ capture type
+ guard (type == "chunked")
+
+ send "store blob"
+ send "test"
+ send ""
+ expect /store-done ($refpat)/ capture blob_test_ref
+
+ # Chunked object
+ local:
+ send "store-raw EOF"
+ send "chunked 146\n8\n$blob_test_ref\n$blob_test_ref\n"
+ send "EOF"
+ expect /store-done ($refpat)/ capture r
+
+ send "load-type $r"
+ expect /load-type (.*)/ capture type
+ guard (type == "chunked")
+
+ # Invalid chunked object (missing last newline)
+ local:
+ send "store-raw EOF"
+ send "chunked 145\n8\n$blob_test_ref\n$blob_test_ref"
+ send "EOF"
+ expect /store-done ($refpat)/ capture r
+
+ send "load-type $r"
+ expect /load-type (.*)/ capture type
+ guard (type == "unknown chunked")
+
+ # Invalid chunked object (missing size)
+ local:
+ send "store-raw EOF"
+ send "chunked 144\n$blob_test_ref\n$blob_test_ref\n"
+ send "EOF"
+ expect /store-done ($refpat)/ capture r
+
+ send "load-type $r"
+ expect /load-type (.*)/ capture type
+ guard (type == "unknown chunked")
+
+ # Invalid chunked object (invalid ref)
+ local:
+ send "store-raw EOF"
+ send "chunked 78\n8\nabc\n$blob_test_ref\n"
+ send "EOF"
+ expect /store-done ($refpat)/ capture r
+
+ send "load-type $r"
+ expect /load-type (.*)/ capture type
+ guard (type == "unknown chunked")
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-20 18:58:50 +0000