From 0ef31d05e00696d08adaf3ff4d5300424f88bdc1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 30 Jan 2021 22:33:15 +0100
Subject: Storage: encode digest algorithm alongside hash data

---
 src/Storage.hs          |  7 ++-----
 src/Storage/Internal.hs | 13 ++++++++++---
 2 files changed, 12 insertions(+), 8 deletions(-)

(limited to 'src')

diff --git a/src/Storage.hs b/src/Storage.hs
index a7607b7..e0f0c7a 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -149,9 +149,6 @@ isZeroRef :: Ref' c -> Bool
 isZeroRef (Ref _ h) = all (==0) $ BA.unpack h
 
 
-readRefDigest :: ByteString -> Maybe RefDigest
-readRefDigest = refDigestFromByteString <=< readHex @ ByteString
-
 refFromDigest :: Storage' c -> RefDigest -> IO (Maybe (Ref' c))
 refFromDigest st dgst = fmap (const $ Ref st dgst) <$> ioLoadBytesFromStorage st dgst
 
@@ -257,7 +254,7 @@ serializeRecItem name (RecBinary x) = [name, BC.pack ":b ", showHex x, BC.single
 serializeRecItem name (RecDate x) = [name, BC.pack ":d", BC.singleton ' ', BC.pack (formatTime defaultTimeLocale "%s %z" x), BC.singleton '\n']
 serializeRecItem name (RecUUID x) = [name, BC.pack ":u", BC.singleton ' ', U.toASCIIBytes x, BC.singleton '\n']
 serializeRecItem name (RecJson x) = [name, BC.pack ":j", BC.singleton ' '] ++ BL.toChunks (J.encode x) ++ [BC.singleton '\n']
-serializeRecItem name (RecRef x) = [name, BC.pack ":r.b2 ", showRef x, BC.singleton '\n']
+serializeRecItem name (RecRef x) = [name, BC.pack ":r ", showRef x, BC.singleton '\n']
 
 lazyLoadObject :: forall c. StorageCompleteness c => Ref' c -> LoadResult c (Object' c)
 lazyLoadObject = returnLoadResult . unsafePerformIO . ioLoadObject
@@ -320,7 +317,7 @@ unsafeDeserializeObject st bytes =
                           "d" -> RecDate <$> parseTimeM False defaultTimeLocale "%s %z" (BC.unpack content)
                           "u" -> RecUUID <$> U.fromASCIIBytes content
                           "j" -> RecJson <$> J.decode (BL.fromStrict content)
-                          "r.b2" -> RecRef . Ref st <$> readRefDigest content
+                          "r" -> RecRef . Ref st <$> readRefDigest content
                           _   -> Nothing
               return (name, val)
 
diff --git a/src/Storage/Internal.hs b/src/Storage/Internal.hs
index 59eb514..d589c44 100644
--- a/src/Storage/Internal.hs
+++ b/src/Storage/Internal.hs
@@ -101,7 +101,13 @@ showRef :: Ref' c -> ByteString
 showRef = showRefDigest . refDigest
 
 showRefDigest :: RefDigest -> ByteString
-showRefDigest = showHex
+showRefDigest x = BC.pack "blake2#" `BC.append` showHex x
+
+readRefDigest :: ByteString -> Maybe RefDigest
+readRefDigest x = case BC.split '#' x of
+                       [alg, dgst] | BA.convert alg == BC.pack "blake2" ->
+                           refDigestFromByteString =<< readHex @ByteString dgst
+                       _ -> Nothing
 
 refDigestFromByteString :: ByteArrayAccess ba => ba -> Maybe RefDigest
 refDigestFromByteString = fmap RefDigest . digestFromByteString
@@ -181,8 +187,9 @@ ioLoadBytesFromStorage st dgst = loadCurrent st >>=
           loadCurrent Storage { stBacking = StorageMemory { memObjs = tobjs } } = M.lookup dgst <$> readMVar tobjs
 
 refPath :: FilePath -> RefDigest -> FilePath
-refPath spath dgst = intercalate "/" [spath, "objects", pref, rest]
-    where (pref, rest) = splitAt 2 $ BC.unpack $ showRefDigest dgst
+refPath spath rdgst = intercalate "/" [spath, "objects", BC.unpack alg, pref, rest]
+    where [alg, dgst] = BC.split '#' $ showRefDigest rdgst
+          (pref, rest) = splitAt 2 $ BC.unpack dgst
 
 
 openFdParents :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
-- 
cgit v1.2.3