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
|
{- Backends for git-remote-annex.
-
- GITBUNDLE keys store git bundles
- GITMANIFEST keys store ordered lists of GITBUNDLE keys
-
- Copyright 2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Backend.GitRemoteAnnex (
backends,
genGitBundleKey,
genManifestKey,
genBackupManifestKey,
isGitRemoteAnnexKey,
) where
import Annex.Common
import Types.Key
import Types.Backend
import Utility.Hash
import Utility.Metered
import qualified Backend.Hash as Hash
import qualified Data.ByteString.Short as S
import qualified Data.ByteString.Char8 as B8
backends :: [Backend]
backends = [gitbundle, gitmanifest]
gitbundle :: Backend
gitbundle = Backend
{ backendVariety = GitBundleKey
, genKey = Nothing
-- ^ Not provided because these keys can only be generated by
-- git-remote-annex.
, verifyKeyContent = Just $ Hash.checkKeyChecksum sameCheckSum hash
, verifyKeyContentIncrementally = Just (liftIO . incrementalVerifier)
, canUpgradeKey = Nothing
, fastMigrate = Nothing
, isStableKey = const True
, isCryptographicallySecure = Hash.cryptographicallySecure hash
, isCryptographicallySecureKey = const $ pure $
Hash.cryptographicallySecure hash
}
gitmanifest :: Backend
gitmanifest = Backend
{ backendVariety = GitManifestKey
, genKey = Nothing
, verifyKeyContent = Nothing
, verifyKeyContentIncrementally = Nothing
, canUpgradeKey = Nothing
, fastMigrate = Nothing
, isStableKey = const True
, isCryptographicallySecure = False
, isCryptographicallySecureKey = const $ pure False
}
-- git bundle keys use the sha256 hash.
hash :: Hash.Hash
hash = Hash.SHA2Hash (HashSize 256)
incrementalVerifier :: Key -> IO IncrementalVerifier
incrementalVerifier =
mkIncrementalVerifier sha2_256_context "checksum" . sameCheckSum
sameCheckSum :: Key -> String -> Bool
sameCheckSum key s = s == expected
where
-- The checksum comes after a UUID.
expected = reverse $ takeWhile (/= '-') $ reverse $
decodeBS $ S.fromShort $ fromKey keyName key
genGitBundleKey :: UUID -> OsPath -> MeterUpdate -> Annex Key
genGitBundleKey remoteuuid file meterupdate = do
filesize <- liftIO $ getFileSize file
s <- Hash.hashFile hash file meterupdate
return $ mkKey $ \k -> k
{ keyName = S.toShort $ fromUUID remoteuuid <> "-" <> encodeBS s
, keyVariety = GitBundleKey
, keySize = Just filesize
}
genManifestKey :: UUID -> Key
genManifestKey = genManifestKey' Nothing
genBackupManifestKey :: UUID -> Key
genBackupManifestKey = genManifestKey' (Just ".bak")
genManifestKey' :: Maybe S.ShortByteString -> UUID -> Key
genManifestKey' extension u = mkKey $ \kd -> kd
{ keyName = S.toShort (fromUUID u) <>
fromMaybe mempty extension
, keyVariety = GitManifestKey
}
{- Is the key a manifest or bundle key that belongs to the special remote
- with this uuid? -}
isGitRemoteAnnexKey :: UUID -> Key -> Bool
isGitRemoteAnnexKey u k =
case fromKey keyVariety k of
GitBundleKey -> sameuuid $ \b ->
-- Remove the checksum that comes after the UUID.
let b' = fst $ B8.spanEnd (/= '-') b
in B8.take (B8.length b' - 1) b'
GitManifestKey -> sameuuid $ \b ->
-- Remove an optional extension after the UUID.
-- (A UUID never contains '.')
if '.' `B8.elem` b
then
let b' = fst $ B8.spanEnd (/= '.') b
in B8.take (B8.length b' - 1) b'
else b
_ -> False
where
sameuuid f = fromUUID u == f (S.fromShort (fromKey keyName k))
|
