23a485498f
It would be difficult to make Annex.Branch.files query the unmerged
git-annex branches. Might be possible, similar to what was discussed in
7f6b2ca49c but again I decided to make it
not do anything in that situation to start with before adding such a
complicated thing.
git-annex info uses it when getting info about a repostory. The choices
were to make that fail with an error, or display the info it can, and
change the output slightly for the bits of info it cannot access. While
that is a behavior change, and I want to avoid any behavior changes due
to unmerged git-annex branches in a read-only repo, displaying a message
that is not a number seems unlikely to break anything that was consuming
a number, any worse than throwing an exception would. Probably.
Also git-annex unused --from origin is made to throw an error, but
it would fail later anyway when trying to write to the unused log files.
Sponsored-by: Dartmouth College's Datalad project
89 lines
2.7 KiB
Haskell
89 lines
2.7 KiB
Haskell
{- git-annex assistant remote deletion utilities
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Assistant.DeleteRemote where
|
|
|
|
import Assistant.Common
|
|
import Assistant.Types.UrlRenderer
|
|
import Assistant.TransferQueue
|
|
import Types.Transfer
|
|
import Logs.Location
|
|
import Assistant.DaemonStatus
|
|
import qualified Remote
|
|
import Remote.List.Util
|
|
import qualified Git.Remote.Remove
|
|
import Logs.Trust
|
|
import qualified Annex
|
|
|
|
#ifdef WITH_WEBAPP
|
|
import Assistant.WebApp.Types
|
|
import Assistant.Alert
|
|
import qualified Data.Text as T
|
|
#endif
|
|
|
|
{- Removes a remote (but leave the repository as-is), and returns the old
|
|
- Remote data. -}
|
|
disableRemote :: UUID -> Assistant Remote
|
|
disableRemote uuid = do
|
|
remote <- fromMaybe (error "unknown remote")
|
|
<$> liftAnnex (Remote.remoteFromUUID uuid)
|
|
liftAnnex $ do
|
|
inRepo $ Git.Remote.Remove.remove (Remote.name remote)
|
|
remotesChanged
|
|
updateSyncRemotes
|
|
return remote
|
|
|
|
{- Removes a remote, marking it dead .-}
|
|
removeRemote :: UUID -> Assistant Remote
|
|
removeRemote uuid = do
|
|
liftAnnex $ trustSet uuid DeadTrusted
|
|
disableRemote uuid
|
|
|
|
{- Called when a Remote is probably empty, to remove it.
|
|
-
|
|
- This does one last check for any objects remaining in the Remote,
|
|
- and if there are any, queues Downloads of them, and defers removing
|
|
- the remote for later. This is to catch any objects not referred to
|
|
- in keys in the current branch.
|
|
-}
|
|
removableRemote :: UrlRenderer -> UUID -> Assistant ()
|
|
removableRemote urlrenderer uuid = getkeys >>= \case
|
|
Just keys
|
|
| null keys -> finishRemovingRemote urlrenderer uuid
|
|
| otherwise -> do
|
|
r <- fromMaybe (error "unknown remote")
|
|
<$> liftAnnex (Remote.remoteFromUUID uuid)
|
|
mapM_ (queueremaining r) keys
|
|
Nothing -> noop
|
|
where
|
|
queueremaining r k =
|
|
queueTransferWhenSmall "remaining object in unwanted remote"
|
|
(AssociatedFile Nothing) (Transfer Download uuid (fromKey id k)) r
|
|
{- Scanning for keys can take a long time; do not tie up
|
|
- the Annex monad while doing it, so other threads continue to
|
|
- run. -}
|
|
getkeys = do
|
|
a <- liftAnnex $ Annex.withCurrentState $ loggedKeysFor uuid
|
|
liftIO a
|
|
|
|
{- With the webapp, this asks the user to click on a button to finish
|
|
- removing the remote.
|
|
-
|
|
- Without the webapp, just do the removal now.
|
|
-}
|
|
finishRemovingRemote :: UrlRenderer -> UUID -> Assistant ()
|
|
#ifdef WITH_WEBAPP
|
|
finishRemovingRemote urlrenderer uuid = do
|
|
desc <- liftAnnex $ Remote.prettyUUID uuid
|
|
button <- mkAlertButton True (T.pack "Finish deletion process") urlrenderer $
|
|
FinishDeleteRepositoryR uuid
|
|
void $ addAlert $ remoteRemovalAlert desc button
|
|
#else
|
|
finishRemovingRemote _ uuid = void $ removeRemote uuid
|
|
#endif
|