From 16876457bc526e22c64d024cd76c188dd5ba62c6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 26 Nov 2024 21:21:09 +0100
Subject: Test: avoid the need for exposing Erebos.Storage.Internal

---
 erebos.cabal |  3 +--
 main/Test.hs | 13 ++++++++++---
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/erebos.cabal b/erebos.cabal
index ba00538..0b33141 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -115,11 +115,10 @@ library
         Erebos.Storage.Merge
         Erebos.Sync
 
-        -- Used by test tool:
-        Erebos.Storage.Internal
     other-modules:
         Erebos.Flow
         Erebos.Object.Internal
+        Erebos.Storage.Internal
         Erebos.Storage.Platform
         Erebos.Util
 
diff --git a/main/Test.hs b/main/Test.hs
index 628e351..3db50bd 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -46,7 +46,6 @@ import Erebos.State
 import Erebos.Storable
 import Erebos.Storage
 import Erebos.Storage.Head
-import Erebos.Storage.Internal (unsafeStoreRawBytes)
 import Erebos.Storage.Merge
 import Erebos.Sync
 
@@ -301,12 +300,20 @@ commands = map (T.pack *** id)
 cmdStore :: Command
 cmdStore = do
     st <- asks tiStorage
+    pst <- liftIO $ derivePartialStorage st
     [otype] <- asks tiParams
     ls <- getLines
 
     let cnt = encodeUtf8 $ T.unlines ls
-    ref <- liftIO $ unsafeStoreRawBytes st $ BL.fromChunks [encodeUtf8 otype, BC.singleton ' ', BC.pack (show $ B.length cnt), BC.singleton '\n', cnt]
-    cmdOut $ "store-done " ++ show (refDigest ref)
+        full = BL.fromChunks
+            [ encodeUtf8 otype
+            , BC.singleton ' '
+            , BC.pack (show $ B.length cnt)
+            , BC.singleton '\n', cnt
+            ]
+    liftIO (copyRef st =<< storeRawBytes pst full) >>= \case
+        Right ref -> cmdOut $ "store-done " ++ show (refDigest ref)
+        Left _ -> cmdOut $ "store-failed"
 
 cmdLoad :: Command
 cmdLoad = do
-- 
cgit v1.2.3