external backends wip

It's able to start them up, the only thing not implemented is generating
and verifying keys. And, the key translation for HasExt.
This commit is contained in:
Joey Hess 2020-07-29 15:23:18 -04:00
parent b5d6a36db0
commit f75be32166
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
24 changed files with 482 additions and 136 deletions

View file

@ -6,12 +6,13 @@
-}
module Backend (
list,
builtinList,
defaultBackend,
genKey,
getBackend,
chooseBackend,
lookupBackendVariety,
lookupBuiltinBackendVariety,
maybeLookupBackendVariety,
isStableKey,
isCryptographicallySecure,
@ -26,16 +27,18 @@ import Types.KeySource
import qualified Types.Backend as B
import Utility.Metered
-- When adding a new backend, import it here and add it to the list.
-- When adding a new backend, import it here and add it to the builtinList.
import qualified Backend.Hash
import qualified Backend.WORM
import qualified Backend.URL
import qualified Backend.External
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as S8
list :: [Backend]
list = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends
{- Build-in backends. Does not include externals. -}
builtinList :: [Backend]
builtinList = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends
{- Backend to use by default when generating a new key. -}
defaultBackend :: Annex Backend
@ -44,9 +47,9 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend
cache = do
n <- maybe (annexBackend <$> Annex.getGitConfig) (return . Just)
=<< Annex.getState Annex.forcebackend
let b = case n of
b <- case n of
Just name | valid name -> lookupname name
_ -> Prelude.head list
_ -> pure (Prelude.head builtinList)
Annex.changeState $ \s -> s { Annex.backend = Just b }
return b
valid name = not (null name)
@ -72,12 +75,16 @@ genKey source meterupdate preferredbackend = do
| otherwise = c
getBackend :: FilePath -> Key -> Annex (Maybe Backend)
getBackend file k = case maybeLookupBackendVariety (fromKey keyVariety k) of
getBackend file k = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
Just backend -> return $ Just backend
Nothing -> do
warning $ "skipping " ++ file ++ " (unknown backend " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ ")"
warning $ "skipping " ++ file ++ " (" ++ 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. -}
@ -85,29 +92,38 @@ chooseBackend :: FilePath -> Annex (Maybe Backend)
chooseBackend f = Annex.getState Annex.forcebackend >>= go
where
go Nothing = maybeLookupBackendVariety . parseKeyVariety . encodeBS
<$> checkAttr "annex.backend" f
=<< checkAttr "annex.backend" f
go (Just _) = Just <$> defaultBackend
{- Looks up a backend by variety. May fail if unsupported or disabled. -}
lookupBackendVariety :: KeyVariety -> Backend
lookupBackendVariety v = fromMaybe unknown $ maybeLookupBackendVariety v
where
unknown = giveup $ "unknown backend " ++ decodeBS (formatKeyVariety v)
lookupBackendVariety :: KeyVariety -> Annex Backend
lookupBackendVariety v = fromMaybe (giveup (unknownBackendVarietyMessage v))
<$> maybeLookupBackendVariety v
maybeLookupBackendVariety :: KeyVariety -> Maybe Backend
maybeLookupBackendVariety v = M.lookup v varietyMap
lookupBuiltinBackendVariety :: KeyVariety -> Backend
lookupBuiltinBackendVariety v = fromMaybe (giveup (unknownBackendVarietyMessage v)) $
maybeLookupBuiltinBackendVariety v
maybeLookupBackendVariety :: KeyVariety -> Annex (Maybe Backend)
maybeLookupBackendVariety (ExternalKey s hasext) =
Just <$> Backend.External.makeBackend s hasext
maybeLookupBackendVariety v =
pure $ M.lookup v varietyMap
maybeLookupBuiltinBackendVariety :: KeyVariety -> Maybe Backend
maybeLookupBuiltinBackendVariety v = M.lookup v varietyMap
varietyMap :: M.Map KeyVariety Backend
varietyMap = M.fromList $ zip (map B.backendVariety list) list
varietyMap = M.fromList $ zip (map B.backendVariety builtinList) builtinList
isStableKey :: Key -> Bool
isStableKey :: Key -> Annex Bool
isStableKey k = maybe False (`B.isStableKey` k)
(maybeLookupBackendVariety (fromKey keyVariety k))
<$> maybeLookupBackendVariety (fromKey keyVariety k)
isCryptographicallySecure :: Key -> Bool
isCryptographicallySecure :: Key -> Annex Bool
isCryptographicallySecure k = maybe False (`B.isCryptographicallySecure` k)
(maybeLookupBackendVariety (fromKey keyVariety k))
<$> maybeLookupBackendVariety (fromKey keyVariety k)
isVerifiable :: Key -> Bool
isVerifiable k = maybe False (isJust . B.verifyKeyContent)
(maybeLookupBackendVariety (fromKey keyVariety k))
isVerifiable :: Key -> Annex Bool
isVerifiable k = maybe False (isJust . B.verifyKeyContent)
<$> maybeLookupBackendVariety (fromKey keyVariety k)