From f56594af9e6ec2d726b98d7bb16fb8c9382ecde4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 13 Apr 2018 15:16:07 -0400 Subject: [PATCH] finish fixing inverted Ord for TrustLevel Flipped all comparisons. When a TrustLevel list was wanted from Trusted downwards, used Down to compare it in that order. This commit was sponsored by mo on Patreon. --- Annex/SpecialRemote.hs | 3 +-- Command/Move.hs | 2 +- Command/Vicfg.hs | 20 +++++++++----------- Limit.hs | 2 +- Logs/Trust.hs | 2 +- Logs/Trust/Pure.hs | 2 +- Types/TrustLevel.hs | 10 ++++++++-- 7 files changed, 22 insertions(+), 19 deletions(-) diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs index 4f2f99a537..64f90852bf 100644 --- a/Annex/SpecialRemote.hs +++ b/Annex/SpecialRemote.hs @@ -26,8 +26,7 @@ findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig)) findExisting name = do t <- trustMap headMaybe - . reverse - -- . sortBy (comparing $ \(u, _c) -> M.lookup u t) + . sortBy (comparing $ \(u, _c) -> Down $ M.lookup u t) . findByName name <$> Logs.Remote.readRemoteLog diff --git a/Command/Move.hs b/Command/Move.hs index 6b02528803..529dbb0e68 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -300,6 +300,6 @@ willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile = checktrustlevel = do desttrust <- lookupTrust destuuid srctrust <- lookupTrust srcuuid - return True -- return (desttrust >= srctrust || desttrust > UnTrusted) + return (desttrust > UnTrusted || desttrust >= srctrust) data DropCheck = DropWorse | DropAllowed | DropCheckNumCopies diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 9bf31f1f4b..6048c8bbcc 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -15,6 +15,7 @@ import System.Environment (getEnv) import Data.Tuple (swap) import Data.Char (isSpace) import Data.Default +import Data.Ord import Command import Annex.Perms @@ -63,7 +64,7 @@ vicfg curcfg f = do Right newcfg -> setCfg curcfg newcfg data Cfg = Cfg - { cfgTrustMap :: TrustMap + { cfgTrustMap :: M.Map UUID (Down TrustLevel) , cfgGroupMap :: M.Map UUID (S.Set Group) , cfgPreferredContentMap :: M.Map UUID PreferredContentExpression , cfgRequiredContentMap :: M.Map UUID PreferredContentExpression @@ -75,7 +76,7 @@ data Cfg = Cfg getCfg :: Annex Cfg getCfg = Cfg - <$> trustMapRaw -- without local trust overrides + <$> (M.map Down <$> trustMapRaw) -- without local trust overrides <*> (groupsByUUID <$> groupMap) <*> preferredContentMapRaw <*> requiredContentMapRaw @@ -87,7 +88,7 @@ getCfg = Cfg setCfg :: Cfg -> Cfg -> Annex () setCfg curcfg newcfg = do let diff = diffCfg curcfg newcfg - mapM_ (uncurry trustSet) $ M.toList $ cfgTrustMap diff + mapM_ (uncurry trustSet) $ M.toList $ M.map (\(Down v) -> v) $ cfgTrustMap diff mapM_ (uncurry groupSet) $ M.toList $ cfgGroupMap diff mapM_ (uncurry preferredContentSet) $ M.toList $ cfgPreferredContentMap diff mapM_ (uncurry requiredContentSet) $ M.toList $ cfgRequiredContentMap diff @@ -151,18 +152,15 @@ genCfg cfg descs = unlines $ intercalate [""] , com " setting field = value" ] - trust = undefined - -- TODO: Down order - {- settings cfg descs cfgTrustMap + trust = settings cfg descs cfgTrustMap [ com "Repository trust configuration" , com "(Valid trust levels: " ++ trustlevels ++ ")" ] - (\(t, u) -> line "trust" u $ showTrustLevel t) + (\(Down t, u) -> line "trust" u $ showTrustLevel t) (\u -> lcom $ line "trust" u $ showTrustLevel def) where - trustlevels = "XXX" -- unwords $ reverse $ - -- map showTrustLevel [minBound..maxBound] - -} + trustlevels = unwords $ reverse $ + map showTrustLevel [minBound..maxBound] groups = settings cfg descs cfgGroupMap [ com "Repository groups" @@ -281,7 +279,7 @@ parseCfg defcfg = go [] defcfg . lines | setting == "trust" = case readTrustLevel val of Nothing -> badval "trust value" val Just t -> - let m = M.insert u t (cfgTrustMap cfg) + let m = M.insert u (Down t) (cfgTrustMap cfg) in Right $ cfg { cfgTrustMap = m } | setting == "group" = let m = M.insert u (S.fromList $ words val) (cfgGroupMap cfg) diff --git a/Limit.hs b/Limit.hs index 918f4a3999..483336eb9f 100644 --- a/Limit.hs +++ b/Limit.hs @@ -180,7 +180,7 @@ limitCopies want = case splitc ':' want of checktrust checker u = checker <$> lookupTrust u checkgroup g u = S.member g <$> lookupGroups u parsetrustspec s - -- | "+" `isSuffixOf` s = (<=) <$> readTrustLevel (beginning s) + | "+" `isSuffixOf` s = (<=) <$> readTrustLevel (beginning s) | otherwise = (==) <$> readTrustLevel s {- Adds a limit to match files that need more copies made. -} diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 95843c882e..706140b65c 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -72,7 +72,7 @@ trustMapLoad = do map (\r -> (Types.Remote.uuid r, UnTrusted)) exports logged <- trustMapRaw let configured = M.fromList $ mapMaybe configuredtrust l - let m = --M.unionWith max exportoverrides $ + let m = M.unionWith min exportoverrides $ M.union overrides $ M.union configured logged Annex.changeState $ \s -> s { Annex.trustmap = Just m } diff --git a/Logs/Trust/Pure.hs b/Logs/Trust/Pure.hs index e67583b568..74b7fd38cb 100644 --- a/Logs/Trust/Pure.hs +++ b/Logs/Trust/Pure.hs @@ -31,6 +31,6 @@ showTrustLog DeadTrusted = "X" showTrustLog SemiTrusted = "?" prop_parse_show_TrustLog :: Bool -prop_parse_show_TrustLog = True -- all check [minBound .. maxBound] +prop_parse_show_TrustLog = all check [minBound .. maxBound] where check l = parseTrustLog (showTrustLog l) == l diff --git a/Types/TrustLevel.hs b/Types/TrustLevel.hs index f0ff495eba..8aec125d7d 100644 --- a/Types/TrustLevel.hs +++ b/Types/TrustLevel.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE FlexibleInstances #-} + module Types.TrustLevel ( TrustLevel(..), TrustMap, @@ -15,15 +17,19 @@ module Types.TrustLevel ( import qualified Data.Map as M import Data.Default +import Data.Ord import Types.UUID data TrustLevel = DeadTrusted | UnTrusted | SemiTrusted | Trusted - deriving (Eq, Bounded, Show) + deriving (Eq, Enum, Ord, Bounded, Show) instance Default TrustLevel where def = SemiTrusted +instance Default (Down TrustLevel) where + def = Down def + type TrustMap = M.Map UUID TrustLevel readTrustLevel :: String -> Maybe TrustLevel @@ -40,6 +46,6 @@ showTrustLevel SemiTrusted = "semitrusted" showTrustLevel DeadTrusted = "dead" prop_read_show_TrustLevel :: Bool -prop_read_show_TrustLevel = True -- all check [minBound .. maxBound] +prop_read_show_TrustLevel = all check [minBound .. maxBound] where check l = readTrustLevel (showTrustLevel l) == Just l