keccak 0.1.0 → 0.1.1

raw patch · 7 files changed

+223/−32 lines, 7 filesdep +cryptonitedep +gaugedep +memorydep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: cryptonite, gauge, memory, parsec, quickcheck-instances, text

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +7/−4
• benchs/Main.hs +17/−0
• keccak.cabal +23/−2
• src/Crypto/Hash/Keccak.hs +58/−20
• test/Spec.hs +61/−6
• test/Test/Cryptonite.hs +11/−0
• test/Test/Parse/KAT.hs +46/−0

@@ -3,7 +3,7 @@ [![Travis CI](https://img.shields.io/travis/aupiff/keccak.svg?label=Travis%20CI)](https://travis-ci.org/aupiff/keccak) -A pure haskell implementation of keccak.+A pure haskell implementation of the keccak family of hashes.  ## Example usage @@ -26,12 +26,15 @@  ## Benchmarks -TODO+```+stack bench+```  ## References -[Official Keccak Refeerence](https://keccak.team/files/Keccak-reference-3.0.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://keccak.team/files/Keccak-reference-3.0.pdf)+[SHA-3 and The Hash Function Keccak (textbook+chapter)](https://pdfs.semanticscholar.org/8450/06456ff132a406444fa85aa7b5636266a8d0.pdf)

@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Crypto.Hash.Keccak+import           Test.Cryptonite+import qualified Data.ByteString    as BS++import Gauge++stringsToHash :: [BS.ByteString]+stringsToHash =  ["", "testing", "1234891237489127349817238497"]++main = defaultMain+    [ bench "keccak" $ nf (map keccak256) stringsToHash+    , bench "cryptonite-keccak" $ nf (map cryptoniteKeccak') stringsToHash+    ]

@@ -1,5 +1,5 @@ name:                keccak-version:             0.1.0+version:             0.1.1 synopsis:            haskell keccak functions description:         pure haskell implementation of keccak hash functions for                      use with ghc or ghcjs@@ -25,18 +25,39 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Spec.hs+  other-modules:       Test.Cryptonite+                       Test.Parse.KAT   build-depends:       base                      , bytestring                      , base16-bytestring+                     , cryptonite                      , keccak                      , HUnit+                     , memory+                     , parsec                      , QuickCheck+                     , quickcheck-instances                      , test-framework                      , test-framework-hunit                      , test-framework-quickcheck2+                     , text   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   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+ source-repository head   type:     git-  location: https://github.com/hasketh/keccak+  location: https://github.com/aupiff/keccak

@@ -30,28 +30,69 @@                     ]  -paddingKeccak :: BS.ByteString -> [Word8]-paddingKeccak = multiratePadding 0x1+paddingKeccak :: Int -> BS.ByteString -> [Word8]+paddingKeccak bitRateBytes = multiratePadding bitRateBytes 0x1  -paddingSha3 :: BS.ByteString -> [Word8]-paddingSha3 = multiratePadding 0x6+paddingSha3 :: Int -> BS.ByteString -> [Word8]+paddingSha3 bitRateBytes = multiratePadding bitRateBytes 0x6  -multiratePadding :: Word -> BS.ByteString -> [Word8]-multiratePadding pad input = BS.unpack . BS.append input $ if padlen == 1+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 $ 0x01 : replicate (padlen - 2) 0x00 ++ [0x80]-    where bitRateBytes = 136-          -- TODO: modulo bitRateBytes?+    else BS.pack $ padByte : replicate (padlen - 2) 0x00 ++ [0x80]+    where -- TODO: modulo bitRateBytes?           usedBytes = BS.length input           padlen = bitRateBytes - mod usedBytes bitRateBytes ++-- r (bitrate) = 576+-- c (capacity) = 1024+keccak512Rate :: Int+keccak512Rate = 576++keccak512 :: BS.ByteString -> BS.ByteString+keccak512 = squeeze 64 . absorb keccak512Rate+                       . toBlocks bitRateBytes+                       . paddingKeccak bitRateBytes+    where bitRateBytes = div keccak512Rate 8+++-- r (bitrate) = 832+-- c (capacity) = 768+keccak384Rate :: Int+keccak384Rate = 832++keccak384 :: BS.ByteString -> BS.ByteString+keccak384 = squeeze 48 . absorb keccak384Rate+                       . toBlocks bitRateBytes+                       . paddingKeccak bitRateBytes+    where bitRateBytes = div keccak384Rate 8+ -- r (bitrate) = 1088 -- c (capacity) = 512+keccak256Rate :: Int+keccak256Rate = 1088+ keccak256 :: BS.ByteString -> BS.ByteString-keccak256 = squeeze 32 . absorb . toBlocks 136 . paddingKeccak+keccak256 = squeeze 32 . absorb keccak256Rate+                       . toBlocks bitRateBytes+                       . paddingKeccak bitRateBytes+    where bitRateBytes = div keccak256Rate 8 +-- r (bitrate) = 1152+-- c (capacity) = 448+keccak224Rate :: Int+keccak224Rate = 1152++keccak224 :: BS.ByteString -> BS.ByteString+keccak224 = squeeze 28 . absorb keccak224Rate+                       . toBlocks bitRateBytes+                       . paddingKeccak bitRateBytes+    where bitRateBytes = div keccak224Rate 8++ -- Sized inputs to this? toBlocks :: Int -> [Word8] -> [[Word64]] toBlocks _ [] = []@@ -68,18 +109,16 @@ --   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)---     TODO support `input` larger than single block-absorb :: [[Word64]] -> State-absorb = foldl absorbBlock emptyState+absorb :: Int -> [[Word64]] -> State+absorb rate = foldl (absorbBlock rate) emptyState -absorbBlock :: State -> [Word64] -> State-absorbBlock state input = keccakF state'-    where r = 1088-          w = 64-          state' = [ [ if x + 5 * y < div r w+absorbBlock :: Int -> State -> [Word64] -> State+absorbBlock rate state input = keccakF state'+    where w = 64 -- lane size+          state' = [ [ if x + 5 * y < div rate w                             then ((state !! x) !! y) `xor` (input !! (x + 5 * y))                             else (state !! x) !! y-                        | y <- [0..4]  ]+                        | y <- [0..4] ]                             | x <- [0..4] ]  @@ -91,7 +130,6 @@ --    TODO handle longer outputs squeeze :: Int -> State -> BS.ByteString squeeze len = BS.pack . take len . stateToBytes-    where comma = 44   stateToBytes :: State -> [Word8]

@@ -3,12 +3,17 @@ import           Crypto.Hash.Keccak import qualified Data.ByteString                      as BS import qualified Data.ByteString.Base16               as BS16+import           Data.Either+import           Test.Cryptonite import           Test.Framework                       (defaultMain, Test, testGroup) import           Test.Framework.Providers.HUnit       (testCase) import           Test.Framework.Providers.QuickCheck2 (testProperty)-import           Test.HUnit                           (Assertion, assertEqual)-import           Test.QuickCheck                      (Property, (==>))+import           Test.HUnit                           (Assertion, assertEqual, assertFailure)+import           Test.Parse.KAT+import           Test.QuickCheck                      ((==>), Property, withMaxSuccess)+import           Test.QuickCheck.Instances.ByteString + main :: IO () main = defaultMain tests @@ -26,26 +31,38 @@         , testGroup "keccak256"             [ testCase "hashing empty bytestring" keccak256EmptyTest             , testCase "hashing string 'testing'" keccak256AsciiTest+            , testProperty "extensionally equivalent to cryptonite-keccak"+                           (withMaxSuccess 3000 cryptoniteKeccak256_eq)             ]+        , testGroup "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+            ]         ]   keccakEmptyPaddingTest :: Assertion-keccakEmptyPaddingTest = assertEqual "Pads empty string properly" zeroPadding (paddingKeccak "")+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 "testing")+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 . toBlocks 136 $ paddingKeccak "")+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 . toBlocks 136 $ paddingKeccak "testing")+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]]  @@ -55,3 +72,41 @@  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++shortMsgKAT_224 :: Assertion+shortMsgKAT_224 = knownAnswerTestAssertion "test/KAT_MCT/ShortMsgKAT_224.txt" keccak224++longMsgKAT_224 :: Assertion+longMsgKAT_224 = knownAnswerTestAssertion "test/KAT_MCT/LongMsgKAT_224.txt" keccak224++shortMsgKAT_256 :: Assertion+shortMsgKAT_256 = knownAnswerTestAssertion "test/KAT_MCT/ShortMsgKAT_256.txt" keccak256++longMsgKAT_256 :: Assertion+longMsgKAT_256 = knownAnswerTestAssertion "test/KAT_MCT/LongMsgKAT_256.txt" keccak256++shortMsgKAT_384 :: Assertion+shortMsgKAT_384 = knownAnswerTestAssertion "test/KAT_MCT/ShortMsgKAT_384.txt" keccak384++longMsgKAT_384 :: Assertion+longMsgKAT_384 = knownAnswerTestAssertion "test/KAT_MCT/LongMsgKAT_384.txt" keccak384++shortMsgKAT_512 :: Assertion+shortMsgKAT_512 = knownAnswerTestAssertion "test/KAT_MCT/ShortMsgKAT_512.txt" keccak512++longMsgKAT_512 :: Assertion+longMsgKAT_512 = knownAnswerTestAssertion "test/KAT_MCT/LongMsgKAT_512.txt" keccak512

@@ -0,0 +1,11 @@+module Test.Cryptonite where++import           Crypto.Hash        (Digest, Keccak_256, hash)+import           Data.ByteArray     (convert)+import qualified Data.ByteString    as BS++cryptoniteKeccak' :: BS.ByteString -> BS.ByteString+cryptoniteKeccak' = convert . cryptoniteKeccak++cryptoniteKeccak :: BS.ByteString -> Digest Keccak_256+cryptoniteKeccak = hash

@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Parse.KAT where++import           Control.Monad          (void)+import qualified Data.ByteString        as BS+import qualified Data.ByteString.Base16 as BS16+import qualified Data.Text              as T+import qualified Data.Text.Encoding     as T+import           Data.Text.IO           as T+import           Text.Parsec+import           Text.Parsec.Text+import           Text.Parsec.Expr++type TestFile = [KAT]++data KAT = KAT { length  :: Int+               , message :: BS.ByteString+               , digest  :: BS.ByteString+               } deriving Show++parseTestFile :: Parser TestFile+parseTestFile = skipMany (commentLine <|> blankLine) *> many1 parseKat++commentLine :: Parser ()+commentLine = 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+              digest <- string "MD = " *> many1 hexDigit <* endOfLine+              skipMany (commentLine <|> blankLine)+              let parsedLen = read len+              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+    input <- T.readFile fname+    return (runParser p () fname input)