git-lfs: remember urls, and autoenable remotes using known urls

* git-lfs: The url provided to initremote/enableremote will now be
  stored in the git-annex branch, allowing enableremote to be used without
  an url. initremote --sameas can be used to add additional urls.
* git-lfs: When there's a git remote with an url that's known to be
  used for git-lfs, automatically enable the special remote.

Annex/SpecialRemote.hs

@@ -34,21 +34,9 @@ findExisting name = do
 	t <- trustMap
 	headMaybe
 		. sortBy (comparing $ \(u, _, _) -> Down $ M.lookup u t)
-		. findByName name
+		. findByRemoteConfig (\c -> lookupName c == Just name)
 		<$> Logs.Remote.readRemoteLog
 
-findByName :: RemoteName ->  M.Map UUID RemoteConfig -> [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))]
-findByName n = map sameasuuid . filter (matching . snd) . M.toList
-  where
-	matching c = case lookupName c of
-		Nothing -> False
-		Just n'
-			| n' == n -> True
-			| otherwise -> False
-	sameasuuid (u, c) = case M.lookup sameasUUIDField c of
-		Nothing -> (u, c, Nothing)
-		Just u' -> (toUUID u', c, Just (ConfigFrom u))
-
 newConfig
 	:: RemoteName
 	-> Maybe (Sameas UUID)

Annex/SpecialRemote/Config.hs

@@ -101,3 +101,11 @@ removeSameasInherited :: RemoteConfig -> RemoteConfig
 removeSameasInherited c = case M.lookup sameasUUIDField c of
 	Nothing -> c
 	Just _ -> M.withoutKeys c sameasInherits
+
+{- Finds remote uuids with matching RemoteConfig. -}
+findByRemoteConfig :: (RemoteConfig -> Bool) -> M.Map UUID RemoteConfig -> [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))]
+findByRemoteConfig matching = map sameasuuid . filter (matching . snd) . M.toList
+  where
+	sameasuuid (u, c) = case M.lookup sameasUUIDField c of
+		Nothing -> (u, c, Nothing)
+		Just u' -> (toUUID u', c, Just (ConfigFrom u))

CHANGELOG

@@ -2,6 +2,11 @@ git-annex (7.20191115) UNRELEASED; urgency=medium
 
   * Stop displaying rsync progress, and use git-annex's own progress display
     for local-to-local repo transfers.
+  * git-lfs: The url provided to initremote/enableremote will now be
+    stored in the git-annex branch, allowing enableremote to be used without
+    an url. initremote --sameas can be used to add additional urls.
+  * git-lfs: When there's a git remote with an url that's known to be
+    used for git-lfs, automatically enable the special remote.
 
  -- Joey Hess <id@joeyh.name>  Fri, 15 Nov 2019 11:57:19 -0400
 

Git/Config.hs

@@ -94,6 +94,14 @@ store s repo = do
 		, fullconfig = M.unionWith (++) c (fullconfig repo)
 		}
 
