From 10216b44d24c4050c449301d37889dba40ddaa42 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 26 Sep 2024 18:15:00 -0400 Subject: [PATCH] use NonEmpty for dirHashes This avoids 4 uses of head. --- Annex/DirHashes.hs | 7 ++++--- Annex/Locations.hs | 5 +++-- Assistant/Gpg.hs | 11 +++++++---- Remote/Bup.hs | 2 +- Remote/Directory.hs | 19 ++++++++++++------- Remote/Rsync.hs | 3 ++- Remote/Rsync/RsyncUrl.hs | 3 ++- Test.hs | 6 +++--- 8 files changed, 34 insertions(+), 22 deletions(-) diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs index 7311acf3e6..0c6e932711 100644 --- a/Annex/DirHashes.hs +++ b/Annex/DirHashes.hs @@ -1,4 +1,4 @@ -{- git-annex file locations +{- git-annex object file locations - - Copyright 2010-2019 Joey Hess - @@ -19,6 +19,7 @@ module Annex.DirHashes ( import Data.Default import Data.Bits +import qualified Data.List.NonEmpty as NE import qualified Data.ByteArray as BA import qualified Data.ByteArray.Encoding as BA 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. - All special remotes use the lower-case hash for new data, but old data - may still use the mixed case hash. -} -dirHashes :: [HashLevels -> Hasher] -dirHashes = [hashDirLower, hashDirMixed] +dirHashes :: NE.NonEmpty (HashLevels -> Hasher) +dirHashes = hashDirLower NE.:| [hashDirMixed] hashDirs :: HashLevels -> Int -> S.ByteString -> RawFilePath hashDirs (HashLevels 1) sz s = P.addTrailingPathSeparator $ S.take sz s diff --git a/Annex/Locations.hs b/Annex/Locations.hs index e28fb7c5ad..5d7e75f58c 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -118,6 +118,7 @@ module Annex.Locations ( import Data.Char import Data.Default +import qualified Data.List.NonEmpty as NE import qualified Data.ByteString.Char8 as S8 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, - for interoperability between special remotes and git-annex repos. -} -keyPaths :: Key -> [RawFilePath] -keyPaths key = map (\h -> keyPath key (h def)) dirHashes +keyPaths :: Key -> NE.NonEmpty RawFilePath +keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes diff --git a/Assistant/Gpg.hs b/Assistant/Gpg.hs index 01226e0640..e6391d179d 100644 --- a/Assistant/Gpg.hs +++ b/Assistant/Gpg.hs @@ -9,10 +9,12 @@ module Assistant.Gpg where import Utility.Gpg import Utility.UserInfo +import Utility.PartialPrelude import Types.Remote (RemoteConfigField) import Annex.SpecialRemote.Config import Types.ProposedAccepted +import Data.Maybe import qualified Data.Map as M import Control.Applicative import Prelude @@ -23,10 +25,11 @@ newUserId cmd = do oldkeys <- secretKeys cmd username <- either (const "unknown") id <$> myUserName let basekeyname = username ++ "'s git-annex encryption key" - return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys) - ( basekeyname - : map (\n -> basekeyname ++ show n) ([2..] :: [Int]) - ) + return $ fromMaybe (error "internal") $ headMaybe $ + filter (\n -> M.null $ M.filter (== n) oldkeys) + ( basekeyname + : map (\n -> basekeyname ++ show n) ([2..] :: [Int]) + ) data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption deriving (Eq) diff --git a/Remote/Bup.hs b/Remote/Bup.hs index b490c79ad5..1cd2dcb165 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -307,7 +307,7 @@ bup2GitRemote r | otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir where bits = splitc ':' r - host = Prelude.head bits + host = fromMaybe "" $ headMaybe bits dir = intercalate ":" $ drop 1 bits -- "host:~user/dir" is not supported specially by bup; -- "host:dir" is relative to the home directory; diff --git a/Remote/Directory.hs b/Remote/Directory.hs index a70ce15a51..cebd5e61fe 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -17,6 +17,7 @@ module Remote.Directory ( import qualified Data.ByteString.Lazy as L import qualified Data.Map as M +import qualified Data.List.NonEmpty as NE import qualified System.FilePath.ByteString as P import Data.Default 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. - We try more than one since we used to write to different hash - directories. -} -locations :: RawFilePath -> Key -> [RawFilePath] -locations d k = map (d P.) (keyPaths k) +locations :: RawFilePath -> Key -> NE.NonEmpty RawFilePath +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 - 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 d k = do let locs = locations d k - fromMaybe (Prelude.head locs) - <$> firstM (doesFileExist . fromRawFilePath) locs + fromMaybe (NE.head locs) + <$> firstM (doesFileExist . fromRawFilePath) + (NE.toList locs) {- Directory where the file(s) for a key are stored. -} storeDir :: RawFilePath -> Key -> RawFilePath @@ -246,7 +251,7 @@ finalizeStoreGeneric d tmp dest = do dest' = fromRawFilePath dest 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 src <- liftIO $ fromRawFilePath <$> getLocation d k void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv @@ -311,8 +316,8 @@ removeDirGeneric removeemptyparents topdir dir = do goparents (upFrom subdir) =<< tryIO (removeDirectory d) checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent -checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k -checkPresentM d _ k = checkPresentGeneric d (locations d k) +checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations' k +checkPresentM d _ k = checkPresentGeneric d (locations' d k) checkPresentGeneric :: RawFilePath -> [RawFilePath] -> Annex Bool checkPresentGeneric d ps = checkPresentGeneric' d $ diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 719489aae6..3479e7bb12 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -51,6 +51,7 @@ import Annex.Verify import qualified Utility.RawFilePath as R import qualified Data.Map as M +import qualified Data.List.NonEmpty as NE remote :: RemoteType remote = specialRemoteType $ RemoteType @@ -222,7 +223,7 @@ rsyncSetup _ mu _ c gc = do store :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex () store o k src meterupdate = storeGeneric o meterupdate basedest populatedest where - basedest = fromRawFilePath $ Prelude.head (keyPaths k) + basedest = fromRawFilePath $ NE.head (keyPaths k) populatedest dest = liftIO $ if canrename then do R.rename (toRawFilePath src) (toRawFilePath dest) diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs index d0e1714557..8b3c2eba14 100644 --- a/Remote/Rsync/RsyncUrl.hs +++ b/Remote/Rsync/RsyncUrl.hs @@ -22,6 +22,7 @@ import Utility.Split import Data.Default import System.FilePath.Posix +import qualified Data.List.NonEmpty as NE type RsyncUrl = String @@ -42,7 +43,7 @@ mkRsyncUrl :: RsyncOpts -> FilePath -> RsyncUrl mkRsyncUrl o f = rsyncUrl o rsyncEscape o f rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] -rsyncUrls o k = map use dirHashes +rsyncUrls o k = map use (NE.toList dirHashes) where use h = rsyncUrl o hash h rsyncEscape o (f f) f = fromRawFilePath (keyFile k) diff --git a/Test.hs b/Test.hs index 851ec29b1b..eecd7f6590 100644 --- a/Test.hs +++ b/Test.hs @@ -1940,9 +1940,9 @@ test_gpg_crypto = do checkFile mvariant filename = Utility.Gpg.checkEncryptionFile gpgcmd (Just environ) filename $ if mvariant == Just Types.Crypto.PubKey then ks else Nothing - serializeKeys cipher = map fromRawFilePath . - Annex.Locations.keyPaths . - Crypto.encryptKey Types.Crypto.HmacSha1 cipher + serializeKeys cipher = map fromRawFilePath . NE.toList + . Annex.Locations.keyPaths + . Crypto.encryptKey Types.Crypto.HmacSha1 cipher #else test_gpg_crypto = putStrLn "gpg testing not implemented on Windows" #endif -- 2.30.2