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.
This commit is contained in:
Joey Hess 2018-04-13 15:16:07 -04:00
parent a0e4b9678b
commit f56594af9e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
7 changed files with 22 additions and 19 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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