make encrypted remotes have slightly higher costs

This commit is contained in:
Joey Hess 2011-04-17 01:13:21 -04:00
parent 89fab6c7b8
commit 50cfcdf54b
3 changed files with 21 additions and 2 deletions

View file

@ -52,10 +52,25 @@ remoteCost r def = do
cheapRemoteCost :: Int
cheapRemoteCost = 100
semiCheapRemoteCost :: Int
semiCheapRemoteCost = 150
semiCheapRemoteCost = 110
expensiveRemoteCost :: Int
expensiveRemoteCost = 200
{- Adjust's a remote's cost to reflect it being encrypted. -}
encryptedRemoteCostAdj :: Int
encryptedRemoteCostAdj = 50
{- Make sure the remote cost numbers work out. -}
prop_cost_sane :: Bool
prop_cost_sane = False `notElem`
[ expensiveRemoteCost > 0
, cheapRemoteCost < semiCheapRemoteCost
, semiCheapRemoteCost < expensiveRemoteCost
, cheapRemoteCost + encryptedRemoteCostAdj > semiCheapRemoteCost
, cheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
, semiCheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
]
{- Checks if a repo should be ignored, based either on annex-ignore
- setting, or on command-line options. Allows command-line to override
- annex-ignore. -}

View file

@ -15,6 +15,7 @@ import RemoteClass
import Crypto
import qualified Annex
import Messages
import Config
{- Encryption setup for a remote. The user must specify whether to use
- an encryption key, or not encrypt. An encrypted cipher is created, or is
@ -48,7 +49,8 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
storeKey = store,
retrieveKeyFile = retrieve,
removeKey = withkey $ removeKey r,
hasKey = withkey $ hasKey r
hasKey = withkey $ hasKey r,
cost = cost r + encryptedRemoteCostAdj
}
where
store k = do

View file

@ -39,6 +39,7 @@ import qualified Remote
import qualified Content
import qualified Command.DropUnused
import qualified Key
import qualified Config
main :: IO ()
main = do
@ -61,6 +62,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
, qctest "prop_relPathDirToDir_basics" Utility.prop_relPathDirToDir_basics
, qctest "prop_cost_sane" Config.prop_cost_sane
]
blackbox :: Test