+{- Stores a single config setting in a Repo, returning the new version of
+ - the Repo. Config settings can be updated incrementally. -}
+store' :: String -> String -> Repo -> Repo
+store' k v repo = repo
+	{ config = M.singleton k v `M.union` config repo
+	, fullconfig = M.unionWith (++) (M.singleton k [v]) (fullconfig repo)
+	}
+
 {- Updates the location of a repo, based on its configuration.
  -
  - Git.Construct makes LocalUknown repos, of which only a directory is

Git/Remote.hs

@@ -51,6 +51,7 @@ makeLegalName s = case filter legal $ replace "/" "_" s of
 	legal c = isAlphaNum c
 	
 data RemoteLocation = RemoteUrl String | RemotePath FilePath
+	deriving (Eq)
 
 remoteLocationIsUrl :: RemoteLocation -> Bool
 remoteLocationIsUrl (RemoteUrl _) = True

Remote/Git.hs

@@ -143,7 +143,9 @@ configRead autoinit r = do
 		(True, _, _)
 			| remoteAnnexCheckUUID gc -> tryGitConfigRead autoinit r
 			| otherwise -> return r
-		(False, _, NoUUID) -> tryGitConfigRead autoinit r
+		(False, _, NoUUID) -> configSpecialGitRemotes r >>= \case
+			Nothing -> tryGitConfigRead autoinit r
+			Just r' -> return r'
 		_ -> return r
 
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
@@ -231,7 +233,7 @@ repoAvail r
 tryGitConfigRead :: Bool -> Git.Repo -> Annex Git.Repo
 tryGitConfigRead autoinit r 
 	| haveconfig r = return r -- already read
-	| Git.repoIsSsh r = store $ do
+	| Git.repoIsSsh r = storeUpdatedRemote $ do
 		v <- Ssh.onRemote NoConsumeStdin r
 			(pipedconfig, return (Left $ giveup "configlist failed"))
 			"configlist" [] configlistfields
@@ -240,10 +242,10 @@ tryGitConfigRead autoinit r
 				| haveconfig r' -> return r'
 				| otherwise -> configlist_failed
 			Left _ -> configlist_failed
-	| Git.repoIsHttp r = store geturlconfig
+	| Git.repoIsHttp r = storeUpdatedRemote geturlconfig
 	| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid")
 	| Git.repoIsUrl r = return r
-	| otherwise = store $ liftIO $ 
+	| otherwise = storeUpdatedRemote $ liftIO $ 
 		readlocalannexconfig `catchNonAsync` (const $ return r)
   where
 	haveconfig = not . M.null . Git.config
@@ -278,18 +280,6 @@ tryGitConfigRead autoinit r
 				set_ignore "not usable by git-annex" False
 				return r
 
-	store = observe $ \r' -> do
-		l <- Annex.getGitRemotes
-		let rs = exchange l r'
-		Annex.changeState $ \s -> s { Annex.gitremotes = Just rs }
-
-	exchange [] _ = []
-	exchange (old:ls) new
-		| Git.remoteName old == Git.remoteName new =
-			new : exchange ls new
-		| otherwise =
-			old : exchange ls new
-
 	{- Is this remote just not available, or does
 	 - it not have git-annex-shell?
 	 - Find out by trying to fetch from the remote. -}
@@ -319,7 +309,7 @@ tryGitConfigRead autoinit r
 		g <- gitRepo
 		case Git.GCrypt.remoteRepoId g (Git.remoteName r) of
 			Nothing -> return r
-			Just v -> store $ liftIO $ setUUID r $
+			Just v -> storeUpdatedRemote $ liftIO $ setUUID r $
 				genUUIDInNameSpace gCryptNameSpace v
 
 	{- The local repo may not yet be initialized, so try to initialize
@@ -337,6 +327,31 @@ tryGitConfigRead autoinit r
 		then [(Fields.autoInit, "1")]
 		else []
 
+{- Handles special remotes that can be enabled by the presence of
+ - regular git remotes.
+ -
+ - When a remote repo is found to be such a special remote, its
+ - UUID is cached in the git config, and the repo returned with
+ - the UUID set.
+ -}
+configSpecialGitRemotes :: Git.Repo -> Annex (Maybe Git.Repo)
+configSpecialGitRemotes r = Remote.GitLFS.configKnownUrl r >>= \case
+	Nothing -> return Nothing
+	Just r' -> Just <$> storeUpdatedRemote (return r')
+
+storeUpdatedRemote :: Annex Git.Repo -> Annex Git.Repo
+storeUpdatedRemote = observe $ \r' -> do
+	l <- Annex.getGitRemotes
+	let rs = exchange l r'
+	Annex.changeState $ \s -> s { Annex.gitremotes = Just rs }
+  where
+	exchange [] _ = []
+	exchange (old:ls) new
+		| Git.remoteName old == Git.remoteName new =
+			new : exchange ls new
+		| otherwise =
+			old : exchange ls new
+
 {- Checks if a given remote has the content for a key in its annex. -}
 inAnnex :: Remote -> State -> Key -> Annex Bool
 inAnnex rmt st key = do

Remote/GitLFS.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Remote.GitLFS (remote, gen) where
+module Remote.GitLFS (remote, gen, configKnownUrl) where
 
 import Annex.Common
 import Types.Remote
@@ -13,9 +13,11 @@ import Annex.Url
 import Types.Key
 import Types.Creds
 import qualified Annex
+import qualified Annex.SpecialRemote.Config
 import qualified Git
 import qualified Git.Types as Git
 import qualified Git.Url
+import qualified Git.Remote
 import qualified Git.GCrypt
 import qualified Git.Credential as Git
 import Config
@@ -31,8 +33,10 @@ import Crypto
 import Backend.Hash
 import Utility.Hash
 import Utility.SshHost
+import Logs.Remote
 import Logs.RemoteState
 import qualified Utility.GitLFS as LFS
+import qualified Git.Config
 
 import Control.Concurrent.STM
 import Data.String
@@ -145,21 +149,46 @@ mySetup _ mu _ c gc = do
 				, "likely insecure configuration.)"
 				]
 
