webapp: Improve UI around remote that have no annex.uuid set, either because setup of them is incomplete, or because the remote git repository is not a git-annex repository.

Complicated by such repositories potentially being repos that should have
an annex.uuid, but it failed to be gotten, perhaps due to the past ssh repo
setup bugs. This is handled now by an Upgrade Repository button.

Assistant/MakeRemote.hs

@@ -20,6 +20,7 @@ import qualified Command.InitRemote
 import Logs.UUID
 import Logs.Remote
 import Git.Remote
+import Git.Types (RemoteName)
 import Creds
 import Assistant.Gpg
 import Utility.Gpg (KeyId)

Assistant/WebApp/Common.hs

@@ -12,6 +12,7 @@ import Assistant.WebApp as X
 import Assistant.WebApp.Page as X
 import Assistant.WebApp.Form as X
 import Assistant.WebApp.Types as X
+import Assistant.WebApp.RepoId as X
 import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)
 
 import Data.Text as X (Text)

Assistant/WebApp/Configurators/AWS.hs

@@ -23,7 +23,7 @@ import Types.Remote (RemoteConfig)
 import Types.StandardGroups
 import Creds
 import Assistant.Gpg
-import Git.Remote
+import Git.Types (RemoteName)
 
 import qualified Data.Text as T
 import qualified Data.Map as M

Assistant/WebApp/Configurators/Edit.hs

@@ -38,6 +38,8 @@ import Remote.Helper.Encryptable (extractCipher)
 import Types.Crypto
 import Utility.Gpg
 import Annex.UUID
+import Assistant.Ssh
+import Config
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -158,26 +160,26 @@ editRepositoryAForm ishere def = RepoConfig
 		Nothing -> aopt hiddenField "" Nothing
 		Just d -> aopt textField "Associated directory" (Just $ Just d)
 
-getEditRepositoryR :: UUID -> Handler Html
+getEditRepositoryR :: RepoId -> Handler Html
 getEditRepositoryR = postEditRepositoryR
 
-postEditRepositoryR :: UUID -> Handler Html
+postEditRepositoryR :: RepoId -> Handler Html
 postEditRepositoryR = editForm False
 
 getEditNewRepositoryR :: UUID -> Handler Html
 getEditNewRepositoryR = postEditNewRepositoryR
 
 postEditNewRepositoryR :: UUID -> Handler Html
-postEditNewRepositoryR = editForm True
+postEditNewRepositoryR = editForm True . RepoUUID
 
 getEditNewCloudRepositoryR :: UUID -> Handler Html
 getEditNewCloudRepositoryR = postEditNewCloudRepositoryR
 
 postEditNewCloudRepositoryR :: UUID -> Handler Html
-postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
+postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True (RepoUUID uuid)
 
-editForm :: Bool -> UUID -> Handler Html
-editForm new uuid = page "Edit repository" (Just Configuration) $ do
+editForm :: Bool -> RepoId -> Handler Html
+editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
 	mremote <- liftAnnex $ Remote.remoteFromUUID uuid
 	when (mremote == Nothing) $
 		whenM ((/=) uuid <$> liftAnnex getUUID) $
@@ -196,7 +198,13 @@ editForm new uuid = page "Edit repository" (Just Configuration) $ do
 			config <- liftAnnex $ M.lookup uuid <$> readRemoteLog
 			let repoInfo = getRepoInfo mremote config
 			let repoEncryption = getRepoEncryption mremote config
-			$(widgetFile "configurators/editrepository")
+			$(widgetFile "configurators/edit/repository")
+editForm new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
+	mr <- liftAnnex (repoIdRemote r)
+	let repoInfo = getRepoInfo mr Nothing
+	g <- liftAnnex gitRepo
+	let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation . Remote.repo) mr
+	$(widgetFile "configurators/edit/nonannexremote")
 
 {- Makes any directory associated with the repository. -}
 checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex ()
@@ -245,3 +253,17 @@ encrypted using gpg key:
       ^{gpgKeyDisplay k (M.lookup k knownkeys)}
 |]
 getRepoEncryption _ _ = return () -- local repo
+
+getUpgradeRepositoryR  :: RepoId -> Handler ()
+getUpgradeRepositoryR (RepoUUID _) = redirect DashboardR
+getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)
+  where
+  	go Nothing = redirect DashboardR
+	go (Just rmt) = do
+		liftIO fixSshKeyPair
+		liftAnnex $ setConfig 
+			(remoteConfig (Remote.repo rmt) "ignore")
+			(Git.Config.boolConfig False)
+		liftAssistant $ syncRemote rmt
+		liftAnnex $ void Remote.remoteListRefresh
+		redirect DashboardR

Assistant/WebApp/Configurators/Local.hs

@@ -200,7 +200,7 @@ getCombineRepositoryR :: FilePath -> UUID -> Handler Html
 getCombineRepositoryR newrepopath newrepouuid = do
 	r <- combineRepos newrepopath remotename
 	liftAssistant $ syncRemote r
-	redirect $ EditRepositoryR newrepouuid
+	redirect $ EditRepositoryR $ RepoUUID newrepouuid
   where
 	remotename = takeFileName newrepopath
 

Assistant/WebApp/Configurators/Ssh.hs

@@ -20,7 +20,7 @@ import Types.StandardGroups
 import Utility.UserInfo
 import Utility.Gpg
 import Types.Remote (RemoteConfig)
-import Git.Remote
+import Git.Types (RemoteName)
 import qualified Remote.GCrypt as GCrypt
 import Annex.UUID
 import Logs.UUID

Assistant/WebApp/Configurators/WebDAV.hs

@@ -18,7 +18,7 @@ import qualified Remote
 import Types.Remote (RemoteConfig)
 import Types.StandardGroups
 import Logs.Remote
-import Git.Remote
+import Git.Types (RemoteName)
 
 import qualified Data.Map as M
 #endif

Assistant/WebApp/Gpg.hs

@@ -18,6 +18,7 @@ import qualified Git.Construct
 import qualified Annex.Branch
 import qualified Git.GCrypt
 import qualified Remote.GCrypt as GCrypt
+import Git.Types (RemoteName)
 import Assistant.WebApp.MakeRemote
 import Logs.Remote
 
@@ -63,7 +64,7 @@ withNewSecretKey use = do
  - branch from the gcrypt remote and merges it in, and then looks up
  - the name.
  -}
-getGCryptRemoteName :: UUID -> String -> Annex Git.Remote.RemoteName
+getGCryptRemoteName :: UUID -> String -> Annex RemoteName
 getGCryptRemoteName u repoloc = do
 	tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> gitRepo
 	void $ inRepo $ Git.Command.runBool

Assistant/WebApp/MakeRemote.hs

@@ -17,7 +17,7 @@ import qualified Remote
 import qualified Config
 import Config.Cost
 import Types.StandardGroups
-import Git.Remote
+import Git.Types (RemoteName)
 import Logs.PreferredContent
 import Assistant.MakeRemote
 

Assistant/WebApp/RepoId.hs

