cache the serialization of a Key

This will speed up the common case where a Key is deserialized from
disk, but is then serialized to build eg, the path to the annex object.

It means that every place a Key has any of its fields changed, the cache
has to be dropped. I've grepped and found them all. But, it would be
better to avoid that gotcha somehow..
This commit is contained in:
Joey Hess 2019-01-14 16:33:20 -04:00
parent 918868915c
commit 4536c93bb2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 34 additions and 7 deletions

13
Key.hs
View file

@ -51,6 +51,7 @@ stubKey = Key
, keyMtime = Nothing
, keyChunkSize = Nothing
, keyChunkNum = Nothing
, keySerialization = Nothing
}
-- Gets the parent of a chunk key.
@ -58,6 +59,7 @@ nonChunkKey :: Key -> Key
nonChunkKey k = k
{ keyChunkSize = Nothing
, keyChunkNum = Nothing
, keySerialization = Nothing
}
-- Where a chunk key is offset within its parent.
@ -97,7 +99,9 @@ serializeKey :: Key -> String
serializeKey = decodeBL' . serializeKey'
serializeKey' :: Key -> L.ByteString
serializeKey' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . buildKey
serializeKey' k = case keySerialization k of
Nothing -> toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty (buildKey k)
Just b -> L.fromStrict b
{- This is a strict parser for security reasons; a key
- can contain only 4 fields, which all consist only of numbers.
@ -127,6 +131,7 @@ keyParser = do
, keyMtime = m
, keyChunkSize = cs
, keyChunkNum = cn
, keySerialization = Nothing
}
else fail "invalid keyName"
where
@ -140,7 +145,10 @@ deserializeKey :: String -> Maybe Key
deserializeKey = deserializeKey' . encodeBS'
deserializeKey' :: S.ByteString -> Maybe Key
deserializeKey' b = eitherToMaybe $ A.parseOnly keyParser b
deserializeKey' b = either
(const Nothing)
(\k -> Just $ k { keySerialization = Just b })
(A.parseOnly keyParser b)
{- This splits any extension out of the keyName, returning the
- keyName minus extension, and the extension (including leading dot).
@ -177,6 +185,7 @@ instance Arbitrary Key where
<*> ((abs . fromInteger <$>) <$> arbitrary) -- mtime cannot be negative
<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative
<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative
<*> pure Nothing
instance Hashable Key where
hashIO32 = hashIO32 . serializeKey'