keccak (empty) → 0.1.0

raw patch · 6 files changed

+300/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, base16-bytestring, bytestring, keccak, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

LICENSE +20/−0
README.md +37/−0
Setup.hs +2/−0
keccak.cabal +42/−0
src/Crypto/Hash/Keccak.hs +142/−0
test/Spec.hs +57/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright Roy Blankman (c) 2017++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ README.md view

@@ -0,0 +1,37 @@+# keccak++[![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.++## Example usage++```haskell+ghci> :t keccak256+keccak256 :: BS.ByteString -> BS.ByteString++ghci> BS16.encode $ keccak256 "testing"+"5f16f4c7f149ac4f9510d9cf8cf384038ad348b3bcdc01915f95de12df9d1b02"++ghci> BS16.encode $ keccak256 ""+"c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470"+```++## Testing++```+stack test+```++## Benchmarks++TODO++## References++[Official Keccak Refeerence](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)

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ keccak.cabal view

@@ -0,0 +1,42 @@+name:                keccak+version:             0.1.0+synopsis:            haskell keccak functions+description:         pure haskell implementation of keccak hash functions for+                     use with ghc or ghcjs+homepage:            https://github.com/aupiff/keccak#readme+license:             MIT+license-file:        LICENSE+author:              Roy Blankman+maintainer:          riblankman@gmail.com+copyright:           2018 Roy Blankman+category:            Crypto+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Crypto.Hash.Keccak+  build-depends:       base >= 4.7 && < 5+                     , bytestring+  default-language:    Haskell2010++test-suite keccak-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , bytestring+                     , base16-bytestring+                     , keccak+                     , HUnit+                     , QuickCheck+                     , test-framework+                     , test-framework-hunit+                     , test-framework-quickcheck2+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/hasketh/keccak

+ src/Crypto/Hash/Keccak.hs view

@@ -0,0 +1,142 @@+module Crypto.Hash.Keccak where++import           Data.Bits+import qualified Data.ByteString            as BS+import qualified Data.ByteString.Lazy       as LBS+import           Data.Word++type State = [[Word64]]++emptyState :: State+emptyState = replicate 5 (replicate 5 0)++-- truncated when w is smaller than 64+roundConstants :: [Word64]+roundConstants = [ 0x0000000000000001, 0x0000000000008082, 0x800000000000808A+                 , 0x8000000080008000, 0x000000000000808B, 0x0000000080000001+                 , 0x8000000080008081, 0x8000000000008009, 0x000000000000008A+                 , 0x0000000000000088, 0x0000000080008009, 0x000000008000000A+                 , 0x000000008000808B, 0x800000000000008B, 0x8000000000008089+                 , 0x8000000000008003, 0x8000000000008002, 0x8000000000000080+                 , 0x000000000000800A, 0x800000008000000A, 0x8000000080008081+                 , 0x8000000000008080, 0x0000000080000001, 0x8000000080008008 ]++rotationConstants :: [[Int]]+rotationConstants = [ [  0, 36,  3, 41, 18 ]+                    , [  1, 44, 10, 45,  2 ]+                    , [ 62,  6, 43, 15, 61 ]+                    , [ 28, 55, 25, 21, 56 ]+                    , [ 27, 20, 39,  8, 14 ]+                    ]+++paddingKeccak :: BS.ByteString -> [Word8]+paddingKeccak = multiratePadding 0x1+++paddingSha3 :: BS.ByteString -> [Word8]+paddingSha3 = multiratePadding 0x6+++multiratePadding :: Word -> BS.ByteString -> [Word8]+multiratePadding pad 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?+          usedBytes = BS.length input+          padlen = bitRateBytes - mod usedBytes bitRateBytes++-- r (bitrate) = 1088+-- c (capacity) = 512+keccak256 :: BS.ByteString -> BS.ByteString+keccak256 = squeeze 32 . absorb . toBlocks 136 . paddingKeccak++-- Sized inputs to this?+toBlocks :: Int -> [Word8] -> [[Word64]]+toBlocks _ [] = []+toBlocks sizeInBytes input = let (a, b) = splitAt sizeInBytes input+                             in toLanes a : toBlocks sizeInBytes b+    where toLanes :: [Word8] -> [Word64]+          toLanes [] = []+          toLanes octets = let (a, b) = splitAt 8 octets+                           in toLane a : toLanes b+          toLane :: [Word8] -> Word64+          toLane octets = foldl1 xor $ zipWith (\offset octet -> shiftL (fromIntegral octet) (offset * 8)) [0..7] octets+++--   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++absorbBlock :: State -> [Word64] -> State+absorbBlock state input = keccakF state'+    where r = 1088+          w = 64+          state' = [ [ if x + 5 * y < div r w+                            then ((state !! x) !! y) `xor` (input !! (x + 5 * y))+                            else (state !! x) !! y+                        | y <- [0..4]  ]+                            | 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+squeeze :: Int -> State -> BS.ByteString+squeeze len = BS.pack . take len . stateToBytes+    where comma = 44+++stateToBytes :: State -> [Word8]+stateToBytes state = concat [ laneToBytes (state !! x !!  y) | y <- [0..4] , x <- [0..4] ]+++laneToBytes :: Word64 -> [Word8]+laneToBytes word = fmap (\x -> fromIntegral (shiftR word (x * 8) .&. 0xFF)) [0..7]+++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)+theta :: State -> State+theta state = [ [ ((state !! x) !! y) `xor` (d !! x)+                    | y <- [0..4] ]+                        | x <- [0..4] ]+    where c = [ foldl1 xor [ (state !! x) !! y+                    | y <- [0..4] ]+                        | x <- [0..4] ]+          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)+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)+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+iota :: Int -> State -> State+iota round ((first : rest) : restRows) = (xor (roundConstants !! round) first : rest) : restRows

+ test/Spec.hs view

@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++import           Crypto.Hash.Keccak+import qualified Data.ByteString                      as BS+import qualified Data.ByteString.Base16               as BS16+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, (==>))++main :: IO ()+main = defaultMain tests+++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+            ]+        ]+++keccakEmptyPaddingTest :: Assertion+keccakEmptyPaddingTest = assertEqual "Pads empty string properly" zeroPadding (paddingKeccak "")+    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")+    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 "")+    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")+    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")