summaryrefslogtreecommitdiff
path: root/Types/Key.hs
blob: 8c1828c7e4df13c466e69b3086fe4c189e0b3980 (plain)
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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
{- git-annex Key data type
 -
 - Copyright 2011-2014 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Types.Key (
	Key(..),
	AssociatedFile,
	stubKey,
	key2file,
	file2key,
	nonChunkKey,
	chunkKeyOffset,
	isChunkKey,
	isKeyPrefix,

	prop_isomorphic_key_encode,
	prop_isomorphic_key_decode
) where

import System.Posix.Types

import Common
import Utility.QuickCheck
import Utility.Bloom

{- A Key has a unique name, which is derived from a particular backend,
 - and may contain other optional metadata. -}
data Key = Key
	{ keyName :: String
	, keyBackendName :: String
	, keySize :: Maybe Integer
	, keyMtime :: Maybe EpochTime
	, keyChunkSize :: Maybe Integer
	, keyChunkNum :: Maybe Integer
	} deriving (Eq, Ord, Read, Show)

{- A filename may be associated with a Key. -}
type AssociatedFile = Maybe FilePath

stubKey :: Key
stubKey = Key
	{ keyName = ""
	, keyBackendName = ""
	, keySize = Nothing
	, keyMtime = Nothing
	, keyChunkSize = Nothing
	, keyChunkNum = Nothing
	}

-- Gets the parent of a chunk key.
nonChunkKey :: Key -> Key
nonChunkKey k = k
	{ keyChunkSize = Nothing
	, keyChunkNum = Nothing
	}

-- Where a chunk key is offset within its parent.
chunkKeyOffset :: Key -> Maybe Integer
chunkKeyOffset k = (*)
	<$> keyChunkSize k
	<*> (pred <$> keyChunkNum k)

isChunkKey :: Key -> Bool
isChunkKey k = isJust (keyChunkSize k) && isJust (keyChunkNum k)

-- Checks if a string looks like at least the start of a key.
isKeyPrefix :: String -> Bool
isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s

fieldSep :: Char
fieldSep = '-'

{- Converts a key to a string that is suitable for use as a filename.
 - The name field is always shown last, separated by doubled fieldSeps,
 - and is the only field allowed to contain the fieldSep. -}
key2file :: Key -> FilePath
key2file Key { keyBackendName = b, keySize = s, keyMtime = m, keyChunkSize = cs, keyChunkNum = cn, keyName = n } =
	b +++ ('s' ?: s) +++ ('m' ?: m) +++ ('S' ?: cs) +++ ('C' ?: cn) +++ (fieldSep : n)
  where
	"" +++ y = y
	x +++ "" = x
	x +++ y = x ++ fieldSep:y
	f ?: (Just v) = f : show v
	_ ?: _ = ""

file2key :: FilePath -> Maybe Key
file2key s
	| key == Just stubKey || (keyName <$> key) == Just "" || (keyBackendName <$> key) == Just "" = Nothing
	| otherwise = key
  where
	key = startbackend stubKey s

	startbackend k v = sepfield k v addbackend
		
	sepfield k v a = case span (/= fieldSep) v of
		(v', _:r) -> findfields r $ a k v'
		_ -> Nothing

	findfields (c:v) (Just k)
		| c == fieldSep = Just $ k { keyName = v }
		| otherwise = sepfield k v $ addfield c
	findfields _ v = v

	addbackend k v = Just k { keyBackendName = v }
	addfield 's' k v = do
		sz <- readish v
		return $ k { keySize = Just sz }
	addfield 'm' k v = do
		mtime <- readish v
		return $ k { keyMtime = Just mtime }
	addfield 'S' k v = do
		chunksize <- readish v
		return $ k { keyChunkSize = Just chunksize }
	addfield 'C' k v = case readish v of
		Just chunknum | chunknum > 0 ->
			return $ k { keyChunkNum = Just chunknum }
		_ -> return k
	addfield _ _ _ = Nothing

instance Arbitrary Key where
	arbitrary = Key
		<$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t")
		<*> (listOf1 $ elements ['A'..'Z']) -- BACKEND
		<*> ((abs <$>) <$> arbitrary) -- size cannot be negative
		<*> arbitrary
		<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative
		<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative

instance Hashable Key where
	hashIO32 = hashIO32 . key2file
	hashIO64 = hashIO64 . key2file

prop_isomorphic_key_encode :: Key -> Bool
prop_isomorphic_key_encode k = Just k == (file2key . key2file) k

prop_isomorphic_key_decode :: FilePath -> Bool
prop_isomorphic_key_decode f
	| normalfieldorder = maybe True (\k -> key2file k == f) (file2key f)
	| otherwise = True
  where
	-- file2key will accept the fields in any order, so don't
	-- try the test unless the fields are in the normal order
	normalfieldorder = fields `isPrefixOf` "smSC"
	fields = map (f !!) $ filter (< length f) $ map succ $
		elemIndices fieldSep f