diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -35,7 +35,8 @@ NIST uses the [Secure Hash Algorithm Validation System (SHAVS)](https://csrc.nist.gov/CSRC/media//Projects/Cryptographic-Algorithm-Validation-Program/documents/shs/SHAVS.pdf) to validate the correctness of hash implementations. For all four variants of -SHA3 and Keccak, the `keccak` library's implementations successfully +SHA3 and Keccak and the two standard variants of SHAKE, the `keccak` library's +implementations successfully [pass](https://github.com/aupiff/keccak/blob/master/test/Spec.hs) the standard KATs (Known Answer Tests). @@ -45,23 +46,23 @@ stack bench ``` -`cryptonite`'s C-based implementation of Keccack256 is currently 31x faster +`cryptonite`'s C-based implementation of Keccack256 is currently 21 times faster than my Haskell. ``` benchmarked keccak -time 192.9 μs (189.3 μs .. 196.5 μs) - 0.997 R² (0.994 R² .. 0.999 R²) -mean 196.2 μs (194.2 μs .. 199.8 μs) -std dev 8.622 μs (5.653 μs .. 12.30 μs) -variance introduced by outliers: 24% (moderately inflated) +time 768.3 μs (758.7 μs .. 775.7 μs) + 0.998 R² (0.995 R² .. 0.999 R²) +mean 774.2 μs (767.5 μs .. 784.0 μs) +std dev 29.27 μs (23.12 μs .. 36.87 μs) +variance introduced by outliers: 19% (moderately inflated) benchmarked cryptonite-keccak -time 6.105 μs (6.038 μs .. 6.186 μs) - 0.999 R² (0.998 R² .. 0.999 R²) -mean 6.302 μs (6.236 μs .. 6.413 μs) -std dev 293.5 ns (196.1 ns .. 440.9 ns) -variance introduced by outliers: 26% (moderately inflated) +time 36.92 μs (35.95 μs .. 38.03 μs) + 0.996 R² (0.995 R² .. 0.998 R²) +mean 36.27 μs (35.99 μs .. 36.66 μs) +std dev 1.147 μs (918.3 ns .. 1.471 μs) +variance introduced by outliers: 14% (moderately inflated) ``` Eventually, I hope the library will have very few dependencies (only base, diff --git a/benchs/Main.hs b/benchs/Main.hs --- a/benchs/Main.hs +++ b/benchs/Main.hs @@ -8,11 +8,19 @@ import Gauge --- TODO short test & long test for multiple hashes stringsToHash :: [BS.ByteString] -stringsToHash = ["", "testing", "1234891237489127349817238497"] +stringsToHash = ["", "testing", "1234891237489127349817238497", msg1, msg2] + main = defaultMain [ bench "keccak" $ nf (map keccak256) stringsToHash , bench "cryptonite-keccak" $ nf (map cryptoniteKeccak') stringsToHash ] + + +msg1 :: BS.ByteString +msg1 = "b1caa396771a09a1db9bc20543e988e359d47c2a616417bbca1b62cb02796a888fc6eeff5c0b5c3d5062fcb4256f6ae1782f492c1cf03610b4a1fb7b814c057878e1190b9835425c7a4a0e182ad1f91535ed2a35033a5d8c670e21c575ff43c194a58a82d4a1a44881dd61f9f8161fc6b998860cbe4975780be93b6f87980bad0a99aa2cb7556b478ca35d1f3746c33e2bb7c47af426641cc7bbb3425e2144820345e1d0ea5b7da2c3236a52906acdc3b4d34e474dd714c0c40bf006a3a1d889a632983814bbc4a14fe5f159aa89249e7c738b3b73666bac2a615a83fd21ae0a1ce7352ade7b278b587158fd2fabb217aa1fe31d0bda53272045598015a8ae4d8cec226fefa58daa05500906c4d85e7567" + + +msg2 :: BS.ByteString +msg2 = "460f8c7aac921fa9a55800b1d04cf981717c78217cd43f98f02c5c0e66865c2eea90bcce0971a0d22bc1c74d24d9bfea054e558b38b8502fccb85f190d394f2f58f581a02d3b9cc986f07f5a67d57ab4b707bd964ecc10f94f8cc538b81eeb743746c537407b7b575ced0e1ec4c691a72eb0978be798e8be22b278b390be99c730896fdc69b6a44456be5ee261366e8b1351cbb22aa53e45ec325ed2bca0bfeeebc867d7d07681581b6d56ed66ac78280df04053407a7b57561261dd644cc7b20f0a95709e42795b5402dd89fcb11746c597e0b650a008bc085c681bb24b17db4458e1effba3f414a883ddfc4bccb3ace24d9223839d4b3ca9185ad5cc24193134b9339b0e205a4cc0fa3d8f7a85b4230d1b3ee101fbae9ee14c2153da5f337c853573bd004114cb436ee58ab1648373ee07cc39f14198ac5a02a4dd0585cf83dfd4899df88e8859dae8bc351af286642c1c25737bf8712cb941cbbb741d540feb9f5d831f901fbe2d6facd7dab626bd705f2fd7c9a7a0e7a9127e3451af2ae8509dd7b79dce41c1e30b9dba1c38cb4861dad3ac00d68fa5d07ba591c1c3b9d6b7d6e08099d0572ca4c475240601decba894fa3c4b0ea52ed687281beee268a1c8535e283b1fc7c51aa31d5ec098c50fec958acdd0d54a49643bef170093a1102a1b3bf5ad42fb55ebaf7db07385eadcd6e66da8b7b6e6c022a1e3d01f5fccec86365d3014c159a3bff17d614751b3fa0e8e89152936e159b7c0ea8d71cd4ffd83adae209b254b793f6f06bb63838a303b95c85b4edfa4ddcca0ed952165930bca87140f67f5389d1233fe04f0a3d647050410c44d389513084ad53155af00de02cc7943a3b988d8e1454f85153aff0816e24b964ec91dc514c588a93634ff3dd485c40575faa2f254abdf86fbcf6d381337601a7b1ba5b99719f045eb7bf6f2e8b9dd9d053ef0b3126f984fc9ea87a2a70b3798fab593b83a4ff44d9c0c4ec3e570ac537c10d9e3c4996027a813b70d7867b858f31f508aa56e7b087370707974b2186f02f5c549112f2158c0d365402e52cba18fe245f77f7e6fbf952ec2dc3c880b38be771caea23bc22838b1f70472d558bdf585d9c77088b7ba2dceaeb3e6f96df7d91d47da1ec42be03936d621ecf747f24f9073c122923b4161d99bc8190e24f57b6fac952ed344c7eae86a5f43c08089c28c7daf3aa7e39c59d6f1e17ece1977caf6b4a77a6ff52774521b861f38ebc978005e5763cc97123e4d17c7bc4134c8f139c7d7a9a02646fef9525d2a6871fc99747e81430b3fec38c677427c6f5e2f16c14eee646ebf6eb16775ad0957f8684c7045f7826bc3736eca" diff --git a/keccak.cabal b/keccak.cabal --- a/keccak.cabal +++ b/keccak.cabal @@ -1,6 +1,6 @@ name: keccak -version: 0.1.3 -synopsis: haskell keccak functions +version: 0.2.0 +synopsis: cryptographic functions based on the sponge construction description: pure haskell implementation of keccak hash functions for use with ghc or ghcjs homepage: https://github.com/aupiff/keccak#readme @@ -21,6 +21,7 @@ , bytestring , vector default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs -optc-O3 test-suite keccak-test type: exitcode-stdio-1.0 diff --git a/src/Crypto/Hash/Keccak.hs b/src/Crypto/Hash/Keccak.hs --- a/src/Crypto/Hash/Keccak.hs +++ b/src/Crypto/Hash/Keccak.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE BangPatterns #-} + module Crypto.Hash.Keccak ( -- * Standard keccak hash functions keccak224 @@ -9,6 +11,9 @@ , sha3_384 , sha3_256 , sha3_224 + -- * SHAKE extendable-output functions + , shake128 + , shake256 -- * Building blocks of a Keccak hash function , keccakHash , sha3Hash @@ -19,11 +24,20 @@ ) where import Data.Bits -import qualified Data.ByteString as BS -import Data.Vector.Unboxed ((!), (//)) -import qualified Data.Vector.Unboxed as V +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BS +import qualified Data.ByteString.Lazy as LBS +import Data.Foldable +import Data.Monoid +import Data.Vector.Unboxed ((!)) +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector.Unboxed.Mutable as MV import Data.Word +import Prelude hiding (pi) +rounds :: Int +rounds = 24 + numLanes :: Int numLanes = 25 @@ -54,13 +68,21 @@ , 28, 55, 25, 21, 56 , 27, 20, 39, 8, 14 ] +-- TODO explain how these are generated +piConstants :: V.Vector Int +piConstants = V.fromList [ 0, 15, 5, 20, 10 + , 6, 21, 11, 1, 16 + , 12, 2, 17, 7, 22 + , 18, 8, 23, 13, 3 + , 24, 14, 4, 19, 9 ] + ---------------------------------------------------- -- Keccak and SHA3 hash functions ---------------------------------------------------- hashFunction :: (Int -> BS.ByteString -> V.Vector Word8) -> Int -> BS.ByteString -> BS.ByteString -hashFunction paddingFunction rate = squeeze outputBytes . absorb rate - . paddingFunction (div rate 8) +hashFunction paddingFunction rate = squeeze rate 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 @@ -114,17 +136,43 @@ sha3_224 = sha3Hash 1152 ---------------------------------------------------- +-- SHAKE Extendable-Output Functions +---------------------------------------------------- + +shakeFunction :: (Int -> BS.ByteString -> V.Vector Word8) -> Int + -> Int -> BS.ByteString -> BS.ByteString +shakeFunction paddingFunction rate outputBytes = + squeeze rate outputBytes . absorb rate + . paddingFunction (div rate 8) + + +-- | SHAKE128 (128 bit security level) cryptographic extendable-output function +shake128 :: Int -> BS.ByteString -> BS.ByteString +shake128 outputBits = shakeFunction paddingShake 1344 (div outputBits 8) + + +-- | SHAKE256 (256 bit security level) cryptographic extendable-output function +shake256 :: Int -> BS.ByteString -> BS.ByteString +shake256 outputBits = shakeFunction paddingShake 1088 (div outputBits 8) + + +---------------------------------------------------- -- 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 -> V.Vector Word8 -multiratePadding bitrateBytes padByte input = V.fromList . (++) (BS.unpack input) $ if padlen == 1 - then [0x80 .|. padByte] - else padByte : replicate (padlen - 2) 0x00 ++ [0x80] - where padlen = bitrateBytes - mod (BS.length input) bitrateBytes - +multiratePadding bitrateBytes padByte input = V.generate totalLength process + where msglen = BS.length input + padlen = bitrateBytes - mod (BS.length input) bitrateBytes + totalLength = padlen + msglen + process x + | x < msglen = BS.index input x + | x == (totalLength - 1) && padlen == 1 = 0x80 .|. padByte + | x == (totalLength - 1) = 0x80 + | x == msglen = padByte + | otherwise = 0x00 -- | 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 @@ -138,6 +186,10 @@ paddingSha3 :: Int -> BS.ByteString -> V.Vector Word8 paddingSha3 bitrateBytes = multiratePadding bitrateBytes 0x06 + +paddingShake :: Int -> BS.ByteString -> V.Vector Word8 +paddingShake bitrateBytes = multiratePadding bitrateBytes 0x1F + ---------------------------------------------------- -- Sponge function primitives ---------------------------------------------------- @@ -147,8 +199,8 @@ where toLane :: V.Vector Word8 -> Maybe (Word64, V.Vector Word8) toLane input | V.null input = Nothing - | otherwise = let (head, tail) = V.splitAt 8 input - in Just (V.ifoldl' createWord64 0 head, tail) + | otherwise = let (h, t) = V.splitAt 8 input + in Just (V.ifoldl' createWord64 0 h, t) createWord64 acc offset octet = acc `xor` shiftL (fromIntegral octet) (offset * 8) @@ -159,66 +211,64 @@ absorbBlock :: Int -> V.Vector Word64 -> V.Vector Word64 -> V.Vector Word64 -absorbBlock rate state input +absorbBlock !rate !state !input | V.null input = state | otherwise = absorbBlock rate (keccakF state') (V.drop (div rate 64) input) -- TODO this can be optimized with some sort of in-place manipulation - where state' = V.map (\z -> if div z 5 + 5 * mod z 5 < div rate laneWidth - then (state ! z) `xor` (input ! (div z 5 + 5 * mod z 5)) - else state ! z) - (V.enumFromN 0 numLanes) + where state' = V.imap (\z el -> if div z 5 + 5 * mod z 5 < threshold + then el `xor` (input ! (div z 5 + 5 * mod z 5)) + else el) state + threshold = div rate laneWidth + -- | 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@. --- TODO make this support SHAKE -squeeze :: Int -> V.Vector Word64 -> BS.ByteString -squeeze l = BS.pack . V.toList . V.take l . stateToBytes - - --- TODO this can probably be an unfold -stateToBytes :: V.Vector Word64 -> V.Vector Word8 -stateToBytes state = V.concatMap (\z -> laneToBytes $ state ! (div z 5 + mod z 5 * 5)) (V.enumFromN 0 numLanes) - - -laneToBytes :: Word64 -> V.Vector Word8 -laneToBytes = V.unfoldrN 8 (\x -> Just (fromIntegral $ x .&. 0xFF, shiftR x 8)) +squeeze :: Int -> Int -> V.Vector Word64 -> BS.ByteString +squeeze !rate !l !state = BS.take l . LBS.toStrict . BS.toLazyByteString + . V.foldl' (\acc n -> acc <> BS.word64LE n) mempty + $ stateToBytes state + where lanesToExtract = ceiling $ fromIntegral l / fromIntegral (div laneWidth 8) + stateToBytes :: V.Vector Word64 -> V.Vector Word64 + stateToBytes s = V.unfoldrN lanesToExtract extract (0, s) + threshold = div rate laneWidth + extract (x, s) + | x < threshold = Just (s ! (div x 5 + mod x 5 * 5), (succ x, s)) + | otherwise = extract (0, keccakF s) ---------------------------------------------------- -- KeccakF permutation & constituent primatives ---------------------------------------------------- keccakF :: V.Vector Word64 -> V.Vector Word64 -keccakF state = V.foldl' (\s r -> iota r . chi . rhoPi $ theta s) state (V.enumFromN 0 rounds) - where rounds = 24 +keccakF !state = snd $ foldl1 (.) (replicate rounds f) (0, state) + where f (!r, !s) = (succ r, iota r . chi . pi . rho $ theta s) theta :: V.Vector Word64 -> V.Vector Word64 -theta state = V.map (\z -> xor (d ! div z 5) (state ! z)) $ V.enumFromN 0 numLanes - where c = V.fromList [ state ! 0 `xor` state ! 1 `xor` state ! 2 `xor` state ! 3 `xor` state ! 4 - , state ! 5 `xor` state ! 6 `xor` state ! 7 `xor` state ! 8 `xor` state ! 9 - , state ! 10 `xor` state ! 11 `xor` state ! 12 `xor` state ! 13 `xor` state ! 14 - , state ! 15 `xor` state ! 16 `xor` state ! 17 `xor` state ! 18 `xor` state ! 19 - , state ! 20 `xor` state ! 21 `xor` state ! 22 `xor` state ! 23 `xor` state ! 24 - ] - d = V.map (\x -> c ! ((x - 1) `mod` 5) `xor` rotateL (c ! ((x + 1) `mod` 5)) 1) - (V.enumFromN 0 5) +theta !state = V.concatMap (\(i, e) -> V.map (xor e) (V.slice (i * 5) 5 state)) $ V.indexed d + where c = V.generate 5 (\i -> V.foldl1' xor (V.slice (i * 5) 5 state)) + d = V.generate 5 (\i -> c ! ((i - 1) `mod` 5) `xor` rotateL (c ! ((i + 1) `mod` 5)) 1) +{-# INLINE theta #-} --- can be done using backpermute & update -rhoPi :: V.Vector Word64 -> V.Vector Word64 -rhoPi state = V.map (\z -> rotFunc ((div z 5 + 3 * rem z 5) `mod` 5, div z 5)) (V.enumFromN 0 numLanes) - where rotFunc (x, y) = rotateL (state ! (x * 5 + y)) (rotationConstants ! (x * 5 + y)) +rho :: V.Vector Word64 -> V.Vector Word64 +rho !state = V.zipWith (flip rotateL) rotationConstants state +{-# INLINE rho #-} +pi :: V.Vector Word64 -> V.Vector Word64 +pi !state = V.backpermute state piConstants +{-# INLINE pi #-} + + -- The only non-linear component of keccakF chi :: V.Vector Word64 -> V.Vector Word64 -chi b = V.map func (V.enumFromN 0 numLanes) - where func z = let x = div z 5 - y = rem z 5 - in (b ! z) `xor` - (complement (b ! (mod (x + 1) 5 * 5 + y)) .&. (b ! (((x + 2) `mod` 5) * 5 + y))) +chi !b = V.imap subChi b + where subChi z el = el `xor` (complement (b ! mod (z + 5) 25) .&. (b ! mod (z + 10) 25)) +{-# INLINE chi #-} iota :: Int -> V.Vector Word64 -> V.Vector Word64 -iota round state = state // [(0, xor (roundConstants ! round) (V.head state))] +iota !roundNumber !state = V.modify (\v -> MV.write v 0 $ xor (roundConstants ! roundNumber) (V.head state)) state +{-# INLINE iota #-} diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -18,25 +18,32 @@ tests :: [Test] tests = [ testGroup "Keccak KAT" - [ testCase "ShortMsgKAT_224.txt" shortMsgKAT_224 - , testCase "LongMsgKAT_224.txt" longMsgKAT_224 - , testCase "ShortMsgKAT_256.txt" shortMsgKAT_256 - , testCase "LongMsgKAT_256.txt" longMsgKAT_256 - , testCase "ShortMsgKAT_384.txt" shortMsgKAT_384 - , testCase "LongMsgKAT_384.txt" longMsgKAT_384 - , testCase "ShortMsgKAT_512.txt" shortMsgKAT_512 - , testCase "LongMsgKAT_512.txt" longMsgKAT_512 + [ testCase "Keccak-224 ShortMsg KAT" shortMsgKAT_224 + , testCase "Keccak-224 LongMsg KAT" longMsgKAT_224 + , testCase "Keccak-256 ShortMsg KAT" shortMsgKAT_256 + , testCase "Keccak-256 LongMsg KAT" longMsgKAT_256 + , testCase "Keccak-256 ShortMsg KAT" shortMsgKAT_384 + , testCase "Keccak-384 LongMsg KAT" longMsgKAT_384 + , testCase "Keccak-512 ShortMsg KAT" shortMsgKAT_512 + , testCase "Keccak-512 LongMsg KAT" 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 + [ testCase "SHA3-224 ShortMsg KAT" shortMsgKAT_SHA3_224 + , testCase "SHA3-244 LongMsg KAT" longMsgKAT_SHA3_224 + , testCase "SHA3-256 ShortMsg KAT" shortMsgKAT_SHA3_256 + , testCase "SHA3-256 LongMsg KAT" longMsgKAT_SHA3_256 + , testCase "SHA3-384 ShortMsg KAT" shortMsgKAT_SHA3_384 + , testCase "SHA3-384 LongMsg KAT" longMsgKAT_SHA3_384 + , testCase "SHA3-512 ShortMsg KAT" shortMsgKAT_SHA3_512 + , testCase "SHA3-512 LongMsg KAT" longMsgKAT_SHA3_512 ] + , testGroup "SHAKE" + [ testCase "SHAKE-128 ShortMsg KAT" shortMsgKAT_SHAKE_128 + , testCase "SHAKE-128 LongMsg KAT" longMsgKAT_SHAKE_128 + , testCase "SHAKE-256 ShortMsg KAT" shortMsgKAT_SHAKE_256 + , testCase "SHAKE-256 LongMsg KAT" longMsgKAT_SHAKE_256 + , testCase "SHAKE-256 long output test" longOutputSHAKE256 + ] ] @@ -50,6 +57,16 @@ (hashFunction $ BS.take l m) d +knownAnswerTestShakeAssertion :: FilePath -> (Int -> BS.ByteString -> BS.ByteString) -> Assertion +knownAnswerTestShakeAssertion testFile hashFunction = do + katsE <- parseFromFile parseShakeTestFile testFile + (len, kats) <- either (assertFailure . show) + (\(ShakeTestFile len kats) -> pure (len, filter (\kat -> byteLength kat `mod` 8 == 0) kats)) katsE + mapM_ (runKat len) $ zip [0..] kats + where runKat len (index, KAT l m d) = assertEqual (show index ++ ": Bad digest.") + (hashFunction len $ BS.take l m) d + + shortMsgKAT_224 :: Assertion shortMsgKAT_224 = knownAnswerTestAssertion "test/KAT_MCT/ShortMsgKAT_224.txt" keccak224 @@ -97,3 +114,22 @@ longMsgKAT_SHA3_512 :: Assertion longMsgKAT_SHA3_512 = knownAnswerTestAssertion "test/KAT_MCT/SHA3_512LongMsg.rsp" sha3_512 + +shortMsgKAT_SHAKE_128 :: Assertion +shortMsgKAT_SHAKE_128 = knownAnswerTestShakeAssertion "test/KAT_MCT/SHAKE128ShortMsg.rsp" shake128 + +longMsgKAT_SHAKE_128 :: Assertion +longMsgKAT_SHAKE_128 = knownAnswerTestShakeAssertion "test/KAT_MCT/SHAKE128LongMsg.rsp" shake128 + +shortMsgKAT_SHAKE_256 :: Assertion +shortMsgKAT_SHAKE_256 = knownAnswerTestShakeAssertion "test/KAT_MCT/SHAKE256ShortMsg.rsp" shake256 + +longMsgKAT_SHAKE_256 :: Assertion +longMsgKAT_SHAKE_256 = knownAnswerTestShakeAssertion "test/KAT_MCT/SHAKE256LongMsg.rsp" shake256 + +longOutputSHAKE256 :: Assertion +longOutputSHAKE256 = assertEqual "bad 2000-bit shake256 output" + (BS16.encode $ shake256 outputlen msg) (BS16.encode output) + where outputlen = 2000 + msg = fst $ BS16.decode "8d8001e2c096f1b88e7c9224a086efd4797fbf74a8033a2d422a2b6b8f6747e4" + output = fst $ BS16.decode "2e975f6a8a14f0704d51b13667d8195c219f71e6345696c49fa4b9d08e9225d3d39393425152c97e71dd24601c11abcfa0f12f53c680bd3ae757b8134a9c10d429615869217fdd5885c4db174985703a6d6de94a667eac3023443a8337ae1bc601b76d7d38ec3c34463105f0d3949d78e562a039e4469548b609395de5a4fd43c46ca9fd6ee29ada5efc07d84d553249450dab4a49c483ded250c9338f85cd937ae66bb436f3b4026e859fda1ca571432f3bfc09e7c03ca4d183b741111ca0483d0edabc03feb23b17ee48e844ba2408d9dcfd0139d2e8c7310125aee801c61ab7900d1efc47c078281766f361c5e6111346235e1dc38325666c" diff --git a/test/Test/Parse/KAT.hs b/test/Test/Parse/KAT.hs --- a/test/Test/Parse/KAT.hs +++ b/test/Test/Parse/KAT.hs @@ -14,6 +14,10 @@ type TestFile = [KAT] +data ShakeTestFile = ShakeTestFile { outputLength :: Int + , kats :: [KAT] + } + data KAT = KAT { byteLength :: Int , message :: BS.ByteString , digest :: BS.ByteString @@ -23,10 +27,23 @@ parseTestFile = skipMany (commentLine <|> dataLine <|> blankLine) *> many1 parseKat +parseShakeTestFile :: Parser ShakeTestFile +parseShakeTestFile = ShakeTestFile <$> + (skipMany (commentLine <|> blankLine) + *> outputLengthField + <* skipMany (commentLine <|> blankLine)) + <*> many1 parseShakeKat + + commentLine :: Parser () commentLine = void $ char '#' *> manyTill anyChar endOfLine +outputLengthField :: Parser Int +outputLengthField = read <$> (string "[Outputlen = " *> many1 digit + <* manyTill anyChar endOfLine) + + dataLine :: Parser () dataLine = void $ char '[' *> manyTill anyChar endOfLine @@ -43,6 +60,16 @@ let parsedLen = read len pure $ KAT parsedLen (BS.take parsedLen $ bytesDecode msg) (bytesDecode digest) + + +parseShakeKat :: Parser KAT +parseShakeKat = do len <- string "Len = " *> many1 digit <* endOfLine + msg <- string "Msg = " *> many1 hexDigit <* endOfLine + digest <- string "Output = " *> many1 hexDigit <* endOfLine + skipMany (commentLine <|> blankLine) + let parsedLen = read len + pure $ KAT parsedLen (BS.take parsedLen $ bytesDecode msg) + (bytesDecode digest) bytesDecode :: String -> BS.ByteString