diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Storage.hs | 7 | ||||
| -rw-r--r-- | src/Storage/Internal.hs | 13 | 
2 files changed, 12 insertions, 8 deletions
| 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 |