make encrypted remotes have slightly higher costs
This commit is contained in:
parent
89fab6c7b8
commit
50cfcdf54b
3 changed files with 21 additions and 2 deletions
17
Config.hs
17
Config.hs
|
@ -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. -}
|
||||
|
|
|
@ -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
|
||||
|
|
2
test.hs
2
test.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue