use types to enforce that removeAnnex can only be called inside lockContent

This fixed one bug where it needed to be and wasn't (in Assistant.Unused).
And also found one place where lockContent was used unnecessarily (by
drop --from remote).

A few other places like uninit probably don't really need to lockContent,
but it doesn't hurt to do call it anyway.

This commit was sponsored by David Wagner.
This commit is contained in:
Joey Hess 2014-08-20 20:08:45 -04:00
parent 9cb78e18ad
commit aebcc395ff
9 changed files with 35 additions and 31 deletions

View file

@ -55,8 +55,12 @@ startRemote afile numcopies key remote = do
showStart' ("drop " ++ Remote.name remote) key afile
next $ performRemote key afile numcopies remote
-- Note that lockContent is called before checking if the key is present
-- on enough remotes to allow removal. This avoids a scenario where two
-- or more remotes are trying to remove a key at the same time, and each
-- see the key is present on the other.
performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
performLocal key afile numcopies knownpresentremote = lockContent key $ do
performLocal key afile numcopies knownpresentremote = lockContent key $ \contentlock -> do
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
let trusteduuids' = case knownpresentremote of
Nothing -> trusteduuids
@ -66,7 +70,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do
u <- getUUID
ifM (canDrop u key afile numcopies trusteduuids' tocheck [])
( do
removeAnnex key
removeAnnex contentlock
notifyDrop afile True
next $ cleanupLocal key
, do
@ -75,7 +79,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do
)
performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> CommandPerform
performRemote key afile numcopies remote = lockContent key $ do
performRemote key afile numcopies remote = do
-- Filter the remote it's being dropped from out of the lists of
-- places assumed to have the key, and places to check.
-- When the local repo has the key, that's one additional copy,

View file

@ -28,8 +28,8 @@ start key = stopUnless (inAnnex key) $ do
next $ perform key
perform :: Key -> CommandPerform
perform key = lockContent key $ do
removeAnnex key
perform key = lockContent key $ \contentlock -> do
removeAnnex contentlock
next $ cleanup key
cleanup :: Key -> CommandCleanup

View file

@ -91,7 +91,7 @@ expectedPresent dest key = do
return $ dest `elem` remotes
toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
toPerform dest move key afile fastcheck isthere = moveLock move key $
toPerform dest move key afile fastcheck isthere = do
case isthere of
Left err -> do
showNote err
@ -115,8 +115,8 @@ toPerform dest move key afile fastcheck isthere = moveLock move key $
finish
where
finish
| move = do
removeAnnex key
| move = lockContent key $ \contentlock -> do
removeAnnex contentlock
next $ Command.Drop.cleanupLocal key
| otherwise = next $ return True
@ -164,10 +164,3 @@ fromPerform src move key afile = ifM (inAnnex key)
dispatch True True = do -- finish moving
ok <- Remote.removeKey src key
next $ Command.Drop.cleanupRemote key src ok
{- Locks a key in order for it to be moved away from the current repository.
- No lock is needed when a key is being copied, or moved to the current
- repository. -}
moveLock :: Bool -> Key -> Annex a -> Annex a
moveLock True key a = lockContent key a
moveLock False _ a = a

View file

@ -114,7 +114,7 @@ test st r k =
, check "storeKey when already present" store
, present True
, check "retrieveKeyFile" $ do
removeAnnex k
lockContent k removeAnnex
get
, check "fsck downloaded object" fsck
, check "retrieveKeyFile resume from 33%" $ do
@ -124,20 +124,20 @@ test st r k =
sz <- hFileSize h
L.hGet h $ fromInteger $ sz `div` 3
liftIO $ L.writeFile tmp partial
removeAnnex k
lockContent k removeAnnex
get
, check "fsck downloaded object" fsck
, check "retrieveKeyFile resume from 0" $ do
tmp <- prepTmp k
liftIO $ writeFile tmp ""
removeAnnex k
lockContent k removeAnnex
get
, check "fsck downloaded object" fsck
, check "retrieveKeyFile resume from end" $ do
loc <- Annex.calcRepo (gitAnnexLocation k)
tmp <- prepTmp k
void $ liftIO $ copyFileExternal loc tmp
removeAnnex k
lockContent k removeAnnex
get
, check "fsck downloaded object" fsck
, check "removeKey when present" remove
@ -183,7 +183,7 @@ testUnavailable st r k =
cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup
cleanup rs ks ok = do
forM_ rs $ \r -> forM_ ks (Remote.removeKey r)
forM_ ks removeAnnex
forM_ ks $ \k -> lockContent k removeAnnex
return ok
chunkSizes :: Int -> Bool -> [Int]

View file

@ -103,7 +103,7 @@ removeUnannexed = go []
go c [] = return c
go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks)
( do
removeAnnex k
lockContent k removeAnnex
go c ks
, go (k:c) ks
)