19e78816f0This adds the overhead of a copy when serializing and deserializing keys. I have not benchmarked much, but runtimes seem barely changed at all by that. When a lot of keys are in memory, it improves memory use. And, it prevents keys sometimes getting PINNED in memory and failing to GC, which is a problem ByteString has sometimes. In particular, git-annex sync from a borg special remote had that problem and this improved its memory use by a large amount. Sponsored-by: Shae Erisson on Patreon
108 lines
2.8 KiB
Haskell
108 lines
2.8 KiB
Haskell
{- git-annex Keys
|
|
-
|
|
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Key (
|
|
Key,
|
|
KeyData(..),
|
|
AssociatedFile(..),
|
|
fromKey,
|
|
mkKey,
|
|
alterKey,
|
|
keyParser,
|
|
serializeKey,
|
|
serializeKey',
|
|
deserializeKey,
|
|
deserializeKey',
|
|
nonChunkKey,
|
|
chunkKeyOffset,
|
|
isChunkKey,
|
|
isKeyPrefix,
|
|
splitKeyNameExtension,
|
|
|
|
prop_isomorphic_key_encode
|
|
) where
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Data.ByteString as S
|
|
import qualified Data.ByteString.Short as S (toShort, fromShort)
|
|
import qualified Data.Attoparsec.ByteString as A
|
|
|
|
import Common
|
|
import Types.Key
|
|
import Utility.QuickCheck
|
|
import Utility.Bloom
|
|
import Utility.Aeson
|
|
import qualified Utility.SimpleProtocol as Proto
|
|
|
|
-- Gets the parent of a chunk key.
|
|
nonChunkKey :: Key -> Key
|
|
nonChunkKey k
|
|
| fromKey keyChunkSize k == Nothing && fromKey keyChunkNum k == Nothing = k
|
|
| otherwise = alterKey k $ \d -> d
|
|
{ keyChunkSize = Nothing
|
|
, keyChunkNum = Nothing
|
|
}
|
|
|
|
-- Where a chunk key is offset within its parent.
|
|
chunkKeyOffset :: Key -> Maybe Integer
|
|
chunkKeyOffset k = (*)
|
|
<$> fromKey keyChunkSize k
|
|
<*> (pred <$> fromKey keyChunkNum k)
|
|
|
|
isChunkKey :: Key -> Bool
|
|
isChunkKey k = isJust (fromKey keyChunkSize k) && isJust (fromKey keyChunkNum k)
|
|
|
|
serializeKey :: Key -> String
|
|
serializeKey = decodeBS . serializeKey'
|
|
|
|
serializeKey' :: Key -> S.ByteString
|
|
serializeKey' = S.fromShort . keySerialization
|
|
|
|
deserializeKey :: String -> Maybe Key
|
|
deserializeKey = deserializeKey' . encodeBS
|
|
|
|
deserializeKey' :: S.ByteString -> Maybe Key
|
|
deserializeKey' = eitherToMaybe . A.parseOnly keyParser
|
|
|
|
instance Arbitrary KeyData where
|
|
arbitrary = Key
|
|
<$> (S.toShort . encodeBS <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t"))
|
|
<*> (parseKeyVariety . encodeBS <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND
|
|
<*> ((abs <$>) <$> arbitrary) -- size cannot be negative
|
|
<*> ((abs . fromInteger <$>) <$> arbitrary) -- mtime cannot be negative
|
|
<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative
|
|
<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative
|
|
|
|
instance Arbitrary AssociatedFile where
|
|
arbitrary = AssociatedFile
|
|
. fmap (toRawFilePath . fromTestableFilePath)
|
|
<$> arbitrary
|
|
|
|
instance Arbitrary Key where
|
|
arbitrary = mkKey . const <$> arbitrary
|
|
|
|
instance Hashable Key where
|
|
hashIO32 = hashIO32 . serializeKey'
|
|
hashIO64 = hashIO64 . serializeKey'
|
|
|
|
instance ToJSON' Key where
|
|
toJSON' = toJSON' . serializeKey
|
|
|
|
instance FromJSON Key where
|
|
parseJSON (String t) = maybe mempty pure $ deserializeKey $ T.unpack t
|
|
parseJSON _ = mempty
|
|
|
|
instance Proto.Serializable Key where
|
|
serialize = serializeKey
|
|
deserialize = deserializeKey
|
|
|
|
prop_isomorphic_key_encode :: Key -> Bool
|
|
prop_isomorphic_key_encode k = Just k == (deserializeKey . serializeKey) k
|
|
|