SHA1 trong Haskell - đã xảy ra sự cố với việc triển khai của tôi

Question

Tôi nghĩ mình sẽ cố gắng triển khai SHA1 trong Haskell. Tôi đã đưa ra một triển khai thực hiện biên dịch và trả về câu trả lời đúng cho chuỗi rỗng (""), nhưng không có gì khác. Tôi không thể hiểu được điều gì có thể sai. Ai đó có thể quen thuộc với thuật toán và SHA1 chỉ ra nó?

import Data.Bits 
import Data.Int 
import Data.List 
import Data.Word 
import Text.Printf 
import qualified Data.ByteString.Lazy as L 
import qualified Data.ByteString.Lazy.Char8 as C 

h0 = 0x67452301 :: Word32 
h1 = 0xEFCDAB89 :: Word32 
h2 = 0x98BADCFE :: Word32 
h3 = 0x10325476 :: Word32 
h4 = 0xC3D2E1F0 :: Word32 

sha1string :: String -> String 
sha1string s = concat $ map (printf "%02x") $ sha1 . C.pack $ s 

sha1 :: L.ByteString -> [Word8] 
sha1 msg = concat [w32ToComps a, w32ToComps b, w32ToComps c, w32ToComps d, w32ToComps e] 
    where (a, b, c, d, e) = sha1' msg 0 h0 h1 h2 h3 h4 

sha1' msg sz a b c d e 
    | L.length m1 < 64 = sha1'last (padded msg sz) a b c d e 
    | otherwise  = uncurry5 (sha1' m2 (sz + 64)) $ whole a b c d e m1 
    where (m1, m2) = L.splitAt 64 msg 

sha1'last msg a b c d e 
    | m1 == L.empty = (a, b, c, d, e) 
    | otherwise  = uncurry5 (sha1'last m2) $ whole a b c d e m1 
    where (m1, m2) = L.splitAt 64 msg 

whole a b c d e msg = partcd (partab msg) a b c d e 

partcd ws a b c d e = (h0 + a', h1 + b', h2 + c', h3 + d', h4 + e') 
    where 
    (a', b', c', d', e') = go ws a b c d e 0 
    go ws a b c d e 80 = (a, b, c, d, e) 
    go (w:ws) a b c d e t = go ws temp a (rotate b 30) c d (t+1) 
     where temp = (rotate a 5) + f t b c d + e + w + k t 

partab chunk = take 80 ns 
    where 
    ns  = initial ++ zipWith4 g (drop 13 ns) (drop 8 ns) (drop 2 ns) ns 
    g a b c d = rotate (a `xor` b `xor` c `xor` d) 1 
    initial = map (L.foldl (\a b -> (a * 256) + fromIntegral b) 0) $ paginate 4 chunk 

f t b c d 
    | t >= 0 && t <= 19 = (b .&. c) .|. ((complement b) .&. d) 
    | t >= 20 && t <= 39 = b `xor` c `xor` d 
    | t >= 40 && t <= 59 = (b .&. c) .|. (b .&. d) .|. (c .&. d) 
    | t >= 60 && t <= 79 = b `xor` c `xor` d 

k t 
    | t >= 0 && t <= 19 = 0x5A827999 
    | t >= 20 && t <= 39 = 0x6ED9EBA1 
    | t >= 40 && t <= 59 = 0x8F1BBCDC 
    | t >= 60 && t <= 79 = 0xCA62C1D6 

padded msg prevsz = L.append msg (L.pack pad) 
    where 
    sz  = L.length msg 
    totalsz = prevsz + sz 
    padsz = fromIntegral $ (128 - 9 - sz) `mod` 64 
    pad  = [0x80] ++ (replicate padsz 0) ++ int64ToComps totalsz 

uncurry5 f (a, b, c, d, e) = f a b c d e 

paginate n xs 
    | xs == L.empty = [] 
    | otherwise  = let (a, b) = L.splitAt n xs in a : paginate n b 

w32ToComps :: Word32 -> [Word8] 
w32ToComps = integerToComps [24, 16 .. 0] 

int64ToComps :: Int64 -> [Word8] 
int64ToComps = integerToComps [56, 48 .. 0] 

integerToComps :: (Integral a, Bits a) => [Int] -> a -> [Word8] 
integerToComps bits x = map f bits 
    where f n = fromIntegral ((x `shiftR` n) .&. 0xff) :: Word8 

Answer 1

Để bắt đầu, bạn dường như đang giữ một số kích thước tính bằng byte (xem sz + 64), nhưng số lượng đó được nối phải ở trong bit, do đó bạn cần phải nhân với 8 ở đâu đó (tình cờ, tôi đề nghị bạn sử dụng cereal hoặc binary thay vì cuộn Số nguyên của riêng bạn sang Word64 lớn cuối cùng). Đây không phải là vấn đề duy nhất.

EDIT: Tìm thấy Nó

Ah-ha! Không bao giờ quên, wikipedia được viết bởi một loạt các unimlighteneds mệnh lệnh, mutable-thế giới! Bạn hoàn thành mỗi đoạn với h0 + a', h1 + b', ... nhưng đó phải là bối cảnh cũ cộng với các giá trị mới của bạn: a + a', b + b', .... Tất cả mọi thứ kiểm tra sau đó (và kích thước ở trên) sửa chữa.

Mã thử nghiệm hoàn tất ngay bây giờ với 5 thử nghiệm thuộc tính và 129 KAT thành công.

End Sửa

Nó sẽ giúp bạn rất nhiều nếu bạn chia thực hiện của bạn vào bình thường ban đầu, cập nhật, hoàn thiện hoạt động. Bằng cách đó bạn có thể so sánh kết quả trung gian với các triển khai khác.

Tôi vừa xây dựng mã thử nghiệm cho việc triển khai của bạn bằng cách sử dụng crypto-api-tests. Mã bổ sung bên dưới nếu bạn quan tâm, đừng quên cài đặt crypto-api-tests.

import Test.SHA 
import Test.Crypto 
import Crypto.Classes 
import Data.Serialize 
import Data.Tagged 
import Control.Monad 

main = defaultMain =<< makeSHA1Tests (undefined :: SHA1) 

data SHA1 = SHA1 [Word8] 
    deriving (Eq, Ord, Show) 
data CTX = CTX L.ByteString 
instance Serialize SHA1 where 
    get = liftM SHA1 (mapM (const get) [1..20]) 
    put (SHA1 x) = mapM_ put x 

instance Hash CTX SHA1 where 
    outputLength = Tagged 160 
    blockLength = Tagged (64*8) 
    initialCtx = CTX L.empty 
    updateCtx (CTX m) x = CTX (L.append m (L.fromChunks [x])) 
    finalize (CTX m) b = SHA1 $ sha1 (L.append m (L.fromChunks [b]))