Merge branch 'master' into v8

Git/CatFile.hs

@@ -148,13 +148,12 @@ parseResp object l
 	| " missing" `isSuffixOf` l -- less expensive than full check
 		&& l == fromRef object ++ " missing" = Just DNE
 	| otherwise = case words l of
-		[sha, objtype, size]
-			| length sha == shaSize ->
-				case (readObjectType (encodeBS objtype), reads size) of
-					(Just t, [(bytes, "")]) -> 
-						Just $ ParsedResp (Ref sha) bytes t
-					_ -> Nothing
-			| otherwise -> Nothing
+		[sha, objtype, size] -> case extractSha sha of
+			Just sha' -> case (readObjectType (encodeBS objtype), reads size) of
+				(Just t, [(bytes, "")]) -> 
+					Just $ ParsedResp sha' bytes t
+				_ -> Nothing
+			Nothing -> Nothing
 		_ -> Nothing
 
 querySingle :: CommandParam -> Ref -> Repo -> (Handle -> IO a) -> IO (Maybe a)

Git/Config.hs

@@ -1,6 +1,6 @@
 {- git repository configuration handling
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -14,6 +14,7 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import Data.Char
 import qualified System.FilePath.ByteString as P
+import Control.Concurrent.Async
 
 import Common
 import Git
@@ -184,19 +185,22 @@ coreBare = "core.bare"
 
 {- Runs a command to get the configuration of a repo,
  - and returns a repo populated with the configuration, as well as the raw
- - output of the command. -}
-fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString))
+ - output and any standard output of the command. -}
+fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
 fromPipe r cmd params = try $
-	withHandle StdoutHandle createProcessSuccess p $ \h -> do
-		val <- S.hGetContents h
+	withOEHandles createProcessSuccess p $ \(hout, herr) -> do
+		geterr <- async $ S.hGetContents herr
+		getval <- async $ S.hGetContents hout
+		val <- wait getval
+		err <- wait geterr
 		r' <- store val r
