diff --git a/src/Quarterround.hs b/src/Quarterround.hs index 0073688..349d910 100644 --- a/src/Quarterround.hs +++ b/src/Quarterround.hs @@ -228,6 +228,10 @@ quarterroundEquations _ = error "input to `quarterroundEquations` must be a list -- | The quarterround expression as a keelung computation. quarterroundKeelung :: [UInt 32] -> Comp [UInt 32] -quarterroundKeelung input = - return [evalKeelung $ z0Keelung input, evalKeelung $ z1Keelung input, - evalKeelung $ z2Keelung input, evalKeelung $ z3Keelung input] +quarterroundKeelung input = do + z1' <- reuse . evalKeelung . z1Keelung $ input + z2' <- reuse . evalKeelung . z2Keelung $ input + z3' <- reuse . evalKeelung . z3Keelung $ input + z0' <- reuse . evalKeelung . z0Keelung $ input + + return [z0', z1', z2', z3'] diff --git a/src/Rowround.hs b/src/Rowround.hs index 2dd3b05..1287512 100644 --- a/src/Rowround.hs +++ b/src/Rowround.hs @@ -70,7 +70,7 @@ algMapsDisplay (Quarterround a) = Quarterround.quarterroundDisplay a -- |The algebra maps for Keelung. algMapsKeelung :: ExprFKeelung (Comp [UInt 32]) -> Comp [UInt 32] -algMapsKeelung (ConstK i) = return i +algMapsKeelung (ConstK i) = return i algMapsKeelung (QuarterroundK a) = Quarterround.quarterroundKeelung =<< a -- |The rowround evaluator. diff --git a/test/unit/keelung/Spec.hs b/test/unit/keelung/Spec.hs index c3ba6c1..eea7cd3 100644 --- a/test/unit/keelung/Spec.hs +++ b/test/unit/keelung/Spec.hs @@ -9,6 +9,8 @@ import Test.HUnit import Keelung import Data.Word +import Data.Either (fromRight) +import Keelung.Constraint.R1CS (toR1Cs) demoInputUInt32 :: [UInt 32] demoInputUInt32 = [ @@ -28,60 +30,61 @@ main :: IO Counts main = do -- Run tests - putStrLn "Running Keelung quarterround tests:" - putStrLn "" - let quarterround_computed = quarterroundCompute [1, 0, 0, 0] - putStrLn "Quarterround computed for input [1, 0, 0, 0]:" - print quarterround_computed - quarterround_interpreted <- interpret gf181 (quarterroundKeelung [1, 0, 0, 0]) [] [] - putStrLn "Quarterround simulated for input [1, 0, 0, 0]:" - print quarterround_interpreted + putStrLn $ if quarterround_computed == map fromIntegral quarterround_interpreted then "OK" else "FAIL!" - let quarterround_computed2 = quarterroundCompute [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137] - putStrLn "Quarterround computed for input [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]:" - print quarterround_computed2 + quarterround_compiled <- compile bn128 (quarterroundKeelung [1, 0, 0, 0]) + let quarterround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") quarterround_compiled) + putStrLn $ if quarterround_constraints == 2393 then "OK" else "FAIL!" + let quarterround_computed2 = quarterroundCompute [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137] quarterround_interpreted2 <- interpret gf181 (quarterroundKeelung [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]) [] [] - putStrLn "Quarterround simulated for input [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]:" - print quarterround_interpreted2 + putStrLn $ if quarterround_computed2 == map fromIntegral quarterround_interpreted2 then "OK" else "FAIL!" - _quarterround_compiled <- compile bn128 (quarterroundKeelung [1, 0, 0, 0]) - --putStrLn "Quarterround compiled:" - --print quarterround_compiled + quarterround_compiled2 <- compile bn128 (quarterroundKeelung [0xe7e8c006, 0xc4f9417d, 0x6479b4b2, 0x68c67137]) + let quarterround_constraints2 = length $ toR1Cs (fromRight (error "error parsing r1cs") quarterround_compiled2) + putStrLn $ if quarterround_constraints2 == 2393 then "OK" else "FAIL!" let rowround_computed = rowroundCompute demoInputWord32 - putStrLn "Rowround computed for input demoInput:" - print rowround_computed + rowround_interpreted <- interpret gf181 (rowroundKeelung demoInputUInt32) [] [] + putStrLn $ if rowround_computed == map fromIntegral rowround_interpreted then "OK" else "FAIL!" - rowround_interpreted2 <- interpret gf181 (rowroundKeelung demoInputUInt32) [] [] - putStrLn "Rowround simulated for input demoInput:" - print rowround_interpreted2 + rowround_compiled <- compile bn128 (rowroundKeelung demoInputUInt32) + let rowround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") rowround_compiled) + putStrLn $ if rowround_constraints == 9572 then "OK" else "FAIL!" let columnround_computed = columnroundCompute demoInputWord32 - putStrLn "Columnround computed for input demoInput:" - print columnround_computed + columnround_interpreted <- interpret gf181 (columnroundKeelung demoInputUInt32) [] [] + putStrLn $ if columnround_computed == map fromIntegral columnround_interpreted then "OK" else "FAIL!" - columnround_interpreted2 <- interpret gf181 (columnroundKeelung demoInputUInt32) [] [] - putStrLn "Columnround simulated for input demoInput:" - print columnround_interpreted2 + columnround_compiled <- compile bn128 (columnroundKeelung demoInputUInt32) + let columnround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") columnround_compiled) + putStrLn $ if columnround_constraints == 9572 then "OK" else "FAIL!" let doubleround_computed = doubleroundCompute demoInputWord32 - putStrLn "Doubleround computed for input demoInput:" - print doubleround_computed + doubleround_interpreted <- interpret gf181 (doubleroundKeelung demoInputUInt32) [] [] + putStrLn $ if doubleround_computed == map fromIntegral doubleround_interpreted then "OK" else "FAIL!" + + doubleround_compiled <- compile bn128 (doubleroundKeelung demoInputUInt32) + let douleround_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") doubleround_compiled) + putStrLn $ if douleround_constraints == 18644 then "OK" else "FAIL!" + + let doubleroundR_computed = doubleroundRCompute demoInputWord32 2 + doubleroundR_interpreted <- interpret gf181 (doubleroundRKeelung demoInputUInt32 2) [] [] + putStrLn $ if doubleroundR_computed == map fromIntegral doubleroundR_interpreted then "OK" else "FAIL!" - doubleround_interpreted2 <- interpret gf181 (doubleroundKeelung demoInputUInt32) [] [] - putStrLn "Doubleround simulated for input demoInput:" - print doubleround_interpreted2 + doubleroundR_compiled <- compile bn128 (doubleroundRKeelung demoInputUInt32 2) + let douleroundR_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") doubleroundR_compiled) + putStrLn $ if douleroundR_constraints == 36788 then "OK" else "FAIL!" - let doubleroundR_computed = doubleroundRCompute demoInputWord32 3 - putStrLn "Doubleround computed for input demoInput and 2 rounds:" - print doubleroundR_computed + let doubleround10_computed = doubleroundRCompute demoInputWord32 10 + doubleround10_interpreted <- interpret gf181 (doubleroundRKeelung demoInputUInt32 10) [] [] + putStrLn $ if doubleround10_computed == map fromIntegral doubleround10_interpreted then "OK" else "FAIL!" - doubleroundR_interpreted2 <- interpret gf181 (doubleroundRKeelung demoInputUInt32 2) [] [] - putStrLn "DoubleroundR simulated for input demoInput and 2 rounds:" - print doubleroundR_interpreted2 + doubleround10_compiled <- compile bn128 (doubleroundRKeelung demoInputUInt32 10) + let douleround10_constraints = length $ toR1Cs (fromRight (error "error parsing r1cs") doubleround10_compiled) + putStrLn $ if douleround10_constraints == 181940 then "OK" else "FAIL!" -- just return an empty `Count` so we don't have to return the one from a specific test: return (Counts 0 0 0 0)