Test: basic object format

2 files changed, 92 insertions, 10 deletions

diff --git a/main/Test.hs b/main/Test.hs
index c3dca14..30f6356 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -117,9 +117,9 @@ runTestTool st = do
 getLineMb :: MonadIO m => m (Maybe Text)
 getLineMb = liftIO $ catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e)
 
-getLines :: MonadIO m => m [Text]
-getLines = getLineMb >>= \case
-    Just line | not (T.null line) -> (line:) <$> getLines
+getLines :: MonadIO m => Text -> m [ Text ]
+getLines eof = getLineMb >>= \case
+    Just line | line /= eof -> (line :) <$> getLines eof
     _ -> return []
 
 getHead :: CommandM (Head LocalState)
@@ -268,7 +268,9 @@ type Command = CommandM ()
 commands :: [ ( Text, Command ) ]
 commands =
     [ ( "store", cmdStore )
+    , ( "store-raw", cmdStoreRaw )
     , ( "load", cmdLoad )
+    , ( "load-type", cmdLoadType )
     , ( "stored-generation", cmdStoredGeneration )
     , ( "stored-roots", cmdStoredRoots )
     , ( "stored-set-add", cmdStoredSetAdd )
@@ -332,7 +334,7 @@ cmdStore = do
     st <- asks tiStorage
     pst <- liftIO $ derivePartialStorage st
     [otype] <- asks tiParams
-    ls <- getLines
+    ls <- getLines T.empty
 
     let cnt = encodeUtf8 $ T.unlines ls
         full = BL.fromChunks
@@ -345,6 +347,18 @@ cmdStore = do
         Right ref -> cmdOut $ "store-done " ++ show (refDigest ref)
         Left _ -> cmdOut $ "store-failed"
 
+cmdStoreRaw :: Command
+cmdStoreRaw = do
+    st <- asks tiStorage
+    pst <- liftIO $ derivePartialStorage st
+    [ eof ] <- asks tiParams
+    ls <- getLines eof
+
+    let full = BL.fromStrict $ BC.init $ encodeUtf8 $ T.unlines ls
+    liftIO (copyRef st =<< storeRawBytes pst full) >>= \case
+        Right ref -> cmdOut $ "store-done " ++ show (refDigest ref)
+        Left _ -> cmdOut $ "store-failed"
+
 cmdLoad :: Command
 cmdLoad = do
     st <- asks tiStorage
@@ -357,6 +371,19 @@ cmdLoad = do
         cmdOut $ "load-line " <> T.unpack (decodeUtf8 $ BL.toStrict line)
     cmdOut "load-done"
 
+cmdLoadType :: Command
+cmdLoadType = do
+    st <- asks tiStorage
+    [ tref ] <- asks tiParams
+    Just ref <- liftIO $ readRef st $ encodeUtf8 tref
+    let obj = load @Object ref
+    let otype = case obj of
+            Blob {} -> "blob"
+            Rec {} -> "rec"
+            ZeroObject {} -> "zero"
+            UnknownObject utype _ -> "unknown " <> decodeUtf8 utype
+    cmdOut $ "load-type " <> T.unpack otype
+
 cmdStoredGeneration :: Command
 cmdStoredGeneration = do
     st <- asks tiStorage
diff --git a/test/storage.et b/test/storage.et
index 2230eac..9bbbe6b 100644
--- a/test/storage.et
+++ b/test/storage.et
@@ -1,3 +1,5 @@
+import common
+
 test Storage:
 	spawn as p1
 
@@ -432,8 +434,6 @@ test SharedStateWatcher:
 
 
 test LocalStateKeepUnknown:
-	let refpat = /blake2#[0-9a-f]*/
-
 	spawn as p
 	with p:
 		send "create-identity Device"
@@ -480,8 +480,6 @@ test LocalStateKeepUnknown:
 
 
 test UnknownObjectType:
-	let refpat = /blake2#[0-9a-f]*/
-
 	spawn as p
 	spawn as p2 on p.node
 
@@ -502,8 +500,6 @@ test UnknownObjectType:
 
 
 test UnknownRecordItemType:
-	let refpat = /blake2#[0-9a-f]*/
-
 	spawn as p
 	spawn as p2 on p.node
 
@@ -521,3 +517,62 @@ test UnknownRecordItemType:
 			local:
 				expect /load-(.*)/ capture done
 				guard (done == "done")
+
+
+test ObjectFormat:
+	spawn as p
+	with p:
+		# Empty blob
+		local:
+			send "store-raw EOF"
+			send "blob 0\n"
+			send "EOF"
+			expect /store-done ($refpat)/ capture r
+
+			send "load-type $r"
+			expect /load-type (.*)/ capture type
+			guard (type == "blob")
+
+		# Small blob
+		local:
+			send "store-raw EOF"
+			send "blob 2\nab"
+			send "EOF"
+			expect /store-done ($refpat)/ capture r
+
+			send "load-type $r"
+			expect /load-type (.*)/ capture type
+			guard (type == "blob")
+
+		# Empty record
+		local:
+			send "store-raw EOF"
+			send "rec 0\n"
+			send "EOF"
+			expect /store-done ($refpat)/ capture r
+
+			send "load-type $r"
+			expect /load-type (.*)/ capture type
+			guard (type == "rec")
+
+		# Small record
+		local:
+			send "store-raw EOF"
+			send "rec 8\nnum:n 1\n"
+			send "EOF"
+			expect /store-done ($refpat)/ capture r
+
+			send "load-type $r"
+			expect /load-type (.*)/ capture type
+			guard (type == "rec")
+
+		# Empty unknown
+		local:
+			send "store-raw EOF"
+			send "test-unknown 0\n"
+			send "EOF"
+			expect /store-done ($refpat)/ capture r
+
+			send "load-type $r"
+			expect /load-type (.*)/ capture type
+			guard (type == "unknown test-unknown")