keccak 0.1.2 → 0.1.3

raw patch · 5 files changed

+124/−80 lines, 5 filesdep +vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: vector

API changes (from Hackage documentation)

Files

• README.md +35/−0
• benchs/Main.hs +1/−0
• examples/lowCapacityCollision.hs +1/−1
• keccak.cabal +3/−2
• src/Crypto/Hash/Keccak.hs +84/−77

@@ -5,8 +5,14 @@  A pure haskell implementation of the keccak family of hashes. +Documentation available on+[Hackage](http://hackage.haskell.org/package/keccak).+ ## Example usage +In the example usage below, I encode `ByteString`s in base16 so that they+can be read as standard hex strings.+ ```haskell ghci> import Data.ByteString.Base16 as BS16 @@ -26,11 +32,40 @@ stack test ``` +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+[pass](https://github.com/aupiff/keccak/blob/master/test/Spec.hs) the standard+KATs (Known Answer Tests).+ ## Benchmarks  ``` stack bench ```++`cryptonite`'s C-based implementation of Keccack256 is currently 31x 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)++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)+```++Eventually, I hope the library will have very few dependencies (only base,+vector & bytestring, currently) and excellent performance.  ## References 

@@ -8,6 +8,7 @@  import Gauge +-- TODO short test & long test for multiple hashes stringsToHash :: [BS.ByteString] stringsToHash =  ["", "testing", "1234891237489127349817238497"] 

@@ -8,7 +8,7 @@ smallKeccak = keccakHash 1568  message :: BS.ByteString-message = "I am fascinated by Tim May's crypto-anarchy. Unlike the communities traditionally associated with the word 'anarchy', in a crypto-anarchy the government is not temporarily destroyed but permanently forbidden and permanently unnecessary. It's a community where the threat of violence is impotent because violence is impossible, and violence is impossible because its participants cannot be linked to their true names or physical locations.  Until now it's not clear, even theoretically, how such a community could operate. A community is defined by the cooperation of its participants, and efficient cooperation requires a medium of exchange (money) and a way to enforce contracts. Traditionally these services have been provided by the government or government sponsored institutions and only to legal entities. In this article I describe a protocol by which these services can be provided to and by untraceable entities.  I will actually describe two protocols. The first one is impractical, because it makes heavy use of a synchronous and unjammable anonymous broadcast channel. However it will motivate the second, more practical protocol. In both cases I will assume the existence of an untraceable network, where senders and receivers are identified only by digital pseudonyms (i.e. public keys) and every messages is signed by its sender and encrypted to its receiver.  In the first protocol, every participant maintains a (seperate) database of how much money belongs to each pseudonym. These accounts collectively define the ownership of money, and how these accounts are updated is the subject of this protocol."+message = "In the context of cryptography, sponge functions provide a particular way to generalize hash functions to more general functions whose output length is arbitrary. A sponge func- tion instantiates the sponge construction, which is a simple iterated construction building a variable-length input variable-length output function based on a fixed length permutation (or transformation). With this interface, a sponge function can also be used as a stream ci- pher, hence covering a wide range of functionality with hash functions and stream ciphers as particular points.  From a theoretical point of view, sponge functions model in a very simple way the finite memory any concrete construction has access to. A random sponge function is as strong as a random oracle, except for the effects induced by the finite memory. This model can thus be used as an alternative to the random oracle model for expressing security claims.  From a more practical point of view, the sponge construction and its sister construction, called the duplex construction, can be used to implement a large spectrum of the symmetric cryptography functionality. This includes hashing, reseedable pseudo random bit sequence generation, key derivation, encryption, message authentication code (MAC) computation and authenticated encryption. This provides users with a lot of functionality from a single fixed permutation, hence making the implementation easier. The designers of cryptographic primitives may also find it advantageous to develop a strong permutation without worrying about other components such as the key schedule of a block cipher."  hashImage :: BS.ByteString hashImage = smallKeccak message

@@ -1,5 +1,5 @@ name:                keccak-version:             0.1.2+version:             0.1.3 synopsis:            haskell keccak functions description:         pure haskell implementation of keccak hash functions for                      use with ghc or ghcjs@@ -7,7 +7,7 @@ license:             MIT license-file:        LICENSE author:              Roy Blankman-maintainer:          riblankman@gmail.com+maintainer:          blankman@boustro.com copyright:           2018 Roy Blankman category:            Crypto build-type:          Simple@@ -19,6 +19,7 @@   exposed-modules:     Crypto.Hash.Keccak   build-depends:       base >= 4.7 && < 5                      , bytestring+                     , vector   default-language:    Haskell2010  test-suite keccak-test

@@ -20,41 +20,45 @@  import           Data.Bits import qualified Data.ByteString            as BS-import qualified Data.ByteString.Lazy       as LBS+import           Data.Vector.Unboxed        ((!), (//))+import qualified Data.Vector.Unboxed        as V import           Data.Word -type State = [[Word64]]+numLanes :: Int+numLanes = 25 -emptyState :: State-emptyState = replicate 5 (replicate 5 0)+laneWidth :: Int+laneWidth = 64 +emptyState :: V.Vector Word64+emptyState = V.replicate numLanes 0+ ---------------------------------------------------- -- Constants used in KeccakF[1600] permutation ---------------------------------------------------- -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 ]+roundConstants :: V.Vector Word64+roundConstants = V.fromList [ 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 ]-                    ]+rotationConstants :: V.Vector Int+rotationConstants = V.fromList [  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 ]  ---------------------------------------------------- -- Keccak and SHA3 hash functions ---------------------------------------------------- -hashFunction :: (Int -> BS.ByteString -> [Word8]) -> Int -> BS.ByteString -> BS.ByteString+hashFunction :: (Int -> BS.ByteString -> V.Vector Word8) -> Int -> BS.ByteString -> BS.ByteString hashFunction paddingFunction rate = squeeze outputBytes . absorb rate                                                         . paddingFunction (div rate 8)     where outputBytes = div (1600 - rate) 16@@ -115,103 +119,106 @@  -- | 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 -> [Word8]-multiratePadding bitrateBytes padByte input = BS.unpack . BS.append input $ if padlen == 1-    then BS.pack [0x80 .|. padByte]-    else BS.pack $ padByte : replicate (padlen - 2) 0x00 ++ [0x80]+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   -- | 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 -- a multiple of the bitrate.-paddingKeccak :: Int -> BS.ByteString -> [Word8]+paddingKeccak :: Int -> BS.ByteString -> V.Vector Word8 paddingKeccak bitrateBytes = multiratePadding bitrateBytes 0x01   -- | Appends to a message M padding of the form (M || 0x06 || 0x00... || 0x80) -- such that the length of the result is a multiple of the bitrate.-paddingSha3 :: Int -> BS.ByteString -> [Word8]+paddingSha3 :: Int -> BS.ByteString -> V.Vector Word8 paddingSha3 bitrateBytes = multiratePadding bitrateBytes 0x06  ---------------------------------------------------- -- Sponge function primitives ---------------------------------------------------- -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+toBlocks :: V.Vector Word8 -> V.Vector Word64+toBlocks = V.unfoldr toLane+    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)+          createWord64 acc offset octet = acc `xor` shiftL (fromIntegral octet) (offset * 8) + -- | Takes as input the bitrate @rate@ and a string P with |P| a multiple of -- @rate@. Returns the value of the state obtained after absorbing P.-absorb :: Int -> [Word8] -> State-absorb rate = foldl (absorbBlock rate) emptyState . toBlocks (div rate 8)+absorb :: Int -> V.Vector Word8 -> V.Vector Word64+absorb rate = absorbBlock rate emptyState . toBlocks  -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] ]-                            | x <- [0..4] ]-+absorbBlock :: Int -> V.Vector Word64 -> V.Vector Word64 -> V.Vector Word64+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)  -- | 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@.-squeeze :: Int -> State -> BS.ByteString-squeeze l = BS.pack . take l . stateToBytes+-- TODO make this support SHAKE+squeeze :: Int -> V.Vector Word64 -> BS.ByteString+squeeze l = BS.pack . V.toList . V.take l . stateToBytes  -stateToBytes :: State -> [Word8]-stateToBytes state = concat [ laneToBytes (state !! x !!  y) | y <- [0..4] , x <- [0..4] ]+-- 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 -> [Word8]-laneToBytes word = fmap (\x -> fromIntegral (shiftR word (x * 8) .&. 0xFF)) [0..7]+laneToBytes :: Word64 -> V.Vector Word8+laneToBytes = V.unfoldrN 8 (\x -> Just (fromIntegral $ x .&. 0xFF, shiftR x 8))  ---------------------------------------------------- -- KeccakF permutation & constituent primatives ---------------------------------------------------- -keccakF :: State -> State-keccakF state = foldl (\s r -> iota r . chi . rhoPi $ theta s) state [0 .. (rounds - 1)]+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  --- | θ step-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] ]+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)  --- | ρ and π steps-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)+-- 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))  --- | χ step-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] ]+-- 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)))  --- | ι step-iota :: Int -> State -> State-iota round ((first : rest) : restRows) = (xor (roundConstants !! round) first : rest) : restRows+iota :: Int -> V.Vector Word64 -> V.Vector Word64+iota round state = state // [(0, xor (roundConstants ! round) (V.head state))]