7189dfd77d
* webapp: Detect when upgrades are available, and upgrade if the user
desires.
(Only when git-annex is installed using the prebuilt binaries
from git-annex upstream, not from eg Debian.)
* assistant: Detect when the git-annex binary is modified or replaced,
and either prompt the user to restart the program, or automatically
restart it.
* annex.autoupgrade configures both the above upgrade behaviors.
* Added support for quvi 0.9. Slightly suboptimal due to limitations in its
interface compared with the old version.
* Bug fix: annex.version did not get set on automatic upgrade to v5 direct
mode repo, so the upgrade was performed repeatedly, slowing commands down.
* webapp: Fix bug that broke switching between local repositories
that use the new guarded direct mode.
* Android: Fix stripping of the git-annex binary.
* Android: Make terminal app show git-annex version number.
* Android: Re-enable XMPP support.
* reinject: Allow to be used in direct mode.
* Futher improvements to git repo repair. Has now been tested in tens
of thousands of intentionally damaged repos, and successfully
repaired them all.
* Allow use of --unused in bare repository.
# imported from the archive
82 lines
2.5 KiB
Haskell
82 lines
2.5 KiB
Haskell
{- Remote costs.
|
|
-
|
|
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Config.Cost where
|
|
|
|
{- We use a float for a cost to ensure that there is a cost in
|
|
- between any two other costs. -}
|
|
type Cost = Float
|
|
|
|
{- Some predefined default costs.
|
|
- Users setting costs in config files can be aware of these,
|
|
- and pick values relative to them. So don't change. -}
|
|
cheapRemoteCost :: Cost
|
|
cheapRemoteCost = 100
|
|
nearlyCheapRemoteCost :: Cost
|
|
nearlyCheapRemoteCost = 110
|
|
semiExpensiveRemoteCost :: Cost
|
|
semiExpensiveRemoteCost = 175
|
|
expensiveRemoteCost :: Cost
|
|
expensiveRemoteCost = 200
|
|
veryExpensiveRemoteCost :: Cost
|
|
veryExpensiveRemoteCost = 1000
|
|
|
|
{- Adjusts a remote's cost to reflect it being encrypted. -}
|
|
encryptedRemoteCostAdj :: Cost
|
|
encryptedRemoteCostAdj = 50
|
|
|
|
{- Given an ordered list of costs, and the position of one of the items
|
|
- the list, inserts a new cost into the list, in between the item
|
|
- and the item after it.
|
|
-
|
|
- If two or move items have the same cost, their costs are adjusted
|
|
- to make room. The costs of other items in the list are left
|
|
- unchanged.
|
|
-
|
|
- To insert the new cost before any other in the list, specify a negative
|
|
- position. To insert the new cost at the end of the list, specify a
|
|
- position longer than the list.
|
|
-}
|
|
insertCostAfter :: [Cost] -> Int -> [Cost]
|
|
insertCostAfter [] _ = []
|
|
insertCostAfter l pos
|
|
| pos < 0 = costBetween 0 (l !! 0) : l
|
|
| nextpos > maxpos = l ++ [1 + l !! maxpos]
|
|
| item == nextitem =
|
|
let (_dup:new:l') = insertCostAfter lastsegment 0
|
|
in firstsegment ++ [costBetween item new, new] ++ l'
|
|
| otherwise =
|
|
firstsegment ++ [costBetween item nextitem ] ++ lastsegment
|
|
where
|
|
nextpos = pos + 1
|
|
maxpos = length l - 1
|
|
|
|
item = l !! pos
|
|
nextitem = l !! nextpos
|
|
|
|
(firstsegment, lastsegment) = splitAt (pos + 1) l
|
|
|
|
costBetween :: Cost -> Cost -> Cost
|
|
costBetween x y
|
|
| x == y = x
|
|
| x > y = -- avoid fractions unless needed
|
|
let mid = y + (x - y) / 2
|
|
mid' = fromIntegral (floor mid :: Int)
|
|
in if mid' > y then mid' else mid
|
|
| otherwise = costBetween y x
|
|
|
|
{- Make sure the remote cost numbers work out. -}
|
|
prop_cost_sane :: Bool
|
|
prop_cost_sane = False `notElem`
|
|
[ expensiveRemoteCost > 0
|
|
, cheapRemoteCost < nearlyCheapRemoteCost
|
|
, nearlyCheapRemoteCost < semiExpensiveRemoteCost
|
|
, semiExpensiveRemoteCost < expensiveRemoteCost
|
|
, cheapRemoteCost + encryptedRemoteCostAdj > nearlyCheapRemoteCost
|
|
, nearlyCheapRemoteCost + encryptedRemoteCostAdj < semiExpensiveRemoteCost
|
|
, nearlyCheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
|
|
]
|