From bc47aa7472e05b810339752da4d34bc04d37ef72 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 21 Mar 2020 21:35:46 +0100
Subject: Generation number for stored objects

---
 src/Storage.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

(limited to 'src/Storage.hs')

diff --git a/src/Storage.hs b/src/Storage.hs
index 5af34b7..5a5d992 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -6,6 +6,7 @@ module Storage (
     Ref, PartialRef, RefDigest,
     refStorage, refDigest,
     readRef, showRef, showRefDigest,
+    refDigestFromByteString, hashToRefDigest,
     copyRef, partialRef, partialRefFromDigest,
 
     Object, PartialObject, Object'(..), RecItem, RecItem'(..),
@@ -72,6 +73,7 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Lazy.Char8 as BLC
 import Data.Char
 import Data.Function
+import qualified Data.HashTable.IO as HT
 import Data.List
 import qualified Data.Map as M
 import Data.Maybe
@@ -105,12 +107,14 @@ openStorage path = do
     createDirectoryIfMissing True $ path ++ "/objects"
     createDirectoryIfMissing True $ path ++ "/heads"
     watchers <- newMVar (Nothing, [])
-    return $ Storage { stBacking = StorageDir path watchers, stParent = Nothing }
+    refgen <- newMVar =<< HT.new
+    return $ Storage { stBacking = StorageDir path watchers, stParent = Nothing, stRefGeneration = refgen }
 
 memoryStorage' :: IO (Storage' c')
 memoryStorage' = do
     backing <- StorageMemory <$> newMVar [] <*> newMVar M.empty <*> newMVar M.empty <*> newMVar []
-    return $ Storage { stBacking = backing, stParent = Nothing }
+    refgen <- newMVar =<< HT.new
+    return $ Storage { stBacking = backing, stParent = Nothing, stRefGeneration = refgen }
 
 memoryStorage :: IO Storage
 memoryStorage = memoryStorage'
@@ -129,7 +133,7 @@ type Ref = Ref' Complete
 type PartialRef = Ref' Partial
 
 zeroRef :: Storage' c -> Ref' c
-zeroRef s = Ref s h
+zeroRef s = Ref s (RefDigest h)
     where h = case digestFromByteString $ B.replicate (hashDigestSize $ digestAlgo h) 0 of
                    Nothing -> error $ "Failed to create zero hash"
                    Just h' -> h'
@@ -141,7 +145,7 @@ isZeroRef (Ref _ h) = all (==0) $ BA.unpack h
 
 
 readRefDigest :: ByteString -> Maybe RefDigest
-readRefDigest = digestFromByteString . B.concat <=< readHex
+readRefDigest = refDigestFromByteString . B.concat <=< readHex
     where readHex bs | B.null bs = Just []
           readHex bs = do (bx, bs') <- B.uncons bs
                           (by, bs'') <- B.uncons bs'
@@ -239,7 +243,7 @@ storeRawBytes = unsafeStoreRawBytes
 
 unsafeStoreRawBytes :: Storage' c -> BL.ByteString -> IO (Ref' c)
 unsafeStoreRawBytes st raw = do
-    let dgst = hashFinalize $ hashUpdates hashInit $ BL.toChunks raw
+    let dgst = hashToRefDigest raw
     case stBacking st of
          StorageDir { dirPath = sdir } -> writeFileOnce (refPath sdir dgst) $ compress raw
          StorageMemory { memObjs = tobjs } ->
@@ -269,7 +273,7 @@ ioLoadObject ref@(Ref st rhash) = do
     file' <- ioLoadBytes ref
     return $ do
         file <- file'
-        let chash = hashFinalize $ hashUpdates hashInit $ BL.toChunks file
+        let chash = hashToRefDigest file
         when (chash /= rhash) $ error $ "Hash mismatch on object " ++ BC.unpack (showRef ref) {- TODO throw -}
         return $ case runExcept $ unsafeDeserializeObject st file of
                       Left err -> error $ err ++ ", ref " ++ BC.unpack (showRef ref) {- TODO throw -}
-- 
cgit v1.2.3