refactoring
This commit is contained in:
parent
9c2c3002a6
commit
1704b5e327
3 changed files with 25 additions and 14 deletions
12
Backend.hs
12
Backend.hs
|
@ -10,13 +10,14 @@
|
||||||
module Backend (
|
module Backend (
|
||||||
builtinList,
|
builtinList,
|
||||||
defaultBackend,
|
defaultBackend,
|
||||||
defaultHashBackend,
|
hashBackend,
|
||||||
genKey,
|
genKey,
|
||||||
getBackend,
|
getBackend,
|
||||||
chooseBackend,
|
chooseBackend,
|
||||||
lookupBackendVariety,
|
lookupBackendVariety,
|
||||||
lookupBuiltinBackendVariety,
|
lookupBuiltinBackendVariety,
|
||||||
maybeLookupBackendVariety,
|
maybeLookupBackendVariety,
|
||||||
|
unknownBackendVarietyMessage,
|
||||||
isStableKey,
|
isStableKey,
|
||||||
isCryptographicallySecureKey,
|
isCryptographicallySecureKey,
|
||||||
isCryptographicallySecure,
|
isCryptographicallySecure,
|
||||||
|
@ -54,6 +55,15 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend
|
||||||
valid name = not (null name)
|
valid name = not (null name)
|
||||||
lookupname = lookupBackendVariety . parseKeyVariety . encodeBS
|
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. -}
|
{- Generates a key for a file. -}
|
||||||
genKey :: KeySource -> MeterUpdate -> Backend -> Annex (Key, Backend)
|
genKey :: KeySource -> MeterUpdate -> Backend -> Annex (Key, Backend)
|
||||||
genKey source meterupdate b = case B.genKey b of
|
genKey source meterupdate b = case B.genKey b of
|
||||||
|
|
|
@ -56,3 +56,11 @@ generateEquivilantKey b f =
|
||||||
, contentLocation = f
|
, contentLocation = f
|
||||||
, inodeCache = Nothing
|
, inodeCache = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
recordVurlKey :: Backend -> OsPath -> Key -> [Key] -> Annex Bool
|
||||||
|
recordVurlKey b f key eks = generateEquivilantKey b f >>= \case
|
||||||
|
Nothing -> return False
|
||||||
|
Just ek -> do
|
||||||
|
unless (ek `elem` eks) $
|
||||||
|
setEquivilantKey key ek
|
||||||
|
return True
|
||||||
|
|
|
@ -30,7 +30,7 @@ import Annex.SpecialRemote.Config
|
||||||
import Logs.Remote
|
import Logs.Remote
|
||||||
import Logs.EquivilantKeys
|
import Logs.EquivilantKeys
|
||||||
import Backend
|
import Backend
|
||||||
import Backend.VURL.Utilities (generateEquivilantKey)
|
import Backend.VURL.Utilities (recordVurlKey)
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
@ -169,18 +169,11 @@ downloadKey urlincludeexclude key _af dest p vc =
|
||||||
| otherwise = return (Just v)
|
| otherwise = return (Just v)
|
||||||
|
|
||||||
recordvurlkey eks = do
|
recordvurlkey eks = do
|
||||||
-- Make sure to pick a backend that is cryptographically
|
b <- hashBackend
|
||||||
-- secure.
|
ifM (recordVurlKey b dest key eks)
|
||||||
db <- defaultBackend
|
( return (Just Verified)
|
||||||
let b = if isCryptographicallySecure db
|
, return Nothing
|
||||||
then db
|
)
|
||||||
else defaultHashBackend
|
|
||||||
generateEquivilantKey b dest >>= \case
|
|
||||||
Nothing -> return Nothing
|
|
||||||
Just ek -> do
|
|
||||||
unless (ek `elem` eks) $
|
|
||||||
setEquivilantKey key ek
|
|
||||||
return (Just Verified)
|
|
||||||
|
|
||||||
uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
|
uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
|
||||||
uploadKey _ _ _ _ = giveup "upload to web not supported"
|
uploadKey _ _ _ _ = giveup "upload to web not supported"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue