diff options
| -rw-r--r-- | Encryption.hs | 79 | ||||
| -rw-r--r-- | Tunables.hs | 3 | ||||
| -rw-r--r-- | keysafe.cabal | 2 | ||||
| -rw-r--r-- | keysafe.hs | 17 |
4 files changed, 69 insertions, 32 deletions
diff --git a/Encryption.hs b/Encryption.hs index 8af25d4..1ad3402 100644 --- a/Encryption.hs +++ b/Encryption.hs @@ -21,6 +21,8 @@ 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) -- | An AES key, which is used to encrypt the key that is stored @@ -34,6 +36,26 @@ data KeyEncryptionKey = KeyEncryptionKey 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 + UsePuzzleIV 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) + let decryptcost = CombinedCost puzzlecost (castCost hashcost) + -- 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 + where + hash@(ExpensiveHash hashcost _) = expensiveHash tunables salt password + salt = Salt name + cipher :: Raaz.AES 256 'Raaz.CBC cipher = Raaz.aes256cbc @@ -53,31 +75,34 @@ encrypt kek (SecretKey secret) = EncryptedSecretKey b (keyBruteForceCalc kek) decrypt :: KeyEncryptionKey -> EncryptedSecretKey -> Maybe SecretKey decrypt kek (EncryptedSecretKey b _) = SecretKey <$> fromPaddedBytes pbs where - pbs = PaddedBytes $ Raaz.unsafeDecrypt cipher (keyEncryptionKey kek) b + pbs = PaddedBytes $ + let bb = Raaz.unsafeDecrypt cipher (keyEncryptionKey kek) b + in traceShow ("padded", bb) bb --- | The ExpensiveHash of the Password used as the AES key. --- Name is used as a salt, to prevent rainbow table attacks. +-- | A stream of all the key encryption keys that need to be tried to +-- decrypt. -- -- The DecryptionPuzzleTunable is used to alter the AES key --- in some way that requires significant work to determine at --- decryption time. -genKeyEncryptionKey :: Tunables -> Name -> Password -> IO KeyEncryptionKey -genKeyEncryptionKey tunables name (Password password) = case decryptionPuzzleTunable tunables of - UsePuzzleIV 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) - let decryptcost = CombinedCost puzzlecost (castCost hashcost) - -- 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 +-- in some way; this stream includes every possible solution to the puzzle. +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) + +allByteStringsOfLength :: Int -> [B.ByteString] +allByteStringsOfLength = go [] where - hash@(ExpensiveHash hashcost _) = expensiveHash tunables salt password - salt = Salt name + go ws n + | n == 0 = return (B.pack ws) + | otherwise = do + w <- [0..255] + go (w:ws) (n-1) -- | Make an AES key out of a hash value. -- @@ -124,12 +149,16 @@ sizePuzzleIV tunables = ceiling $ nbits / 8 | otherwise = logBase 2 (fromIntegral $ targetseconds * triespersecond) + 1 mkPuzzleIV :: Raaz.IV -> Int -> PuzzleIV -mkPuzzleIV randomiv nrand = PuzzleIV $ +mkPuzzleIV randomiv nrand = mkPuzzleIV' randomiv + (B.take nrand $ Raaz.toByteString randomiv) + +mkPuzzleIV' :: Raaz.IV -> B.ByteString -> PuzzleIV +mkPuzzleIV' randomiv b = PuzzleIV $ fromMaybe (error "mkPuzzleIV fromByteString failed") $ - Raaz.fromByteString $ B.take nrand b <> padding + Raaz.fromByteString (b <> padding) where - b = Raaz.toByteString randomiv - padding = B.replicate (B.length b - nrand) 0 + ivlen = B.length (Raaz.toByteString randomiv) + padding = B.replicate (ivlen - B.length b) 0 genPuzzleIV :: Tunables -> IO PuzzleIV genPuzzleIV tunables = do diff --git a/Tunables.hs b/Tunables.hs index 18e3f84..ab170a5 100644 --- a/Tunables.hs +++ b/Tunables.hs @@ -38,6 +38,7 @@ data Tunables = Tunables -- allowed to choose between them , objectSize :: Int -- ^ a StorableObject is exactly this many bytes in size + -- (must be a multiple of AES block size 16) , expensiveHashTunable :: ExpensiveHashTunable , encryptionTunable :: EncryptionTunable , decryptionPuzzleTunable :: DecryptionPuzzleTunable @@ -95,7 +96,7 @@ testModeTunables = Tunables , objectSize = 1024*64 , expensiveHashTunable = UseArgon2 weakargonoptions argoncost , encryptionTunable = UseAES256 - , decryptionPuzzleTunable = UsePuzzleIV (GPUCost (Seconds 0)) + , decryptionPuzzleTunable = UsePuzzleIV (GPUCost (Seconds 1)) } where UseArgon2 argonoptions argoncost = expensiveHashTunable defaultTunables diff --git a/keysafe.cabal b/keysafe.cabal index bebc882..54fa4e1 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -16,7 +16,7 @@ Description: Executable keysafe Main-Is: keysafe.hs - GHC-Options: -Wall -fno-warn-tabs + GHC-Options: -Wall -fno-warn-tabs -O2 Build-Depends: base (>= 4.5) , bytestring == 0.10.* @@ -14,6 +14,7 @@ import Cost import Shard import Storage import Storage.LocalFiles +import System.IO main :: IO () main = do @@ -47,12 +48,18 @@ retrievedemo = do <$> mapM (uncurry (retrieveShard localFiles)) l _ <- obscureShards localFiles let esk = combineShards tunables shards - kek <- genKeyEncryptionKey tunables name password - -- TODO: need to solve the encryption puzzle - case decrypt kek esk of - Just (SecretKey sk) -> print sk - Nothing -> print ("Failed" :: String, esk) + basekek <- genKeyEncryptionKey tunables name password + go esk (candidateKeyEncryptionKeys tunables basekek) where + go _ [] = error "decryption failed" + go esk (kek:rest) = do + print (keyEncryptionKey kek) + hFlush stdout + case decrypt kek esk of + -- TODO: verify checksum to avoid false positives + Just (SecretKey sk) -> print sk + Nothing -> go esk rest + password = Password "correct horse battery staple" name = Name "bar" tunables = testModeTunables -- defaultTunables |