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…
Reference in a new issue