SHA1 în Haskell - ceva în neregulă cu implementarea mea

Gândeam că aș încerca să pun în aplicare SHA1 în Haskell eu însumi. Am venit cu o implementare care compilează și returnează răspunsul corect pentru șirul nul (""), dar nimic altceva. Nu-mi dau seama ce ar putea fi greșit. Poate cineva familiarizat cu algoritmul și SHA1 să o scoată în evidență?

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
Când depanați, este foarte util dacă puteți restrânge problema la funcția cea mai adâncă din stiva de apel care face ceva neașteptat. Puteți încerca să faceți câteva apeluri la celelalte funcții din ghci și să verificați dacă acestea compun ceea ce vă așteptați să le calculeze?
adăugat autor Daniel Wagner, sursa

1 răspunsuri

Pentru început, par să păstrați un număr de dimensiuni în octeți (vezi sz + 64 ), dar numărul care este adăugat ar trebui să fie în biți, deci trebuie să multiplicați cu 8 undeva utilizați cereal sau binary în loc să vă aliniați propriul Integer la endian big64). Aceasta nu este însă singura problemă.

EDIT: a fost găsit

Ah-ha! Nu uita niciodată, wikipedia este scrisă de o grămadă de lumi imperioase și de neschimbate din lume! Terminați fiecare bucată cu h0 + a ', h1 + b', ... , dar acesta ar trebui să fie vechiul context plus noile valori: a + a ', b + b' ... . Totul se verifică după aceea (și mărimea de mai sus).

Codul de testare se încheie acum cu 5 teste de proprietate și 129 KAT succese.

End Editare

V-ar ajuta foarte mult dacă ați împărțit implementarea în operațiunile normale inițiale, actualizate, finalizate. În acest fel puteți compara rezultatele intermediare cu alte implementări.

Tocmai am construit codul de testare pentru implementarea dvs. utilizând crypto-api-tests . Codul suplimentar este mai jos dacă sunteți interesat, nu uitați să instalați 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
adăugat
E incredibil, Thomas. Mulțumesc foarte mult :)
adăugat autor Ana, sursa