record VURL key hashes in addcomputed and recompute
This commit is contained in:
parent
2bd64059f1
commit
63d73d8d1b
4 changed files with 14 additions and 9 deletions
|
@ -19,8 +19,10 @@ import Annex.CatFile
|
||||||
import Annex.Content.Presence
|
import Annex.Content.Presence
|
||||||
import Annex.Ingest
|
import Annex.Ingest
|
||||||
import Types.KeySource
|
import Types.KeySource
|
||||||
|
import Types.Key
|
||||||
import Messages.Progress
|
import Messages.Progress
|
||||||
import Logs.Location
|
import Logs.Location
|
||||||
|
import Logs.EquivilantKeys
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Backend.URL (fromUrl)
|
import Backend.URL (fromUrl)
|
||||||
|
|
||||||
|
@ -174,6 +176,10 @@ addComputed addaction stagefiles r reproducibleconfig choosebackend destfile fas
|
||||||
Nothing -> giveup "ingestion failed"
|
Nothing -> giveup "ingestion failed"
|
||||||
Just k -> do
|
Just k -> do
|
||||||
logStatus NoLiveUpdate k InfoPresent
|
logStatus NoLiveUpdate k InfoPresent
|
||||||
|
when (fromKey keyVariety k == VURLKey) $ do
|
||||||
|
hb <- hashBackend
|
||||||
|
void $ addEquivilantKey hb k
|
||||||
|
=<< calcRepo (gitAnnexLocation k)
|
||||||
return k
|
return k
|
||||||
|
|
||||||
ldc = LockDownConfig
|
ldc = LockDownConfig
|
||||||
|
|
|
@ -11,6 +11,7 @@ module Logs.EquivilantKeys (
|
||||||
getEquivilantKeys,
|
getEquivilantKeys,
|
||||||
setEquivilantKey,
|
setEquivilantKey,
|
||||||
updateEquivilantKeys,
|
updateEquivilantKeys,
|
||||||
|
addEquivilantKey,
|
||||||
generateEquivilantKey,
|
generateEquivilantKey,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -37,8 +38,6 @@ setEquivilantKey key equivkey = do
|
||||||
addLog (Annex.Branch.RegardingUUID []) (equivilantKeysLogFile config key)
|
addLog (Annex.Branch.RegardingUUID []) (equivilantKeysLogFile config key)
|
||||||
InfoPresent (LogInfo (serializeKey' equivkey))
|
InfoPresent (LogInfo (serializeKey' equivkey))
|
||||||
|
|
||||||
-- The Backend must use a cryptographically secure hash.
|
|
||||||
--
|
|
||||||
-- This returns Verified when when an equivilant key has been added to the
|
-- This returns Verified when when an equivilant key has been added to the
|
||||||
-- log (or was already in the log). This is to avoid hashing the object
|
-- log (or was already in the log). This is to avoid hashing the object
|
||||||
-- again later.
|
-- again later.
|
||||||
|
@ -50,6 +49,12 @@ updateEquivilantKeys b obj key eks = generateEquivilantKey b obj >>= \case
|
||||||
setEquivilantKey key ek
|
setEquivilantKey key ek
|
||||||
return (Just Verified)
|
return (Just Verified)
|
||||||
|
|
||||||
|
addEquivilantKey :: Backend -> Key -> OsPath -> Annex (Maybe Verification)
|
||||||
|
addEquivilantKey b key obj =
|
||||||
|
updateEquivilantKeys b obj key
|
||||||
|
=<< getEquivilantKeys key
|
||||||
|
|
||||||
|
-- The Backend must use a cryptographically secure hash.
|
||||||
generateEquivilantKey :: Backend -> OsPath -> Annex (Maybe Key)
|
generateEquivilantKey :: Backend -> OsPath -> Annex (Maybe Key)
|
||||||
generateEquivilantKey b obj =
|
generateEquivilantKey b obj =
|
||||||
case genKey b of
|
case genKey b of
|
||||||
|
|
|
@ -482,10 +482,7 @@ computeKey rs (ComputeProgram program) k _af dest p vc =
|
||||||
hb <- hashBackend
|
hb <- hashBackend
|
||||||
let updatevurl key getobj =
|
let updatevurl key getobj =
|
||||||
if (fromKey keyVariety key == VURLKey)
|
if (fromKey keyVariety key == VURLKey)
|
||||||
then do
|
then addEquivilantKey hb key =<< getobj
|
||||||
obj <- getobj
|
|
||||||
updateEquivilantKeys hb obj key
|
|
||||||
=<< getEquivilantKeys key
|
|
||||||
else return Nothing
|
else return Nothing
|
||||||
|
|
||||||
let keyfile' = tmpdir </> keyfile
|
let keyfile' = tmpdir </> keyfile
|
||||||
|
|
|
@ -1,6 +1,3 @@
|
||||||
* VURL keys don't currently have the hash key recorded in the equivilant
|
|
||||||
key log by addcompute
|
|
||||||
|
|
||||||
* need progress bars for computations and implement PROGRESS message
|
* need progress bars for computations and implement PROGRESS message
|
||||||
|
|
||||||
* get input files for a computation (so `git-annex get .` gets every file,
|
* get input files for a computation (so `git-annex get .` gets every file,
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue