use NonEmpty for dirHashes

This avoids 4 uses of head.
This commit is contained in:
Joey Hess 2024-09-26 18:15:00 -04:00
parent 43f31121a5
commit 10216b44d2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 34 additions and 22 deletions

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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;

View file

@ -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 $

View file

@ -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)

View file

@ -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)

View file

@ -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