1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
{- 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',
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 Data.ByteString.Short (ShortByteString, 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' = fromShort . keySerialization
serializeKey'' :: Key -> ShortByteString
serializeKey'' = keySerialization
deserializeKey :: String -> Maybe Key
deserializeKey = deserializeKey' . encodeBS
deserializeKey' :: S.ByteString -> Maybe Key
deserializeKey' = eitherToMaybe . A.parseOnly keyParser
instance Arbitrary KeyData where
arbitrary = Key
<$> (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 (toOsPath . 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
|
