packages feed

git-annex 7.20190730 → 7.20190819

raw patch · 42 files changed

+1360/−260 lines, 42 filesdep +silently

Dependencies added: silently

Files

Annex/DirHashes.hs view
@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.DirHashes (
Annex/FileMatcher.hs view
@@ -35,8 +35,10 @@ import Git.FilePath import Types.Remote (RemoteConfig) import Annex.CheckAttr-import Annex.Magic import Git.CheckAttr (unspecifiedAttr)+#ifdef WITH_MAGICMIME+import Annex.Magic+#endif  import Data.Either import qualified Data.Set as S
Annex/Hook.hs view
@@ -13,7 +13,6 @@  import Annex.Common import qualified Git.Hook as Git-import Config import qualified Annex import Utility.Shell @@ -57,11 +56,8 @@ 	]  hookWrite :: Git.Hook -> Annex ()-hookWrite h = -	-- cannot have git hooks in a crippled filesystem (no execute bit)-	unlessM crippledFileSystem $-		unlessM (inRepo $ Git.hookWrite h) $-			hookWarning h "already exists, not configuring"+hookWrite h = unlessM (inRepo $ Git.hookWrite h) $+	hookWarning h "already exists, not configuring"  hookUnWrite :: Git.Hook -> Annex () hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $
Annex/View.hs view
@@ -283,8 +283,12 @@  - MetaFields that were present in the input metadata  - (excluding fields that are not visible). -} prop_view_roundtrips :: FilePath -> MetaData -> Bool -> Bool-prop_view_roundtrips f metadata visible = null f || viewTooLarge view ||-	all hasfields (viewedFiles view viewedFileFromReference f metadata)+prop_view_roundtrips f metadata visible = or+	[ null f+	, null (takeFileName f) && null (takeDirectory f)+	, viewTooLarge view+	, all hasfields (viewedFiles view viewedFileFromReference f metadata)+	]   where 	view = View (Git.Ref "master") $ 		map (\(mf, mv) -> ViewComponent mf (FilterValues $ S.filter (not . B.null . fromMetaValue) mv) visible)
Annex/WorkTree.hs view
@@ -78,7 +78,7 @@  - an annex object. If so, make the unlocked file use that content.  -} scanUnlockedFiles :: Annex ()-scanUnlockedFiles = whenM (inRepo $ Git.Ref.exists Git.Ref.headRef) $ do+scanUnlockedFiles = whenM (inRepo Git.Ref.headExists) $ do 	showSideAction "scanning for unlocked files" 	Database.Keys.runWriter $ 		liftIO . Database.Keys.SQL.dropAllAssociatedFiles
Backend/Hash.hs view
@@ -10,6 +10,7 @@ module Backend.Hash ( 	backends, 	testKeyBackend,+	keyHash, ) where  import Annex.Common
Build/DesktopFile.hs view
@@ -22,10 +22,12 @@ import Assistant.Install.Menu  import System.Environment+#ifndef mingw32_HOST_OS  import System.PosixCompat.User import Data.Maybe import Control.Applicative import Prelude+#endif  systemwideInstall :: IO Bool #ifndef mingw32_HOST_OS 
CHANGELOG view
@@ -1,3 +1,43 @@+git-annex (7.20190819) upstream; urgency=medium++  * New git-lfs special remote, which can be used to store data on any git-lfs+    server, including github, gitlab, and gogs.+  * Support fully encrypting all data sent to a git-lfs special remote,+    using a combination of gcrypt to encrypt the git data, and git-annex's+    encryption of its data.+  * Use the same optimisation for --in=here as has always been+    used for --in=. rather than the slow code path that unncessarily+    queries the git-annex branch.+  * Allow setting up a gcrypt special remote with encryption=shared.+  * Fix querying git for object type when operating on a file containing+    newlines.+  * merge: When run with a branch parameter, merges from that branch.+    This is especially useful when using an adjusted branch, because+    it applies the same adjustment to the branch before merging it.+  * init: Install working hook scripts when run on a crippled filesystem+    and on Windows. If your repository was set up by an old version+    of git-annex that omitted the hooks, you can simply re-run git-annex init+    to install them.+  * init: When the repo is already initialized, and --version requests a+    different version, error out rather than silently not changing the+    version.+  * S3: Fix encoding when generating public urls of S3 objects.+  * Make git-annex-standalone.deb include the shell completions again.+  * Makefile: Changed default zsh completion location to zsh default fpath.+    Systems such as Debian that have overridden the default fpath will+    need to set ZSH_COMPLETIONS_PATH.+  * test: Add pass using adjusted unlocked branch.+  * Fix intermittent failure of the test suite, where its repeated opening+    and writing to the sqlite database somehow caused inode cache information+    to occasionally be lost.+  * Fix several test suite failures on Windows.+  * Windows installer: Always install to 64 bit program files directory,+    since it needs 64 bit git now.+  * Build with silently-1.2.5.1 on Windows; the old one used "NUL" device+    which is not supported with recent versions of ghc.++ -- Joey Hess <id@joeyh.name>  Mon, 19 Aug 2019 12:23:16 -0400+ git-annex (7.20190730) upstream; urgency=medium    * Improved probing when CoW copies can be made between files on the same
@@ -25,6 +25,10 @@            2013 Michael Snoyman License: Expat +Files: Utility/GitLFS.hs+Copyright: © 2019 Joey Hess <id@joeyh.name>+License: AGPL-3++ Files: Utility/* Copyright: 2012-2019 Joey Hess <id@joeyh.name> License: BSD-2-clause
Command/Init.hs view
@@ -51,6 +51,12 @@  perform :: InitOptions -> CommandPerform perform os = do+	case initVersion os of+		Nothing -> noop+		Just wantversion -> getVersion >>= \case+			Just v | v /= wantversion ->+				giveup $ "This repository is already a initialized with version " ++ show (fromRepoVersion v) ++ ", not changing to requested version."+			_ -> noop 	initialize 		(if null (initDesc os) then Nothing else Just (initDesc os)) 		(initVersion os)
Command/Merge.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2011, 2013 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,27 +9,36 @@  import Command import qualified Annex.Branch+import qualified Git+import qualified Git.Branch import Annex.CurrentBranch-import Command.Sync (prepMerge, mergeLocal, mergeConfig)+import Command.Sync (prepMerge, mergeLocal, mergeConfig, merge)  cmd :: Command cmd = command "merge" SectionMaintenance-	"automatically merge changes from remotes"-	paramNothing (withParams seek)+	"merge changes from remotes"+	(paramOptional paramRef) (withParams seek)  seek :: CmdParams -> CommandSeek-seek _ = do-	commandAction mergeBranch-	commandAction mergeSynced+seek [] = do+	prepMerge+	commandAction mergeAnnexBranch+	commandAction mergeSyncedBranch+seek bs = do+	prepMerge+	forM_ bs (commandAction . mergeBranch . Git.Ref) -mergeBranch :: CommandStart-mergeBranch = starting "merge" (ActionItemOther (Just "git-annex")) $ do+mergeAnnexBranch :: CommandStart+mergeAnnexBranch = starting "merge" (ActionItemOther (Just "git-annex")) $ do 	Annex.Branch.update 	-- commit explicitly, in case no remote branches were merged 	Annex.Branch.commit =<< Annex.Branch.commitMessage 	next $ return True -mergeSynced :: CommandStart-mergeSynced = do-	prepMerge-	mergeLocal mergeConfig def =<< getCurrentBranch+mergeSyncedBranch :: CommandStart+mergeSyncedBranch = mergeLocal mergeConfig def =<< getCurrentBranch++mergeBranch :: Git.Ref -> CommandStart+mergeBranch r = starting "merge" (ActionItemOther (Just (Git.fromRef r))) $ do+	currbranch <- getCurrentBranch+	next $ merge currbranch mergeConfig def Git.Branch.ManualCommit r
Git/CatFile.hs view
@@ -182,7 +182,7 @@  queryObjectType :: Ref -> Repo -> IO (Maybe ObjectType) queryObjectType r repo = maybe Nothing (readObjectType . takeWhile (/= '\n'))-	<$> querySingle (Param "cat-file") r repo hGetContentsStrict+	<$> querySingle (Param "-t") r repo hGetContentsStrict  queryContent :: Ref -> Repo -> IO (Maybe L.ByteString) queryContent r repo = fmap (\b -> L.fromChunks [b])
Git/Hook.hs view
@@ -31,7 +31,18 @@ hookFile h r = localGitDir r </> "hooks" </> hookName h  {- Writes a hook. Returns False if the hook already exists with a different- - content. Upgrades old scripts. -}+ - content. Upgrades old scripts.+ -+ - This can install hooks on both filesystem like FAT that do not support+ - execute bits, and on Windows.+ -+ - If the filesystem does not support execute bits, it's typically mounted+ - such that all files have the execute bit set. So just write the hook+ - and ignore failure to make it executable.+ -+ - On Windows, git will run hooks that are not executable. The hook+ - is run with a bundled bash, so should start with #!/bin/sh+ -} hookWrite :: Hook -> Repo -> IO Bool hookWrite h r = ifM (doesFileExist f) 	( expectedContent h r >>= \case@@ -45,7 +56,7 @@ 	go = do 		viaTmp writeFile f (hookScript h) 		p <- getPermissions f-		setPermissions f $ p {executable = True}+		void $ tryIO $ setPermissions f $ p {executable = True} 		return True  {- Removes a hook. Returns False if the hook contained something else, and
Git/Url.hs view
@@ -11,9 +11,10 @@ 	port, 	hostuser, 	authority,+	path, ) where -import Network.URI hiding (scheme, authority)+import Network.URI hiding (scheme, authority, path)  import Common import Git.Types@@ -65,6 +66,11 @@ authpart :: (URIAuth -> a) -> Repo -> Maybe a authpart a Repo { location = Url u } = a <$> uriAuthority u authpart _ repo = notUrl repo++{- Path part of an URL repo. -}+path :: Repo -> FilePath+path Repo { location = Url u } = uriPath u+path repo = notUrl repo  notUrl :: Repo -> a notUrl repo = error $
Limit.hs view
@@ -110,15 +110,15 @@ {- Adds a limit to skip files not believed to be present  - in a specfied repository. Optionally on a prior date. -} addIn :: String -> Annex ()-addIn s = addLimit =<< mk+addIn s = do+	u <- Remote.nameToUUID name+	hereu <- getUUID+	addLimit $ if u == hereu && null date+		then use inhere+		else use (inuuid u)   where 	(name, date) = separate (== '@') s-	mk-		| name == "." = if null date-			then use inhere-			else use . inuuid =<< getUUID-		| otherwise = use . inuuid =<< Remote.nameToUUID name-	use a = return $ Right $ \notpresent -> checkKey (a notpresent)+	use a = Right $ checkKey . a 	inuuid u notpresent key 		| null date = do 			us <- Remote.keyLocations key
Remote/Adb.hs view
@@ -291,17 +291,19 @@   where 	src = androidExportLocation adir loc -storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)-storeExportWithContentIdentifierM serial adir src _k loc overwritablecids _p = catchDefaultIO Nothing $+storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)+storeExportWithContentIdentifierM serial adir src _k loc overwritablecids _p = 	-- Check if overwrite is safe before sending, because sending the 	-- file is expensive and don't want to do it unncessarily. 	ifM checkcanoverwrite 		( ifM (store'' serial dest src checkcanoverwrite)-			( liftIO $ either (const Nothing) id -				<$> getExportContentIdentifier serial adir loc-			, return Nothing+			( liftIO $ getExportContentIdentifier serial adir loc >>= return . \case+				Right (Just cid) -> Right cid+				Right Nothing -> Left "adb failed to store file"+				Left _ -> Left "unable to get content identifier for file stored on adtb"+			, return $ Left "adb failed to store file" 			)-		, return Nothing+		, return $ Left "unsafe to overwrite file" 		)   where 	dest = androidExportLocation adir loc@@ -377,6 +379,7 @@ mkAdbCommand serial cmd = [Param "-s", Param (fromAndroidSerial serial)] ++ cmd  -- Gets the current content identifier for a file on the android device.+-- If the file is not present, returns Right Nothing getExportContentIdentifier :: AndroidSerial -> AndroidPath -> ExportLocation -> IO (Either ExitCode (Maybe ContentIdentifier)) getExportContentIdentifier serial adir loc = liftIO $ do 	ls <- adbShellRaw serial $ unwords
Remote/Directory.hs view
@@ -395,20 +395,23 @@ 		| currcid == Just cid = cont 		| otherwise = return Nothing -storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)+storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier) storeExportWithContentIdentifierM dir src _k loc overwritablecids p =-	catchDefaultIO Nothing $ do+	catchIO go (return . Left . show)+  where+	go = do 		liftIO $ createDirectoryIfMissing True destdir 		withTmpFileIn destdir template $ \tmpf tmph -> do 			liftIO $ withMeteredFile src p (L.hPut tmph) 			liftIO $ hFlush tmph+			liftIO $ hClose tmph 			liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case-				Nothing -> return Nothing+				Nothing -> +					return $ Left "unable to generate content identifier" 				Just newcid ->-					checkExportContent dir loc (newcid:overwritablecids) Nothing $ const $ do+					checkExportContent dir loc (newcid:overwritablecids) (Left "unsafe to overwrite file") $ const $ do 						liftIO $ rename tmpf dest-						return (Just newcid)-  where+						return (Right newcid) 	dest = exportPath dir loc 	(destdir, base) = splitFileName dest 	template = relatedTemplate (base ++ ".tmp")
Remote/GCrypt.hs view
@@ -12,6 +12,7 @@ 	coreGCryptId, 	setupRepo, 	accessShellConfig,+	setGcryptEncryption, ) where  import qualified Data.Map as M@@ -318,16 +319,18 @@ setGcryptEncryption :: RemoteConfig -> String -> Annex () setGcryptEncryption c remotename = do 	let participants = remoteconfig Git.GCrypt.remoteParticipantConfigKey-	case cipherKeyIds =<< extractCipher c of+	case extractCipher c of 		Nothing -> noCrypto-		Just (KeyIds { keyIds = ks}) -> do-			setConfig participants (unwords ks)-			let signingkey = ConfigKey $ Git.GCrypt.remoteSigningKey remotename-			cmd <- gpgCmd <$> Annex.getGitConfig-			skeys <- M.keys <$> liftIO (secretKeys cmd)-			case filter (`elem` ks) skeys of-				[] -> noop-				(k:_) -> setConfig signingkey k+		Just cip -> case cipherKeyIds cip of+			Nothing -> noop+			Just (KeyIds { keyIds = ks}) -> do+				setConfig participants (unwords ks)+				let signingkey = ConfigKey $ Git.GCrypt.remoteSigningKey remotename+				cmd <- gpgCmd <$> Annex.getGitConfig+				skeys <- M.keys <$> liftIO (secretKeys cmd)+				case filter (`elem` ks) skeys of+					[] -> noop+					(k:_) -> setConfig signingkey k 	setConfig (remoteconfig Git.GCrypt.remotePublishParticipantConfigKey) 		(Git.Config.boolConfig True)   where
Remote/Git.hs view
@@ -43,6 +43,7 @@ import Logs.Location import Utility.Metered import Utility.CopyFile+import Utility.FileMode import Utility.Env import Utility.Batch import Utility.SimpleProtocol@@ -51,6 +52,7 @@ import Remote.Helper.ExportImport import qualified Remote.Helper.Ssh as Ssh import qualified Remote.GCrypt+import qualified Remote.GitLFS import qualified Remote.P2P import qualified Remote.Helper.P2P as P2PHelper import P2P.Address@@ -143,6 +145,9 @@  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc+	-- Remote.GitLFS may be used with a repo that is also encrypted+	-- with gcrypt so is checked first.+	| remoteAnnexGitLFS gc = Remote.GitLFS.gen r u c gc 	| Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc 	| otherwise = case repoP2PAddress r of 		Nothing -> do@@ -737,6 +742,8 @@ 	copycowtried = case st of 		State _ _ (CopyCoWTried v) _ -> v 	dorsync = do+		-- dest may already exist, so make sure rsync can write to it+		void $ liftIO $ tryIO $ allowWrite dest 		oh <- mkOutputHandler 		Ssh.rsyncHelper oh (Just p) $ 			rsyncparams ++ [File src, File dest]@@ -814,9 +821,11 @@ getRepoFromState :: State -> Annex Git.Repo getRepoFromState (State _ _ _ a) = fst <$> a +#ifndef mingw32_HOST_OS {- The config of the remote git repository, cached for speed. -} getGitConfigFromState :: State -> Annex GitConfig getGitConfigFromState (State _ _ _ a) = snd <$> a+#endif  mkState :: Git.Repo -> UUID -> RemoteGitConfig -> Annex State mkState r u gc = do
+ Remote/GitLFS.hs view
@@ -0,0 +1,449 @@+{- Using git-lfs as a remote.+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Remote.GitLFS (remote, gen) where++import Annex.Common+import Types.Remote+import Annex.Url+import Types.Key+import Types.Creds+import qualified Annex+import qualified Git+import qualified Git.Types as Git+import qualified Git.Url+import qualified Git.GCrypt+import Config+import Config.Cost+import Remote.Helper.Special+import Remote.Helper.ExportImport+import Remote.Helper.Git+import Remote.Helper.Http+import qualified Remote.GCrypt+import Annex.Ssh+import Annex.UUID+import Crypto+import Backend.Hash+import Utility.Hash+import Utility.SshHost+import Logs.RemoteState+import qualified Utility.GitLFS as LFS++import Control.Concurrent.STM+import Data.String+import Network.HTTP.Types+import Network.HTTP.Client hiding (port)+import System.Log.Logger+import qualified Data.Map as M+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as E++remote :: RemoteType+remote = RemoteType+	{ typename = "git-lfs"+	-- Remote.Git takes care of enumerating git-lfs remotes too,+	-- and will call our gen on them.+	, enumerate = const (return [])+	, generate = gen+	, setup = mySetup+	, exportSupported = exportUnsupported+	, importSupported = importUnsupported+	}++gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)+gen r u c gc = do+	-- If the repo uses gcrypt, get the underlaying repo without the+	-- gcrypt url, to do LFS endpoint discovery on.+	r' <- if Git.GCrypt.isEncrypted r+		then do+			g <- Annex.gitRepo+			liftIO $ Git.GCrypt.encryptedRemote g r+		else pure r+	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing r' gc+	cst <- remoteCost gc expensiveRemoteCost+	return $ Just $ specialRemote' specialcfg c+		(simplyPrepare $ store u h)+		(simplyPrepare $ retrieve u h)+		(simplyPrepare $ remove h)+		(simplyPrepare $ checkKey u h)+		(this cst)+  where+	this cst = Remote+		{ uuid = u+		, cost = cst+		, name = Git.repoDescribe r+		, storeKey = storeKeyDummy+		, retrieveKeyFile = retreiveKeyFileDummy+		, retrieveKeyFileCheap = retrieveCheap+		-- content stored on git-lfs is hashed with SHA256+		-- no matter what git-annex key it's for, and the hash+		-- is checked on download+		, retrievalSecurityPolicy = RetrievalAllKeysSecure+		, removeKey = removeKeyDummy+		, lockContent = Nothing+		, checkPresent = checkPresentDummy+		, checkPresentCheap = False+		, exportActions = exportUnsupported+		, importActions = importUnsupported+		, whereisKey = Nothing+		, remoteFsck = Nothing+		, repairRepo = Nothing+		, config = c+		, getRepo = return r+		, gitconfig = gc+		, localpath = Nothing+		, remotetype = remote+		, availability = GloballyAvailable+		, readonly = False+		-- content cannot be removed from a git-lfs repo+		, appendonly = True+		, mkUnavailable = return Nothing+		, getInfo = gitRepoInfo (this cst)+		, claimUrl = Nothing+		, checkUrl = Nothing+		}+	specialcfg = (specialRemoteCfg c)+		-- chunking would not improve git-lfs+		{ chunkConfig = NoChunks+		}++mySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+mySetup _ mu _ c gc = do+	u <- maybe (liftIO genUUID) return mu++	(c', _encsetup) <- encryptionSetup c gc+	case (isEncrypted c', Git.GCrypt.urlPrefix `isPrefixOf` url) of+		(False, False) -> noop+		(True, True) -> Remote.GCrypt.setGcryptEncryption c' remotename+		(True, False) -> unlessM (Annex.getState Annex.force) $+			giveup $ unwords $+				[ "Encryption is enabled for this remote,"+				, "but only the files that git-annex stores on"+				, "it would be encrypted; "+				, "anything that git push sends to it would"+				, "not be encrypted. Recommend prefixing the"+				, "url with \"gcrypt::\" to also encrypt"+				, "git pushes."+				, "(Use --force if you want to use this"+				, "likely insecure configuration.)"+				]+		(False, True) -> unlessM (Annex.getState Annex.force) $+			giveup $ unwords $+				[ "You used a \"gcrypt::\" url for this remote,"+				, "but encryption=none prevents git-annex"+				, "from encrypting files it stores there."+				, "(Use --force if you want to use this"+				, "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,+	-- (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")]+	setConfig (ConfigKey ("remote." ++ getRemoteName c ++ ".url")) url+	return (c'', u)+  where+	url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)+	remotename = fromJust (M.lookup "name" c)++data LFSHandle = LFSHandle+	{ downloadEndpoint :: Maybe LFS.Endpoint+	, uploadEndpoint :: Maybe LFS.Endpoint+	, remoteRepo :: Git.Repo+	, remoteGitConfig :: RemoteGitConfig+	}++discoverLFSEndpoint :: LFS.TransferRequestOperation -> LFSHandle -> Annex (Maybe LFS.Endpoint)+discoverLFSEndpoint tro h+	| Git.repoIsSsh r = gossh+	| Git.repoIsHttp r = gohttp+	| otherwise = do+		warning "git-lfs endpoint has unsupported URI scheme"+		return Nothing+  where+  	r = remoteRepo h+	lfsrepouri = case Git.location r of+		Git.Url u -> u+		_ -> giveup $ "unsupported git-lfs remote location " ++ Git.repoLocation r+	gohttp = case tro of+		LFS.RequestDownload -> return $ LFS.guessEndpoint lfsrepouri+		LFS.RequestUpload -> do+			-- git-lfs does support storing over http,+			-- but it would need prompting for http basic+			-- authentication each time git-annex discovered+			-- the endpoint.+			warning "Storing content in git-lfs currently needs a ssh repository url, not http."+			return Nothing+	gossh = case mkSshHost <$> Git.Url.hostuser r of+		Nothing -> do+			warning "Unable to parse ssh url for git-lfs remote."+			return Nothing+		Just (Left err) -> do+			warning err+			return Nothing+		Just (Right hostuser) -> do+			let port = Git.Url.port r+			-- Remove leading /~/ from path. That is added when+			-- converting a scp-style repository location with+			-- a relative path into an url, and is legal+			-- according to git-clone(1), but github does not+			-- support it.+			let remotepath = if "/~/" `isPrefixOf` Git.Url.path r+				then drop 3 (Git.Url.path r)+				else Git.Url.path r+			let ps = LFS.sshDiscoverEndpointCommand remotepath tro+			-- Note that no shellEscape is done here, because+			-- at least github's git-lfs implementation does+			-- not allow for shell quoting.+			let remotecmd = unwords ps+			(sshcommand, sshparams) <- sshCommand NoConsumeStdin (hostuser, port) (remoteGitConfig h) remotecmd+			liftIO (tryIO (readProcess sshcommand (toCommand sshparams))) >>= \case+				Left err -> do+					warning $ "ssh connection to git-lfs remote failed: " ++ show err+					return Nothing+				Right resp -> case LFS.parseSshDiscoverEndpointResponse (fromString resp) of+					Nothing -> do+						warning $ "unexpected response from git-lfs remote when doing ssh endpoint discovery"+						return Nothing+					Just endpoint -> return (Just endpoint)++-- The endpoint is cached for later use.+getLFSEndpoint :: LFS.TransferRequestOperation -> TVar LFSHandle -> Annex (Maybe LFS.Endpoint)+getLFSEndpoint tro hv = do+	h <- liftIO $ atomically $ readTVar hv+	case f h of+		Just endpoint -> return (Just endpoint)+		Nothing -> discoverLFSEndpoint tro h >>= \case+			Just endpoint -> do+				liftIO $ atomically $ writeTVar hv $+					case tro of+						LFS.RequestDownload -> +							h { downloadEndpoint = Just endpoint }+						LFS.RequestUpload ->+							h { uploadEndpoint = Just endpoint }+				return (Just endpoint)+			Nothing -> return Nothing+  where+	f = case tro of+		LFS.RequestDownload -> downloadEndpoint+		LFS.RequestUpload -> uploadEndpoint++-- Make an API request that is expected to have a small response body.+-- Not for use in downloading an object.+makeSmallAPIRequest :: Request -> Annex (Response L.ByteString)+makeSmallAPIRequest req = do+	uo <- getUrlOptions+	let req' = applyRequest uo req+	liftIO $ debugM "git-lfs" (show req')+	resp <- liftIO $ httpLbs req' (httpManager uo)+	-- Only debug the http status code, not the json+	-- which may include an authentication token.+	liftIO $ debugM "git-lfs" (show $ responseStatus resp)+	return resp++sendTransferRequest+	:: LFS.IsTransferResponseOperation op+	=> LFS.TransferRequest+	-> LFS.Endpoint+	-> Annex (Either String (LFS.TransferResponse op))+sendTransferRequest req endpoint = +	case LFS.startTransferRequest endpoint req of+		Just httpreq -> do+			httpresp <- makeSmallAPIRequest $ setRequestCheckStatus httpreq+			return $ case LFS.parseTransferResponse (responseBody httpresp) of+				LFS.ParsedTransferResponse resp -> Right resp+				LFS.ParsedTransferResponseError tro -> Left $+					T.unpack $ LFS.resperr_message tro+				LFS.ParseFailed err -> Left err+		Nothing -> return $ Left "unable to parse git-lfs endpoint url"++extractKeySha256 :: Key -> Maybe LFS.SHA256+extractKeySha256 k = case keyVariety k of+	SHA2Key (HashSize 256) (HasExt hasext)+		| hasext -> eitherToMaybe $ E.decodeUtf8' (keyHash k)+		| otherwise -> eitherToMaybe $ E.decodeUtf8' (keyName k)+	_ -> Nothing++-- The size of an encrypted key is the size of the input data, but we need+-- the actual object size.+extractKeySize :: Key -> Maybe Integer+extractKeySize k+	| isEncKey k = Nothing+	| otherwise = keySize k++mkUploadRequest :: UUID -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)+mkUploadRequest u k content = case (extractKeySha256 k, extractKeySize k) of+	(Just sha256, Just size) ->+		ret sha256 size+	(_, Just size) -> do+		sha256 <- calcsha256+		remembersha256 sha256+		ret sha256 size+	_ -> do+		sha256 <- calcsha256+		size <- liftIO $ getFileSize content+		rememberboth sha256 size+		ret sha256 size+  where+	calcsha256 = liftIO $ T.pack . show . sha2_256 <$> L.readFile content+	ret sha256 size = do+		let obj = LFS.TransferRequestObject+			{ LFS.req_oid = sha256+			, LFS.req_size = size+			}+		let req = LFS.TransferRequest+			{ LFS.req_operation = LFS.RequestUpload+			, LFS.req_transfers = [LFS.Basic]+			, LFS.req_ref = Nothing +			, LFS.req_objects = [obj]+			}+		return (req, sha256, size)+	+	remembersha256 sha256 = setRemoteState u k (T.unpack sha256)+	rememberboth sha256 size = setRemoteState u k $+		show size ++ " " ++ T.unpack sha256++mkDownloadRequest :: UUID -> Key -> Annex (Maybe (LFS.TransferRequest, LFS.SHA256, Integer))+mkDownloadRequest u k = case (extractKeySha256 k, extractKeySize k) of+	(Just sha256, Just size) -> ret sha256 size+	(_, Just size) ->+		remembersha256 >>= \case+			Just sha256 -> ret sha256 size+			Nothing -> return Nothing+	_ -> do+		rememberboth >>= \case+			Just (sha256, size) -> ret sha256 size+			Nothing -> return Nothing+  where+	ret sha256 size = do+		let obj = LFS.TransferRequestObject+			{ LFS.req_oid = sha256+			, LFS.req_size = size+			}+		let req = LFS.TransferRequest+			{ LFS.req_operation = LFS.RequestDownload+			, LFS.req_transfers = [LFS.Basic]+			, LFS.req_ref = Nothing +			, LFS.req_objects = [obj]+			}+		return $ Just (req, sha256, size)+	remembersha256 = fmap T.pack <$> getRemoteState u k+	rememberboth = maybe Nothing parse <$> getRemoteState u k+	  where+		parse s = case words s of+			[ssize, ssha256] -> do+				size <- readish ssize+				return (T.pack ssha256, size)+			_ -> Nothing++store :: UUID -> TVar LFSHandle -> Storer+store u h = fileStorer $ \k src p -> getLFSEndpoint LFS.RequestUpload h >>= \case+	Nothing -> return False+	Just endpoint -> flip catchNonAsync failederr $ do+		(req, sha256, size) <- mkUploadRequest u k src+		sendTransferRequest req endpoint >>= \case+			Left err -> do+				warning err+				return False+			Right resp -> do+				body <- liftIO $ httpBodyStorer src p+				forM_ (LFS.objects resp) $+					send body sha256 size+				return True+  where+	send body sha256 size tro+		| LFS.resp_oid tro /= sha256 || LFS.resp_size tro /= size =+			giveup "git-lfs server requested other object than the one we asked to send"+		| otherwise = case LFS.resp_error tro of+			Just err -> giveup $+				T.unpack $ LFS.respobjerr_message err+			Nothing -> case LFS.resp_actions tro of+				Nothing -> noop+				Just op -> case LFS.uploadOperationRequests op body sha256 size of+					Nothing -> giveup "unable to parse git-lfs server upload url"+					Just [] -> noop -- server already has it+					Just reqs -> forM_ reqs $+						makeSmallAPIRequest . setRequestCheckStatus+	failederr e = do+		warning (show e)+		return False++retrieve :: UUID -> TVar LFSHandle -> Retriever+retrieve u h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h >>= \case+	Nothing -> giveup "unable to connect to git-lfs endpoint"+	Just endpoint -> mkDownloadRequest u k >>= \case+		Nothing -> giveup "unable to download this object from git-lfs"+		Just (req, sha256, size) -> sendTransferRequest req endpoint >>= \case+			Left err -> giveup (show err)+			Right resp -> case LFS.objects resp of+				[] -> giveup "git-lfs server did not provide a way to download this object"+				(tro:_)+					| LFS.resp_oid tro /= sha256 || LFS.resp_size tro /= size ->+						giveup "git-lfs server replied with other object than the one we requested"+					| otherwise -> go dest p tro+  where+	go dest p tro = case LFS.resp_error tro of+		Just err -> giveup $ T.unpack $ LFS.respobjerr_message err+		Nothing -> case LFS.resp_actions tro of+			Nothing -> giveup "git-lfs server did not provide a way to download this object"+			Just op -> case LFS.downloadOperationRequest op of+				Nothing -> giveup "unable to parse git-lfs server download url"+				Just req -> do+					uo <- getUrlOptions+					liftIO $ downloadConduit p req dest uo++checkKey :: UUID -> TVar LFSHandle -> CheckPresent+checkKey u h key = getLFSEndpoint LFS.RequestDownload h >>= \case+	Nothing -> giveup "unable to connect to git-lfs endpoint"+	Just endpoint -> mkDownloadRequest u key >>= \case+		-- Unable to find enough information to request the key+		-- from git-lfs, so it's not present there.+		Nothing -> return False+		Just (req, sha256, size) -> case LFS.startTransferRequest endpoint req of+			Nothing -> giveup "unable to parse git-lfs endpoint url"+			Just httpreq -> go sha256 size =<< makeSmallAPIRequest httpreq+  where+	go sha256 size httpresp+		| responseStatus httpresp == status200 = go' sha256 size $+			LFS.parseTransferResponse (responseBody httpresp)+		| otherwise = giveup $+			"git-lfs server refused request: " ++ show (responseStatus httpresp)+	+	go' :: LFS.SHA256 -> Integer -> LFS.ParsedTransferResponse LFS.DownloadOperation -> Annex Bool+	go' _ _ (LFS.ParseFailed err) =+		giveup $ "unable to parse response from git-lfs server: " ++ err+	-- If the server responds with a json error message,+	-- the content is presumably not present.+	go' _ _ (LFS.ParsedTransferResponseError _) = return False+	-- If the server responds with at least one download operation,+	-- we will assume the content is present. We could also try to HEAD+	-- that download, but there's no guarantee HEAD is supported, and+	-- at most that would detect breakage where the server is confused+	-- about what objects it has.+	go' sha256 size (LFS.ParsedTransferResponse resp) =+		case LFS.objects resp of+			[] -> return False+			(tro:_)+				| isNothing (LFS.resp_actions tro) -> return False+				| isJust (LFS.resp_error tro) -> return False+				| LFS.resp_oid tro /= sha256 || LFS.resp_size tro /= size ->+					giveup "git-lfs server replied with other object than the one we requested"+				| otherwise -> return True++retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool+retrieveCheap _ _ _ = return False++remove :: TVar LFSHandle -> Remover+remove _h _key = do+	warning "git-lfs does not support removing content"+	return False
Remote/Helper/ExportImport.hs view
@@ -57,7 +57,7 @@ 	importUnsupported = ImportActions 		{ listImportableContents = return Nothing 		, retrieveExportWithContentIdentifier = \_ _ _ _ _ -> return Nothing-		, storeExportWithContentIdentifier = \_ _ _ _ _ -> return Nothing+		, storeExportWithContentIdentifier = \_ _ _ _ _ -> return (Left "import not supported") 		, removeExportWithContentIdentifier = \_ _ _ -> return False 		, removeExportDirectoryWhenEmpty = Just $ \_ -> return False 		, checkPresentExportWithContentIdentifier = \_ _ _ -> return False@@ -154,8 +154,10 @@ 					oldcids <- liftIO $ concat 						<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) oldks 					storeExportWithContentIdentifier (importActions r') f k loc oldcids p >>= \case-						Nothing -> return False-						Just newcid -> do+						Left err -> do+							warning err+							return False+						Right newcid -> do 							withExclusiveLock gitAnnexContentIdentifierLock $ do 								liftIO $ ContentIdentifier.recordContentIdentifier db (uuid r') newcid k 								liftIO $ ContentIdentifier.flushDbQueue db
Remote/Helper/ReadOnly.hs view
@@ -65,18 +65,17 @@ readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool) readonlyRenameExport _ _ _ = return Nothing -readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)-readonlyStoreExportWithContentIdentifier _ _ _ _ _ = do-	readonlyWarning-	return Nothing+readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)+readonlyStoreExportWithContentIdentifier _ _ _ _ _ =+	return $ Left readonlyWarning  readonlyRemoveExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool readonlyRemoveExportWithContentIdentifier _ _ _ = readonlyFail  readonlyFail :: Annex Bool readonlyFail = do-	readonlyWarning+	warning readonlyWarning 	return False -readonlyWarning :: Annex ()-readonlyWarning = warning "this remote is readonly"+readonlyWarning :: String+readonlyWarning = "this remote is readonly"
Remote/List.hs view
@@ -40,6 +40,7 @@ import qualified Remote.Tahoe import qualified Remote.Glacier import qualified Remote.Ddar+import qualified Remote.GitLFS import qualified Remote.Hook import qualified Remote.External @@ -63,6 +64,7 @@ 	, Remote.Tahoe.remote 	, Remote.Glacier.remote 	, Remote.Ddar.remote+	, Remote.GitLFS.remote 	, Remote.Hook.remote 	, Remote.External.remote 	]
Remote/S3.hs view
@@ -29,6 +29,7 @@ import Network.HTTP.Conduit (Manager) import Network.HTTP.Client (responseStatus, responseBody, RequestBody(..)) import Network.HTTP.Types+import Network.URI import Control.Monad.Trans.Resource import Control.Monad.Catch import Data.IORef@@ -387,15 +388,15 @@   where 	go = withS3Handle hv $ \case 		Just h -> do-			retrieveHelper info h (Left (T.pack exporturl)) f p+			retrieveHelper info h (Left (T.pack exportloc)) f p 			return True 		Nothing -> case getPublicUrlMaker info of 			Nothing -> do 				warning $ needS3Creds (uuid r) 				return False 			Just geturl -> Url.withUrlOptions $ -				liftIO . Url.download p (geturl exporturl) f-	exporturl = bucketExportLocation info loc+				liftIO . Url.download p (geturl exportloc) f+	exportloc = bucketExportLocation info loc  removeExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> Annex Bool removeExportS3 hv r info k loc = withS3Handle hv $ \case@@ -575,7 +576,7 @@ -- -- When the bucket is not versioned, data loss can result. -- This is why that configuration requires --force to enable.-storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)+storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier) storeExportWithContentIdentifierS3 hv r info magic src k loc _overwritablecids p 	| versioning info = go 	-- FIXME Actual aws version that supports getting Etag for a store@@ -584,20 +585,18 @@ #if MIN_VERSION_aws(0,99,0) 	| otherwise = go #else-	| otherwise = do-		warning "git-annex is built with too old a version of the aws library to support this operation"-		return Nothing+	| otherwise = return $+		Left "git-annex is built with too old a version of the aws library to support this operation" #endif   where 	go = storeExportS3' hv r info magic src k loc p >>= \case-		(False, _) -> return Nothing-		(True, (_, Just vid)) -> return $ Just $+		(False, _) -> return $ Left "failed to store content in S3 bucket"+		(True, (_, Just vid)) -> return $ Right $ 			mkS3VersionedContentIdentifier vid-		(True, (Just etag, Nothing)) -> return $ Just $+		(True, (Just etag, Nothing)) -> return $ Right $ 			mkS3UnversionedContentIdentifier etag-		(True, (Nothing, Nothing)) -> do-			warning "did not get ETag for store to S3 bucket"-			return Nothing+		(True, (Nothing, Nothing)) -> +			return $ Left "did not get ETag for store to S3 bucket"  -- Does not guarantee that the removed object has the content identifier, -- but when the bucket is versioned, the removed object content can still@@ -930,7 +929,14 @@ 	"https://" ++ T.unpack (bucket info) ++ ".s3.amazonaws.com/"   genericPublicUrl :: URLString -> BucketObject -> URLString-genericPublicUrl baseurl p = baseurl Posix.</> p+genericPublicUrl baseurl p = +	baseurl Posix.</> escapeURIString skipescape p+ where+	-- Don't need to escape '/' because the bucket object+	-- is not necessarily a single url component. +	-- But do want to escape eg '+' and ' '+	skipescape '/' = True+	skipescape c = isUnescapedInURIComponent c  genCredentials :: CredPair -> IO AWS.Credentials genCredentials (keyid, secret) = AWS.Credentials@@ -1128,8 +1134,8 @@ 	| otherwise = return (Right (Left fallback))  s3VersionIDPublicUrl :: (S3Info -> BucketObject -> URLString) -> S3Info -> S3VersionID -> URLString-s3VersionIDPublicUrl mk info (S3VersionID obj vid) = mk info $ concat-	[ T.unpack obj+s3VersionIDPublicUrl mk info (S3VersionID obj vid) = concat+	[ mk info (T.unpack obj) 	, "?versionId=" 	, T.unpack vid -- version ID is "url ready" so no escaping needed 	]
Test.hs view
@@ -36,7 +36,6 @@ import qualified Git.Ref import qualified Git.LsTree import qualified Git.FilePath-import qualified Git.Merge import qualified Annex.Locations #ifndef mingw32_HOST_OS import qualified Types.GitConfig@@ -63,6 +62,7 @@ import qualified Annex.CatFile import qualified Annex.Path import qualified Annex.VectorClock+import qualified Annex.AdjustedBranch import qualified Annex.View import qualified Annex.View.ViewedFile import qualified Logs.View@@ -94,7 +94,7 @@  optParser :: Parser TestOptions optParser = TestOptions-	<$> suiteOptionParser ingredients (tests False mempty)+	<$> suiteOptionParser ingredients (tests False True mempty) 	<*> switch 		( long "keep-failures" 		<> help "preserve repositories on test failure"@@ -126,7 +126,8 @@ 	runsubprocesstests (Just _) = isolateGitConfig $ do 		ensuretmpdir 		crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem' tmpdir-		case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem opts) of+		adjustedbranchok <- Annex.AdjustedBranch.isGitVersionSupported+		case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem adjustedbranchok opts) of 			Nothing -> error "No tests found!?" 			Just act -> ifM act 				( exitSuccess@@ -142,12 +143,14 @@ 	, rerunningTests [consoleTestReporter] 	] -tests :: Bool -> TestOptions -> TestTree-tests crippledfilesystem opts = testGroup "Tests" $ properties :-	map (\(d, te) -> withTestMode te initTests (unitTests d)) testmodes+tests :: Bool -> Bool -> TestOptions -> TestTree+tests crippledfilesystem adjustedbranchok opts = +	testGroup "Tests" $ properties :+		map (\(d, te) -> withTestMode te initTests (unitTests d)) testmodes   where 	testmodes = catMaybes-		[ Just ("v7 unlocked", (testMode opts (RepoVersion 7)) { unlockedFiles = True })+		[ canadjust ("v7 adjusted unlocked branch", (testMode opts (RepoVersion 7)) { adjustedUnlockedBranch = True })+		, unlesscrippled ("v7 unlocked", (testMode opts (RepoVersion 7)) { unlockedFiles = True }) 		, unlesscrippled ("v5", testMode opts (RepoVersion 5)) 		, unlesscrippled ("v7 locked", testMode opts (RepoVersion 7)) 		, Just ("v5 direct", (testMode opts (RepoVersion 5)) { forceDirect = True })@@ -155,6 +158,9 @@ 	unlesscrippled v 		| crippledfilesystem = Nothing 		| otherwise = Just v+	canadjust v+		| adjustedbranchok = Just v+		| otherwise = Nothing  properties :: TestTree properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"@@ -386,14 +392,6 @@ 		let importf = subdir </> "f" 		writecontent (importdir </> importf) (content importf) 		return (importdir </> subdir, importdir </> importf, importf)-	annexed_present_imported f = ifM (annexeval Config.crippledFileSystem)-		( annexed_present_unlocked f-		, annexed_present_locked f-		)-	annexed_notpresent_imported f = ifM (annexeval Config.crippledFileSystem)-		( annexed_notpresent_unlocked f-		, annexed_notpresent_locked f-		)  test_reinject :: Assertion test_reinject = intmpclonerepoInDirect $ do@@ -470,7 +468,12 @@ test_get = test_get' intmpclonerepo  test_get_ssh_remote :: Assertion-test_get_ssh_remote = test_get' (with_ssh_origin intmpclonerepo)+test_get_ssh_remote = +#ifndef mingw32_HOST_OS+	test_get' (with_ssh_origin intmpclonerepo)+#else+	noop+#endif  test_get' :: (Assertion -> Assertion) -> Assertion test_get' setup = setup $ do@@ -493,7 +496,12 @@ test_move = test_move' intmpclonerepo  test_move_ssh_remote :: Assertion-test_move_ssh_remote = test_move' (with_ssh_origin intmpclonerepo)+test_move_ssh_remote =+#ifndef mingw32_HOST_OS+	test_move' (with_ssh_origin intmpclonerepo)+#else+	noop+#endif  test_move' :: (Assertion -> Assertion) -> Assertion test_move' setup = setup $ do@@ -592,7 +600,7 @@ test_lock = intmpclonerepoInDirect $ do 	annexed_notpresent annexedfile 	unlessM (annexeval Annex.Version.versionSupportsUnlockedPointers) $-		ifM (unlockedFiles <$> getTestMode)+		ifM (hasUnlockedFiles <$> getTestMode) 			( git_annex_shouldfail "lock" [annexedfile] @? "lock failed to fail with not present file" 			, git_annex_shouldfail "unlock" [annexedfile] @? "unlock failed to fail with not present file" 			)@@ -698,7 +706,7 @@ 		)  test_fix :: Assertion-test_fix = intmpclonerepoInDirect $ unlessM (unlockedFiles <$> getTestMode) $ do+test_fix = intmpclonerepoInDirect $ unlessM (hasUnlockedFiles <$> getTestMode) $ do 	annexed_notpresent annexedfile 	git_annex "fix" [annexedfile] @? "fix of not present failed" 	annexed_notpresent annexedfile@@ -769,7 +777,7 @@ 		git_annex "get" [f] @? "get of file failed" 		Utility.FileMode.allowWrite f 		writecontent f (changedcontent f)-		ifM (annexeval Config.isDirect <||> unlockedFiles <$> getTestMode)+		ifM (annexeval Config.isDirect <||> hasUnlockedFiles <$> getTestMode) 			( git_annex "fsck" [] @? "fsck failed on unlocked file with changed file content" 			, git_annex_shouldfail "fsck" [] @? "fsck failed to fail with corrupted file content" 			)@@ -850,7 +858,7 @@ 	checkbackend sha1annexedfile backendSHA256  test_unused :: Assertion--- This test is broken in direct mode+-- This test is broken in direct mode. test_unused = intmpclonerepoInDirect $ do 	checkunused [] "in new clone" 	git_annex "get" [annexedfile] @? "get of file failed"@@ -860,13 +868,15 @@ 	checkunused [] "after get" 	boolSystem "git" [Param "rm", Param "-fq", File annexedfile] @? "git rm failed" 	checkunused [] "after rm"-	boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "foo"] @? "git commit failed"+	-- commit the rm, and when on an adjusted branch, sync it back to+	-- the master branch+	git_annex "sync" ["--no-push", "--no-pull"] @? "git-annex sync failed" 	checkunused [] "after commit" 	-- unused checks origin/master; once it's gone it is really unused 	boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "git remote rm origin failed" 	checkunused [annexedfilekey] "after origin branches are gone" 	boolSystem "git" [Param "rm", Param "-fq", File sha1annexedfile] @? "git rm failed"-	boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "foo"] @? "git commit failed"+	git_annex "sync" ["--no-push", "--no-pull"] @? "git-annex sync failed" 	checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile"  	-- good opportunity to test dropkey also@@ -884,7 +894,7 @@ 	-- This is only relevant when using locked files; if the file is 	-- unlocked, the work tree file has the content, and there's no way 	-- to associate it with the key.-	unlessM (unlockedFiles <$> getTestMode) $ do+	unlessM (hasUnlockedFiles <$> getTestMode) $ do 		writecontent "unusedfile" "unusedcontent" 		git_annex "add" ["unusedfile"] @? "add of unusedfile failed" 		unusedfilekey <- getKey backendSHA256E "unusedfile"@@ -916,7 +926,7 @@ 	-- When an unlocked file is modified, git diff will cause git-annex 	-- to add its content to the repository. Make sure that's not 	-- found as unused.-	whenM (unlockedFiles <$> getTestMode) $ do+	whenM (hasUnlockedFiles <$> getTestMode) $ do 		let f = "unlockedfile" 		writecontent f "unlockedcontent1" 		boolSystem "git" [Param "add", File "unlockedfile"] @? "git add failed"@@ -1376,7 +1386,7 @@  - lost track of whether a file was a symlink.   -} test_conflict_resolution_symlink_bit :: Assertion-test_conflict_resolution_symlink_bit = unlessM (unlockedFiles <$> getTestMode) $+test_conflict_resolution_symlink_bit = unlessM (hasUnlockedFiles <$> getTestMode) $ 	withtmpclonerepo $ \r1 -> 		withtmpclonerepo $ \r2 -> 			withtmpclonerepo $ \r3 -> do@@ -1585,6 +1595,7 @@  test_rsync_remote :: Assertion test_rsync_remote = intmpclonerepo $ do+#ifndef mingw32_HOST_OS 	createDirectory "dir" 	git_annex "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" 	git_annex "get" [annexedfile] @? "get of file failed"@@ -1597,6 +1608,9 @@ 	annexed_present annexedfile 	git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" 	annexed_present annexedfile+#else+	noop+#endif  test_bup_remote :: Assertion test_bup_remote = intmpclonerepo $ when BuildInfo.bup $ do@@ -1705,7 +1719,7 @@  	{- Regression test for Windows bug where symlinks were not 	 - calculated correctly for files in subdirs. -}-	unlessM (unlockedFiles <$> getTestMode) $ do+	unlessM (hasUnlockedFiles <$> getTestMode) $ do 		git_annex "sync" [] @? "sync failed" 		l <- annexeval $ Utility.FileSystemEncoding.decodeBL 			<$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo")@@ -1736,22 +1750,22 @@ 	git_annex "get" [] @? "get of files failed" 	annexed_present annexedfile +	-- Nothing to commit, but this makes sure the master branch+	-- is in sync with the adjusted branch, which it may not be+	-- depending on how the repository was set up.+	commitchanges 	git_annex "export" ["master", "--to", "foo"] @? "export to dir failed" 	dircontains annexedfile (content annexedfile)  	writedir "import" (content "import") 	git_annex "import" ["master", "--from", "foo"] @? "import from dir failed"-	up <- Git.Merge.mergeUnrelatedHistoriesParam-	let mergeps = [Param "merge", Param "foo/master", Param "-mmerge"] ++ maybeToList up-	boolSystem "git" mergeps @? "git merge foo/master failed"-	-- FIXME fails when in an adjusted unlocked branch because-	-- it's imported locked-	--annexed_present "import"+	git_annex "merge" ["foo/master"] @? "git annex merge foo/master failed"+	annexed_present_imported "import"  	nukeFile "import" 	writecontent "import" (content "newimport1") 	git_annex "add" ["import"] @? "add of import failed"-	boolSystem "git" [Param "commit", Param "-q", Param "-mchanged"] @? "git commit failed"+	commitchanges 	git_annex "export" ["master", "--to", "foo"] @? "export modified file to dir failed" 	dircontains "import" (content "newimport1") @@ -1760,7 +1774,7 @@ 	nukeFile "import" 	writecontent "import" (content "newimport3") 	git_annex "add" ["import"] @? "add of import failed"-	boolSystem "git" [Param "commit", Param "-q", Param "-mchanged"] @? "git commit failed"+	commitchanges 	git_annex_shouldfail "export" ["master", "--to", "foo"] @? "export failed to fail in conflict" 	dircontains "import" (content "newimport2") @@ -1770,7 +1784,7 @@ 	nukeFile "import" 	writecontent "import" (content "newimport3") 	git_annex "add" ["import"] @? "add of import failed"-	boolSystem "git" [Param "commit", Param "-q", Param "-mchanged"] @? "git commit failed"+	commitchanges 	git_annex "export" ["master", "--to", "foo"] @? "export failed after import conflict" 	dircontains "import" (content "newimport3")   where@@ -1778,6 +1792,10 @@ 		((v==) <$> readFile ("dir" </> f)) 			@? ("did not find expected content of " ++ "dir" </> f) 	writedir f = writecontent ("dir" </> f)+	-- When on an adjusted branch, this updates the master branch+	-- to match it, which is necessary since the master branch is going+	-- to be exported.+	commitchanges = git_annex "sync" ["--no-pull", "--no-push"] @? "sync failed"  test_export_import_subdir :: Assertion test_export_import_subdir = intmpclonerepoInDirect $ do@@ -1791,6 +1809,11 @@ 		@? "git mv failed" 	boolSystem "git" [Param "commit", Param "-m", Param "moved"] 		@? "git commit failed"+	+	-- When on an adjusted branch, this updates the master branch+	-- to match it, which is necessary since the master branch is going+	-- to be exported.+	git_annex "sync" ["--no-pull", "--no-push"] @? "sync failed"  	-- Run three times because there was a bug that took a couple 	-- of runs to lead to the wrong tree being written to the remote@@ -1815,9 +1838,7 @@ 	 	testimport = do 		git_annex "import" ["master:"++subdir, "--from", "foo"] @? "import of subdir failed"-		up <- Git.Merge.mergeUnrelatedHistoriesParam-		let mergeps = [Param "merge", Param "foo/master", Param "-mmerge"] ++ maybeToList up-		boolSystem "git" mergeps @? "git merge foo/master failed"+		git_annex "merge" ["foo/master"] @? "git annex merge foo/master failed"  		-- Make sure that import did not import the file to the top 		-- of the repo.
Test/Framework.hs view
@@ -1,6 +1,6 @@ {- git-annex test suite framework  -- - Copyright 2010-2017 Joey Hess <id@joeyh.name>+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -42,47 +42,26 @@ import qualified Utility.ThreadScheduler import qualified Utility.Tmp.Dir import qualified Utility.Metered+import qualified Utility.SafeCommand import qualified Command.Uninit-import qualified CmdLine.GitAnnex as GitAnnex --- This is equivilant to running git-annex, but it's all run in-process--- so test coverage collection works.+-- Run git-annex. git_annex :: String -> [String] -> IO Bool-git_annex command params = git_annex' command params >>= \case-	Right () -> return True-	Left e -> do-		hPutStrLn stderr (show e)-		return False+git_annex command params = do+	pp <- Annex.Path.programPath+	Utility.SafeCommand.boolSystem pp $+		map Utility.SafeCommand.Param (command:params)  -- For when git-annex is expected to fail.+-- Run with -q to squelch error. git_annex_shouldfail :: String -> [String] -> IO Bool-git_annex_shouldfail command params = git_annex' command ("-q":params) >>= \case-	Right () -> return False-	Left _ -> return True--git_annex' :: String -> [String] -> IO (Either SomeException ())-git_annex' command params = do-	-- catch all errors, including normally fatal errors-	try run ::IO (Either SomeException ())-  where-	run = GitAnnex.run dummyTestOptParser-		dummyTestRunner-		dummyBenchmarkGenerator-		(command:params)-	dummyTestOptParser = pure mempty-	dummyTestRunner _ = noop-	dummyBenchmarkGenerator _ _ = return noop+git_annex_shouldfail command params = not <$> git_annex command ("-q":params)  {- Runs git-annex and returns its output. -} git_annex_output :: String -> [String] -> IO String git_annex_output command params = do 	pp <- Annex.Path.programPath-	got <- Utility.Process.readProcess pp (command:params)-	-- Since the above is a separate process, code coverage stats are-	-- not gathered for things run in it.-	-- Run same command again, to get code coverage.-	_ <- git_annex command params-	return got+	Utility.Process.readProcess pp (command:params)  git_annex_expectoutput :: String -> [String] -> [String] -> IO () git_annex_expectoutput command params expected = do@@ -102,7 +81,9 @@ innewrepo a = withgitrepo $ \r -> indir r a  inmainrepo :: Assertion -> Assertion-inmainrepo = indir mainrepodir+inmainrepo a = do+	d <- mainrepodir+	indir d a  with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion) with_ssh_origin cloner a = cloner $ do@@ -151,7 +132,8 @@ withtmpclonerepo' :: CloneRepoConfig -> (FilePath -> Assertion) -> Assertion withtmpclonerepo' cfg a = do 	dir <- tmprepodir-	clone <- clonerepo mainrepodir dir cfg+	maindir <- mainrepodir+	clone <- clonerepo maindir dir cfg 	r <- tryNonAsync (a clone) 	case r of 		Right () -> return ()@@ -164,7 +146,9 @@ disconnectOrigin = boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "remote rm"  withgitrepo :: (FilePath -> Assertion) -> Assertion-withgitrepo = bracket (setuprepo mainrepodir) return+withgitrepo a = do+	maindir <- mainrepodir+	bracket (setuprepo maindir) return a  indir :: FilePath -> IO a -> IO a indir dir a = do@@ -369,7 +353,7 @@ 	runchecks as f  annexed_notpresent :: FilePath -> Assertion-annexed_notpresent f = ifM (unlockedFiles <$> getTestMode)+annexed_notpresent f = ifM (hasUnlockedFiles <$> getTestMode) 	( annexed_notpresent_unlocked f 	, annexed_notpresent_locked f 	)@@ -381,7 +365,7 @@ annexed_notpresent_unlocked = runchecks [checkregularfile, checkispointerfile, notinlocationlog]  annexed_present :: FilePath -> Assertion-annexed_present f = ifM (unlockedFiles <$> getTestMode)+annexed_present f = ifM (hasUnlockedFiles <$> getTestMode) 	( annexed_present_unlocked f 	, annexed_present_locked f 	)@@ -395,7 +379,25 @@ annexed_present_unlocked :: FilePath -> Assertion annexed_present_unlocked = runchecks 	[checkregularfile, checkcontent, checkwritable, inlocationlog]+	+annexed_present_imported :: FilePath -> Assertion+annexed_present_imported f = ifM (annexeval Config.crippledFileSystem)+	( annexed_present_unlocked f+	, ifM (adjustedUnlockedBranch <$> getTestMode) +		( annexed_present_unlocked f+		, annexed_present_locked f+		)+	) +annexed_notpresent_imported :: FilePath -> Assertion+annexed_notpresent_imported f = ifM (annexeval Config.crippledFileSystem)+	( annexed_notpresent_unlocked f+	, ifM (adjustedUnlockedBranch <$> getTestMode)+		( annexed_notpresent_unlocked f+		, annexed_notpresent_locked f+		)+	)+ unannexed :: FilePath -> Assertion unannexed = runchecks [checkregularfile, checkcontent, checkwritable] @@ -408,6 +410,7 @@ data TestMode = TestMode 	{ forceDirect :: Bool 	, unlockedFiles :: Bool+	, adjustedUnlockedBranch :: Bool 	, annexVersion :: Types.RepoVersion.RepoVersion 	, keepFailures :: Bool 	} deriving (Read, Show)@@ -416,21 +419,26 @@ testMode opts v = TestMode 	{ forceDirect = False 	, unlockedFiles = False+	, adjustedUnlockedBranch = False 	, annexVersion = v 	, keepFailures = keepFailuresOption opts 	} +hasUnlockedFiles :: TestMode -> Bool+hasUnlockedFiles m = unlockedFiles m || adjustedUnlockedBranch m+ withTestMode :: TestMode -> TestTree -> TestTree -> TestTree withTestMode testmode inittests = withResource prepare release . const   where 	prepare = do 		setTestMode testmode+		setmainrepodir =<< newmainrepodir 		case tryIngredients [consoleTestReporter] mempty inittests of 			Nothing -> error "No tests found!?" 			Just act -> unlessM act $ 				error "init tests failed! cannot continue" 		return ()-	release _ = cleanup mainrepodir+	release _ = noop  setTestMode :: TestMode -> IO () setTestMode testmode = do@@ -456,7 +464,6 @@ 		, ("GIT_ANNEX_USE_GIT_SSH", "1") 		, ("TESTMODE", show testmode) 		]- runFakeSsh :: [String] -> IO () runFakeSsh ("-n":ps) = runFakeSsh ps runFakeSsh (_host:cmd:[]) = do@@ -472,6 +479,9 @@ 	testmode <- getTestMode 	when (forceDirect testmode) $ 		git_annex "direct" ["-q"] @? "git annex direct failed"+	when (adjustedUnlockedBranch testmode) $ do+		boolSystem "git" [Param "commit", Param "--allow-empty", Param "-m", Param "empty"] @? "git commit failed"+		git_annex "adjust" ["--unlock"] @? "git annex adjust failed"  changeToTmpDir :: FilePath -> IO () changeToTmpDir t = do@@ -481,8 +491,24 @@ tmpdir :: String tmpdir = ".t" -mainrepodir :: FilePath-mainrepodir = tmpdir </> "repo"+mainrepodir :: IO FilePath+mainrepodir = Utility.Env.getEnvDefault "MAINREPODIR"+	(giveup "MAINREPODIR not set")++setmainrepodir :: FilePath -> IO ()+setmainrepodir d = Utility.Env.Set.setEnv "MAINREPODIR" d True++newmainrepodir :: IO FilePath+newmainrepodir = go (0 :: Int)+  where+	go n = do+		let d = tmpdir </> "main" ++ show n+		ifM (doesDirectoryExist d)+			( go $ n + 1+			, do+				createDirectory d+				return d+			)  tmprepodir :: IO FilePath tmprepodir = go (0 :: Int)
Types/GitConfig.hs view
@@ -263,6 +263,7 @@ 	, remoteAnnexAndroidDirectory :: Maybe FilePath 	, remoteAnnexAndroidSerial :: Maybe String 	, remoteAnnexGCrypt :: Maybe String+	, remoteAnnexGitLFS :: Bool 	, remoteAnnexDdarRepo :: Maybe String 	, remoteAnnexHookType :: Maybe String 	, remoteAnnexExternalType :: Maybe String@@ -321,6 +322,7 @@ 		, remoteAnnexAndroidDirectory = notempty $ getmaybe "androiddirectory" 		, remoteAnnexAndroidSerial = notempty $ getmaybe "androidserial" 		, remoteAnnexGCrypt = notempty $ getmaybe "gcrypt"+		, remoteAnnexGitLFS = getbool "git-lfs" False 		, remoteAnnexDdarRepo = getmaybe "ddarrepo" 		, remoteAnnexHookType = notempty $ getmaybe "hooktype" 		, remoteAnnexExternalType = notempty $ getmaybe "externaltype"
Types/Remote.hs view
@@ -292,7 +292,7 @@ 		-> [ContentIdentifier] 		-- ^ old content that it's safe to overwrite 		-> MeterUpdate-		-> a (Maybe ContentIdentifier)+		-> a (Either String ContentIdentifier) 	-- This is used rather than removeExport when a special remote 	-- supports imports. 	--
Utility/Env/Set.hs view
@@ -10,7 +10,6 @@ module Utility.Env.Set where  #ifdef mingw32_HOST_OS-import qualified System.Environment as E import qualified System.SetEnv import Utility.Env #else
+ Utility/GitLFS.hs view
@@ -0,0 +1,439 @@+{- git-lfs API+ - + - https://github.com/git-lfs/git-lfs/blob/master/docs/api+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE DeriveGeneric, FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Utility.GitLFS (+	-- * transfer requests+	TransferRequest(..),+	TransferRequestOperation(..),+	TransferAdapter(..),+	TransferRequestObject(..),+	startTransferRequest,+	-- * responses to transfer requests+	TransferResponse(..),+	TransferResponseOperation(..),+	IsTransferResponseOperation,+	DownloadOperation(..),+	UploadOperation(..),+	OperationParams(..),+	ParsedTransferResponse(..),+	parseTransferResponse,+	-- * making transfers+	downloadOperationRequest,+	uploadOperationRequests,+	-- * endpoint discovery+	Endpoint,+	guessEndpoint,+	HostUser,+	sshDiscoverEndpointCommand,+	parseSshDiscoverEndpointResponse,+	-- * errors+	TransferResponseError(..),+	TransferResponseObjectError(..),+	-- * additional data types+	Url,+	SHA256,+	GitRef(..),+	NumSeconds,+	HTTPHeader,+	HTTPHeaderValue,+) where++-- | This implementation of the git-lfs API uses http Request and Response,+-- but leaves actually connecting up the http client to the user.+--+-- You'll want to use a Manager that supports https, since the protocol+-- uses http basic auth.+--+-- Some LFS servers, notably Github's, may require a User-Agent header+-- in some of the requests, in order to allow eg, uploads. No such header+-- is added by dedault, so be sure to add your own.++import Data.Aeson+import Data.Aeson.Types+import GHC.Generics+import Network.HTTP.Client+import Data.List+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import qualified Data.ByteString.Lazy as L+import qualified Data.CaseInsensitive as CI+import qualified Network.URI as URI++data TransferRequest = TransferRequest+	{ req_operation :: TransferRequestOperation+	, req_transfers :: [TransferAdapter]+	, req_ref :: Maybe GitRef+	, req_objects :: [TransferRequestObject]+	}+	deriving (Generic, Show)++instance ToJSON TransferRequest where+	toJSON = genericToJSON transferRequestOptions+	toEncoding = genericToEncoding transferRequestOptions++instance FromJSON TransferRequest where+	parseJSON = genericParseJSON transferRequestOptions++transferRequestOptions :: Options+transferRequestOptions = stripFieldPrefix nonNullOptions++data TransferRequestObject = TransferRequestObject+	{ req_oid :: SHA256+	, req_size :: Integer+	}+	deriving (Generic, Show)++instance ToJSON TransferRequestObject where+	toJSON = genericToJSON transferRequestObjectOptions+	toEncoding = genericToEncoding transferRequestObjectOptions++instance FromJSON TransferRequestObject where+	parseJSON = genericParseJSON transferRequestObjectOptions++transferRequestObjectOptions :: Options+transferRequestObjectOptions = stripFieldPrefix defaultOptions++data TransferRequestOperation = RequestDownload | RequestUpload+	deriving (Show)++instance ToJSON TransferRequestOperation where+	toJSON RequestDownload = "download"+	toJSON RequestUpload = "upload"++instance FromJSON TransferRequestOperation where+	parseJSON (String "download") = pure RequestDownload+	parseJSON (String "upload") = pure RequestUpload+	parseJSON invalid = typeMismatch "TransferRequestOperation" invalid++data TransferResponse op = TransferResponse+	{ transfer :: Maybe TransferAdapter+	, objects :: [TransferResponseOperation op]+	}+	deriving (Generic, Show)++instance IsTransferResponseOperation op => ToJSON (TransferResponse op) where+	toJSON = genericToJSON nonNullOptions+	toEncoding = genericToEncoding nonNullOptions++instance IsTransferResponseOperation op => FromJSON (TransferResponse op)++-- | This is an error with a TransferRequest as a whole. It's also possible+-- for a TransferRequest to overall succeed, but fail for some+-- objects; such failures use TransferResponseObjectError.+data TransferResponseError = TransferResponseError+	{ resperr_message :: T.Text+	, resperr_request_id :: Maybe T.Text+	, resperr_documentation_url :: Maybe Url+	}+	deriving (Generic, Show)++instance ToJSON TransferResponseError where+	toJSON = genericToJSON transferResponseErrorOptions+	toEncoding = genericToEncoding transferResponseErrorOptions++instance FromJSON TransferResponseError where+	parseJSON = genericParseJSON transferResponseErrorOptions++transferResponseErrorOptions :: Options+transferResponseErrorOptions = stripFieldPrefix nonNullOptions++-- | An error with a single object within a TransferRequest.+data TransferResponseObjectError = TransferResponseObjectError+	{ respobjerr_code :: Int+	, respobjerr_message :: T.Text+	}+	deriving (Generic, Show)++instance ToJSON TransferResponseObjectError where+	toJSON = genericToJSON transferResponseObjectErrorOptions+	toEncoding = genericToEncoding transferResponseObjectErrorOptions++instance FromJSON TransferResponseObjectError where+	parseJSON = genericParseJSON transferResponseObjectErrorOptions++transferResponseObjectErrorOptions :: Options+transferResponseObjectErrorOptions = stripFieldPrefix nonNullOptions++data TransferAdapter = Basic+	deriving (Show)++instance ToJSON TransferAdapter where+	toJSON Basic = "basic"++instance FromJSON TransferAdapter where+	parseJSON (String "basic") = pure Basic+	parseJSON invalid = typeMismatch "basic" invalid++data TransferResponseOperation op = TransferResponseOperation+	{ resp_oid :: SHA256+	, resp_size :: Integer+	, resp_authenticated :: Maybe Bool+	, resp_actions :: Maybe op+	, resp_error :: Maybe TransferResponseObjectError+	}+	deriving (Generic, Show)++instance ToJSON op => ToJSON (TransferResponseOperation op) where+	toJSON = genericToJSON transferResponseOperationOptions+	toEncoding = genericToEncoding transferResponseOperationOptions++instance FromJSON op => FromJSON (TransferResponseOperation op) where+	parseJSON = genericParseJSON transferResponseOperationOptions++transferResponseOperationOptions :: Options+transferResponseOperationOptions = stripFieldPrefix nonNullOptions++-- | Class of types that can be responses to a transfer request,+-- that contain an operation to use to make the transfer.+class (FromJSON op, ToJSON op) => IsTransferResponseOperation op++data DownloadOperation = DownloadOperation+	{ download :: OperationParams }+	deriving (Generic, Show)++instance IsTransferResponseOperation DownloadOperation+instance ToJSON DownloadOperation+instance FromJSON DownloadOperation++data UploadOperation = UploadOperation+	{ upload :: OperationParams+	, verify :: Maybe OperationParams+	}+	deriving (Generic, Show)++instance IsTransferResponseOperation UploadOperation++instance ToJSON UploadOperation where+	toJSON = genericToJSON nonNullOptions+	toEncoding = genericToEncoding nonNullOptions++instance FromJSON UploadOperation++data OperationParams = OperationParams+	{ href :: Url+	, header :: Maybe (M.Map HTTPHeader HTTPHeaderValue)+	, expires_in :: Maybe NumSeconds+	, expires_at :: Maybe T.Text+	}+	deriving (Generic, Show)++instance ToJSON OperationParams where+	toJSON = genericToJSON nonNullOptions+	toEncoding = genericToEncoding nonNullOptions++instance FromJSON OperationParams++data Verification = Verification+	{ verification_oid :: SHA256+	, verification_size :: Integer+	}+	deriving (Generic, Show)++instance ToJSON Verification where+	toJSON = genericToJSON verificationOptions+	toEncoding = genericToEncoding verificationOptions++instance FromJSON Verification where+	parseJSON = genericParseJSON verificationOptions++verificationOptions :: Options+verificationOptions = stripFieldPrefix defaultOptions++-- | Sent over ssh connection when using that to find the endpoint.+data SshDiscoveryResponse = SshDiscoveryResponse+	{ endpoint_href :: Url+	, endpoint_header :: Maybe (M.Map HTTPHeader HTTPHeaderValue)+	, endpoint_expires_in :: Maybe NumSeconds+	, endpoint_expires_at :: Maybe T.Text+	} deriving (Generic, Show)++instance ToJSON SshDiscoveryResponse where+	toJSON = genericToJSON sshDiscoveryResponseOptions+	toEncoding = genericToEncoding sshDiscoveryResponseOptions++instance FromJSON SshDiscoveryResponse where+	parseJSON = genericParseJSON sshDiscoveryResponseOptions++sshDiscoveryResponseOptions :: Options+sshDiscoveryResponseOptions = stripFieldPrefix nonNullOptions++data GitRef = GitRef+	{ name :: T.Text }+	deriving (Generic, Show)++instance FromJSON GitRef+instance ToJSON GitRef++type SHA256 = T.Text++-- | The endpoint of a git-lfs server.+data Endpoint+	= EndpointURI URI.URI+	| EndpointDiscovered SshDiscoveryResponse+	deriving (Show)++-- | Command to run via ssh with to discover an endpoint. The FilePath is+-- the location of the git repository on the ssh server.+--+-- Note that, when sshing to the server, you should take care that the+-- hostname you pass to ssh is really a hostname and not something that ssh+-- will parse an an option, such as -oProxyCommand=".+sshDiscoverEndpointCommand :: FilePath -> TransferRequestOperation -> [String]+sshDiscoverEndpointCommand remotepath tro =+	[ "git-lfs-authenticate"+	, remotepath+	, case tro of+		RequestDownload -> "download"+		RequestUpload -> "upload"+	]++-- | Parse the json output when doing ssh endpoint discovery.+parseSshDiscoverEndpointResponse :: L.ByteString -> Maybe Endpoint+parseSshDiscoverEndpointResponse resp = EndpointDiscovered <$> decode resp++-- | Guesses the LFS endpoint from the http url of a git remote.+--+-- https://github.com/git-lfs/git-lfs/blob/master/docs/api/server-discovery.md+guessEndpoint :: URI.URI -> Maybe Endpoint+guessEndpoint uri = case URI.uriScheme uri of+	"https:" -> Just endpoint+	"http:" -> Just endpoint+	_ -> Nothing+  where+	endpoint = EndpointURI $ uri+		-- force https because the git-lfs protocol uses http+		-- basic auth tokens, which should not be exposed+		{ URI.uriScheme = "https:"+		, URI.uriPath = guessedpath+		}+	+	guessedpath+		| ".git" `isSuffixOf` URI.uriPath uri =+			URI.uriPath uri ++ "/info/lfs"+		| ".git/" `isSuffixOf` URI.uriPath uri =+			URI.uriPath uri ++ "info/lfs"+		| otherwise = (droptrailing '/' (URI.uriPath uri)) ++ ".git/info/lfs"+	+	droptrailing c = reverse . dropWhile (== c) . reverse++-- | Makes a Request that will start the process of making a transfer to or+-- from the LFS endpoint.+startTransferRequest :: Endpoint -> TransferRequest -> Maybe Request+startTransferRequest (EndpointURI uri) tr = do+	r <- requestFromURI uri+	return $ addLfsJsonHeaders $ r+		-- Since this uses the LFS batch API, it adds /objects/batch+		-- to the endpoint url.+		{ path = path r <> "/objects/batch"+		, method = "POST"+		, requestBody = RequestBodyLBS (encode tr)+		}+startTransferRequest (EndpointDiscovered sr) tr = do+	uri <- URI.parseURI (T.unpack (endpoint_href sr))+	req <- startTransferRequest (EndpointURI uri) tr+	let headers = map convheader $ maybe [] M.toList $ endpoint_header sr+	return $ req { requestHeaders = requestHeaders req ++ headers }+  where+	convheader (k, v) = (CI.mk (E.encodeUtf8 k), E.encodeUtf8 v)++-- | "user@host" or just the hostname.+type HostUser = String++addLfsJsonHeaders :: Request -> Request+addLfsJsonHeaders r = r+	{ requestHeaders = requestHeaders r +++		[ ("Accept", lfsjson)+		, ("Content-Type", lfsjson)+		]+	}+  where+	lfsjson = "application/vnd.git-lfs+json"++data ParsedTransferResponse op+	= ParsedTransferResponse (TransferResponse op)+	| ParsedTransferResponseError TransferResponseError+	| ParseFailed String++-- | Parse the body of a response to a transfer request.+parseTransferResponse+	:: IsTransferResponseOperation op+	=> L.ByteString+	-> ParsedTransferResponse op+parseTransferResponse resp = case eitherDecode resp of+	Right tr -> ParsedTransferResponse tr+	-- If unable to decode as a TransferResponse, try to decode+	-- as a TransferResponseError instead, in case the LFS server+	-- sent an error message.+	Left err ->+		either (const $ ParseFailed err) ParsedTransferResponseError $+			eitherDecode resp++-- | Builds a http request to perform a download.+downloadOperationRequest :: DownloadOperation -> Maybe Request+downloadOperationRequest = operationParamsRequest . download++-- | Builds http request to perform an upload. The content to upload is+-- provided in the RequestBody, along with its SHA256 and size.+--+-- When the LFS server requested verification, there will be a second+-- Request that does that; it should be run only after the upload has+-- succeeded.+--+-- When the LFS server already contains the object, an empty list may be+-- returned.+uploadOperationRequests :: UploadOperation -> RequestBody -> SHA256 -> Integer -> Maybe [Request]+uploadOperationRequests op content oid size = +	case (mkdlreq, mkverifyreq) of+		(Nothing, _) -> Nothing+		(Just dlreq, Nothing) -> Just [dlreq]+		(Just dlreq, Just verifyreq) -> Just [dlreq, verifyreq]+  where+	mkdlreq = mkdlreq'+		<$> operationParamsRequest (upload op)+	mkdlreq' r = r+		{ method = "PUT"+		, requestBody = content+		}+	mkverifyreq = mkverifyreq'+		<$> (operationParamsRequest =<< verify op)+	mkverifyreq' r = addLfsJsonHeaders $ r+		{ method = "POST"+		, requestBody = RequestBodyLBS $ encode $+			Verification oid size+		}++operationParamsRequest :: OperationParams -> Maybe Request+operationParamsRequest ps = do+	r <- parseRequest (T.unpack (href ps))+	let headers = map convheader $ maybe [] M.toList (header ps)+	return $ r { requestHeaders = headers }+  where+	convheader (k, v) = (CI.mk (E.encodeUtf8 k), E.encodeUtf8 v)++type Url = T.Text++type NumSeconds = Integer++type HTTPHeader = T.Text++type HTTPHeaderValue = T.Text++-- Prevent Nothing from serializing to null.+nonNullOptions :: Options+nonNullOptions = defaultOptions { omitNothingFields = True }++-- Remove prefix from field names.+stripFieldPrefix :: Options -> Options+stripFieldPrefix o =+	o { fieldLabelModifier = drop 1 . dropWhile (/= '_') }
Utility/Gpg.hs view
@@ -16,10 +16,10 @@ import System.Posix.IO import Utility.Env import Utility.Env.Set+import Utility.FileMode #else import Utility.Tmp #endif-import Utility.FileMode import Utility.Format (decode_c)  import Control.Concurrent
Utility/InodeCache.hs view
@@ -48,7 +48,6 @@  #ifdef mingw32_HOST_OS import Data.Word (Word64)-import System.Directory #else import System.Posix.Files #endif
Utility/Metered.hs view
@@ -210,7 +210,14 @@  - to update a meter.  -} commandMeter :: ProgressParser -> OutputHandler -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool-commandMeter progressparser oh meterupdate cmd params = +commandMeter progressparser oh meterupdate cmd params = do+	ret <- commandMeter' progressparser oh meterupdate cmd params+	return $ case ret of+		Just ExitSuccess -> True+		_ -> False++commandMeter' :: ProgressParser -> OutputHandler -> MeterUpdate -> FilePath -> [CommandParam] -> IO (Maybe ExitCode)+commandMeter' progressparser oh meterupdate cmd params =  	outputFilter cmd params Nothing 		(feedprogress zeroBytesProcessed []) 		handlestderr@@ -245,9 +252,13 @@ demeterCommand oh cmd params = demeterCommandEnv oh cmd params Nothing  demeterCommandEnv :: OutputHandler -> FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool-demeterCommandEnv oh cmd params environ = outputFilter cmd params environ-	(\outh -> avoidProgress True outh stdouthandler)-	(\errh -> avoidProgress True errh $ stderrHandler oh)+demeterCommandEnv oh cmd params environ = do+	ret <- outputFilter cmd params environ+		(\outh -> avoidProgress True outh stdouthandler)+		(\errh -> avoidProgress True errh $ stderrHandler oh)+	return $ case ret of+		Just ExitSuccess -> True+		_ -> False   where 	stdouthandler l =  		unless (quietMode oh) $@@ -270,16 +281,15 @@ 	-> Maybe [(String, String)] 	-> (Handle -> IO ()) 	-> (Handle -> IO ())-	-> IO Bool-outputFilter cmd params environ outfilter errfilter = catchBoolIO $ do+	-> IO (Maybe ExitCode)+outputFilter cmd params environ outfilter errfilter = catchMaybeIO $ do 	(_, Just outh, Just errh, pid) <- createProcess p 		{ std_out = CreatePipe 		, std_err = CreatePipe 		} 	void $ async $ tryIO (outfilter outh) >> hClose outh 	void $ async $ tryIO (errfilter errh) >> hClose errh-	ret <- checkSuccessProcess pid-	return ret+	waitForProcess pid   where 	p = (proc cmd (toCommand params)) 		{ env = environ }
Utility/Path/Max.hs view
@@ -11,13 +11,13 @@ module Utility.Path.Max where  import System.FilePath-import Data.List-import Control.Applicative-import Prelude  #ifndef mingw32_HOST_OS import Utility.Exception import System.Posix.Files+import Data.List+import Control.Applicative+import Prelude #endif  {- Maximum size to use for a file in a specified directory.
Utility/Rsync.hs view
@@ -103,7 +103,16 @@  - The params must enable rsync's --progress mode for this to work.  -} rsyncProgress :: OutputHandler -> MeterUpdate -> [CommandParam] -> IO Bool-rsyncProgress oh meter = commandMeter parseRsyncProgress oh meter "rsync" . rsyncParamsFixup+rsyncProgress oh meter ps =+	commandMeter' parseRsyncProgress oh meter "rsync" (rsyncParamsFixup ps) >>= \case+		Just ExitSuccess -> return True+		Just (ExitFailure exitcode) -> do+			when (exitcode /= 1) $+				hPutStrLn stderr $ "rsync exited " ++ show exitcode+			return False+		Nothing -> do+			hPutStrLn stderr $ "unable to run rsync"+			return False  {- Strategy: Look for chunks prefixed with \r (rsync writes a \r before  - the first progress output, and each thereafter). The first number
Utility/Url.hs view
@@ -29,6 +29,7 @@ 	assumeUrlExists, 	download, 	downloadQuiet,+	downloadConduit, 	sinkResponseFile, 	downloadPartial, 	parseURIRelaxed,@@ -335,12 +336,11 @@ 			case (urlDownloader uo, parseUrlRequest (show u)) of 				(DownloadWithConduit (DownloadWithCurlRestricted r), Just req) -> catchJust 					(matchStatusCodeException (== found302))-					(downloadconduit req)+					(downloadConduit meterupdate req file uo >> return True) 					(followredir r) 				(DownloadWithConduit (DownloadWithCurlRestricted r), Nothing) 					| isfileurl u -> downloadfile u 					| isftpurl u -> downloadcurlrestricted r u url ftpport-						`catchNonAsync` (dlfailed . show) 					| otherwise -> unsupportedUrlScheme u dlfailed 				(DownloadWithCurl _, _) 					| isfileurl u -> downloadfile u@@ -354,58 +354,6 @@  	ftpport = 21 -	downloadconduit req = catchMaybeIO (getFileSize file) >>= \case-		Just sz | sz > 0 -> resumeconduit req' sz-		_ -> runResourceT $ do-			liftIO $ debugM "url" (show req')-			resp <- http req' (httpManager uo)-			if responseStatus resp == ok200-				then store zeroBytesProcessed WriteMode resp-				else showrespfailure resp-	  where-		req' = applyRequest uo $ req-			-- Override http-client's default decompression of gzip-			-- compressed files. We want the unmodified file content.-			{ requestHeaders = (hAcceptEncoding, "identity") :-				filter ((/= hAcceptEncoding) . fst)-					(requestHeaders req)-			, decompress = const False-			}-	-	alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 -		&& case lookup hContentRange h of-			-- This could be improved by fixing-			-- https://github.com/aristidb/http-types/issues/87-			Just crh -> crh == B8.fromString ("bytes */" ++ show sz)-			-- Some http servers send no Content-Range header when-			-- the range extends beyond the end of the file.-			-- There is no way to distinguish between the file-			-- being the same size on the http server, vs-			-- it being shorter than the file we already have.-			-- So assume we have the whole content of the file-			-- already, the same as wget and curl do.-			Nothing -> True--	-- Resume download from where a previous download was interrupted, -	-- when supported by the http server. The server may also opt to-	-- send the whole file rather than resuming.-	resumeconduit req sz = catchJust-		(matchStatusCodeHeadersException (alreadydownloaded sz))-		dl-		(const $ return True)-	  where-		dl = runResourceT $ do-			let req' = req { requestHeaders = resumeFromHeader sz : requestHeaders req }-			liftIO $ debugM "url" (show req')-			resp <- http req' (httpManager uo)-			if responseStatus resp == partialContent206-				then store (BytesProcessed sz) AppendMode resp-				else if responseStatus resp == ok200-					then store zeroBytesProcessed WriteMode resp-					else showrespfailure resp-	-	showrespfailure = liftIO . dlfailed . B8.toString -		. statusMessage . responseStatus 	showhttpexception he = do 		let msg = case he of 			HttpExceptionRequest _ (StatusCodeException r _) ->@@ -417,6 +365,7 @@ 			HttpExceptionRequest _ other -> show other 			_ -> show he 		dlfailed msg+	 	dlfailed msg 		| noerror = return False 		| otherwise = do@@ -424,10 +373,6 @@ 			hFlush stderr 			return False 	-	store initialp mode resp = do-		sinkResponseFile meterupdate initialp file mode resp-		return True-	 	basecurlparams = curlParams uo 		[ if noerror 			then Param "-S"@@ -453,6 +398,8 @@ 			L.writeFile file 		return True +	-- Conduit does not support ftp, so will throw an exception on a+	-- redirect to a ftp url; fall back to curl. 	followredir r ex@(HttpExceptionRequest _ (StatusCodeException resp _)) =  		case headMaybe $ map decodeBS $ getResponseHeader hLocation resp of 			Just url' -> case parseURIRelaxed url' of@@ -463,6 +410,68 @@ 			Nothing -> throwIO ex 	followredir _ ex = throwIO ex +{- Download a perhaps large file using conduit, with auto-resume+ - of incomplete downloads.+ -+ - Does not catch exceptions.+ -}+downloadConduit :: MeterUpdate -> Request -> FilePath -> UrlOptions -> IO ()+downloadConduit meterupdate req file uo =+	catchMaybeIO (getFileSize file) >>= \case+		Just sz | sz > 0 -> resumedownload sz+		_ -> runResourceT $ do+			liftIO $ debugM "url" (show req')+			resp <- http req' (httpManager uo)+			if responseStatus resp == ok200+				then store zeroBytesProcessed WriteMode resp+				else respfailure resp+  where+	req' = applyRequest uo $ req+		-- Override http-client's default decompression of gzip+		-- compressed files. We want the unmodified file content.+		{ requestHeaders = (hAcceptEncoding, "identity") :+			filter ((/= hAcceptEncoding) . fst)+				(requestHeaders req)+		, decompress = const False+		}++	-- Resume download from where a previous download was interrupted, +	-- when supported by the http server. The server may also opt to+	-- send the whole file rather than resuming.+	resumedownload sz = catchJust+		(matchStatusCodeHeadersException (alreadydownloaded sz))+		dl+		(const noop)+	  where+		dl = runResourceT $ do+			let req'' = req' { requestHeaders = resumeFromHeader sz : requestHeaders req }+			liftIO $ debugM "url" (show req'')+			resp <- http req'' (httpManager uo)+			if responseStatus resp == partialContent206+				then store (BytesProcessed sz) AppendMode resp+				else if responseStatus resp == ok200+					then store zeroBytesProcessed WriteMode resp+					else respfailure resp+	+	alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 +		&& case lookup hContentRange h of+			-- This could be improved by fixing+			-- https://github.com/aristidb/http-types/issues/87+			Just crh -> crh == B8.fromString ("bytes */" ++ show sz)+			-- Some http servers send no Content-Range header when+			-- the range extends beyond the end of the file.+			-- There is no way to distinguish between the file+			-- being the same size on the http server, vs+			-- it being shorter than the file we already have.+			-- So assume we have the whole content of the file+			-- already, the same as wget and curl do.+			Nothing -> True+	+	store initialp mode resp =+		sinkResponseFile meterupdate initialp file mode resp+	+	respfailure = giveup . B8.toString . statusMessage . responseStatus+	 {- Sinks a Response's body to a file. The file can either be opened in  - WriteMode or AppendMode. Updates the meter as data is received.  -
doc/git-annex-adjust.mdwn view
@@ -24,6 +24,11 @@ and to other repositories, as well as to merge in changes from other repositories, run `git annex sync`. +When in an adjusted branch, using `git merge otherbranch` is often not+ideal, because merging a non-adjusted branch may lead to unncessary+merge conflicts, or add files in non-adjusted form. To avoid those+problems, use `git annex merge otherbranch`.+ Re-running this command with the same options while inside the adjusted branch will update the adjusted branch as necessary (eg for `--hide-missing`), and will also propagate commits
doc/git-annex-import.mdwn view
@@ -35,17 +35,23 @@ To import from a special remote, you must specify the name of a branch. A corresponding remote tracking branch will be updated by `git annex import`. After that point, it's the same as if you had run a `git fetch`-from a regular git remote; you can `git merge` the changes into your+from a regular git remote; you can merge the changes into your currently checked out branch.  For example:  	git annex import master --from myremote-	git merge myremote/master+	git annex merge myremote/master -Note that you may need to pass `--allow-unrelated-histories` the first time-you `git merge` from an import. Think of this as the remote being a-separate git repository with its own files. If you first+You could just as well use `git merge myremote/master` as the second step,+but using `git-annex merge` avoids a couple of gotchas. When using adjusted+branches, it adjusts the branch before merging from it. And it avoids+the merge failing on the first merge from an import due to unrelated+histories.++If you do use `git merge`, you can pass `--allow-unrelated-histories` the+first time you `git merge` from an import. Think of this as the remote+being a separate git repository with its own files. If you first `git annex export` files to a remote, and then `git annex import` from it, you won't need that option. 
doc/git-annex-merge.mdwn view
@@ -1,17 +1,22 @@ # NAME -git-annex merge - automatically merge changes from remotes+git-annex merge - merge changes from remotes  # SYNOPSIS -git annex merge+git annex merge [branch]  # DESCRIPTION -This performs the same merging (and merge conflict resolution)-that is done by the sync command, but without pushing or pulling any-data.+When run without any parameters, this performs the same merging (and merge+conflict resolution) that is done by the sync command, but without pushing+or pulling any data. +When a branch to merge is specified, this merges it, using the same merge+conflict resolution as the sync command. This is especially useful on+an adjusted branch, because it applies the same adjustment to the+branch before merging it.+ When annex.resolvemerge is set to false, merge conflict resolution will not be done. @@ -20,6 +25,8 @@ [[git-annex]](1)  [[git-annex-sync]](1)++[[git-annex-adjust]](1)  # AUTHOR 
doc/git-annex.mdwn view
@@ -1546,71 +1546,71 @@    For example, to use the wipe command, set it to `wipe -f %file`. -* `remote.<name>.rsyncurl`+* `remote.<name>.annex-rsyncurl`    Used by rsync special remotes, this configures   the location of the rsync repository to use. Normally this is automatically   set up by `git annex initremote`, but you can change it if needed. -* `remote.<name>.buprepo`+* `remote.<name>.annex-buprepo`    Used by bup special remotes, this configures   the location of the bup repository to use. Normally this is automatically   set up by `git annex initremote`, but you can change it if needed. -* `remote.<name>.ddarrepo`+* `remote.<name>.annex-ddarrepo`    Used by ddar special remotes, this configures   the location of the ddar repository to use. Normally this is automatically   set up by `git annex initremote`, but you can change it if needed. -* `remote.<name>.directory`+* `remote.<name>.annex-directory`    Used by directory special remotes, this configures   the location of the directory where annexed files are stored for this   remote. Normally this is automatically set up by `git annex initremote`,   but you can change it if needed. -* `remote.<name>.adb`+* `remote.<name>.annex-adb`    Used to identify remotes on Android devices accessed via adb.   Normally this is automatically set up by `git annex initremote`. -* `remote.<name>.androiddirectory`+* `remote.<name>.annex-androiddirectory`    Used by adb special remotes, this is the directory on the Android   device where files are stored for this remote. Normally this is   automatically set up by `git annex initremote`, but you can change   it if needed. -* `remote.<name>.androidserial`+* `remote.<name>.annex-androidserial`    Used by adb special remotes, this is the serial number of the Android   device used by the remote. Normally this is automatically set up by   `git annex initremote`, but you can change it if needed, eg when   upgrading to a new Android device. -* `remote.<name>.s3`+* `remote.<name>.annex-s3`    Used to identify Amazon S3 special remotes.   Normally this is automatically set up by `git annex initremote`. -* `remote.<name>.glacier`+* `remote.<name>.annex-glacier`    Used to identify Amazon Glacier special remotes.   Normally this is automatically set up by `git annex initremote`. -* `remote.<name>.webdav`+* `remote.<name>.annex-webdav`    Used to identify webdav special remotes.   Normally this is automatically set up by `git annex initremote`. -* `remote.<name>.tahoe`+* `remote.<name>.annex-tahoe`    Used to identify tahoe special remotes.   Points to the configuration directory for tahoe. -* `remote.<name>.gcrypt`+* `remote.<name>.annex-gcrypt`    Used to identify gcrypt special remotes.   Normally this is automatically set up by `git annex initremote`.@@ -1619,7 +1619,14 @@   If the gcrypt remote is accessible over ssh and has git-annex-shell   available to manage it, it's set to "shell". -* `remote.<name>.hooktype`, `remote.<name>.externaltype`+* `remote.<name>.annex-git-lfs`++  Used to identify git-lfs special remotes.+  Normally this is automatically set up by `git annex initremote`.++  It is set to "true" if this is a git-lfs remote.++* `remote.<name>.annex-hooktype`, `remote.<name>.annex-externaltype`    Used by hook special remotes and external special remotes to record   the type of the remote.
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20190730+Version: 7.20190819 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -393,7 +393,8 @@       Win32 (>= 2.6.1.0),       unix-compat (>= 0.5),       setenv,-      process (>= 1.6.2.0)+      process (>= 1.6.2.0),+      silently (>= 1.2.5.1)   else     Build-Depends: unix (>= 2.7.2) @@ -931,6 +932,7 @@     Remote.External.Types     Remote.GCrypt     Remote.Git+    Remote.GitLFS     Remote.Glacier     Remote.Helper.AWS     Remote.Helper.Chunked@@ -1039,6 +1041,7 @@     Utility.FileSystemEncoding     Utility.Format     Utility.FreeDesktop+    Utility.GitLFS     Utility.Glob     Utility.Gpg     Utility.Hash
stack.yaml view
@@ -23,6 +23,7 @@ - torrent-10000.1.1 - sandi-0.5 - http-client-0.5.14+- silently-1.2.5.1 explicit-setup-deps:   git-annex: true resolver: lts-13.29