-	-- The url is not stored in the remote log, because the same
-	-- git-lfs repo can be accessed using different urls by different
-	-- people (eg over ssh or http).
-	--
-	-- Instead, set up remote.name.url to point to the repo,
+	-- Set up remote.name.url to point to the repo,
 	-- (so it's also usable by git as a non-special remote),
-	-- and set remote.name.git-lfs = true
-	let c'' = M.delete "url" c'
-	gitConfigSpecialRemote u c'' [("git-lfs", "true")]
+	-- and set remote.name.annex-git-lfs = true
+	gitConfigSpecialRemote u c' [("git-lfs", "true")]
 	setConfig (ConfigKey ("remote." ++ getRemoteName c ++ ".url")) url
-	return (c'', u)
+	return (c', u)
   where
 	url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)
 	remotename = fromJust (lookupName c)
 
+{- Check if a remote's url is one known to belong to a git-lfs repository.
+ - If so, set the necessary configuration to enable using the remote
+ - with git-lfs. -}
+configKnownUrl :: Git.Repo -> Annex (Maybe Git.Repo)
+configKnownUrl r
+	| Git.repoIsUrl r = do
+		l <- readRemoteLog
+		g <- Annex.gitRepo
+		case Annex.SpecialRemote.Config.findByRemoteConfig (match g) l of
+			((u, _, mcu):[]) -> Just <$> go u mcu
+			_ -> return Nothing
+	| otherwise = return Nothing
+  where
+	match g c = fromMaybe False $ do
+		t <- M.lookup Annex.SpecialRemote.Config.typeField c
+		u <- M.lookup "url" c
+		let u' = Git.Remote.parseRemoteLocation u g
+		return $ Git.Remote.RemoteUrl (Git.repoLocation r) == u' 
+			&& t == typename remote
+	go u mcu = do
+		r' <- set "uuid" (fromUUID u) =<< set "git-lfs" "true" r
+		case mcu of
+			Just (Annex.SpecialRemote.Config.ConfigFrom cu) ->
+				set "config-uuid" (fromUUID cu) r'
+			Nothing -> return r'
+	set k v r' = do
+		let ck@(ConfigKey k') = remoteConfig r' k
+		setConfig ck v
+		return $ Git.Config.store' k' v r'
+
 data LFSHandle = LFSHandle
 	{ downloadEndpoint :: Maybe LFS.Endpoint
 	, uploadEndpoint :: Maybe LFS.Endpoint

doc/tips/storing_data_in_git-lfs.mdwn

@@ -4,9 +4,11 @@ repositories, using the [[git-lfs special remote|special_remotes/git-lfs]].
 You do not need the git-lfs program installed to use it, just a recent
 enough version of git-annex.
 
+## getting started
+
 Here's how to initialize a git-lfs special remote on Github.
 
-	git annex initremote lfs type=git-lfs encryption=none url=git@github.com:yourname/yourrepo.git
+	git annex initremote lfs type=git-lfs encryption=none url=https://github.com/yourname/yourrepo
 
 In this example, the remote will not be encrypted, so anyone who can access
 it can see its contents. It is possible to encrypt everything stored in a
@@ -24,8 +26,44 @@ because the protocol does not support deletion.
 A git-lfs special remote also functions as a regular git remote. You can
 use things like `git push` and `git pull` with it.
 
-To enable an existing git-lfs remote in another clone of the repository,
-you'll need to provide an url to it again. It's ok to provide a different
-url as long as it points to the same git-lfs repository.
+## enabling existing git-lfs special remotes
 
-	git annex enableremote lfs url=https://github.com/yourname/yourrepo.git
+There are two different ways to enable a git-lfs special 
+remote in another clone of the repository.
+
+Of course, you can use `git annex enableremote` to enable a git-lfs special
+remote, the same as you would enable any other special remote.
+Eg, for the "lfs" remote initialized above:
+
+	git annex enableremote lfs
+
+But perhaps more simply, if git-annex sees a git remote that matches
+the url that was provided to initremote earlier, it will *automatically*
+enable that git remote as a git-lfs special remote.
+
+So you can just git clone from the url, and the "origin" remote will be
+automatically used as a git-lfs special remote.
+
+	git clone https://github.com/yourname/yourrepo
+	cd yourrepo
+	git-annex get --from origin
+
+Nice and simple, and much the same as git-annex handles its regular
+remotes.
+
+(Note that git-annex versions 7.20191115 and older didn't remember the url
+privided to initremote, so you'll need to pass the url= parameter
+to enableremote in that case. Newer versions of git-annex will then
+remember the url.)
+
+## multiple urls
+
+Often there are multiple urls that can access the same git repository.
+You can set up git-lfs remotes for each url. For example,
+to add a remote accessing the github repository over ssh:
+
+	git annex initremote lfs-http --sameas=lfs url=git@github.com:yourname/yourrepo.git
+
+The `--sameas` parameter tells git-annex that this is the same as the "lfs"
+repository, so it will understand that anything it stores in one remote can
+be accessed also with the other remote.

doc/todo/git-lfs_special_remote_simpler_setup.mdwn

@@ -19,5 +19,8 @@ obvious two or three. Now that `initremote --sameas` is available,
 special remotes can be initialized for all the urls. The user would need to
 do that themselves probably.
 
-[[!tag projects/dandi]]
+> [[done]], the url is stored, and when there's a remote that has an url
+> that's known to be to a git-lfs repo, that remote is automatically
+> enabled to be used as a git-lfs special remote. --[[Joey]]
 
+[[!tag projects/dandi]]