fsck distribution key

This commit is contained in:
Joey Hess 2013-11-23 21:58:39 -04:00
parent b429ea0cea
commit e563c7e6f4
3 changed files with 34 additions and 7 deletions

View file

@ -12,9 +12,14 @@ import Assistant.Restart
import qualified Annex
import Assistant.Alert
import Assistant.DaemonStatus
import Utility.Url
import Utility.Env
import Types.Distribution
import Logs.Transfer
import Logs.Web
import Annex.Content
import qualified Backend
import qualified Types.Backend
import qualified Types.Key
{- Upgrade without interaction in the webapp. -}
unattendedUpgrade :: Assistant ()
@ -40,3 +45,29 @@ checkSuccessfulUpgrade = isJust <$> getEnv upgradedEnv
upgradedEnv :: String
upgradedEnv = "GIT_ANNEX_UPGRADED"
{- Fsck the key to verify the download. -}
distributionDownloadComplete :: GitAnnexDistribution -> Transfer -> Assistant ()
distributionDownloadComplete d t
| transferDirection t == Download = do
maybe noop upgradeToDistribution
=<< liftAnnex (withObjectLoc k fsckit (getM fsckit))
liftAnnex $ setUrlMissing k (distributionUrl d)
| otherwise = noop
where
k = distributionKey d
fsckit f = case Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of
Nothing -> return $ Just f
Just b -> case Types.Backend.fsckKey b of
Nothing -> return $ Just f
Just a -> ifM (a k f)
( return $ Just f
, do
-- unlikely to resume a bad
-- download from web
liftIO $ nukeFile f
return Nothing
)
upgradeToDistribution :: FilePath -> Assistant ()
upgradeToDistribution f = error "TODO"