-		return (r', val)
+		return (r', val, err)
   where
 	p = proc cmd $ toCommand params
 
 {- Reads git config from a specified file and returns the repo populated
  - with the configuration. -}
-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString))
+fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
 fromFile r f = fromPipe r "git"
 	[ Param "config"
 	, Param "--file"

Git/Credential.hs

@@ -1,6 +1,6 @@
 {- git credential interface
  -
- - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,6 +22,23 @@ credentialUsername = M.lookup "username" . fromCredential
 credentialPassword :: Credential -> Maybe String
 credentialPassword = M.lookup "password" . fromCredential
 
+credentialBasicAuth :: Credential -> Maybe BasicAuth
+credentialBasicAuth cred = BasicAuth
+	<$> credentialUsername cred
+	<*> credentialPassword cred
+
+getBasicAuthFromCredential :: Repo -> GetBasicAuth
+getBasicAuthFromCredential r u = do
+	c <- getUrlCredential u r
+	case credentialBasicAuth c of
+		Just ba -> return $ Just (ba, signalsuccess c)
+		Nothing -> do
+			signalsuccess c False
+			return Nothing
+  where
+	signalsuccess c True = approveUrlCredential c r
+	signalsuccess c False = rejectUrlCredential c r
+
 -- | This may prompt the user for login information, or get cached login
 -- information.
 getUrlCredential :: URLString -> Repo -> IO Credential

Git/DiffTree.hs

@@ -77,14 +77,14 @@ diffFiles = getdiff (Param "diff-files")
  - is adjusted to be the same as diff-tree --raw._-}
 diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 diffLog params = getdiff (Param "log")
-	(Param "-n1" : Param "--abbrev=40" : Param "--pretty=format:" : params)
+	(Param "-n1" : Param "--no-abbrev" : Param "--pretty=format:" : params)
 
 {- Uses git show to get the changes made by a commit.
  -
  - Does not support merge commits, and will fail on them. -}
 commitDiff :: Sha -> Repo -> IO ([DiffTreeItem], IO Bool)
 commitDiff ref = getdiff (Param "show")
-	[ Param "--abbrev=40", Param "--pretty=", Param "--raw", Param (fromRef ref) ]
+	[ Param "--no-abbrev", Param "--pretty=", Param "--raw", Param (fromRef ref) ]
 
 getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 getdiff command params repo = do
@@ -119,10 +119,7 @@ parseDiffRaw l = go l
 		readmode = fst . Prelude.head . readOct
 
 		-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
-		-- All fields are fixed, so we can pull them out of
-		-- specific positions in the line.
 		(srcm, past_srcm) = splitAt 7 $ drop 1 info
 		(dstm, past_dstm) = splitAt 7 past_srcm
-		(ssha, past_ssha) = splitAt shaSize past_dstm
-		(dsha, past_dsha) = splitAt shaSize $ drop 1 past_ssha
-		s = drop 1 past_dsha
+		(ssha, past_ssha) = separate (== ' ') past_dstm
+		(dsha, s) = separate (== ' ') past_ssha

Git/DiffTreeItem.hs

@@ -17,8 +17,8 @@ import Git.Types
 data DiffTreeItem = DiffTreeItem
 	{ srcmode :: FileMode
 	, dstmode :: FileMode
-	, srcsha :: Sha -- nullSha if file was added
-	, dstsha :: Sha -- nullSha if file was deleted
+	, srcsha :: Sha -- null sha if file was added
+	, dstsha :: Sha -- null sha if file was deleted
 	, status :: String
 	, file :: TopFilePath
 	} deriving Show

Git/LsFiles.hs

@@ -162,17 +162,20 @@ stagedDetails = stagedDetails' []
 stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails' ps l repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
-	return (map parse ls, cleanup)
+	return (map parseStagedDetails ls, cleanup)
   where
 	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
 		Param "--" : map (File . fromRawFilePath) l
-	parse s
-		| null file = (L.toStrict s, Nothing, Nothing)
-		| otherwise = (toRawFilePath file, extractSha $ take shaSize rest, readmode mode)
-	  where
-		(metadata, file) = separate (== '\t') (decodeBL' s)
-		(mode, rest) = separate (== ' ') metadata
-		readmode = fst <$$> headMaybe . readOct
+
+parseStagedDetails :: L.ByteString -> StagedDetails
+parseStagedDetails s
+	| null file = (L.toStrict s, Nothing, Nothing)
+	| otherwise = (toRawFilePath file, extractSha sha, readmode mode)
+  where
+	(metadata, file) = separate (== '\t') (decodeBL' s)
+	(mode, metadata') = separate (== ' ') metadata
+	(sha, _) = separate (== ' ') metadata'
+	readmode = fst <$$> headMaybe . readOct
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}

Git/LsTree.hs

@@ -21,7 +21,6 @@ module Git.LsTree (
 import Common
 import Git
 import Git.Command
-import Git.Sha
 import Git.FilePath
 import qualified Git.Filename
 import Utility.Attoparsec
@@ -94,10 +93,10 @@ parserLsTree = TreeItem
 	<$> octal
 	<* A8.char ' '
 	-- type
-	<*> A.takeTill (== 32)
+	<*> A8.takeTill (== ' ')
 	<* A8.char ' '
 	-- sha
-	<*> (Ref . decodeBS' <$> A.take shaSize)
+	<*> (Ref . decodeBS' <$> A8.takeTill (== '\t'))
 	<* A8.char '\t'
 	-- file
 	<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)

Git/Sha.hs

@@ -1,6 +1,6 @@
 {- git SHA stuff
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011,2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -21,8 +21,8 @@ getSha subcommand a = maybe bad return =<< extractSha <$> a
  - it, but nothing else. -}
 extractSha :: String -> Maybe Sha
 extractSha s
-	| len == shaSize = val s
-	| len == shaSize + 1 && length s' == shaSize = val s'
+	| len `elem` shaSizes = val s
+	| len - 1 `elem` shaSizes && length s' == len - 1 = val s'
 	| otherwise = Nothing
   where
 	len = length s
@@ -31,13 +31,30 @@ extractSha s
 		| all (`elem` "1234567890ABCDEFabcdef") v = Just $ Ref v
 		| otherwise = Nothing
 
-{- Size of a git sha. -}
-shaSize :: Int
-shaSize = 40
+{- Sizes of git shas. -}
+shaSizes :: [Int]
+shaSizes = 
+	[ 40 -- sha1 (must come first)
+	, 64 -- sha256
+	]
 
-nullSha :: Ref		
-nullSha = Ref $ replicate shaSize '0'
+{- Git plumbing often uses a all 0 sha to represent things like a
+ - deleted file. -}
+nullShas :: [Sha]
+nullShas = map (\n -> Ref (replicate n '0')) shaSizes
 
-{- Git's magic empty tree. -}
+{- Sha to provide to git plumbing when deleting a file.
+ -
+ - It's ok to provide a sha1; git versions that use sha256 will map the
+ - sha1 to the sha256, or probably just treat all null sha1 specially
+ - the same as all null sha256. -}
+deleteSha :: Sha
+deleteSha = Prelude.head nullShas
+
+{- Git's magic empty tree.
+ -
+ - It's ok to provide the sha1 of this to git to refer to an empty tree;
+ - git versions that use sha256 will map the sha1 to the sha256.
+ -}
 emptyTree :: Ref
 emptyTree = Ref "4b825dc642cb6eb9a060e54bf8d69288fbee4904"

Git/UnionMerge.hs

@@ -82,7 +82,7 @@ doMerge hashhandle ch differ repo streamer = do
  - a line suitable for update-index that union merges the two sides of the
  - diff. -}
 mergeFile :: String -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
-mergeFile info file hashhandle h = case filter (/= nullSha) [Ref asha, Ref bsha] of
+mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, Ref bsha] of
 	[] -> return Nothing
 	(sha:[]) -> use sha
 	shas -> use

Git/UpdateIndex.hs

@@ -108,7 +108,7 @@ unstageFile file repo = do
 unstageFile' :: TopFilePath -> Streamer
 unstageFile' p = pureStreamer $ L.fromStrict $
 	"0 "
-	<> encodeBS' (fromRef nullSha)
+	<> encodeBS' (fromRef deleteSha)
 	<> "\t"
 	<> indexPath p