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
|
{- git-annex key/value backends
-
- Copyright 2010-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Backend (
builtinList,
defaultBackend,
hashBackend,
genKey,
getBackend,
chooseBackend,
lookupBackendVariety,
lookupBuiltinBackendVariety,
maybeLookupBackendVariety,
unknownBackendVarietyMessage,
isStableKey,
isCryptographicallySecureKey,
isCryptographicallySecure,
) where
import qualified Data.Map as M
import Annex.Common
import qualified Annex
import Annex.CheckAttr
import Types.Key
import Types.KeySource
import qualified Types.Backend as B
import Utility.Metered
import Backend.Variety
import qualified Backend.VURL
{- Built-in backends. Does not include externals. -}
builtinList :: [Backend]
builtinList = regularBackendList ++ Backend.VURL.backends
{- Backend to use by default when generating a new key. Takes git config
- and --backend option into account. -}
defaultBackend :: Annex Backend
defaultBackend = maybe cache return =<< Annex.getState Annex.backend
where
cache = do
n <- maybe (annexBackend <$> Annex.getGitConfig) (return . Just)
=<< Annex.getRead Annex.forcebackend
b <- case n of
Just name | valid name -> lookupname name
_ -> pure defaultHashBackend
Annex.changeState $ \s -> s { Annex.backend = Just b }
return b
valid name = not (null name)
lookupname = lookupBackendVariety . parseKeyVariety . encodeBS
{- A hashing backend. Takes git config into account, but
- guarantees the backend is cryptographically secure. -}
hashBackend :: Annex Backend
hashBackend = do
db <- defaultBackend
return $ if isCryptographicallySecure db
then db
else defaultHashBackend
{- Generates a key for a file. -}
genKey :: KeySource -> MeterUpdate -> Backend -> Annex (Key, Backend)
genKey source meterupdate b = case B.genKey b of
Just a -> do
k <- a source meterupdate
return (k, b)
Nothing -> giveup $ "Cannot generate a key for backend " ++
decodeBS (formatKeyVariety (B.backendVariety b))
getBackend :: OsPath -> Key -> Annex (Maybe Backend)
getBackend file k = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
Just backend -> return $ Just backend
Nothing -> do
warning $ "skipping " <> QuotedPath file <> " (" <>
UnquotedString (unknownBackendVarietyMessage (fromKey keyVariety k)) <> ")"
return Nothing
unknownBackendVarietyMessage :: KeyVariety -> String
unknownBackendVarietyMessage v =
"unknown backend " ++ decodeBS (formatKeyVariety v)
{- Looks up the backend that should be used for a file.
- That can be configured on a per-file basis in the gitattributes file,
- or forced with --backend. -}
chooseBackend :: OsPath -> Annex Backend
chooseBackend f = Annex.getRead Annex.forcebackend >>= go
where
go Nothing = do
mb <- maybeLookupBackendVariety . parseKeyVariety . encodeBS
=<< checkAttr "annex.backend" f
case mb of
Just b -> return b
Nothing -> defaultBackend
go (Just _) = defaultBackend
{- Looks up a backend by variety. May fail if unsupported or disabled. -}
lookupBackendVariety :: KeyVariety -> Annex Backend
lookupBackendVariety v = fromMaybe (giveup (unknownBackendVarietyMessage v))
<$> maybeLookupBackendVariety v
lookupBuiltinBackendVariety :: KeyVariety -> Backend
lookupBuiltinBackendVariety v = fromMaybe (giveup (unknownBackendVarietyMessage v)) $
maybeLookupBuiltinBackendVariety v
maybeLookupBuiltinBackendVariety :: KeyVariety -> Maybe Backend
maybeLookupBuiltinBackendVariety v = M.lookup v varietyMap
maybeLookupBackendVariety :: KeyVariety -> Annex (Maybe Backend)
maybeLookupBackendVariety v = maybeLookupBackendVarietyMap v varietyMap
varietyMap :: M.Map KeyVariety Backend
varietyMap = makeVarietyMap builtinList
isStableKey :: Key -> Annex Bool
isStableKey k = maybe False (`B.isStableKey` k)
<$> maybeLookupBackendVariety (fromKey keyVariety k)
isCryptographicallySecureKey :: Key -> Annex Bool
isCryptographicallySecureKey k = maybe
(pure False)
(\b -> B.isCryptographicallySecureKey b k)
=<< maybeLookupBackendVariety (fromKey keyVariety k)
isCryptographicallySecure :: Backend -> Bool
isCryptographicallySecure = B.isCryptographicallySecure
|
