SHA1 в Haskell - что-то не так с моей реализацией

Думал, что я попытаюсь реализовать SHA1 в Haskell. Я придумал реализацию, которая компилирует и возвращает правильный ответ для нулевой строки (""), но ничего больше. Я не могу понять, что может быть неправильным. Может ли кто-нибудь, знакомый с алгоритмом и SHA1, указать на это?

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
5
При отладке очень полезно, если вы можете сузить проблему до самой функции в стеке вызовов, которая делает что-то неожиданное. Можете ли вы попытаться сделать несколько вызовов для других функций в ghci и убедиться, что они вычисляют то, что вы ожидаете от них?
добавлено автор Daniel Wagner, источник

1 ответы

Во-первых, вы, кажется, сохраняете размер в байтах (см. <�Код> sz + 64 ), но подсчет, который добавляется, должен быть в битах, поэтому вам нужно умножить на 8 где-то (кстати, я предлагаю вы используете cereal или binary вместо того, чтобы перематывать свой собственный Integer в большой конец Word64). Однако это не единственная проблема.

EDIT: Found It

Ах-ха! Никогда не забывайте, что википедия написана кучей императивных, изменчивых мировых непросвещенных! Вы заканчиваете каждый фрагмент с помощью h0 + a ', h1 + b', ... , но это должен быть старый контекст плюс ваши новые значения: a + a ', b + b' ... . После этого все проверяется (и указанный размер).

Теперь тестовый код завершен с 5 критериями свойств и последующим 129 KAT.

Редактировать конец

Это поможет вам много, если вы разделили свою реализацию на обычные начальные, обновленные, завершающие операции. Таким образом, вы можете сравнивать промежуточные результаты с другими реализациями.

Я только что создал тестовый код для вашей реализации, используя crypto-api-tests . Дополнительный код ниже, если вам интересно, не забудьте установить 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]))
9
добавлено
Это невероятно, Томас. Большое спасибо :)
добавлено автор Ana, источник
Haskell
Haskell
910 участник(ов)

https://combot.org/chat/-1001043143583 Ссылки на полезные ресурсы: https://ruhaskell.org/links.html ;