From 3b4a775d536b2b2956269a59f886487efe29ed51 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 16 Aug 2016 12:57:19 -0400 Subject: switch to random salt byte to make decryption expensive --- Encryption.hs | 202 ++++++++++++++++++++++------------------------------------ 1 file changed, 77 insertions(+), 125 deletions(-) (limited to 'Encryption.hs') diff --git a/Encryption.hs b/Encryption.hs index bf2370c..8d508d8 100644 --- a/Encryption.hs +++ b/Encryption.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, DataKinds #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} {- Copyright 2016 Joey Hess - @@ -11,9 +12,9 @@ import Types import Tunables import Cost import ExpensiveHash -import Data.Bits import Data.Monoid import Data.Maybe +import Data.Word import qualified Raaz import qualified Raaz.Cipher.AES as Raaz import qualified Raaz.Cipher.Internal as Raaz @@ -24,49 +25,6 @@ import Text.Read type AesKey = Raaz.KEY256 --- | An AES key, which is used to encrypt the key that is stored --- in keysafe. -data KeyEncryptionKey = KeyEncryptionKey - { keyEncryptionKey :: AesKey - , keyEncryptionIV :: Raaz.IV - , keyDecryptionCost :: Cost DecryptionOp - , keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword - } - -instance Bruteforceable KeyEncryptionKey UnknownPassword where - getBruteCostCalc = keyBruteForceCalc - --- | The ExpensiveHash of the Password used as the AES key. --- Name is used as a salt, to prevent rainbow table attacks. -genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey -genKeyEncryptionKey tunables name (Password password) = case decryptionPuzzleTunable tunables of - KeyBlindingLeftSide puzzlecost -> do - prg <- Raaz.newPRG () :: IO Raaz.SystemPRG - ob <- genRandomObstacle tunables - randomkey <- Raaz.random prg :: IO AesKey - let k = hashToAESKey randomkey hash - let strongk = mixinRandomObstacle ob k - let decryptcost = CombinedCost puzzlecost (castCost hashcost) - iv <- genIV (Password password) - -- To brute force data encrypted with this key, - -- an attacker needs to pay the decryptcost for - -- each password checked. - let bruteforcecalc = bruteForceLinearSearch decryptcost - return $ KeyEncryptionKey strongk iv decryptcost bruteforcecalc - where - hash@(ExpensiveHash hashcost _) = expensiveHash tunables salt password - salt = Salt name - --- Use the sha256 of the password (truncated) as the IV. -genIV :: Password -> IO Raaz.IV -genIV (Password password) = do - prg <- Raaz.newPRG () :: IO Raaz.SystemPRG - exampleiv <- Raaz.random prg :: IO Raaz.IV - let ivlen = B.length (Raaz.toByteString exampleiv) - return $ fromMaybe (error "genIV fromByteString failed") $ - Raaz.fromByteString $ B.take ivlen $ - Raaz.toByteString $ Raaz.sha256 password - cipher :: Raaz.AES 256 'Raaz.CBC cipher = Raaz.aes256cbc @@ -85,21 +43,57 @@ decrypt kek (EncryptedSecretKey b _) = SecretKey <$> fromEncryptableBytes pbs where pbs = EncryptableBytes $ Raaz.unsafeDecrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) b --- | A stream of all the key encryption keys that need to be tried to --- decrypt. +-- | An AES key, which is used to encrypt the secret key that is stored +-- in keysafe. +data KeyEncryptionKey = KeyEncryptionKey + { keyEncryptionKey :: AesKey + , keyEncryptionIV :: Raaz.IV + , keyDecryptionCost :: Cost DecryptionOp + , keyBruteForceCalc :: CostCalc BruteForceOp UnknownPassword + } + +instance Bruteforceable KeyEncryptionKey UnknownPassword where + getBruteCostCalc = keyBruteForceCalc + +-- | The ExpensiveHash of the Password used as the KeyEncryptionKey +-- +-- Name is used as a salt, to prevent rainbow table attacks. -- --- The DecryptionPuzzleTunable is used to alter the AES key --- in some way; this stream includes every possible solution to the puzzle. -candidateKeyEncryptionKeys :: Tunables -> KeyEncryptionKey -> [KeyEncryptionKey] -candidateKeyEncryptionKeys tunables basekek = - case decryptionPuzzleTunable tunables of - KeyBlindingLeftSide _ -> - let k = keyEncryptionKey basekek - nrand = sizeRandomObstacle tunables - mkcandidate b = - let ob = mkRandomObstacle' k b - in basekek { keyEncryptionKey = mixinRandomObstacle ob k } - in map mkcandidate (allByteStringsOfLength nrand) +-- A random prefix is added to the salt, to force an attacker to +-- run the hash repeatedly. +genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey +genKeyEncryptionKey tunables name password = do + prg <- Raaz.newPRG () :: IO Raaz.SystemPRG + saltprefix <- genRandomSaltPrefix prg tunables + return $ head $ + genKeyEncryptionKeys [saltprefix] tunables name password + +-- | A stream of KeyEncryptionKeys, using the specified salt prefixes. +genKeyEncryptionKeys :: [SaltPrefix] -> Tunables -> Name -> Password -> [KeyEncryptionKey] +genKeyEncryptionKeys saltprefixes tunables (Name name) (Password password) = + map mk saltprefixes + where + iv = genIV (Password password) + -- To brute force data encrypted with a key, + -- an attacker needs to pay the decryptcost for + -- each password checked. + bruteforcecalc = bruteForceLinearSearch decryptcost + decryptcost = castCost $ randomSaltBytesBruteForceCost kektunables + kektunables = keyEncryptionKeyTunable tunables + + mk saltprefix = KeyEncryptionKey (hashToAESKey hash) iv decryptcost bruteforcecalc + where + salt = Salt (saltprefix <> name) + hash = expensiveHash (keyEncryptionKeyHash kektunables) salt password + +-- | A stream of all the key encryption keys that need to be tried to +-- decrypt. +candidateKeyEncryptionKeys :: Tunables -> Name -> Password -> [KeyEncryptionKey] +candidateKeyEncryptionKeys tunables name password = + genKeyEncryptionKeys saltprefixes tunables name password + where + saltprefixes = allByteStringsOfLength $ + randomSaltBytes $ keyEncryptionKeyTunable tunables allByteStringsOfLength :: Int -> [B.ByteString] allByteStringsOfLength = go [] @@ -110,84 +104,42 @@ allByteStringsOfLength = go [] w <- [0..255] go (w:ws) (n-1) +-- Use the sha256 of the password (truncated) as the IV. +genIV :: Password -> Raaz.IV +genIV (Password password) = + fromMaybe (error "genIV fromByteString failed") $ + Raaz.fromByteString $ B.take ivlen $ + Raaz.toByteString $ Raaz.sha256 password + where + ivlen = fromIntegral $ Raaz.byteSize (undefined :: Raaz.IV) + +type SaltPrefix = B.ByteString + +genRandomSaltPrefix :: Raaz.SystemPRG -> Tunables -> IO SaltPrefix +genRandomSaltPrefix prg tunables = go [] + (randomSaltBytes $ keyEncryptionKeyTunable tunables) + where + go ws 0 = return (B.pack ws) + go ws n = do + b <- Raaz.random prg :: IO Word8 + go (b:ws) (n-1) + +instance Raaz.Random Word8 + -- | Make an AES key out of a hash value. -- -- Since the ExpensiveHash value is ascii encoded, and has a common prefix, -- it does not have a high entropy in every byte, and its length is longer -- than the AES key length. To deal with this, use the SHA256 of -- the ExpensiveHash, as a bytestring. -hashToAESKey :: AesKey -> ExpensiveHash -> AesKey -hashToAESKey samplekey (ExpensiveHash _ t) = +hashToAESKey :: ExpensiveHash -> AesKey +hashToAESKey (ExpensiveHash _ t) = fromMaybe (error "hashToAESKey fromByteString failed") $ Raaz.fromByteString b where - b = B.take (B.length (Raaz.toByteString samplekey)) $ + b = B.take (fromIntegral $ Raaz.byteSize (undefined :: AesKey)) $ Raaz.toByteString $ Raaz.sha256 (E.encodeUtf8 t) --- | A random value which can be mixed into an AES key to --- require decrypting it to perform some brute-force work. --- --- The random value is left-padded with NULL bytes, so ORing it with an AES --- key varies the initial bytes of the key. --- --- The AesKey also includes a random IV. -data RandomObstacle = RandomObstacle AesKey - --- | Length of the random obstacle, in bytes, that will satisfy the --- decryptionPuzzleCost. --- --- AES can be calculated more efficiently by a GPU, so the cost must be --- a GPU cost. --- --- This depends on the objectSize, because to brute force the --- RandomObstable, AES decryptions must be done repeatedly, and the --- time needed for an AES decryption depends on the amount of data. -sizeRandomObstacle :: Tunables -> Int -sizeRandomObstacle tunables = ceiling $ nbits / 8 - where - -- in 2016, a GPU can run AES at 10 GB/s. - bytespersecond = 10*1024*1024*1024 - triespersecond = bytespersecond `div` fromIntegral (objectSize tunables) - targetseconds = case decryptionPuzzleTunable tunables of - KeyBlindingLeftSide cost -> case cost of - GPUCost (Seconds n) -> n - _ -> error "decryptionPuzzleCost must be a GPUCost" - -- Add one bit of entropy, because a brute-force attack will - -- on average succeed half-way through the search space. - nbits :: Double - nbits - | targetseconds < 1 = 0 - | otherwise = logBase 2 (fromIntegral $ targetseconds * triespersecond) + 1 - -mkRandomObstacle :: AesKey -> Int -> RandomObstacle -mkRandomObstacle k nbytes = mkRandomObstacle' k $ - B.take nbytes $ Raaz.toByteString k - -mkRandomObstacle' :: AesKey -> B.ByteString -> RandomObstacle -mkRandomObstacle' examplek b = RandomObstacle $ - fromMaybe (error "mkRandomObstacle' fromByteString failed") $ - Raaz.fromByteString (b <> padding) - where - klen = B.length (Raaz.toByteString examplek) - padding = B.replicate (klen - B.length b) 0 - -genRandomObstacle :: Tunables -> IO RandomObstacle -genRandomObstacle tunables = do - prg <- Raaz.newPRG () :: IO Raaz.SystemPRG - randomkey <- Raaz.random prg :: IO AesKey - let size = sizeRandomObstacle tunables - return $ mkRandomObstacle randomkey size - -mixinRandomObstacle :: RandomObstacle -> AesKey -> AesKey -mixinRandomObstacle (RandomObstacle r) k = k' - where - k' = fromMaybe (error "mixinRandomObstacle fromByteString failed") $ - Raaz.fromByteString $ - Raaz.toByteString r `orBytes` Raaz.toByteString k - -orBytes :: B.ByteString -> B.ByteString -> B.ByteString -orBytes a b = B.pack $ map (uncurry (.|.)) $ zip (B.unpack a) (B.unpack b) - -- | A bytestring that can be AES enctypted. It includes a checksum, -- and size, and is padded to the objectSize with NULs. -- -- cgit v1.2.3