@@ -0,0 +1,40 @@
+{- git-annex assistant webapp RepoId type
+ -
+ - Copyright 2012,2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Assistant.WebApp.RepoId where
+
+import Common.Annex
+import Git.Types (RemoteName)
+import qualified Remote
+
+{- Parts of the webapp need to be able to act on repositories that may or
+ - may not have a UUID. -}
+data RepoId
+	= RepoUUID UUID
+	| RepoName RemoteName
+  deriving (Eq, Ord, Show, Read)
+
+mkRepoId :: Remote -> RepoId
+mkRepoId r = case Remote.uuid r of
+	NoUUID -> RepoName (Remote.name r)
+	u -> RepoUUID u
+
+
+describeRepoId :: RepoId -> Annex String
+describeRepoId (RepoUUID u) = Remote.prettyUUID u
+describeRepoId (RepoName n) = return n
+
+repoIdRemote :: RepoId -> Annex (Maybe Remote)
+repoIdRemote (RepoUUID u) = Remote.remoteFromUUID u
+repoIdRemote (RepoName n) = Remote.byNameOnly n
+
+lacksUUID :: RepoId -> Bool
+lacksUUID r = asUUID r == NoUUID
+
+asUUID :: RepoId -> UUID
+asUUID (RepoUUID u) = u
+asUUID _ = NoUUID

Assistant/WebApp/RepoList.hs

@@ -12,7 +12,6 @@ module Assistant.WebApp.RepoList where
 import Assistant.WebApp.Common
 import Assistant.DaemonStatus
 import Assistant.WebApp.Notifications
-import Assistant.Ssh
 import qualified Annex
 import qualified Remote
 import qualified Types.Remote as Remote
@@ -22,20 +21,22 @@ import Logs.Remote
 import Logs.Trust
 import Logs.Group
 import Config
-import Git.Config
 import Git.Remote
 import Assistant.Sync
 import Config.Cost
 import Utility.NotificationBroadcaster
 import qualified Git
-#ifdef WITH_XMPP
-#endif
 
 import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Function
 
+type RepoList = [(RepoDesc, RepoId, Actions)]
+
+type RepoDesc = String
+
+{- Actions that can be performed on a repo in the list. -}
 data Actions
 	= DisabledRepoActions
 		{ setupRepoLink :: Route WebApp }
@@ -50,21 +51,21 @@ data Actions
 	| UnwantedRepoActions
 		{ setupRepoLink :: Route WebApp }
 
-mkSyncingRepoActions :: UUID -> Actions
-mkSyncingRepoActions u = SyncingRepoActions
-	{ setupRepoLink = EditRepositoryR u
-	, syncToggleLink = DisableSyncR u
+mkSyncingRepoActions :: RepoId -> Actions
+mkSyncingRepoActions repoid = SyncingRepoActions
+	{ setupRepoLink = EditRepositoryR repoid
+	, syncToggleLink = DisableSyncR repoid
 	}
 
-mkNotSyncingRepoActions :: UUID -> Actions
-mkNotSyncingRepoActions u = NotSyncingRepoActions
-	{ setupRepoLink = EditRepositoryR u
-	, syncToggleLink = EnableSyncR u
+mkNotSyncingRepoActions :: RepoId -> Actions
+mkNotSyncingRepoActions repoid = NotSyncingRepoActions
+	{ setupRepoLink = EditRepositoryR repoid
+	, syncToggleLink = EnableSyncR repoid
 	}
 
-mkUnwantedRepoActions :: UUID -> Actions
-mkUnwantedRepoActions u = UnwantedRepoActions
-	{ setupRepoLink = EditRepositoryR u
+mkUnwantedRepoActions :: RepoId -> Actions
+mkUnwantedRepoActions repoid = UnwantedRepoActions
+	{ setupRepoLink = EditRepositoryR repoid
 	}
 
 needsEnabled :: Actions -> Bool
@@ -122,9 +123,6 @@ repoListDisplay reposelector = do
 	$(widgetFile "repolist")
   where
 	ident = "repolist"
-	unfinished uuid = uuid == NoUUID
-
-type RepoList = [(String, UUID, Actions)]
 
 {- A list of known repositories, with actions that can be taken on them. -}
 repoList :: RepoSelector -> Handler RepoList
@@ -133,27 +131,27 @@ repoList reposelector
 	| otherwise = list =<< (++) <$> configured <*> unconfigured
   where
 	configured = do
-		syncing <- S.fromList . map Remote.uuid . syncRemotes
-			<$> liftAssistant getDaemonStatus
+		syncremotes <- syncRemotes <$> liftAssistant getDaemonStatus
+		let syncing = S.fromList $ map mkRepoId syncremotes
 		liftAnnex $ do
 			unwanted <- S.fromList
-				<$> filterM inUnwantedGroup (S.toList syncing)
+				<$> filterM inUnwantedGroup (map Remote.uuid syncremotes)
 			rs <- filter selectedrepo . concat . Remote.byCost
 				<$> Remote.remoteList
-			let us = map Remote.uuid rs
-			let maker u
-				| u `S.member` unwanted = mkUnwantedRepoActions u
-				| u `S.member` syncing = mkSyncingRepoActions u
-				| otherwise = mkNotSyncingRepoActions u
-			let l = zip us $ map (maker . Remote.uuid) rs
+			let l = flip map (map mkRepoId rs) $ \r -> case r of
+				(RepoUUID u)
+					| u `S.member` unwanted -> (r, mkUnwantedRepoActions r)
+				_
+					| r `S.member` syncing -> (r, mkSyncingRepoActions r)
+					| otherwise -> (r, mkNotSyncingRepoActions r)
 			if includeHere reposelector
 				then do
-					u <- getUUID
+					r <- RepoUUID <$> getUUID
 					autocommit <- annexAutoCommit <$> Annex.getGitConfig
 					let hereactions = if autocommit
-						then mkSyncingRepoActions u
-						else mkNotSyncingRepoActions u
-					let here = (u, hereactions)
+						then mkSyncingRepoActions r
+						else mkNotSyncingRepoActions r
+					let here = (r, hereactions)
 					return $ here : l
 				else return l
 	unconfigured = liftAnnex $ do
@@ -164,7 +162,9 @@ repoList reposelector
 			<$> trustExclude DeadTrusted (M.keys m)
 	selectedrepo r
 		| Remote.readonly r = False
-		| onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r)
+		| onlyCloud reposelector = Git.repoIsUrl (Remote.repo r)
+			&& Remote.uuid r /= NoUUID 
+			&& not (isXMPPRemote r)
 		| otherwise = True
 	selectedremote Nothing = False
 	selectedremote (Just (iscloud, _))
@@ -190,23 +190,23 @@ repoList reposelector
 		_ -> Nothing
 	  where
 	  	getconfig k = M.lookup k =<< M.lookup u m
-		val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
-	list l = liftAnnex $ do
-		let l' = nubBy ((==) `on` fst) l
-		l'' <- zip
-			<$> Remote.prettyListUUIDs (map fst l')
-			<*> pure l'
-		return $ map (\(name, (uuid, actions)) -> (name, uuid, actions)) l''
+		val iscloud r = Just (iscloud, (RepoUUID u, DisabledRepoActions $ r u))
+	list l = liftAnnex $
+		forM (nubBy ((==) `on` fst) l) $ \(repoid, actions) ->
+			(,,)
+				<$> describeRepoId repoid
+				<*> pure repoid
+				<*> pure actions
 
-getEnableSyncR :: UUID -> Handler ()
+getEnableSyncR :: RepoId -> Handler ()
 getEnableSyncR = flipSync True
 
-getDisableSyncR :: UUID -> Handler ()
+getDisableSyncR :: RepoId -> Handler ()
 getDisableSyncR = flipSync False
 
-flipSync :: Bool -> UUID -> Handler ()
-flipSync enable uuid = do
-	mremote <- liftAnnex $ Remote.remoteFromUUID uuid
+flipSync :: Bool -> RepoId -> Handler ()
+flipSync enable repoid = do
+	mremote <- liftAnnex $ repoIdRemote repoid
 	liftAssistant $ changeSyncable mremote enable
 	redirectBack
 
@@ -238,29 +238,3 @@ reorderCosts remote rs = zip rs'' (insertCostAfter costs i)
 	costs = map Remote.cost rs'
 	rs'' = (\(x, y) -> x ++ [remote] ++ y) $ splitAt (i + 1) rs'
 
-{- Checks to see if any repositories with NoUUID have annex-ignore set.
- - That could happen if there's a problem contacting a ssh remote
- - soon after it was added. -}
-getCheckUnfinishedRepositoriesR :: Handler Html
-getCheckUnfinishedRepositoriesR = page "Unfinished repositories" (Just Configuration) $ do
-	stalled <- liftAnnex findStalled
-	$(widgetFile "configurators/checkunfinished")
-
-findStalled :: Annex [Remote]
-findStalled = filter isstalled <$> remoteListRefresh
-  where
-  	isstalled r = Remote.uuid r == NoUUID
-		&& remoteAnnexIgnore (Remote.gitconfig r)
-
-getRetryUnfinishedRepositoriesR :: Handler ()
-getRetryUnfinishedRepositoriesR = do
-	liftAssistant $ mapM_ unstall =<< liftAnnex findStalled
-	redirect DashboardR
-  where
-	unstall r = do
-		liftIO fixSshKeyPair
-		liftAnnex $ setConfig 
-			(remoteConfig (Remote.repo r) "ignore")
-			(boolConfig False)
-		syncRemote r
-		liftAnnex $ void remoteListRefresh

Assistant/WebApp/Types.hs

@@ -24,6 +24,7 @@ import Logs.Transfer
 import Utility.Gpg (KeyId)
 import Build.SysConfig (packageversion)
 import Types.ScheduledActivity
+import Assistant.WebApp.RepoId
 
 import Yesod.Static
 import Text.Hamlet
@@ -216,3 +217,7 @@ instance PathPiece ThreadName where
 instance PathPiece ScheduledActivity where
 	toPathPiece = pack . show
 	fromPathPiece = readish . unpack
+
+instance PathPiece RepoId where
+	toPathPiece = pack . show
+	fromPathPiece = readish . unpack

Assistant/WebApp/routes

@@ -29,13 +29,12 @@
 /config/repository/switcher RepositorySwitcherR GET
 /config/repository/switchto/#FilePath SwitchToRepositoryR GET
 /config/repository/combine/#FilePath/#UUID CombineRepositoryR GET
-/config/repository/edit/#UUID EditRepositoryR GET POST
+/config/repository/edit/#RepoId EditRepositoryR GET POST
 /config/repository/edit/new/#UUID EditNewRepositoryR GET POST
 /config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET POST
-/config/repository/sync/disable/#UUID DisableSyncR GET
-/config/repository/sync/enable/#UUID EnableSyncR GET
-/config/repository/unfinished/check CheckUnfinishedRepositoriesR GET
-/config/repository/unfinished/retry RetryUnfinishedRepositoriesR GET
+/config/repository/sync/disable/#RepoId DisableSyncR GET
+/config/repository/sync/enable/#RepoId EnableSyncR GET
+/config/repository/upgrade/#RepoId UpgradeRepositoryR GET
 
 /config/repository/add/drive AddDriveR GET POST
 /config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET