Fixed bug in decodeSecret/encodeSecret.

1 files changed, 50 insertions, 15 deletions

diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index 9f86f6a4..307a5db5 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -428,27 +428,62 @@ getPublicKey = throwCryptoError . publicKey <$> S.getBytes 32
 putPublicKey :: PublicKey -> S.Put
 putPublicKey bs = S.putByteString $ BA.convert bs
 
+-- 32 bytes -> 42 base64 digits.
+--
 encodeSecret :: SecretKey -> Maybe C8.ByteString
 encodeSecret k = do
     (a,bs) <- BA.uncons (BA.convert k)
+    -- Bytes
+    -- 1   31
+    -- a | bs
     (cs,c) <- unsnoc bs
-    let a' = shiftR a 1 .|. (shiftR c 4 .&. 0x03)
+    -- Bytes
+    --  1   30   1
+    --  a | cs | c
+    --
+    -- Based on the following pasted from the generateSecretKey function:
+    --
+    --   tweakToSecretKey :: ScrubbedBytes -> SecretKey
+    --   tweakToSecretKey bin = SecretKey $ B.copyAndFreeze bin $ \inp -> do
+    --         modifyByte inp 0 (\e0 -> e0 .&. 0xf8)
+    --         modifyByte inp 31 (\e31 -> (e31 .&. 0x7f) .|. 0x40)
+    --
+    -- We know the following holds:
+    --   a == a .&. 0xf8
+    --   c == (c .&. 0x7f) .|. 0x40
+    --
+    -- Therefore, there are 5 reserved bits:
+    --   a := aaaa a000
+    --   c := 01dd cccc
+    --
+    -- That gives us 256 - 5 = 251 bits to encode.
+    -- 42 * 6 = 252
+    --
+    let -- We'll reserve the first bit as zero so that the encoded
+        -- key starts with a digit between A and f.  Other digits will be
+        -- arbitrary.
+        --
+        -- The middle 30 bytes will be encoded as is from the source byte
+        -- string (cs). It remains to compute the first (a') and last (c')
+        -- bytes.
+        xs = Base64.encode $ a' `BA.cons` cs `BA.snoc` c'
+        -- a' := 0aaaaadd
+        a' = shiftR a 1 .|. (shiftR c 4 .&. 0x03)
+        -- c' := cccc0000
         c' = shiftL c 4
-        xs = Base64.encode $ cs `BA.snoc` a' `BA.snoc` c'
-        (ys,ds) = BA.splitAt 40 xs
-    return $ BA.index ds 0 `BA.cons` ys `BA.snoc` BA.index ds 1
+    return $ BA.take 42 xs
 
+-- 42 base64 digits. First digit should be between A and f.  The rest are
+-- arbitrary.
 decodeSecret :: C8.ByteString -> Maybe SecretKey
+decodeSecret k64 | B.length k64 < 42 = Nothing
 decodeSecret k64 = do
-    (ds0,ysds1) <- BA.uncons k64
-    (ys,ds1) <- unsnoc ysds1
-    let k64' = B.append ys (BA.cons ds0 (BA.cons ds1 "A="))
-    k <- either (const Nothing) Just $ Base64.decode k64'
-    (csa,c') <- unsnoc k
-    (cs,a') <- unsnoc csa
-    let a = shiftL (a' .&. 0x7c) 1
-        c = shiftR c' 4 .|. (shiftL a' 4 .&. 0x30) .|. 0x40
-    let r = a `BA.cons` (cs `BA.snoc` c)
-    case secretKey r of
+    xs <- either (const Nothing) Just $ Base64.decode $ B.append k64 "A="
+    (a',ds) <- B.uncons $ B.take 32 xs
+    (cs,c') <- B.unsnoc ds
+    let c = 0x40 .|. shiftR c' 4 .|. ( 0x30 .&. shiftL a' 4)
+        a = 0xf8 .&. shiftL a' 1
+    case secretKey $ B.cons a cs `B.snoc` c of
         CryptoPassed x -> Just x
-        _ -> Nothing
+        _              -> Nothing
+