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 :: Int
cheapRemoteCost = 100 cheapRemoteCost = 100
semiCheapRemoteCost :: Int semiCheapRemoteCost :: Int
semiCheapRemoteCost = 150 semiCheapRemoteCost = 110
expensiveRemoteCost :: Int expensiveRemoteCost :: Int
expensiveRemoteCost = 200 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 {- Checks if a repo should be ignored, based either on annex-ignore
- setting, or on command-line options. Allows command-line to override - setting, or on command-line options. Allows command-line to override
- annex-ignore. -} - annex-ignore. -}

View file

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

View file

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