use NonEmpty for dirHashes
This avoids 4 uses of head.
This commit is contained in:
		
					parent
					
						
							
								43f31121a5
							
						
					
				
			
			
				commit
				
					
						10216b44d2
					
				
			
		
					 8 changed files with 34 additions and 22 deletions
				
			
		|  | @ -1,4 +1,4 @@ | ||||||
| {- git-annex file locations | {- git-annex object file locations | ||||||
|  - |  - | ||||||
|  - Copyright 2010-2019 Joey Hess <id@joeyh.name> |  - Copyright 2010-2019 Joey Hess <id@joeyh.name> | ||||||
|  - |  - | ||||||
|  | @ -19,6 +19,7 @@ module Annex.DirHashes ( | ||||||
| 
 | 
 | ||||||
| import Data.Default | import Data.Default | ||||||
| import Data.Bits | import Data.Bits | ||||||
|  | import qualified Data.List.NonEmpty as NE | ||||||
| import qualified Data.ByteArray as BA | import qualified Data.ByteArray as BA | ||||||
| import qualified Data.ByteArray.Encoding as BA | import qualified Data.ByteArray.Encoding as BA | ||||||
| import qualified Data.ByteString as S | import qualified Data.ByteString as S | ||||||
|  | @ -60,8 +61,8 @@ branchHashDir = hashDirLower . branchHashLevels | ||||||
|  - To support that, some git-annex repositories use the lower case-hash. |  - To support that, some git-annex repositories use the lower case-hash. | ||||||
|  - All special remotes use the lower-case hash for new data, but old data |  - All special remotes use the lower-case hash for new data, but old data | ||||||
|  - may still use the mixed case hash. -} |  - may still use the mixed case hash. -} | ||||||
| dirHashes :: [HashLevels -> Hasher] | dirHashes :: NE.NonEmpty (HashLevels -> Hasher) | ||||||
| dirHashes = [hashDirLower, hashDirMixed] | dirHashes = hashDirLower NE.:| [hashDirMixed] | ||||||
| 
 | 
 | ||||||
| hashDirs :: HashLevels -> Int -> S.ByteString -> RawFilePath | hashDirs :: HashLevels -> Int -> S.ByteString -> RawFilePath | ||||||
| hashDirs (HashLevels 1) sz s = P.addTrailingPathSeparator $ S.take sz s | hashDirs (HashLevels 1) sz s = P.addTrailingPathSeparator $ S.take sz s | ||||||
|  |  | ||||||
|  | @ -118,6 +118,7 @@ module Annex.Locations ( | ||||||
| 
 | 
 | ||||||
| import Data.Char | import Data.Char | ||||||
| import Data.Default | import Data.Default | ||||||
|  | import qualified Data.List.NonEmpty as NE | ||||||
| import qualified Data.ByteString.Char8 as S8 | import qualified Data.ByteString.Char8 as S8 | ||||||
| import qualified System.FilePath.ByteString as P | import qualified System.FilePath.ByteString as P | ||||||
| 
 | 
 | ||||||
|  | @ -775,5 +776,5 @@ keyPath key hasher = hasher key P.</> f P.</> f | ||||||
|  - This is compatible with the annexLocationsNonBare and annexLocationsBare, |  - This is compatible with the annexLocationsNonBare and annexLocationsBare, | ||||||
|  - for interoperability between special remotes and git-annex repos. |  - for interoperability between special remotes and git-annex repos. | ||||||
|  -} |  -} | ||||||
| keyPaths :: Key -> [RawFilePath] | keyPaths :: Key -> NE.NonEmpty RawFilePath | ||||||
| keyPaths key = map (\h -> keyPath key (h def)) dirHashes | keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes | ||||||
|  |  | ||||||
|  | @ -9,10 +9,12 @@ module Assistant.Gpg where | ||||||
| 
 | 
 | ||||||
| import Utility.Gpg | import Utility.Gpg | ||||||
| import Utility.UserInfo | import Utility.UserInfo | ||||||
|  | import Utility.PartialPrelude | ||||||
| import Types.Remote (RemoteConfigField) | import Types.Remote (RemoteConfigField) | ||||||
| import Annex.SpecialRemote.Config | import Annex.SpecialRemote.Config | ||||||
| import Types.ProposedAccepted | import Types.ProposedAccepted | ||||||
| 
 | 
 | ||||||
|  | import Data.Maybe | ||||||
| import qualified Data.Map as M | import qualified Data.Map as M | ||||||
| import Control.Applicative | import Control.Applicative | ||||||
| import Prelude | import Prelude | ||||||
|  | @ -23,10 +25,11 @@ newUserId cmd = do | ||||||
| 	oldkeys <- secretKeys cmd | 	oldkeys <- secretKeys cmd | ||||||
| 	username <- either (const "unknown") id <$> myUserName | 	username <- either (const "unknown") id <$> myUserName | ||||||
| 	let basekeyname = username ++ "'s git-annex encryption key" | 	let basekeyname = username ++ "'s git-annex encryption key" | ||||||
| 	return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys) | 	return $ fromMaybe (error "internal") $ headMaybe $ | ||||||
| 		( basekeyname | 		filter (\n -> M.null $ M.filter (== n) oldkeys) | ||||||
| 		: map (\n -> basekeyname ++ show n) ([2..] :: [Int]) | 			( basekeyname | ||||||
| 		) | 			: map (\n -> basekeyname ++ show n) ([2..] :: [Int]) | ||||||
|  | 			) | ||||||
| 
 | 
 | ||||||
| data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption | data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption | ||||||
| 	deriving (Eq) | 	deriving (Eq) | ||||||
|  |  | ||||||
|  | @ -307,7 +307,7 @@ bup2GitRemote r | ||||||
| 	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir | 	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir | ||||||
|   where |   where | ||||||
| 	bits = splitc ':' r | 	bits = splitc ':' r | ||||||
| 	host = Prelude.head bits | 	host = fromMaybe "" $ headMaybe bits | ||||||
| 	dir = intercalate ":" $ drop 1 bits | 	dir = intercalate ":" $ drop 1 bits | ||||||
| 	-- "host:~user/dir" is not supported specially by bup; | 	-- "host:~user/dir" is not supported specially by bup; | ||||||
| 	-- "host:dir" is relative to the home directory; | 	-- "host:dir" is relative to the home directory; | ||||||
|  |  | ||||||
|  | @ -17,6 +17,7 @@ module Remote.Directory ( | ||||||
| 
 | 
 | ||||||
| import qualified Data.ByteString.Lazy as L | import qualified Data.ByteString.Lazy as L | ||||||
| import qualified Data.Map as M | import qualified Data.Map as M | ||||||
|  | import qualified Data.List.NonEmpty as NE | ||||||
| import qualified System.FilePath.ByteString as P | import qualified System.FilePath.ByteString as P | ||||||
| import Data.Default | import Data.Default | ||||||
| import System.PosixCompat.Files (isRegularFile, deviceID) | import System.PosixCompat.Files (isRegularFile, deviceID) | ||||||
|  | @ -166,8 +167,11 @@ directorySetup _ mu _ c gc = do | ||||||
| {- Locations to try to access a given Key in the directory. | {- Locations to try to access a given Key in the directory. | ||||||
|  - We try more than one since we used to write to different hash |  - We try more than one since we used to write to different hash | ||||||
|  - directories. -} |  - directories. -} | ||||||
| locations :: RawFilePath -> Key -> [RawFilePath] | locations :: RawFilePath -> Key -> NE.NonEmpty RawFilePath | ||||||
| locations d k = map (d P.</>) (keyPaths k) | locations d k = NE.map (d P.</>) (keyPaths k) | ||||||
|  | 
 | ||||||
|  | locations' :: RawFilePath -> Key -> [RawFilePath] | ||||||
|  | locations' d k = NE.toList (locations d k) | ||||||
| 
 | 
 | ||||||
| {- Returns the location off a Key in the directory. If the key is | {- Returns the location off a Key in the directory. If the key is | ||||||
|  - present, returns the location that is actually used, otherwise |  - present, returns the location that is actually used, otherwise | ||||||
|  | @ -175,8 +179,9 @@ locations d k = map (d P.</>) (keyPaths k) | ||||||
| getLocation :: RawFilePath -> Key -> IO RawFilePath | getLocation :: RawFilePath -> Key -> IO RawFilePath | ||||||
| getLocation d k = do | getLocation d k = do | ||||||
| 	let locs = locations d k | 	let locs = locations d k | ||||||
| 	fromMaybe (Prelude.head locs) | 	fromMaybe (NE.head locs) | ||||||
| 		<$> firstM (doesFileExist . fromRawFilePath) locs | 		<$> firstM (doesFileExist . fromRawFilePath) | ||||||
|  | 			(NE.toList locs) | ||||||
| 
 | 
 | ||||||
| {- Directory where the file(s) for a key are stored. -} | {- Directory where the file(s) for a key are stored. -} | ||||||
| storeDir :: RawFilePath -> Key -> RawFilePath | storeDir :: RawFilePath -> Key -> RawFilePath | ||||||
|  | @ -246,7 +251,7 @@ finalizeStoreGeneric d tmp dest = do | ||||||
| 	dest' = fromRawFilePath dest | 	dest' = fromRawFilePath dest | ||||||
| 
 | 
 | ||||||
| retrieveKeyFileM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Retriever | retrieveKeyFileM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Retriever | ||||||
| retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations d | retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations' d | ||||||
| retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do | retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do | ||||||
| 	src <- liftIO $ fromRawFilePath <$> getLocation d k | 	src <- liftIO $ fromRawFilePath <$> getLocation d k | ||||||
| 	void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv | 	void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv | ||||||
|  | @ -311,8 +316,8 @@ removeDirGeneric removeemptyparents topdir dir = do | ||||||
| 		goparents (upFrom subdir) =<< tryIO (removeDirectory d) | 		goparents (upFrom subdir) =<< tryIO (removeDirectory d) | ||||||
| 
 | 
 | ||||||
| checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent | checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent | ||||||
| checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k | checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations' k | ||||||
| checkPresentM d _ k = checkPresentGeneric d (locations d k) | checkPresentM d _ k = checkPresentGeneric d (locations' d k) | ||||||
| 
 | 
 | ||||||
| checkPresentGeneric :: RawFilePath -> [RawFilePath] -> Annex Bool | checkPresentGeneric :: RawFilePath -> [RawFilePath] -> Annex Bool | ||||||
| checkPresentGeneric d ps = checkPresentGeneric' d $ | checkPresentGeneric d ps = checkPresentGeneric' d $ | ||||||
|  |  | ||||||
|  | @ -51,6 +51,7 @@ import Annex.Verify | ||||||
| import qualified Utility.RawFilePath as R | import qualified Utility.RawFilePath as R | ||||||
| 
 | 
 | ||||||
| import qualified Data.Map as M | import qualified Data.Map as M | ||||||
|  | import qualified Data.List.NonEmpty as NE | ||||||
| 
 | 
 | ||||||
| remote :: RemoteType | remote :: RemoteType | ||||||
| remote = specialRemoteType $ RemoteType | remote = specialRemoteType $ RemoteType | ||||||
|  | @ -222,7 +223,7 @@ rsyncSetup _ mu _ c gc = do | ||||||
| store :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex () | store :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex () | ||||||
| store o k src meterupdate = storeGeneric o meterupdate basedest populatedest | store o k src meterupdate = storeGeneric o meterupdate basedest populatedest | ||||||
|   where |   where | ||||||
| 	basedest = fromRawFilePath $ Prelude.head (keyPaths k) | 	basedest = fromRawFilePath $ NE.head (keyPaths k) | ||||||
| 	populatedest dest = liftIO $ if canrename | 	populatedest dest = liftIO $ if canrename | ||||||
| 		then do | 		then do | ||||||
| 			R.rename (toRawFilePath src) (toRawFilePath dest) | 			R.rename (toRawFilePath src) (toRawFilePath dest) | ||||||
|  |  | ||||||
|  | @ -22,6 +22,7 @@ import Utility.Split | ||||||
| 
 | 
 | ||||||
| import Data.Default | import Data.Default | ||||||
| import System.FilePath.Posix | import System.FilePath.Posix | ||||||
|  | import qualified Data.List.NonEmpty as NE | ||||||
| 
 | 
 | ||||||
| type RsyncUrl = String | type RsyncUrl = String | ||||||
| 
 | 
 | ||||||
|  | @ -42,7 +43,7 @@ mkRsyncUrl :: RsyncOpts -> FilePath -> RsyncUrl | ||||||
| mkRsyncUrl o f = rsyncUrl o </> rsyncEscape o f | mkRsyncUrl o f = rsyncUrl o </> rsyncEscape o f | ||||||
| 
 | 
 | ||||||
| rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] | rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] | ||||||
| rsyncUrls o k = map use dirHashes | rsyncUrls o k = map use (NE.toList dirHashes) | ||||||
|   where |   where | ||||||
| 	use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f) | 	use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f) | ||||||
| 	f = fromRawFilePath (keyFile k) | 	f = fromRawFilePath (keyFile k) | ||||||
|  |  | ||||||
							
								
								
									
										6
									
								
								Test.hs
									
										
									
									
									
								
							
							
						
						
									
										6
									
								
								Test.hs
									
										
									
									
									
								
							|  | @ -1940,9 +1940,9 @@ test_gpg_crypto = do | ||||||
| 		checkFile mvariant filename = | 		checkFile mvariant filename = | ||||||
| 			Utility.Gpg.checkEncryptionFile gpgcmd (Just environ) filename $ | 			Utility.Gpg.checkEncryptionFile gpgcmd (Just environ) filename $ | ||||||
| 				if mvariant == Just Types.Crypto.PubKey then ks else Nothing | 				if mvariant == Just Types.Crypto.PubKey then ks else Nothing | ||||||
| 		serializeKeys cipher = map fromRawFilePath .  | 		serializeKeys cipher = map fromRawFilePath . NE.toList  | ||||||
| 			Annex.Locations.keyPaths . | 			. Annex.Locations.keyPaths | ||||||
| 			Crypto.encryptKey Types.Crypto.HmacSha1 cipher | 			. Crypto.encryptKey Types.Crypto.HmacSha1 cipher | ||||||
| #else | #else | ||||||
| test_gpg_crypto = putStrLn "gpg testing not implemented on Windows" | test_gpg_crypto = putStrLn "gpg testing not implemented on Windows" | ||||||
| #endif | #endif | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess