f85ca7dc80
A couple of these were probably actual bugs in edge cases. Most of the changes I'm fine with. The fact that aeson's object returns sometihng that we know will be an Object, but the type checker does not know is kind of annoying.
82 lines
2.6 KiB
Haskell
82 lines
2.6 KiB
Haskell
{- Remote costs.
|
|
-
|
|
- Copyright 2011-2013 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL 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 = case insertCostAfter lastsegment 0 of
|
|
(_dup:new:l') -> firstsegment ++ [costBetween item new, new] ++ l'
|
|
_ -> error "insertCostAfter internal error"
|
|
| 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
|
|
]
|