prep for enabling remotre gcrypt repos in webapp

Assistant/WebApp/Configurators/Ssh.hs

@@ -131,6 +131,13 @@ postAddSshR = sshConfigurator $ do
 sshTestModal :: Widget
 sshTestModal = $(widgetFile "configurators/ssh/testmodal")
 
+{- This only handles gcrypt repositories that are located on ssh servers;
+ - ones on local drives are handled via another part of the UI. -}
+getEnableGCryptR :: UUID -> Handler Html
+getEnableGCryptR = postEnableGCryptR
+postEnableGCryptR :: UUID -> Handler Html
+postEnableGCryptR u = error "TODO"
+
 {- To enable an existing rsync special remote, parse the SshInput from
  - its rsyncurl, and display a form whose only real purpose is to check
  - if ssh public keys need to be set up. From there, we can proceed with

Assistant/WebApp/RepoList.hs

@@ -24,6 +24,7 @@ import Logs.Trust
 import Logs.Group
 import Config
 import Git.Config
+import Git.Remote
 import Assistant.Sync
 import Config.Cost
 import qualified Git
@@ -156,8 +157,9 @@ repoList reposelector
 				else return l
 	unconfigured = liftAnnex $ do
 		m <- readRemoteLog
+		g <- gitRepo
 		map snd . catMaybes . filter selectedremote 
-			. map (findinfo m)
+			. map (findinfo m g)
 			<$> (trustExclude DeadTrusted $ M.keys m)
 	selectedrepo r
 		| Remote.readonly r = False
@@ -167,7 +169,7 @@ repoList reposelector
 	selectedremote (Just (iscloud, _))
 		| onlyCloud reposelector = iscloud
 		| otherwise = True
-	findinfo m u = case M.lookup "type" =<< M.lookup u m of
+	findinfo m g u = case getconfig "type" of
 		Just "rsync" -> val True EnableRsyncR
 		Just "directory" -> val False EnableDirectoryR
 #ifdef WITH_S3
@@ -177,8 +179,16 @@ repoList reposelector
 #ifdef WITH_WEBDAV
 		Just "webdav" -> val True EnableWebDAVR
 #endif
+		Just "gcrypt" ->
+			-- Skip gcrypt repos on removable drives;
+			-- handled separately.
+			case getconfig "gitrepo" of
+				Just rr	| remoteLocationIsUrl (parseRemoteLocation rr g) ->
+					val True EnableGCryptR
+				_ -> Nothing
 		_ -> 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 (\x y -> fst x == fst y) l

Assistant/WebApp/routes

@@ -65,6 +65,7 @@
 /config/repository/pair/xmpp/friend/finish/#PairKey FinishXMPPPairFriendR GET
 
 /config/repository/enable/rsync/#UUID EnableRsyncR GET POST
+/config/repository/enable/gcrypt/#UUID EnableGCryptR GET POST
 /config/repository/enable/directory/#UUID EnableDirectoryR GET
 /config/repository/enable/S3/#UUID EnableS3R GET POST
 /config/repository/enable/IA/#UUID EnableIAR GET POST