From 94d351004688992f8aeac7d03da55d179ef50e8c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 6 Aug 2016 21:39:38 -0400 Subject: more cost calculation and refactored Tunables --- .gitignore | 2 + Cost.hs | 76 ++++++++++++++++++++++++++++++++++ Encryption.hs | 42 ++++++++++++++----- ExpensiveHash.hs | 45 ++++++++------------ Tunables.hs | 41 +++++++++++++++++++ Types.hs | 11 ----- Utility/HumanTime.hs | 102 ++++++++++++++++++++++++++++++++++++++++++++++ Utility/PartialPrelude.hs | 70 +++++++++++++++++++++++++++++++ Utility/QuickCheck.hs | 45 ++++++++++++++++++++ 9 files changed, 383 insertions(+), 51 deletions(-) create mode 100644 Cost.hs create mode 100644 Tunables.hs create mode 100644 Utility/HumanTime.hs create mode 100644 Utility/PartialPrelude.hs create mode 100644 Utility/QuickCheck.hs diff --git a/.gitignore b/.gitignore index a261f29..0ff70cb 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,3 @@ dist/* +*.o +*.hi diff --git a/Cost.hs b/Cost.hs new file mode 100644 index 0000000..0425707 --- /dev/null +++ b/Cost.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Cost where + +import Utility.HumanTime +import Data.Monoid + +-- | An estimated cost to perform an operation. +data Cost op = CPUCost Seconds | GPUCost Seconds | CombinedCost (Cost op) (Cost op) + deriving (Show) + +newtype Seconds = Seconds Integer + deriving (Num) + +instance Show Seconds where + show (Seconds n) = fromDuration (Duration n) + +-- | Cost in seconds, with the type of hardware needed. +totalCost :: Cost op -> (Seconds, [UsingHardware]) +totalCost (CPUCost s) = (s, [UsingCPU]) +totalCost (GPUCost s) = (s, [UsingGPU]) +totalCost (CombinedCost a b) = + let (s1, h1) = totalCost a + (s2, h2) = totalCost b + in (s1+s2, h1++h2) + +data UsingHardware = UsingCPU | UsingGPU | UsingASIC + deriving (Show) + +raiseCostPower :: Cost c -> Entropy e -> Cost c +raiseCostPower c (Entropy e) = adjustCost c (* 2^e) + +adjustCost :: Cost c -> (Seconds -> Seconds) -> Cost c +adjustCost (CPUCost s) f = CPUCost (f s) +adjustCost (GPUCost s) f = GPUCost (f s) +adjustCost (CombinedCost a b) f = CombinedCost (adjustCost a f) (adjustCost b f) + +castCost :: Cost a -> Cost b +castCost (CPUCost s) = CPUCost s +castCost (GPUCost s) = GPUCost s +castCost (CombinedCost a b) = CombinedCost (castCost a) (castCost b) + +instance Monoid (Cost t) where + mempty = CPUCost (Seconds 0) + CPUCost (Seconds a) `mappend` CPUCost (Seconds b) = + CPUCost (Seconds (a+b)) + GPUCost (Seconds a) `mappend` GPUCost (Seconds b) = + GPUCost (Seconds (a+b)) + a `mappend` b = CombinedCost a b + +-- | Operations whose cost can be measured. +data DecryptionOp +data CreationOp +data BruteForceOp + +-- | Calculation of a cost that depends on some amount of entropy. +type CostCalc op t = Entropy t -> Cost op + +-- | Number of bits of entropy +newtype Entropy t = Entropy Int + +-- | Entropy can never go negative when subtracting bits from it. +reduceEntropy :: Entropy t -> Int -> Entropy t +reduceEntropy (Entropy a) b = Entropy (max 0 (a - b)) + +-- | Things that can have entropy +data UnknownPassword + +-- | CostCalc for a brute force linear search through an entropy space +-- in which each step entails paying a cost. +-- +-- On average, the solution will be found half way through. +-- This is equivilant to one bit less of entropy. +bruteForceLinearSearch :: Cost step -> CostCalc BruteForceOp t +bruteForceLinearSearch stepcost e = + castCost stepcost `raiseCostPower` reduceEntropy e 1 diff --git a/Encryption.hs b/Encryption.hs index 083aedd..98afdfd 100644 --- a/Encryption.hs +++ b/Encryption.hs @@ -3,23 +3,37 @@ module Encryption where import Types +import Cost +import Tunables import ExpensiveHash import qualified Data.ByteString as B import Raaz.Core.Encode import qualified Raaz.Cipher.AES as AES import Data.Word +import Data.Monoid -- | An AES key, which is used to encrypt the key that is stored -- in keysafe. -newtype KeyEncryptionKey = KeyEncryptionKey AES.KEY256 +data KeyEncryptionKey = KeyEncryptionKey + AES.KEY256 + (Cost DecryptionOp) + (CostCalc BruteForceOp UnknownPassword) --- | An ExpensiveHash of the KeyIdent and a RandomObstacle are combined --- to form the AES key. --- --- An attacker has to brute force both, while a legitimate user --- only has to brute force the RandomObstacle. -genKeyEncryptionKey :: KeyIdent -> Password -> KeyEncryptionKey -genKeyEncryptionKey = undefined +-- | The ExpensiveHash of the Password is combined with a +-- RandomObstacle to form the AES key. Combination method is logical OR. +genKeyEncryptionKey :: Tunables -> KeyIdent -> Password -> KeyEncryptionKey +genKeyEncryptionKey tunables keyident password = + KeyEncryptionKey k decryptcost bruteforcecalc + where + k = undefined -- hashb <> ob -- TODO use logical OR + (ExpensiveHash hashcost hashb) = expensiveHash tunables salt password + salt = Salt keyident + (RandomObstacle ob) = genRandomObstacle decryptcost + decryptcost = CombinedCost (decryptionCost tunables) (castCost hashcost) + -- To brute force data encrypted with this key, + -- an attacker needs to pay the decryptcost for each password + -- checked. + bruteforcecalc = bruteForceLinearSearch decryptcost -- | A random value which adds difficulty to decrypting, since it's never -- written down anywhere and must always be brute-forced. @@ -32,7 +46,13 @@ genKeyEncryptionKey = undefined -- -- The fewer leading 0's and thus longer the random bits, -- the harder it is. -data RandomObstacle = RandomObstacle Word64 +data RandomObstacle = RandomObstacle B.ByteString -genRandomObstacle :: Int -> RandomObstacle -genRandomObstacle difficulty = undefined +-- | Generate a random obstacle that will add the specified cost to AES +-- decryption. +-- +-- AES can be calculated more efficiently by a GPU, so the cost must be +-- a GPU cost. +genRandomObstacle :: Cost DecryptionOp -> RandomObstacle +genRandomObstacle (GPUCost c) = undefined +genRandomObstacle _ = error "decryptionCost must be a GPUCost" diff --git a/ExpensiveHash.hs b/ExpensiveHash.hs index 8bfe004..ca357bc 100644 --- a/ExpensiveHash.hs +++ b/ExpensiveHash.hs @@ -3,6 +3,8 @@ module ExpensiveHash where import Types +import Cost +import Tunables import qualified Data.ByteString as B import Raaz.Core.Encode import qualified Crypto.Argon2 as Argon2 @@ -14,41 +16,26 @@ import Control.DeepSeq -- This is a lynchpin of keysafe's security, because using this hash -- as an encryption key forces brute force attackers to generate -- hashes over and over again, taking a very long time. -data ExpensiveHash = ExpensiveHash Cost B.ByteString +data ExpensiveHash = ExpensiveHash (Cost CreationOp) B.ByteString deriving (Show) data Salt t = Salt t -expensiveHash :: Encodable t => RunMode -> Salt t -> Password -> ExpensiveHash -expensiveHash runmode (Salt s) (Password password) = - ExpensiveHash cost $ Argon2.hash o password (toByteString s) - where - HashParams o cost = hashParams runmode +expensiveHash :: Encodable t => Tunables -> Salt t -> Password -> ExpensiveHash +expensiveHash tunables (Salt s) (Password password) = + ExpensiveHash (argonCost tunables) $ + Argon2.hash (argonOptions tunables) password (toByteString s) -data HashParams = HashParams Argon2.HashOptions Cost - -hashParams :: RunMode -> HashParams -hashParams SecureMode = HashParams o cost - where - -- argon2 is GPU and ASIC resistent, so it uses CPU time. - -- The selected HashOptions were benchmarked at 661 seconds CPU time - -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz. - cost = CPUCost (Seconds 600) - o = Argon2.HashOptions - { Argon2.hashIterations = 10000 - , Argon2.hashMemory = 131072 -- 128 mebibtyes per thread - , Argon2.hashParallelism = 4 -- 4 threads - , Argon2.hashVariant = Argon2.Argon2i - } -hashParams TestingMode = - HashParams Argon2.defaultHashOptions $ CPUCost (Seconds 0) - -benchmarkExpensiveHash :: IO (Benchmark Cost) -benchmarkExpensiveHash = do +benchmarkExpensiveHash :: Tunables -> IO (Benchmark (Cost CreationOp)) +benchmarkExpensiveHash tunables = do start <- getCurrentTime - let ExpensiveHash expected b = expensiveHash SecureMode + let ExpensiveHash expected b = expensiveHash tunables (Salt (KeyIdent gpgKey (Name ("benchmark" :: B.ByteString)))) (Password ("himom" :: B.ByteString)) end <- b `deepseq` getCurrentTime - let actual = (CPUCost $ Seconds $ end `diffUTCTime` start) - return $ Benchmark { expectedBenchmark = expected, actualBenchmark = actual } + let diff = floor $ end `diffUTCTime` start + let actual = CPUCost $ Seconds diff + return $ Benchmark + { expectedBenchmark = expected + , actualBenchmark = actual + } diff --git a/Tunables.hs b/Tunables.hs new file mode 100644 index 0000000..5c39a2d --- /dev/null +++ b/Tunables.hs @@ -0,0 +1,41 @@ +module Tunables where + +import Types +import Cost +import qualified Crypto.Argon2 as Argon2 + +data Tunables = Tunables + { argonOptions :: Argon2.HashOptions + , argonCost :: Cost CreationOp + -- ^ should correspond to the argonOptions + , decryptionCost :: Cost DecryptionOp + -- ^ controls the decryption cost + } + +defaultTunables :: Tunables +defaultTunables = Tunables + { argonOptions = Argon2.HashOptions + { Argon2.hashIterations = 10000 + , Argon2.hashMemory = 131072 -- 128 mebibtyes per thread + , Argon2.hashParallelism = 4 -- 4 threads + , Argon2.hashVariant = Argon2.Argon2i + } + -- argon2 is GPU and ASIC resistent, so it uses CPU time. + -- The above HashOptions were benchmarked at 661 seconds CPU time + -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz. + , argonCost = CPUCost (Seconds 600) + -- AES can be calculated more efficiently by a GPU, so this + -- cost is a GPU cost. + -- This is set to only 1 minute because GPUs are quite a lot + -- faster than CPUs at AES, and so setting it higher would make + -- clients too slow at key recovery. + , decryptionCost = GPUCost (Seconds 60) + } + +-- | Dials back cryptographic difficulty, not for production use. +testModeTunables :: Tunables +testModeTunables = Tunables + { argonOptions = Argon2.defaultHashOptions + , argonCost = CPUCost (Seconds 0) + , decryptionCost = GPUCost (Seconds 0) + } diff --git a/Types.hs b/Types.hs index 2be82a8..3b5d39f 100644 --- a/Types.hs +++ b/Types.hs @@ -63,16 +63,5 @@ instance Encodable ObjectIdent where n <- readMaybe (B8.unpack ns) return $ ObjectIdent (ShardNum n) keyident --- | An estimated cost to perform an operation. -data Cost = CPUCost Seconds | GPUCost Seconds - deriving (Show) - -newtype Seconds = Seconds NominalDiffTime - deriving (Show) - data Benchmark t = Benchmark { expectedBenchmark :: t, actualBenchmark :: t } deriving (Show) - --- | In testing mode, the cryptographic difficulty is dialed back. -data RunMode = SecureMode | TestingMode - deriving (Show) diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs new file mode 100644 index 0000000..fe7cf22 --- /dev/null +++ b/Utility/HumanTime.hs @@ -0,0 +1,102 @@ +{- Time for humans. + - + - Copyright 2012-2013 Joey Hess + - + - License: BSD-2-clause + -} + +module Utility.HumanTime ( + Duration(..), + durationSince, + durationToPOSIXTime, + durationToDays, + daysToDuration, + parseDuration, + fromDuration, + prop_duration_roundtrips +) where + +import Utility.PartialPrelude +import Utility.QuickCheck + +import qualified Data.Map as M +import Data.Time.Clock +import Data.Time.Clock.POSIX (POSIXTime) +import Data.Char +import Control.Applicative +import Prelude + +newtype Duration = Duration { durationSeconds :: Integer } + deriving (Eq, Ord, Read, Show) + +durationSince :: UTCTime -> IO Duration +durationSince pasttime = do + now <- getCurrentTime + return $ Duration $ round $ diffUTCTime now pasttime + +durationToPOSIXTime :: Duration -> POSIXTime +durationToPOSIXTime = fromIntegral . durationSeconds + +durationToDays :: Duration -> Integer +durationToDays d = durationSeconds d `div` dsecs + +daysToDuration :: Integer -> Duration +daysToDuration i = Duration $ i * dsecs + +{- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -} +parseDuration :: Monad m => String -> m Duration +parseDuration = maybe parsefail (return . Duration) . go 0 + where + go n [] = return n + go n s = do + num <- readish s :: Maybe Integer + case dropWhile isDigit s of + (c:rest) -> do + u <- M.lookup c unitmap + go (n + num * u) rest + _ -> return $ n + num + parsefail = fail "duration parse error; expected eg \"5m\" or \"1h5m\"" + +fromDuration :: Duration -> String +fromDuration Duration { durationSeconds = d } + | d == 0 = "0s" + | otherwise = concatMap showunit $ go [] units d + where + showunit (u, n) + | n > 0 = show n ++ [u] + | otherwise = "" + go c [] _ = reverse c + go c ((u, n):us) v = + let (q,r) = v `quotRem` n + in go ((u, q):c) us r + +units :: [(Char, Integer)] +units = + [ ('y', ysecs) + , ('d', dsecs) + , ('h', hsecs) + , ('m', msecs) + , ('s', 1) + ] + +unitmap :: M.Map Char Integer +unitmap = M.fromList units + +ysecs :: Integer +ysecs = dsecs * 365 + +dsecs :: Integer +dsecs = hsecs * 24 + +hsecs :: Integer +hsecs = msecs * 60 + +msecs :: Integer +msecs = 60 + +-- Durations cannot be negative. +instance Arbitrary Duration where + arbitrary = Duration <$> nonNegative arbitrary + +prop_duration_roundtrips :: Duration -> Bool +prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d diff --git a/Utility/PartialPrelude.hs b/Utility/PartialPrelude.hs new file mode 100644 index 0000000..5579556 --- /dev/null +++ b/Utility/PartialPrelude.hs @@ -0,0 +1,70 @@ +{- Parts of the Prelude are partial functions, which are a common source of + - bugs. + - + - This exports functions that conflict with the prelude, which avoids + - them being accidentially used. + -} + +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.PartialPrelude where + +import qualified Data.Maybe + +{- read should be avoided, as it throws an error + - Instead, use: readish -} +read :: Read a => String -> a +read = Prelude.read + +{- head is a partial function; head [] is an error + - Instead, use: take 1 or headMaybe -} +head :: [a] -> a +head = Prelude.head + +{- tail is also partial + - Instead, use: drop 1 -} +tail :: [a] -> [a] +tail = Prelude.tail + +{- init too + - Instead, use: beginning -} +init :: [a] -> [a] +init = Prelude.init + +{- last too + - Instead, use: end or lastMaybe -} +last :: [a] -> a +last = Prelude.last + +{- Attempts to read a value from a String. + - + - Ignores leading/trailing whitespace, and throws away any trailing + - text after the part that can be read. + - + - readMaybe is available in Text.Read in new versions of GHC, + - but that one requires the entire string to be consumed. + -} +readish :: Read a => String -> Maybe a +readish s = case reads s of + ((x,_):_) -> Just x + _ -> Nothing + +{- Like head but Nothing on empty list. -} +headMaybe :: [a] -> Maybe a +headMaybe = Data.Maybe.listToMaybe + +{- Like last but Nothing on empty list. -} +lastMaybe :: [a] -> Maybe a +lastMaybe [] = Nothing +lastMaybe v = Just $ Prelude.last v + +{- All but the last element of a list. + - (Like init, but no error on an empty list.) -} +beginning :: [a] -> [a] +beginning [] = [] +beginning l = Prelude.init l + +{- Like last, but no error on an empty list. -} +end :: [a] -> [a] +end [] = [] +end l = [Prelude.last l] diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs new file mode 100644 index 0000000..4978d42 --- /dev/null +++ b/Utility/QuickCheck.hs @@ -0,0 +1,45 @@ +{- QuickCheck with additional instances + - + - Copyright 2012-2014 Joey Hess + - + - License: BSD-2-clause + -} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Utility.QuickCheck + ( module X + , module Utility.QuickCheck + ) where + +import Test.QuickCheck as X +import Data.Time.Clock.POSIX +import System.Posix.Types +import Control.Applicative +import Prelude + +{- Times before the epoch are excluded. -} +instance Arbitrary POSIXTime where + arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral + +instance Arbitrary EpochTime where + arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral + +{- Pids are never negative, or 0. -} +instance Arbitrary ProcessID where + arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0) + +{- Inodes are never negative. -} +instance Arbitrary FileID where + arbitrary = nonNegative arbitrarySizedIntegral + +{- File sizes are never negative. -} +instance Arbitrary FileOffset where + arbitrary = nonNegative arbitrarySizedIntegral + +nonNegative :: (Num a, Ord a) => Gen a -> Gen a +nonNegative g = g `suchThat` (>= 0) + +positive :: (Num a, Ord a) => Gen a -> Gen a +positive g = g `suchThat` (> 0) -- cgit v1.2.3