keccak 0.1.3 → 0.2.0
raw patch · 6 files changed
+205/−82 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Crypto.Hash.Keccak: shake128 :: Int -> ByteString -> ByteString
+ Crypto.Hash.Keccak: shake256 :: Int -> ByteString -> ByteString
- Crypto.Hash.Keccak: squeeze :: Int -> Vector Word64 -> ByteString
+ Crypto.Hash.Keccak: squeeze :: Int -> Int -> Vector Word64 -> ByteString
Files
- README.md +13/−12
- benchs/Main.hs +10/−2
- keccak.cabal +3/−2
- src/Crypto/Hash/Keccak.hs +100/−50
- test/Spec.hs +52/−16
- test/Test/Parse/KAT.hs +27/−0
README.md view
@@ -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,
benchs/Main.hs view
@@ -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"
keccak.cabal view
@@ -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
src/Crypto/Hash/Keccak.hs view
@@ -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 #-}
test/Spec.hs view
@@ -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"
test/Test/Parse/KAT.hs view
@@ -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