summaryrefslogtreecommitdiff
path: root/Assistant/DeleteRemote.hs
blob: de3d4124bded43916bfd70433db66e2d763f0de0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
{- git-annex assistant remote deletion utilities
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

{-# LANGUAGE CPP #-}

module Assistant.DeleteRemote where

import Assistant.Common
import Assistant.Types.UrlRenderer
import Assistant.TransferQueue
import Logs.Transfer
import Logs.Location
import Assistant.DaemonStatus
import qualified Remote
import Remote.List
import qualified Git.Command
import qualified Git.Version
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.Command.run
			[ Param "remote"
			-- name of this subcommand changed
			, Param $
				if Git.Version.older "1.8.0"
					then "rm"
					else "remove"
			, Param (Remote.name remote)
			]
		void $ remoteListRefresh
	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 = do
	keys <- getkeys
	if null keys
		then finishRemovingRemote urlrenderer uuid
		else do
			r <- fromMaybe (error "unknown remote")
				<$> liftAnnex (Remote.remoteFromUUID uuid)
			mapM_ (queueremaining r) keys
  where
  	queueremaining r k = 
		queueTransferWhenSmall "remaining object in unwanted remote"
			Nothing (Transfer Download uuid 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 (T.pack "Finish deletion process") urlrenderer $
		FinishDeleteRepositoryR uuid
	void $ addAlert $ remoteRemovalAlert desc button
#else
finishRemovingRemote _ uuid = void $ removeRemote uuid
#endif