add SetupStage parameter to RemoteType.setup

Most remotes have an idempotent setup that can be reused for
enableremote, but in a few cases, it needs to tell which, and whether
a UUID was provided to setup was used.

This is groundwork for making initremote be able to provide a UUID.
It should not change any behavior.

Note that it would be nice to make the UUID always be provided to setup,
and make setup not need to generate and return a UUID. What prevented
this simplification is Remote.Git.gitSetup, which needs to reuse the
UUID of the git remote when setting it up, and so has to return that
UUID.

This commit was sponsored by Thom May on Patreon.

12 files changed, 37 insertions, 34 deletions

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 75b379558..9bdb22edd 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -90,8 +90,8 @@ gen r u c gc = do
 		{ chunkConfig = NoChunks
 		}
 
-bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-bupSetup mu _ c gc = do
+bupSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+bupSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index dcb16f5dd..603eccd5e 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -82,8 +82,8 @@ gen r u c gc = do
 		{ chunkConfig = NoChunks
 		}
 
-ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-ddarSetup mu _ c gc = do
+ddarSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+ddarSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 248e5d49f..2452c42e2 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -77,8 +77,8 @@ gen r u c gc = do
   where
 	dir = fromMaybe (giveup "missing directory") $ remoteAnnexDirectory gc
 
-directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-directorySetup mu _ c gc = do
+directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+directorySetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let dir = fromMaybe (giveup "Specify directory=") $
diff --git a/Remote/External.hs b/Remote/External.hs
index 7091a657c..b66e102a4 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -109,8 +109,8 @@ gen r u c gc
 			rmt
 	externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc)
 
-externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-externalSetup mu _ c gc = do
+externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+externalSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	let externaltype = fromMaybe (giveup "Specify externaltype=") $
 		M.lookup "externaltype" c
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 78ab6ed79..78b1eed3c 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -169,8 +169,8 @@ noCrypto = giveup "cannot use gcrypt remote without encryption enabled"
 unsupportedUrl :: a
 unsupportedUrl = giveup "using non-ssh remote repo url with gcrypt is not supported"
 
-gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c
+gCryptSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c
   where
 	remotename = fromJust (M.lookup "name" c)
 	go Nothing = giveup "Specify gitrepo="
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 5eb6fbc9e..a0b590654 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -96,8 +96,8 @@ list autoinit = do
  - No attempt is made to make the remote be accessible via ssh key setup,
  - etc.
  -}
-gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-gitSetup Nothing _ c _ = do
+gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+gitSetup Init mu _ c _ = do
 	let location = fromMaybe (giveup "Specify location=url") $
 		Url.parseURIRelaxed =<< M.lookup "location" c
 	g <- Annex.gitRepo
@@ -105,8 +105,10 @@ gitSetup Nothing _ c _ = do
 		[r] -> getRepoUUID r
 		[] -> giveup "could not find existing git remote with specified location"
 		_ -> giveup "found multiple git remotes with specified location"
-	return (c, u)
-gitSetup (Just u) _ c _ = do
+	if isNothing mu || mu == Just u
+		then return (c, u)
+		else error "git remote did not have specified uuid"
+gitSetup Enable (Just u) _ c _ = do
 	inRepo $ Git.Command.run
 		[ Param "remote"
 		, Param "add"
@@ -114,6 +116,7 @@ gitSetup (Just u) _ c _ = do
 		, Param $ fromMaybe (giveup "no location") (M.lookup "location" c)
 		]
 	return (c, u)
+gitSetup Enable Nothing _ _ _ = error "unable to enable git remote with no specified uuid"
 
 {- It's assumed to be cheap to read the config of non-URL remotes, so this is
  - done each time git-annex is run in a way that uses remotes.
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 77a907b97..c2f9bcf12 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -78,16 +78,16 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 		{ chunkConfig = NoChunks
 		}
 
-glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-glacierSetup mu mcreds c gc = do
+glacierSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+glacierSetup ss mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	glacierSetup' (isJust mu) u mcreds c gc
-glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-glacierSetup' enabling u mcreds c gc = do
+	glacierSetup' ss u mcreds c gc
+glacierSetup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+glacierSetup' ss u mcreds c gc = do
 	(c', encsetup) <- encryptionSetup c gc
 	c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 	let fullconfig = c'' `M.union` defaults
-	unless enabling $
+	when (ss == Init) $
 		genVault fullconfig gc u
 	gitConfigSpecialRemote u fullconfig "glacier" "true"
 	return (fullconfig, u)
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 6abffe117..0ebbf9139 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -70,8 +70,8 @@ gen r u c gc = do
   where
 	hooktype = fromMaybe (giveup "missing hooktype") $ remoteAnnexHookType gc
 
-hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-hookSetup mu _ c gc = do
+hookSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+hookSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	let hooktype = fromMaybe (giveup "Specify hooktype=") $
 		M.lookup "hooktype" c
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 22ef0b2cf..dbaf2acc9 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -137,8 +137,8 @@ rsyncTransport gc url
 	loginopt = maybe [] (\l -> ["-l",l]) login
 	fromNull as xs = if null xs then as else xs
 
-rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-rsyncSetup mu _ c gc = do
+rsyncSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+rsyncSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let url = fromMaybe (giveup "Specify rsyncurl=") $
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 43d07230e..341b66d1a 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -106,12 +106,12 @@ gen r u c gc = do
 			, checkUrl = Nothing
 			}
 
-s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-s3Setup mu mcreds c gc = do
+s3Setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+s3Setup ss mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	s3Setup' (isNothing mu) u mcreds c gc
-s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-s3Setup' new u mcreds c gc
+	s3Setup' ss u mcreds c gc
+s3Setup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+s3Setup' ss u mcreds c gc
 	| configIA c = archiveorg
 	| otherwise = defaulthost
   where
@@ -133,7 +133,7 @@ s3Setup' new u mcreds c gc
 		(c', encsetup) <- encryptionSetup c gc
 		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
-		when new $
+		when (ss == Init) $
 			genBucket fullconfig gc u
 		use fullconfig
 
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index c29cfb438..e4686f2f2 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -91,8 +91,8 @@ gen r u c gc = do
 		, checkUrl = Nothing
 		}
 
-tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-tahoeSetup mu _ c _ = do
+tahoeSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+tahoeSetup _ mu _ c _ = do
 	furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c)
 		<$> liftIO (getEnv "TAHOE_FURL")
 	u <- maybe (liftIO genUUID) return mu
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 14947f1e9..2c4d24c35 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -86,8 +86,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			}
 		chunkconfig = getChunkConfig c
 
-webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-webdavSetup mu mcreds c gc = do
+webdavSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+webdavSetup _ mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	url <- case M.lookup "url" c of
 		Nothing -> giveup "Specify url="