diff --git a/reference/Common.hs b/reference/Common.hs index add43e1..c8b6ecb 100644 --- a/reference/Common.hs +++ b/reference/Common.hs @@ -12,20 +12,33 @@ import Goldilocks -------------------------------------------------------------------------------- data Hash - = Poseidon2 + = Poseidon2_T12 + | Poseidon2_T16 | Monolith -- | Tip4' deriving (Eq,Show) +hashT :: Hash -> Int +hashT hash = case hash of + Poseidon2_T12 -> 12 + Poseidon2_T16 -> 16 + Monolith -> 12 + -------------------------------------------------------------------------------- type State = Array Int F -listToState :: [F] -> State -listToState = listArray (0,11) +listToState' :: Int -> [F] -> State +listToState' n = listArray (0,n-1) -zeroState :: State -zeroState = listToState (replicate 12 0) +listToState :: Hash -> [F] -> State +listToState hash = listToState' (hashT hash) + +zeroState' :: Int -> State +zeroState' n = listToState' n (replicate n 0) + +zeroState :: Hash -> State +zeroState hash = zeroState' (hashT hash) -------------------------------------------------------------------------------- diff --git a/reference/Merkle.hs b/reference/Merkle.hs index cc2b492..d3afcb1 100644 --- a/reference/Merkle.hs +++ b/reference/Merkle.hs @@ -1,5 +1,5 @@ -{-| Merkle tree construction +{-| Merkle tree construction (using a T=12 hash) Conventions: diff --git a/reference/Monolith/Permutation.hs b/reference/Monolith/Permutation.hs index 2a42c85..f6a8dc2 100644 --- a/reference/Monolith/Permutation.hs +++ b/reference/Monolith/Permutation.hs @@ -37,13 +37,13 @@ sboxField = toF . bytesToWord64LE . map sboxByte . bytesFromWord64LE . fromF bars :: State -> State bars old = case splitAt 4 (elems old) of - (four,eight) -> listToState (map sboxField four ++ eight) + (four,eight) -> listToState' 12 (map sboxField four ++ eight) bricks :: State -> State -bricks old = listToState $ zipWith (+) (0 : map square xs) xs where xs = elems old +bricks old = listToState' 12 $ zipWith (+) (0 : map square xs) xs where xs = elems old concrete' :: [F] -> State -> State -concrete' rcs = listToState . zipWith (+) rcs . elems . linearDiffusion +concrete' rcs = listToState' 12 . zipWith (+) rcs . elems . linearDiffusion concrete :: Int -> State -> State concrete ridx = concrete' [ monolithRoundConstants ! (ridx,j) | j<-[0..11] ] @@ -51,10 +51,10 @@ concrete ridx = concrete' [ monolithRoundConstants ! (ridx,j) | j<-[0..11] ] -------------------------------------------------------------------------------- circulantRow :: State -circulantRow = listToState [ 7, 23, 8, 26, 13, 10, 9, 7, 6, 22, 21, 8 ] +circulantRow = listToState' 12 [ 7, 23, 8, 26, 13, 10, 9, 7, 6, 22, 21, 8 ] linearDiffusion :: State -> State -linearDiffusion old = listToState +linearDiffusion old = listToState' 12 [ sum [ old!j * circulantRow!(mod (j-k) 12) | j<-[0..11] ] | k <- [0..11] ] diff --git a/reference/Permutations.hs b/reference/Permutations.hs index 0ffd540..148e8e2 100644 --- a/reference/Permutations.hs +++ b/reference/Permutations.hs @@ -3,8 +3,9 @@ module Permutations where -------------------------------------------------------------------------------- -import qualified Poseidon2.Permutation as Poseidon2 -import qualified Monolith.Permutation as Monolith +import qualified Poseidon2.T12.Permutation as Poseidon2_T12 +import qualified Poseidon2.T16.Permutation as Poseidon2_T16 +import qualified Monolith.Permutation as Monolith import Common @@ -12,7 +13,8 @@ import Common permute :: Hash -> State -> State permute hash = case hash of - Poseidon2 -> Poseidon2.permutation - Monolith -> Monolith.permutation + Poseidon2_T12 -> Poseidon2_T12.permutation + Poseidon2_T16 -> Poseidon2_T16.permutation + Monolith -> Monolith.permutation -------------------------------------------------------------------------------- diff --git a/reference/Poseidon2/Constants.hs b/reference/Poseidon2/T12/Constants.hs similarity index 99% rename from reference/Poseidon2/Constants.hs rename to reference/Poseidon2/T12/Constants.hs index 9c72ff3..0b9e812 100644 --- a/reference/Poseidon2/Constants.hs +++ b/reference/Poseidon2/T12/Constants.hs @@ -1,5 +1,5 @@ -module Poseidon2.Constants where +module Poseidon2.T12.Constants where -------------------------------------------------------------------------------- diff --git a/reference/Poseidon2/Permutation.hs b/reference/Poseidon2/T12/Permutation.hs similarity index 85% rename from reference/Poseidon2/Permutation.hs rename to reference/Poseidon2/T12/Permutation.hs index efa1cb1..340a97e 100644 --- a/reference/Poseidon2/Permutation.hs +++ b/reference/Poseidon2/T12/Permutation.hs @@ -1,18 +1,39 @@ {-# LANGUAGE Strict #-} -module Poseidon2.Permutation where +module Poseidon2.T12.Permutation where -------------------------------------------------------------------------------- +import Data.Word + import Data.Array (Array) import Data.Array.IArray -import Poseidon2.Constants +import Poseidon2.T12.Constants import Goldilocks import Common -------------------------------------------------------------------------------- +-- | permutation of @[0..15]@, from HorizenLabs Rust impl +kats :: [Word64] +kats = + [ 0x01eaef96bdf1c0c1 + , 0x1f0d2cc525b2540c + , 0x6282c1dfe1e0358d + , 0xe780d721f698e1e6 + , 0x280c0b6f753d833b + , 0x1b942dd5023156ab + , 0x43f0df3fcccb8398 + , 0xe8e8190585489025 + , 0x56bdbf72f77ada22 + , 0x7911c32bf9dcd705 + , 0xec467926508fbe67 + , 0x6a50450ddf85a6ed + ] + +-------------------------------------------------------------------------------- + permutation :: State -> State permutation = finalRounds diff --git a/reference/Poseidon2/T16/Constants.hs b/reference/Poseidon2/T16/Constants.hs new file mode 100644 index 0000000..d68e8d1 --- /dev/null +++ b/reference/Poseidon2/T16/Constants.hs @@ -0,0 +1,209 @@ + +module Poseidon2.T16.Constants where + +-------------------------------------------------------------------------------- + +import Data.Array +import Data.Word + +import Goldilocks + +-------------------------------------------------------------------------------- + +internalDiagElems :: Array Int F +internalDiagElems = listArray (0,15) $ map toF + [ 0xde9b91a467d6afc0 + , 0xc5f16b9c76a9be17 + , 0x0ab0fef2d540ac55 + , 0x3001d27009d05773 + , 0xed23b1f906d3d9eb + , 0x5ce73743cba97054 + , 0x1c3bab944af4ba24 + , 0x2faa105854dbafae + , 0x53ffb3ae6d421a10 + , 0xbcda9df8884ba396 + , 0xfc1273e4a31807bb + , 0xc77952573d5142c0 + , 0x56683339a819b85e + , 0x328fcbd8f0ddc8eb + , 0xb5101e303fce9cb7 + , 0x774487b8c40089bb + ] + +-------------------------------------------------------------------------------- + +initialRoundConsts :: Array Int [F] +initialRoundConsts = listArray (0,3) $ map (map toF) + [ [ 0x15ebea3fc73397c3 + , 0xd73cd9fbfe8e275c + , 0x8c096bfce77f6c26 + , 0x4e128f68b53d8fea + , 0x29b779a36b2763f6 + , 0xfe2adc6fb65acd08 + , 0x8d2520e725ad0955 + , 0x1c2392b214624d2a + , 0x37482118206dcc6e + , 0x2f829bed19be019a + , 0x2fe298cb6f8159b0 + , 0x2bbad982deccdbbf + , 0xbad568b8cc60a81e + , 0xb86a814265baad10 + , 0xbec2005513b3acb3 + , 0x6bf89b59a07c2a94 + ] + , [ 0xa25deeb835e230f5 + , 0x3c5bad8512b8b12a + , 0x7230f73c3cb7a4f2 + , 0xa70c87f095c74d0f + , 0x6b7606b830bb2e80 + , 0x6cd467cfc4f24274 + , 0xfeed794df42a9b0a + , 0x8cf7cf6163b7dbd3 + , 0x9a6e9dda597175a0 + , 0xaa52295a684faf7b + , 0x017b811cc3589d8d + , 0x55bfb699b6181648 + , 0xc2ccaf71501c2421 + , 0x1707950327596402 + , 0xdd2fcdcd42a8229f + , 0x8b9d7d5b27778a21 + ] + , [ 0xac9a05525f9cf512 + , 0x2ba125c58627b5e8 + , 0xc74e91250a8147a5 + , 0xa3e64b640d5bb384 + , 0xf53047d18d1f9292 + , 0xbaaeddacae3a6374 + , 0xf2d0914a808b3db1 + , 0x18af1a3742bfa3b0 + , 0x9a621ef50c55bdb8 + , 0xc615f4d1cc5466f3 + , 0xb7fbac19a35cf793 + , 0xd2b1a15ba517e46d + , 0x4a290c4d7fd26f6f + , 0x4f0cf1bb1770c4c4 + , 0x548345386cd377f5 + , 0x33978d2789fddd42 + ] + , [ 0xab78c59deb77e211 + , 0xc485b2a933d2be7f + , 0xbde3792c00c03c53 + , 0xab4cefe8f893d247 + , 0xc5c0e752eab7f85f + , 0xdbf5a76f893bafea + , 0xa91f6003e3d984de + , 0x099539077f311e87 + , 0x097ec52232f9559e + , 0x53641bdf8991e48c + , 0x2afe9711d5ed9d7c + , 0xa7b13d3661b5d117 + , 0x5a0e243fe7af6556 + , 0x1076fae8932d5f00 + , 0x9b53a83d434934e3 + , 0xed3fd595a3c0344a + ] + ] + +-------------------------------------------------------------------------------- + +finalRoundConsts :: Array Int [F] +finalRoundConsts = listArray (0,3) $ map (map toF) + [ [ 0xdacf46dc1c31a045 + , 0x5d2e3c121eb387f2 + , 0x51f8b0658b124499 + , 0x1e7dbd1daa72167d + , 0x8275015a25c55b88 + , 0xe8521c24ac7a70b3 + , 0x6521d121c40b3f67 + , 0xac12de797de135b0 + , 0xafa28ead79f6ed6a + , 0x685174a7a8d26f0b + , 0xeff92a08d35d9874 + , 0x3058734b76dd123a + , 0xfa55dcfba429f79c + , 0x559294d4324c7728 + , 0x7a770f53012dc178 + , 0xedd8f7c408f3883b + ] + , [ 0x39b533cf8d795fa5 + , 0x160ef9de243a8c0a + , 0x431d52da6215fe3f + , 0x54c51a2a2ef6d528 + , 0x9b13892b46ff9d16 + , 0x263c46fcee210289 + , 0xb738c96d25aabdc4 + , 0x5c33a5203996d38f + , 0x2626496e7c98d8dd + , 0xc669e0a52785903a + , 0xaecde726c8ae1f47 + , 0x039343ef3a81e999 + , 0x2615ceaf044a54f9 + , 0x7e41e834662b66e1 + , 0x4ca5fd4895335783 + , 0x64b334d02916f2b0 + ] + , [ 0x87268837389a6981 + , 0x034b75bcb20a6274 + , 0x58e658296cc2cd6e + , 0xe2d0f759acc31df4 + , 0x81a652e435093e20 + , 0x0b72b6e0172eaf47 + , 0x4aec43cec577d66d + , 0xde78365b028a84e6 + , 0x444e19569adc0ee4 + , 0x942b2451fa40d1da + , 0xe24506623ea5bd6c + , 0x082854bf2ef7c743 + , 0x69dbbc566f59d62e + , 0x248c38d02a7b5cb2 + , 0x4f4e8f8c09d15edb + , 0xd96682f188d310cf + ] + , [ 0x6f9a25d56818b54c + , 0xb6cefed606546cd9 + , 0x5bc07523da38a67b + , 0x7df5a3c35b8111cf + , 0xaaa2cc5d4db34bb0 + , 0x9e673ff22a4653f8 + , 0xbd8b278d60739c62 + , 0xe10d20f6925b8815 + , 0xf6c87b91dd4da2bf + , 0xfed623e2f71b6f1a + , 0xa0f02fa52a94d0d3 + , 0xbb5794711b39fa16 + , 0xd3b94fba9d005c7f + , 0x15a26e89fad946c9 + , 0xf3cb87db8a67cf49 + , 0x400d2bf56aa2a577 + ] + ] + +-------------------------------------------------------------------------------- + +internalRoundConsts :: [F] -- :: Array Int F +internalRoundConsts = map toF -- listArray (0,21) $ map toF + [ 0x28eff4b01103d100 + , 0x60400ca3e2685a45 + , 0x1c8636beb3389b84 + , 0xac1332b60e13eff0 + , 0x2adafcc364e20f87 + , 0x79ffc2b14054ea0b + , 0x3f98e4c0908f0a05 + , 0xcdb230bc4e8a06c4 + , 0x1bcaf7705b152a74 + , 0xd9bca249a82a7470 + , 0x91e24af19bf82551 + , 0xa62b43ba5cb78858 + , 0xb4898117472e797f + , 0xb3228bca606cdaa0 + , 0x844461051bca39c9 + , 0xf3411581f6617d68 + , 0xf7fd50646782b533 + , 0x6ca664253c18fb48 + , 0x2d2fcdec0886a08f + , 0x29da00dd799b575e + , 0x47d966cc3b6e1e93 + , 0xde884e9a17ced59e + ] + +-------------------------------------------------------------------------------- diff --git a/reference/Poseidon2/T16/Permutation.hs b/reference/Poseidon2/T16/Permutation.hs new file mode 100644 index 0000000..1957bd0 --- /dev/null +++ b/reference/Poseidon2/T16/Permutation.hs @@ -0,0 +1,131 @@ + +{-# LANGUAGE Strict #-} +module Poseidon2.T16.Permutation where + +-------------------------------------------------------------------------------- + +import Data.Word + +import Data.Array (Array) +import Data.Array.IArray + +import Poseidon2.T16.Constants +import Goldilocks +import Common + +-------------------------------------------------------------------------------- + +-- | permutation of @[0..15]@, from HorizenLabs Rust impl +kats :: [Word64] +kats = + [ 0x85c54702470d9756 + , 0xaa53c7a7d52d9898 + , 0x285128096efb0dd7 + , 0xf3fde5edd3050ac8 + , 0xc7b65efd040df908 + , 0x4be3f6c467f57ae9 + , 0x274e9a67b41754fb + , 0x0f7d39cd5de94dac + , 0xd0224b9794d0b78c + , 0x372f6139570042e1 + , 0xce6e8a93dc4ec26c + , 0xace65e30a4daf7af + , 0x016f2824cc1ba3db + , 0x2e8f3af37c434dec + , 0xc80831bb6e09da01 + , 0x3a7d670bf1a86ee8 + ] + +-------------------------------------------------------------------------------- + +permutation :: State -> State +permutation + = finalRounds + . internalRounds + . initialRounds + . externalDiffusion + +-------------------------------------------------------------------------------- + +initialRounds :: State -> State +initialRounds + = externalRound (initialRoundConsts ! 3) + . externalRound (initialRoundConsts ! 2) + . externalRound (initialRoundConsts ! 1) + . externalRound (initialRoundConsts ! 0) + +internalRounds :: State -> State +internalRounds = foldr1 (.) (map (internalRound $) (reverse internalRoundConsts)) + +finalRounds :: State -> State +finalRounds + = externalRound (finalRoundConsts ! 3) + . externalRound (finalRoundConsts ! 2) + . externalRound (finalRoundConsts ! 1) + . externalRound (finalRoundConsts ! 0) + +-------------------------------------------------------------------------------- + +externalRound :: [F] -> State -> State +externalRound rcs = externalDiffusion . sboxExternal rcs + +internalRound :: F -> State -> State +internalRound rc = internalDiffusion . sboxInternal rc + +-------------------------------------------------------------------------------- + +sbox1 :: F -> F +sbox1 x = pow x 7 + +sboxRC :: F -> F -> F +sboxRC rc x = sbox1 (x+rc) + +sboxInternal :: F -> State -> State +sboxInternal rc s = s // [ (0, sboxRC rc (s!0)) ] + +sboxExternal :: [F] -> State -> State +sboxExternal rcs s = listArray (0,15) $ zipWith sboxRC rcs (elems s) + +-------------------------------------------------------------------------------- + +internalDiffusion :: State -> State +internalDiffusion state = listArray (0,15) $ [ s + (state!i * internalDiagElems!i) | i<-[0..15] ] where + s = sum (elems state) + +{- +matM4 :: Array (Int,Int) F +matM4 = amap toF $ listArray ((0,0),(3,3)) + [ 5 , 7 , 1 , 3 + , 4 , 6 , 1 , 1 + , 1 , 3 , 5 , 7 + , 1 , 1 , 4 , 6 + ] +-} + +matM16:: Array (Int,Int) F +matM16 = amap toF $ listArray ((0,0),(15,15)) + [ 2*5 , 2*7 , 2*1 , 2*3 , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 + , 2*4 , 2*6 , 2*1 , 2*1 , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 + , 2*1 , 2*3 , 2*5 , 2*7 , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 + , 2*1 , 2*1 , 2*4 , 2*6 , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 + , 5 , 7 , 1 , 3 , 2*5 , 2*7 , 2*1 , 2*3 , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 + , 4 , 6 , 1 , 1 , 2*4 , 2*6 , 2*1 , 2*1 , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 + , 1 , 3 , 5 , 7 , 2*1 , 2*3 , 2*5 , 2*7 , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 + , 1 , 1 , 4 , 6 , 2*1 , 2*1 , 2*4 , 2*6 , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 + , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 , 2*5 , 2*7 , 2*1 , 2*3 , 5 , 7 , 1 , 3 + , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 , 2*4 , 2*6 , 2*1 , 2*1 , 4 , 6 , 1 , 1 + , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 , 2*1 , 2*3 , 2*5 , 2*7 , 1 , 3 , 5 , 7 + , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 , 2*1 , 2*1 , 2*4 , 2*6 , 1 , 1 , 4 , 6 + , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 , 2*5 , 2*7 , 2*1 , 2*3 + , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 , 2*4 , 2*6 , 2*1 , 2*1 + , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 , 1 , 3 , 5 , 7 , 2*1 , 2*3 , 2*5 , 2*7 + , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 , 1 , 1 , 4 , 6 , 2*1 , 2*1 , 2*4 , 2*6 + ] + +externalDiffusion :: State -> State +externalDiffusion state = listArray (0,15) + [ sum [ matM16!(i,j) * state!j | j<-[0..15] ] + | i<-[0..15] + ] + +-------------------------------------------------------------------------------- diff --git a/reference/TestGen/TestPermutation.hs b/reference/TestGen/TestPermutation.hs index 7b1f19c..18effcc 100644 --- a/reference/TestGen/TestPermutation.hs +++ b/reference/TestGen/TestPermutation.hs @@ -26,13 +26,25 @@ perms varname f xs = unlines (header : stuff ++ footer) where -------------------------------------------------------------------------------- -testStates :: [State] -testStates = - [ listToState [ fromInteger (a + b*i) | i<-[0..11] ] +testStates12 :: [State] +testStates12 = + [ listToState' 12 [ fromInteger (a + b*i) | i<-[0..11] ] | a <- [0,10,200,3000] , b <- [1, 7, 23, 666] ] +testStates16 :: [State] +testStates16 = + [ listToState' 16 [ fromInteger (a + b*i) | i<-[0..15] ] + | a <- [0,10,200,3000] + , b <- [1, 7, 23, 666] + ] + +testStates :: Hash -> [State] +testStates hash = case hashT hash of + 12 -> testStates12 + 16 -> testStates16 + -------------------------------------------------------------------------------- printTests :: Hash -> IO () @@ -40,7 +52,7 @@ printTests hash = hPrintTests stdout hash hPrintTests :: Handle -> Hash -> IO () hPrintTests h hash = hPutStrLn h $ unlines - [ perms "testcases_perm" (permute hash) testStates + [ perms "testcases_perm" (permute hash) (testStates hash) ] writeTests :: Hash -> IO ()