keccak 0.1.1 → 0.1.2
raw patch · 6 files changed
+222/−148 lines, 6 filesdep ~basenew-component:exe:collisionPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base
API changes (from Hackage documentation)
- Crypto.Hash.Keccak: absorbBlock :: Int -> State -> [Word64] -> State
- Crypto.Hash.Keccak: chi :: [[Word64]] -> State
- Crypto.Hash.Keccak: emptyState :: State
- Crypto.Hash.Keccak: iota :: Int -> State -> State
- Crypto.Hash.Keccak: keccak224Rate :: Int
- Crypto.Hash.Keccak: keccak256Rate :: Int
- Crypto.Hash.Keccak: keccak384Rate :: Int
- Crypto.Hash.Keccak: keccak512Rate :: Int
- Crypto.Hash.Keccak: keccakF :: State -> State
- Crypto.Hash.Keccak: laneToBytes :: Word64 -> [Word8]
- Crypto.Hash.Keccak: multiratePadding :: Int -> Word8 -> ByteString -> [Word8]
- Crypto.Hash.Keccak: rhoPi :: State -> [[Word64]]
- Crypto.Hash.Keccak: rotationConstants :: [[Int]]
- Crypto.Hash.Keccak: roundConstants :: [Word64]
- Crypto.Hash.Keccak: stateToBytes :: State -> [Word8]
- Crypto.Hash.Keccak: theta :: State -> State
- Crypto.Hash.Keccak: toBlocks :: Int -> [Word8] -> [[Word64]]
- Crypto.Hash.Keccak: type State = [[Word64]]
+ Crypto.Hash.Keccak: keccakHash :: Int -> ByteString -> ByteString
+ Crypto.Hash.Keccak: sha3Hash :: Int -> ByteString -> ByteString
+ Crypto.Hash.Keccak: sha3_224 :: ByteString -> ByteString
+ Crypto.Hash.Keccak: sha3_256 :: ByteString -> ByteString
+ Crypto.Hash.Keccak: sha3_384 :: ByteString -> ByteString
+ Crypto.Hash.Keccak: sha3_512 :: ByteString -> ByteString
- Crypto.Hash.Keccak: absorb :: Int -> [[Word64]] -> State
+ Crypto.Hash.Keccak: absorb :: Int -> [Word8] -> State
Files
- README.md +4/−3
- examples/lowCapacityCollision.hs +31/−0
- keccak.cabal +23/−14
- src/Crypto/Hash/Keccak.hs +110/−73
- test/Spec.hs +41/−54
- test/Test/Parse/KAT.hs +13/−4
README.md view
@@ -8,6 +8,8 @@ ## Example usage ```haskell+ghci> import Data.ByteString.Base16 as BS16+ ghci> :t keccak256 keccak256 :: BS.ByteString -> BS.ByteString @@ -32,9 +34,8 @@ ## References +[Cryptographic Sponge Functions](https://keccak.team/files/CSF-0.1.pdf)+ [Official Keccak Reference](https://keccak.team/files/Keccak-reference-3.0.pdf) [Specification summary](https://keccak.team/keccak_specs_summary.html)--[SHA-3 and The Hash Function Keccak (textbook-chapter)](https://pdfs.semanticscholar.org/8450/06456ff132a406444fa85aa7b5636266a8d0.pdf)
+ examples/lowCapacityCollision.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++import Crypto.Hash.Keccak+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as BS16++smallKeccak :: BS.ByteString -> BS.ByteString+smallKeccak = keccakHash 1568++message :: BS.ByteString+message = "I am fascinated by Tim May's crypto-anarchy. Unlike the communities traditionally associated with the word 'anarchy', in a crypto-anarchy the government is not temporarily destroyed but permanently forbidden and permanently unnecessary. It's a community where the threat of violence is impotent because violence is impossible, and violence is impossible because its participants cannot be linked to their true names or physical locations. Until now it's not clear, even theoretically, how such a community could operate. A community is defined by the cooperation of its participants, and efficient cooperation requires a medium of exchange (money) and a way to enforce contracts. Traditionally these services have been provided by the government or government sponsored institutions and only to legal entities. In this article I describe a protocol by which these services can be provided to and by untraceable entities. I will actually describe two protocols. The first one is impractical, because it makes heavy use of a synchronous and unjammable anonymous broadcast channel. However it will motivate the second, more practical protocol. In both cases I will assume the existence of an untraceable network, where senders and receivers are identified only by digital pseudonyms (i.e. public keys) and every messages is signed by its sender and encrypted to its receiver. In the first protocol, every participant maintains a (seperate) database of how much money belongs to each pseudonym. These accounts collectively define the ownership of money, and how these accounts are updated is the subject of this protocol."++hashImage :: BS.ByteString+hashImage = smallKeccak message++incrementByteString :: BS.ByteString -> BS.ByteString+incrementByteString bs = if newHead == 32 then BS.cons newHead (incrementByteString (BS.tail bs))+ else BS.cons newHead (BS.tail bs)+ where newHead = max 32 $ (1 + BS.head bs) `mod` 127++firstCollision :: (Int, BS.ByteString)+firstCollision = head . dropWhile ((hashImage /=) . smallKeccak . snd) . drop 1 $+ zip [0..] (iterate incrementByteString message)++main :: IO ()+main = do let collision = firstCollision+ putStrLn $ "Collision found after checking " ++ show (fst collision) ++ " inputs."+ print $ snd collision+ print message+ print . BS16.encode $ hashImage+ print . BS16.encode . smallKeccak $ snd collision
keccak.cabal view
@@ -1,5 +1,5 @@ name: keccak-version: 0.1.1+version: 0.1.2 synopsis: haskell keccak functions description: pure haskell implementation of keccak hash functions for use with ghc or ghcjs@@ -28,8 +28,8 @@ other-modules: Test.Cryptonite Test.Parse.KAT build-depends: base- , bytestring , base16-bytestring+ , bytestring , cryptonite , keccak , HUnit@@ -45,18 +45,27 @@ default-language: Haskell2010 benchmark self- type: exitcode-stdio-1.0- hs-source-dirs: benchs- , test- other-modules: Test.Cryptonite- default-language: Haskell2010- main-is: Main.hs- build-depends: base- , bytestring- , cryptonite- , gauge- , keccak- , memory+ type: exitcode-stdio-1.0+ hs-source-dirs: benchs+ , test+ other-modules: Test.Cryptonite+ main-is: Main.hs+ build-depends: base+ , bytestring+ , cryptonite+ , gauge+ , keccak+ , memory+ default-language: Haskell2010++executable collision+ main-is: lowCapacityCollision.hs+ hs-source-dirs: examples+ build-depends: base+ , base16-bytestring+ , bytestring+ , keccak+ default-language: Haskell2010 source-repository head type: git
src/Crypto/Hash/Keccak.hs view
@@ -1,4 +1,22 @@-module Crypto.Hash.Keccak where+module Crypto.Hash.Keccak+ ( -- * Standard keccak hash functions+ keccak224+ , keccak256+ , keccak384+ , keccak512+ -- * Standard SHA3 hash functions+ , sha3_512+ , sha3_384+ , sha3_256+ , sha3_224+ -- * Building blocks of a Keccak hash function+ , keccakHash+ , sha3Hash+ , paddingKeccak+ , paddingSha3+ , absorb+ , squeeze+ ) where import Data.Bits import qualified Data.ByteString as BS@@ -10,7 +28,10 @@ emptyState :: State emptyState = replicate 5 (replicate 5 0) --- truncated when w is smaller than 64+----------------------------------------------------+-- Constants used in KeccakF[1600] permutation+----------------------------------------------------+ roundConstants :: [Word64] roundConstants = [ 0x0000000000000001, 0x0000000000008082, 0x800000000000808A , 0x8000000080008000, 0x000000000000808B, 0x0000000080000001@@ -29,71 +50,94 @@ , [ 27, 20, 39, 8, 14 ] ] --paddingKeccak :: Int -> BS.ByteString -> [Word8]-paddingKeccak bitRateBytes = multiratePadding bitRateBytes 0x1-+----------------------------------------------------+-- Keccak and SHA3 hash functions+---------------------------------------------------- -paddingSha3 :: Int -> BS.ByteString -> [Word8]-paddingSha3 bitRateBytes = multiratePadding bitRateBytes 0x6+hashFunction :: (Int -> BS.ByteString -> [Word8]) -> Int -> BS.ByteString -> BS.ByteString+hashFunction paddingFunction rate = squeeze outputBytes . absorb rate+ . paddingFunction (div rate 8)+ where outputBytes = div (1600 - rate) 16 +-- | Given a bitrate @r@, returns a standard Keccak hash with state width @w@ = 1600 and+-- capacity = 1600 - @r@+keccakHash :: Int -> BS.ByteString -> BS.ByteString+keccakHash = hashFunction paddingKeccak -multiratePadding :: Int -> Word8 -> BS.ByteString -> [Word8]-multiratePadding bitRateBytes padByte input = BS.unpack . BS.append input $ if padlen == 1- then BS.pack [0x81]- else BS.pack $ padByte : replicate (padlen - 2) 0x00 ++ [0x80]- where -- TODO: modulo bitRateBytes?- usedBytes = BS.length input- padlen = bitRateBytes - mod usedBytes bitRateBytes+-- | Given a bitrate @r@, returns a standard SHA3 hash with state width @w@ = 1600 and+-- capacity = 1600 - @r@+sha3Hash :: Int -> BS.ByteString -> BS.ByteString+sha3Hash = hashFunction paddingSha3 --- r (bitrate) = 576--- c (capacity) = 1024-keccak512Rate :: Int-keccak512Rate = 576-+-- | Keccak (512 bits) cryptographic hash algorithm keccak512 :: BS.ByteString -> BS.ByteString-keccak512 = squeeze 64 . absorb keccak512Rate- . toBlocks bitRateBytes- . paddingKeccak bitRateBytes- where bitRateBytes = div keccak512Rate 8+keccak512 = keccakHash 576 --- r (bitrate) = 832--- c (capacity) = 768-keccak384Rate :: Int-keccak384Rate = 832-+-- | Keccak (384 bits) cryptographic hash algorithm keccak384 :: BS.ByteString -> BS.ByteString-keccak384 = squeeze 48 . absorb keccak384Rate- . toBlocks bitRateBytes- . paddingKeccak bitRateBytes- where bitRateBytes = div keccak384Rate 8+keccak384 = keccakHash 832 --- r (bitrate) = 1088--- c (capacity) = 512-keccak256Rate :: Int-keccak256Rate = 1088 +-- | Keccak (256 bits) cryptographic hash algorithm keccak256 :: BS.ByteString -> BS.ByteString-keccak256 = squeeze 32 . absorb keccak256Rate- . toBlocks bitRateBytes- . paddingKeccak bitRateBytes- where bitRateBytes = div keccak256Rate 8+keccak256 = keccakHash 1088 --- r (bitrate) = 1152--- c (capacity) = 448-keccak224Rate :: Int-keccak224Rate = 1152 +-- | Keccak (224 bits) cryptographic hash algorithm keccak224 :: BS.ByteString -> BS.ByteString-keccak224 = squeeze 28 . absorb keccak224Rate- . toBlocks bitRateBytes- . paddingKeccak bitRateBytes- where bitRateBytes = div keccak224Rate 8+keccak224 = keccakHash 1152 --- Sized inputs to this?+-- | SHA3 (512 bits) cryptographic hash algorithm+sha3_512 :: BS.ByteString -> BS.ByteString+sha3_512 = sha3Hash 576+++-- | SHA3 (384 bits) cryptographic hash algorithm+sha3_384 :: BS.ByteString -> BS.ByteString+sha3_384 = sha3Hash 832+++-- | SHA3 (256 bits) cryptographic hash algorithm+sha3_256 :: BS.ByteString -> BS.ByteString+sha3_256 = sha3Hash 1088+++-- | SHA3 (224 bits) cryptographic hash algorithm+sha3_224 :: BS.ByteString -> BS.ByteString+sha3_224 = sha3Hash 1152++----------------------------------------------------+-- Padding functions+----------------------------------------------------++-- | Multi-rate padding appends at least 2 bits and at most the number of bits+-- in a block plus one.+multiratePadding :: Int -> Word8 -> BS.ByteString -> [Word8]+multiratePadding bitrateBytes padByte input = BS.unpack . BS.append input $ if padlen == 1+ then BS.pack [0x80 .|. padByte]+ else BS.pack $ padByte : replicate (padlen - 2) 0x00 ++ [0x80]+ where padlen = bitrateBytes - mod (BS.length input) bitrateBytes+++-- | Appends a single bit 1 followed by the minimum number of bits+-- 0 followed by a single bit 1 such that the length of the result is+-- a multiple of the bitrate.+paddingKeccak :: Int -> BS.ByteString -> [Word8]+paddingKeccak bitrateBytes = multiratePadding bitrateBytes 0x01+++-- | Appends to a message M padding of the form (M || 0x06 || 0x00... || 0x80)+-- such that the length of the result is a multiple of the bitrate.+paddingSha3 :: Int -> BS.ByteString -> [Word8]+paddingSha3 bitrateBytes = multiratePadding bitrateBytes 0x06++----------------------------------------------------+-- Sponge function primitives+----------------------------------------------------+ toBlocks :: Int -> [Word8] -> [[Word64]] toBlocks _ [] = [] toBlocks sizeInBytes input = let (a, b) = splitAt sizeInBytes input@@ -105,12 +149,11 @@ toLane :: [Word8] -> Word64 toLane octets = foldl1 xor $ zipWith (\offset octet -> shiftL (fromIntegral octet) (offset * 8)) [0..7] octets +-- | Takes as input the bitrate @rate@ and a string P with |P| a multiple of+-- @rate@. Returns the value of the state obtained after absorbing P.+absorb :: Int -> [Word8] -> State+absorb rate = foldl (absorbBlock rate) emptyState . toBlocks (div rate 8) --- for each block Pi in P--- S[x,y] = S[x,y] xor Pi[x+5*y], for (x,y) such that x+5*y < r/w--- S = Keccak-f[r+c](S)-absorb :: Int -> [[Word64]] -> State-absorb rate = foldl (absorbBlock rate) emptyState absorbBlock :: Int -> State -> [Word64] -> State absorbBlock rate state input = keccakF state'@@ -122,14 +165,11 @@ | x <- [0..4] ] --- # Squeezing phase--- Z = empty string--- while output is requested--- Z = Z || S[x,y], for (x,y) such that x+5*y < r/w--- S = Keccak-f[r+c](S)--- TODO handle longer outputs+-- | Iteratively returns the outer part of the state as output blocks, interleaved+-- with applications of the function @keccakF@. The number of iterations is+-- determined by the requested number of bits @l@. squeeze :: Int -> State -> BS.ByteString-squeeze len = BS.pack . take len . stateToBytes+squeeze l = BS.pack . take l . stateToBytes stateToBytes :: State -> [Word8]@@ -139,15 +179,16 @@ laneToBytes :: Word64 -> [Word8] laneToBytes word = fmap (\x -> fromIntegral (shiftR word (x * 8) .&. 0xFF)) [0..7] +----------------------------------------------------+-- KeccakF permutation & constituent primatives+---------------------------------------------------- keccakF :: State -> State keccakF state = foldl (\s r -> iota r . chi . rhoPi $ theta s) state [0 .. (rounds - 1)] where rounds = 24 --- # θ step--- C[x] = A[x,0] xor A[x,1] xor A[x,2] xor A[x,3] xor A[x,4], for x in 0…4--- D[x] = C[x-1] xor rot(C[x+1],1), for x in 0…4--- A[x,y] = A[x,y] xor D[x], for (x,y) in (0…4,0…4)++-- | θ step theta :: State -> State theta state = [ [ ((state !! x) !! y) `xor` (d !! x) | y <- [0..4] ]@@ -158,23 +199,19 @@ d = [ c !! ((x - 1) `mod` 5) `xor` rotateL (c !! ((x + 1) `mod` 5)) 1 | x <- [0..4] ] --- # ρ and π steps--- B[y,2*x+3*y] = rot(A[x,y], r[x,y]), for (x,y) in (0…4,0…4)+-- | ρ and π steps rhoPi :: State -> [[Word64]] rhoPi state = fmap (fmap rotFunc) [ [ ((x + 3 * y) `mod` 5, x) | y <- [0..4] ] | x <- [0..4] ] where rotFunc (x, y) = rotateL ((state !! x) !! y) ((rotationConstants !! x) !! y) --- # χ step--- A[x,y] = B[x,y] xor ((not B[x+1,y]) and B[x+2,y]), for (x,y) in (0…4,0…4)+-- | χ step chi :: [[Word64]] -> State chi b = [ [ ((b !! x) !! y) `xor` (complement ((b !! ((x + 1) `mod` 5)) !! y) .&. ((b !! ((x + 2) `mod` 5)) !! y)) | y <- [0..4] ] | x <- [0..4] ] --- # ι step--- A[0,0] = A[0,0] xor RC--- TODO Data.List.Lens+-- | ι step iota :: Int -> State -> State iota round ((first : rest) : restRows) = (xor (roundConstants !! round) first : rest) : restRows
test/Spec.hs view
@@ -10,8 +10,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit (Assertion, assertEqual, assertFailure) import Test.Parse.KAT-import Test.QuickCheck ((==>), Property, withMaxSuccess)-import Test.QuickCheck.Instances.ByteString main :: IO ()@@ -19,22 +17,7 @@ tests :: [Test]-tests = [ testGroup "padding & blocking"- [ testCase "proper padding of zero input for keccak256" keccakEmptyPaddingTest- , testCase "proper padding of ascii input for keccak256" keccakAsciiPaddingTest- ]- , testGroup "absorbtion"- [ testCase "proper absorbtion of zero input for keccak256" keccakEmptyAbsorbtionTest- , testCase "proper absorbtion of ascii input for keccak256" keccakAsciiAbsorbtionTest- ]- , testGroup "squeezing" []- , testGroup "keccak256"- [ testCase "hashing empty bytestring" keccak256EmptyTest- , testCase "hashing string 'testing'" keccak256AsciiTest- , testProperty "extensionally equivalent to cryptonite-keccak"- (withMaxSuccess 3000 cryptoniteKeccak256_eq)- ]- , testGroup "KAT"+tests = [ testGroup "Keccak KAT" [ testCase "ShortMsgKAT_224.txt" shortMsgKAT_224 , testCase "LongMsgKAT_224.txt" longMsgKAT_224 , testCase "ShortMsgKAT_256.txt" shortMsgKAT_256@@ -44,49 +27,29 @@ , testCase "ShortMsgKAT_512.txt" shortMsgKAT_512 , testCase "LongMsgKAT_512.txt" longMsgKAT_512 ]+ , testGroup "SHA3 KAT"+ [ testCase "SHA3_224ShortMsg.rsp" shortMsgKAT_SHA3_224+ , testCase "SHA3_244LongMsg.rsp" longMsgKAT_SHA3_224+ , testCase "SHA3_256ShortMsg.rsp" shortMsgKAT_SHA3_256+ , testCase "SHA3_256LongMsg.rsp" longMsgKAT_SHA3_256+ , testCase "SHA3_384ShortMsg.rsp" shortMsgKAT_SHA3_384+ , testCase "SHA3_384LongMsg.rsp" longMsgKAT_SHA3_384+ , testCase "SHA3_512ShortMsg.rsp" shortMsgKAT_SHA3_512+ , testCase "SHA3_512LongMsg.rsp" longMsgKAT_SHA3_512+ ] ] -keccakEmptyPaddingTest :: Assertion-keccakEmptyPaddingTest = assertEqual "Pads empty string properly" zeroPadding (paddingKeccak 136 "")- where zeroPadding = [1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 128]--keccakAsciiPaddingTest :: Assertion-keccakAsciiPaddingTest = assertEqual "Pads ascii string properly" asciiPadding (paddingKeccak 136 "testing")- where asciiPadding = [116, 101, 115, 116, 105, 110, 103, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 128]---keccakEmptyAbsorbtionTest :: Assertion-keccakEmptyAbsorbtionTest = assertEqual "Absorbs empty input properly" endState (absorb keccak256Rate . toBlocks 136 $ paddingKeccak 136 "")- where endState = [[4333579421379646149,14671339323370021561,4391692840257016808,16970298442240338249,16062291397582171322],[13836122230913597074,2243375101132795228,4309499098775122448,1971761234120675839,1601982631079003425],[4262519377828905189,9371364203318886753,13438072403645551266,450719451514497906,7734681229251997073],[8116759062988257915,9347994793612953298,18018124564071650747,18340686150147091359,13256946727218518206],[8406387447366859581,12814238161780307547,4323130096954625545,11254645818134300982,11816912122432958423]]---keccakAsciiAbsorbtionTest :: Assertion-keccakAsciiAbsorbtionTest = assertEqual "Absorbs ascii input properly" asciiState (absorb keccak256Rate . toBlocks 136 $ paddingKeccak 136 "testing")- where asciiState = [[5741044927781148255,5536040307487716601,11084357000576311707,12707954408119767660,8319093435246931416],[253595265147670677,7606140838194786578,2366244087054482559,18181979956023419548,7691975034864958586],[10448875313496118154,17475093054141481980,11669704621260022411,9601734410265320743,13113298532289803684],[151888593866888543,4052828971212897447,7607297586066738160,15654769812205594072,16061863611318168517],[3465997019864229635,12358594370410885724,17971813471771339249,7394790340576097786,5735185612101350050]]---keccak256EmptyTest :: Assertion-keccak256EmptyTest = assertEqual "Hashes empty string" ("c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470" :: BS.ByteString) (BS16.encode $ keccak256 BS.empty)---keccak256AsciiTest :: Assertion-keccak256AsciiTest = assertEqual "Hashes ascii string" ("5f16f4c7f149ac4f9510d9cf8cf384038ad348b3bcdc01915f95de12df9d1b02" :: BS.ByteString) (BS16.encode $ keccak256 "testing")--cryptoniteKeccak256_eq :: BS.ByteString -> Bool-cryptoniteKeccak256_eq xs =- keccak256 xs == cryptoniteKeccak' xs-- knownAnswerTestAssertion :: FilePath -> (BS.ByteString -> BS.ByteString) -> Assertion knownAnswerTestAssertion testFile hashFunction = do katsE <- parseFromFile parseTestFile testFile- kats <- either (assertFailure . show) pure katsE- mapM_ runKat kats- where runKat (KAT l m d) = if l `mod` 8 == 0- then assertEqual "Bad digest" (hashFunction $ BS.take l m) d- else assertEqual "Non-byte lenght msg" True True+ kats <- either (assertFailure . show)+ (pure . filter (\kat -> byteLength kat `mod` 8 == 0)) katsE+ mapM_ runKat $ zip [0..] kats+ where runKat (index, KAT l m d) = assertEqual (show index ++ ": Bad digest.")+ (hashFunction $ BS.take l m) d + shortMsgKAT_224 :: Assertion shortMsgKAT_224 = knownAnswerTestAssertion "test/KAT_MCT/ShortMsgKAT_224.txt" keccak224 @@ -110,3 +73,27 @@ longMsgKAT_512 :: Assertion longMsgKAT_512 = knownAnswerTestAssertion "test/KAT_MCT/LongMsgKAT_512.txt" keccak512++shortMsgKAT_SHA3_224 :: Assertion+shortMsgKAT_SHA3_224 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_224ShortMsg.rsp" sha3_224++longMsgKAT_SHA3_224 :: Assertion+longMsgKAT_SHA3_224 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_224LongMsg.rsp" sha3_224++shortMsgKAT_SHA3_256 :: Assertion+shortMsgKAT_SHA3_256 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_256ShortMsg.rsp" sha3_256++longMsgKAT_SHA3_256 :: Assertion+longMsgKAT_SHA3_256 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_256LongMsg.rsp" sha3_256++shortMsgKAT_SHA3_384 :: Assertion+shortMsgKAT_SHA3_384 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_384ShortMsg.rsp" sha3_384++longMsgKAT_SHA3_384 :: Assertion+longMsgKAT_SHA3_384 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_384LongMsg.rsp" sha3_384++shortMsgKAT_SHA3_512 :: Assertion+shortMsgKAT_SHA3_512 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_512ShortMsg.rsp" sha3_512++longMsgKAT_SHA3_512 :: Assertion+longMsgKAT_SHA3_512 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_512LongMsg.rsp" sha3_512
test/Test/Parse/KAT.hs view
@@ -14,20 +14,27 @@ type TestFile = [KAT] -data KAT = KAT { length :: Int- , message :: BS.ByteString- , digest :: BS.ByteString+data KAT = KAT { byteLength :: Int+ , message :: BS.ByteString+ , digest :: BS.ByteString } deriving Show parseTestFile :: Parser TestFile-parseTestFile = skipMany (commentLine <|> blankLine) *> many1 parseKat+parseTestFile = skipMany (commentLine <|> dataLine <|> blankLine) *> many1 parseKat + commentLine :: Parser () commentLine = void $ char '#' *> manyTill anyChar endOfLine ++dataLine :: Parser ()+dataLine = void $ char '[' *> manyTill anyChar endOfLine++ blankLine :: Parser () blankLine = void endOfLine + parseKat :: Parser KAT parseKat = do len <- string "Len = " *> many1 digit <* endOfLine msg <- string "Msg = " *> many1 hexDigit <* endOfLine@@ -37,8 +44,10 @@ pure $ KAT parsedLen (BS.take parsedLen $ bytesDecode msg) (bytesDecode digest) + bytesDecode :: String -> BS.ByteString bytesDecode = fst . BS16.decode . T.encodeUtf8 . T.pack+ parseFromFile :: Parsec T.Text () a -> FilePath -> IO (Either ParseError a) parseFromFile p fname = do