diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/keccak.cabal b/keccak.cabal new file mode 100644 --- /dev/null +++ b/keccak.cabal @@ -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 diff --git a/src/Crypto/Hash/Keccak.hs b/src/Crypto/Hash/Keccak.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Hash/Keccak.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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")