diff options
| -rw-r--r-- | Encryption.hs | 116 | ||||
| -rw-r--r-- | Tunables.hs | 6 | ||||
| -rw-r--r-- | keysafe.hs | 2 |
3 files changed, 74 insertions, 50 deletions
diff --git a/Encryption.hs b/Encryption.hs index 1ad3402..19cb650 100644 --- a/Encryption.hs +++ b/Encryption.hs @@ -11,6 +11,7 @@ import Types import Tunables import Cost import ExpensiveHash +import Data.Bits import Data.Monoid import Data.Maybe import qualified Raaz @@ -21,14 +22,13 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import Text.Read -import Debug.Trace - -type AesKey = Raaz.Key (Raaz.AES 256 'Raaz.CBC) +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 } @@ -40,22 +40,33 @@ instance Bruteforceable KeyEncryptionKey UnknownPassword where -- 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 - UsePuzzleIV puzzlecost -> do + KeyBlindingLeftSide puzzlecost -> do prg <- Raaz.newPRG () :: IO Raaz.SystemPRG - samplekey <- Raaz.random prg :: IO AesKey - let basek = hashToAESKey samplekey hash - (PuzzleIV iv) <- genPuzzleIV tunables - let strongk = (basek, iv) + 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 decryptcost bruteforcecalc + 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 @@ -67,17 +78,15 @@ encrypt kek (SecretKey secret) = EncryptedSecretKey b (keyBruteForceCalc kek) where -- Raaz does not seem to provide a high-level interface -- for AES encryption, so use unsafeEncrypt, doing our own padding - -- of the secret key, with NULLs, so that it is a multiple of + -- of the secret key, so that it is a multiple of -- the block size. - b = Raaz.unsafeEncrypt cipher (keyEncryptionKey kek) $ getPaddedBytes $ - toPaddedBytes blocksize secret + b = Raaz.unsafeEncrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) $ + getPaddedBytes $ toPaddedBytes blocksize secret decrypt :: KeyEncryptionKey -> EncryptedSecretKey -> Maybe SecretKey decrypt kek (EncryptedSecretKey b _) = SecretKey <$> fromPaddedBytes pbs where - pbs = PaddedBytes $ - let bb = Raaz.unsafeDecrypt cipher (keyEncryptionKey kek) b - in traceShow ("padded", bb) bb + pbs = PaddedBytes $ Raaz.unsafeDecrypt cipher (keyEncryptionKey kek, keyEncryptionIV kek) b -- | A stream of all the key encryption keys that need to be tried to -- decrypt. @@ -87,13 +96,13 @@ decrypt kek (EncryptedSecretKey b _) = SecretKey <$> fromPaddedBytes pbs candidateKeyEncryptionKeys :: Tunables -> KeyEncryptionKey -> [KeyEncryptionKey] candidateKeyEncryptionKeys tunables basekek = case decryptionPuzzleTunable tunables of - UsePuzzleIV _ -> - let (k, randomiv) = keyEncryptionKey basekek - nrand = sizePuzzleIV tunables - mkcandidate (PuzzleIV iv) = basekek - { keyEncryptionKey = (k, iv) } - in map (mkcandidate . mkPuzzleIV' randomiv) - (allByteStringsOfLength nrand) + 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) allByteStringsOfLength :: Int -> [B.ByteString] allByteStringsOfLength = go [] @@ -110,37 +119,42 @@ allByteStringsOfLength = go [] -- 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 -> Raaz.KEY256 -hashToAESKey (samplekey, _iv) (ExpensiveHash _ t) = +hashToAESKey :: AesKey -> ExpensiveHash -> AesKey +hashToAESKey samplekey (ExpensiveHash _ t) = fromMaybe (error "hashToAESKey fromByteString failed") $ Raaz.fromByteString b where b = B.take (B.length (Raaz.toByteString samplekey)) $ Raaz.toByteString $ Raaz.sha256 (E.encodeUtf8 t) --- | A puzzle IV starts with some number of random bytes of IV data, --- and is right-padded with NULL bytes. -data PuzzleIV = PuzzleIV Raaz.IV +-- | 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 puzzle IV, in bytes, that will satisfy the +-- | 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 --- RandomIV, AES decryptions must be done repeatedly, and the +-- RandomObstable, AES decryptions must be done repeatedly, and the -- time needed for an AES decryption depends on the amount of data. -sizePuzzleIV :: Tunables -> Int -sizePuzzleIV tunables = ceiling $ nbits / 8 +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 - UsePuzzleIV cost -> case cost of + KeyBlindingLeftSide cost -> case cost of GPUCost (Seconds n) -> n - _ -> error "decryptionPuzzleTunable must be a GPUCost" + _ -> 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 @@ -148,24 +162,34 @@ sizePuzzleIV tunables = ceiling $ nbits / 8 | targetseconds < 1 = 0 | otherwise = logBase 2 (fromIntegral $ targetseconds * triespersecond) + 1 -mkPuzzleIV :: Raaz.IV -> Int -> PuzzleIV -mkPuzzleIV randomiv nrand = mkPuzzleIV' randomiv - (B.take nrand $ Raaz.toByteString randomiv) +mkRandomObstacle :: AesKey -> Int -> RandomObstacle +mkRandomObstacle k nbytes = mkRandomObstacle' k $ + B.take nbytes $ Raaz.toByteString k -mkPuzzleIV' :: Raaz.IV -> B.ByteString -> PuzzleIV -mkPuzzleIV' randomiv b = PuzzleIV $ - fromMaybe (error "mkPuzzleIV fromByteString failed") $ +mkRandomObstacle' :: AesKey -> B.ByteString -> RandomObstacle +mkRandomObstacle' examplek b = RandomObstacle $ + fromMaybe (error "mkRandomObstacle' fromByteString failed") $ Raaz.fromByteString (b <> padding) where - ivlen = B.length (Raaz.toByteString randomiv) - padding = B.replicate (ivlen - B.length b) 0 + klen = B.length (Raaz.toByteString examplek) + padding = B.replicate (klen - B.length b) 0 -genPuzzleIV :: Tunables -> IO PuzzleIV -genPuzzleIV tunables = do +genRandomObstacle :: Tunables -> IO RandomObstacle +genRandomObstacle tunables = do prg <- Raaz.newPRG () :: IO Raaz.SystemPRG - randomiv <- Raaz.random prg :: IO Raaz.IV - let size = sizePuzzleIV tunables - return $ mkPuzzleIV randomiv size + 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) newtype PaddedBytes = PaddedBytes { getPaddedBytes :: B.ByteString } deriving (Show) diff --git a/Tunables.hs b/Tunables.hs index ab170a5..1ecccf6 100644 --- a/Tunables.hs +++ b/Tunables.hs @@ -60,7 +60,7 @@ data EncryptionTunable = UseAES256 deriving (Show) -- | An additional puzzle that makes decryption more expensive. -data DecryptionPuzzleTunable = UsePuzzleIV (Cost DecryptionOp) +data DecryptionPuzzleTunable = KeyBlindingLeftSide (Cost DecryptionOp) deriving (Show) defaultTunables :: Tunables @@ -74,7 +74,7 @@ defaultTunables = Tunables -- 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. - , decryptionPuzzleTunable = UsePuzzleIV (GPUCost (Seconds 60)) + , decryptionPuzzleTunable = KeyBlindingLeftSide (GPUCost (Seconds 60)) } where argonoptions = Argon2.HashOptions @@ -96,7 +96,7 @@ testModeTunables = Tunables , objectSize = 1024*64 , expensiveHashTunable = UseArgon2 weakargonoptions argoncost , encryptionTunable = UseAES256 - , decryptionPuzzleTunable = UsePuzzleIV (GPUCost (Seconds 1)) + , decryptionPuzzleTunable = KeyBlindingLeftSide (GPUCost (Seconds 1)) } where UseArgon2 argonoptions argoncost = expensiveHashTunable defaultTunables @@ -53,7 +53,7 @@ retrievedemo = do where go _ [] = error "decryption failed" go esk (kek:rest) = do - print (keyEncryptionKey kek) + putStr "." hFlush stdout case decrypt kek esk of -- TODO: verify checksum to avoid false positives |