From 3f06c883f268cdfdb6b3d6531ff4074bec72b001 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 12 Oct 2012 12:45:16 -0400
Subject: [PATCH] hook up syncing toggles

Although I observe that these toggles don't always prevent syncing.
When a transfer scan is active, it will still queue items from the disabled
remote.

Also, transfers from a disabled remote show up as from "unknown", which is
not ideal.
---
 Assistant/WebApp/Configurators.hs      | 14 ++++++-----
 Assistant/WebApp/Configurators/Edit.hs | 32 +++++++-------------------
 Assistant/WebApp/Utility.hs            | 25 +++++++++++++++++---
 Remote.hs                              | 13 +++++++++++
 4 files changed, 51 insertions(+), 33 deletions(-)

diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs
index c097aaab96..dcfa7c4161 100644
--- a/Assistant/WebApp/Configurators.hs
+++ b/Assistant/WebApp/Configurators.hs
@@ -13,6 +13,7 @@ import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
+import Assistant.WebApp.Utility
 import Assistant.WebApp.Configurators.Local
 import Assistant.DaemonStatus
 import Utility.Yesod
@@ -129,13 +130,14 @@ repoList onlyconfigured includehere
 				<*> pure (map snd l')
 		counter = map show ([1..] :: [Int])
 
-
 getEnableSyncR :: UUID -> Handler ()
-getEnableSyncR uuid = do
-	error "TODO"
-	redirect RepositoriesR
+getEnableSyncR = flipSync True
 
 getDisableSyncR :: UUID -> Handler ()
-getDisableSyncR uuid = do
-	error "TODO"
+getDisableSyncR = flipSync False
+
+flipSync :: Bool -> UUID -> Handler ()
+flipSync enable uuid = do
+	mremote <- runAnnex undefined $ snd <$> Remote.repoFromUUID uuid
+	changeSyncable mremote enable
 	redirect RepositoriesR
diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs
index 7e47d9649d..14b3f5f56a 100644
--- a/Assistant/WebApp/Configurators/Edit.hs
+++ b/Assistant/WebApp/Configurators/Edit.hs
@@ -16,8 +16,6 @@ import Assistant.WebApp.SideBar
 import Assistant.WebApp.Utility
 import Utility.Yesod
 import qualified Remote
-import qualified Remote.List as Remote
-import qualified Types.Remote as Remote
 import Logs.UUID
 import Logs.Group
 import Logs.PreferredContent
@@ -54,7 +52,8 @@ getRepoConfig uuid r = RepoConfig
 				maybe (RepoGroupCustom $ unwords $ S.toList groups) RepoGroupStandard
 					(getStandardGroup groups)
 
-{- Returns Just False if syncing has been disabled, or Just True when enabled. -}
+{- Returns Just False if syncing should be disabled, Just True when enabled;
+ - Nothing when it is not changed. -}
 setRepoConfig :: UUID -> Git.Repo -> RepoConfig -> Annex (Maybe Bool)
 setRepoConfig uuid r c = do
 	describeUUID uuid $ T.unpack $ repoDescription c
@@ -65,14 +64,9 @@ setRepoConfig uuid r c = do
 		( return Nothing
 		, do
 			syncable <- Config.repoSyncable r
-			if (syncable /= repoSyncable c)
-				then do
-					let key = Config.remoteConfig r "sync"
-					Config.setConfig key $
-						if syncable then "false" else "true"
-					void $ Remote.remoteListRefresh
-					return $ Just $ repoSyncable c
-				else return Nothing
+			return $ if (syncable /= repoSyncable c)
+				then Just $ repoSyncable c
+				else Nothing
 		)
 
 editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
@@ -100,29 +94,19 @@ editForm new uuid = bootstrap (Just Config) $ do
 	sideBarDisplay
 	setTitle "Configure repository"
 
-	(repo, mremote) <- lift $ runAnnex undefined getrepo
+	(repo, mremote) <- lift $ runAnnex undefined $ Remote.repoFromUUID uuid
 	curr <- lift $ runAnnex undefined $ getRepoConfig uuid repo
 	((result, form), enctype) <- lift $
 		runFormGet $ renderBootstrap $ editRepositoryAForm curr
 	case result of
 		FormSuccess input -> lift $ do
-			r <- runAnnex undefined $
+			syncchanged <- runAnnex undefined $
 				setRepoConfig uuid repo input
-			maybe noop (uncurry changeSyncable) $
-				(,) <$> mremote <*> r
+			maybe noop (changeSyncable mremote) syncchanged
 			redirect RepositoriesR
 		_ -> showform form enctype curr
 	where
-		getrepo = ifM ((==) uuid <$> getUUID)
-			( (,) <$> gitRepo <*> pure Nothing
-			, do
-				remote <- fromMaybe (error "Unknown UUID") . M.lookup uuid
-					<$> Remote.remoteMap id
-				return (Remote.repo remote, Just remote)
-			)
 		showform form enctype curr = do
 			let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
 			let authtoken = webAppFormAuthToken
 			$(widgetFile "configurators/editrepository")
-
-
diff --git a/Assistant/WebApp/Utility.hs b/Assistant/WebApp/Utility.hs
index 21dd8711b5..4b040a5ec6 100644
--- a/Assistant/WebApp/Utility.hs
+++ b/Assistant/WebApp/Utility.hs
@@ -8,6 +8,7 @@
 module Assistant.WebApp.Utility where
 
 import Assistant.Common
+import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.DaemonStatus
 import Assistant.ThreadedMonad
@@ -15,9 +16,12 @@ import Assistant.TransferQueue
 import Assistant.TransferSlots
 import Assistant.Sync
 import qualified Remote
+import qualified Types.Remote as Remote
+import qualified Remote.List as Remote
 import qualified Assistant.Threads.Transferrer as Transferrer
 import Logs.Transfer
 import Locations.UserConfig
+import qualified Config
 
 import Yesod
 import qualified Data.Map as M
@@ -25,9 +29,14 @@ import Control.Concurrent
 import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)
 import System.Posix.Process (getProcessGroupIDOf)
 
-changeSyncable :: Remote -> Bool -> Handler ()
-changeSyncable r True = syncRemote r
-changeSyncable r False = do
+{- Use Nothing to change global sync setting. -}
+changeSyncable :: (Maybe Remote) -> Bool -> Handler ()
+changeSyncable Nothing _ = noop -- TODO
+changeSyncable (Just r) True = do
+	changeSyncFlag r True
+	syncRemote r
+changeSyncable (Just r) False = do
+	changeSyncFlag r False
 	webapp <- getYesod
 	let dstatus = daemonStatus webapp
 	let st = fromJust $ threadState webapp
@@ -41,6 +50,16 @@ changeSyncable r False = do
 	where
 		tofrom t = transferUUID t == Remote.uuid r
 
+changeSyncFlag :: Remote -> Bool -> Handler ()
+changeSyncFlag r enabled = runAnnex undefined $ do
+	Config.setConfig key value
+	void $ Remote.remoteListRefresh
+	where
+		key = Config.remoteConfig (Remote.repo r) "sync"
+		value
+			| enabled = "true"
+			| otherwise = "false"
+
 {- Start syncing remote, using a background thread. -}
 syncRemote :: Remote -> Handler ()
 syncRemote remote = do
diff --git a/Remote.hs b/Remote.hs
index b067fa7497..e1ff9e7d8f 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -27,6 +27,7 @@ module Remote (
 	byCost,
 	prettyPrintUUIDs,
 	prettyListUUIDs,
+	repoFromUUID,
 	remotesWithUUID,
 	remotesWithoutUUID,
 	keyLocations,
@@ -52,6 +53,7 @@ import Logs.UUID
 import Logs.Trust
 import Logs.Location
 import Remote.List
+import qualified Git
 
 {- Map from UUIDs of Remotes to a calculated value. -}
 remoteMap :: (Remote -> a) -> Annex (M.Map UUID a)
@@ -145,6 +147,17 @@ prettyListUUIDs uuids = do
 			where
 				n = finddescription m u
 
+{- Gets the git repo associated with a UUID.
+ - There's no associated remote when this is the UUID of the local repo. -}
+repoFromUUID :: UUID -> Annex (Git.Repo, Maybe Remote)
+repoFromUUID u = ifM ((==) u <$> getUUID)
+	( (,) <$> gitRepo <*> pure Nothing
+	, do
+		remote <- fromMaybe (error "Unknown UUID") . M.lookup u
+			<$> remoteMap id
+		return (repo remote, Just remote)
+	)
+
 {- Filters a list of remotes to ones that have the listed uuids. -}
 remotesWithUUID :: [Remote] -> [UUID] -> [Remote]
 remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs