guessing puzzle answers

1 files changed, 54 insertions, 25 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