diff --git a/pact-repl/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs b/pact-repl/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs index ac7b61d4e..504844084 100644 --- a/pact-repl/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs +++ b/pact-repl/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs @@ -1832,9 +1832,17 @@ zkPairingCheck info b _env = \case g1s <- maybe (argsError info b args) pure (traverse (preview _PObject >=> (toG1 . ObjectData)) p1s) g2s <- maybe (argsError info b args) pure (traverse (preview _PObject >=> (toG2 . ObjectData)) p2s) traverse_ (\p -> ensureOnCurve info p b1) g1s - traverse_ (\p -> ensureOnCurve info p b2) g2s + traverse_ checkMembershipG2 g2s let pairs = zip (V.toList g1s) (V.toList g2s) return $ VBool $ pairingCheck pairs + where + curveOrder :: Integer + curveOrder = 21888242871839275222246405745257275088548364400416034343698204186575808495617 + checkMembershipG2 p = do + p54Disabled <- isExecutionFlagSet FlagDisablePact54 + if p54Disabled then ensureOnCurve info p b2 + else do + unless (isOnCurve p b2 && (multiply p curveOrder == CurveInf)) $ throwExecutionError info PointNotOnCurve args -> argsError info b args zkScalarMult :: (IsBuiltin b) => NativeFunction e b i diff --git a/pact-tests/pact-tests/pairing.repl b/pact-tests/pact-tests/pairing.repl index b9edd46d3..39e7f1670 100644 --- a/pact-tests/pact-tests/pairing.repl +++ b/pact-tests/pact-tests/pairing.repl @@ -109,3 +109,39 @@ ) ) +(env-exec-config ["DisablePact54"]) + +(defun pairing-attack () + (let + ( (goodG1 {"x":1, "y": 2}) + (negG1 {"x":1, "y":21888242871839275222246405745257275088696311157297823662689037894645226208581}) + (badG2 {"x":[ 714174525384625698196324342448018602778427756125896575268723443112276201656 + , 15184454992471448023977227688880154059606923890779081526591309460240767144611 + ], "y": [ 4059636884310975796046572204287767311531424242221074206827231494834828442687 + , 20034115350295064288606382530926850307740152462130073457110526227453661700402 + ]}) + (goodG2 {"x": [10857046999023057135944570762232829481370756359578518086990519993285655852781 + , 11559732032986387107991004021392285783925812861821192530917403151452391805634], "y": + [ 8495653923123431417604973247489272438418190587263600148770280649306958101930 + , 4082367875863433681332203403145435568316851327593401208105741076214120093531]} + ) + (negBadG2{"x":[714174525384625698196324342448018602778427756125896575268723443112276201656 + ,15184454992471448023977227688880154059606923890779081526591309460240767144611] + ,"y":[17828605987528299426199833540969507777164886915076749455861806399810397765896 + , 1854127521544210933640023214330424780956158695167750205578511667191564508181]}) + ) + (pairing-check [goodG1, goodG1] [badG2, negBadG2]) + ) +) + +(expect "Pre-5.4: pairing check can pass with a point in the cofactor subgroup but not in the prime subgroup" + (pairing-attack) + true +) + +(env-exec-config []) + +(expect-failure "Post-5.4: Pairing check will fail with any point on the curve but outside of G2" + "Point lies outside of elliptic curve" + (pairing-attack) +) diff --git a/pact/Pact/Core/Environment/Types.hs b/pact/Pact/Core/Environment/Types.hs index b10fc92db..2d87471ca 100644 --- a/pact/Pact/Core/Environment/Types.hs +++ b/pact/Pact/Core/Environment/Types.hs @@ -183,6 +183,8 @@ data ExecutionFlag | FlagDisablePact52 -- | Flag to disable features from pact 5.3 | FlagDisablePact53 + -- | Flag to disable features from pact 5.4 + | FlagDisablePact54 -- | Flag to enable modref read-only mode | FlagDisableReentrancyCheck deriving (Eq,Ord,Show,Enum,Bounded, Generic) diff --git a/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs b/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs index 01070c9d7..9454099ef 100644 --- a/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs +++ b/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs @@ -1837,9 +1837,18 @@ zkPairingCheck info b cont handler _env = \case g1s <- maybe (argsError info b args) pure (traverse (preview _PObject >=> (toG1 . ObjectData)) p1s) g2s <- maybe (argsError info b args) pure (traverse (preview _PObject >=> (toG2 . ObjectData)) p2s) traverse_ (\p -> ensureOnCurve info p b1) g1s - traverse_ (\p -> ensureOnCurve info p b2) g2s + traverse_ checkMembershipG2 g2s let pairs = zip (V.toList g1s) (V.toList g2s) returnCEKValue cont handler $ VBool $ pairingCheck pairs + where + curveOrder :: Integer + curveOrder = 21888242871839275222246405745257275088548364400416034343698204186575808495617 + checkMembershipG2 p = do + p54Disabled <- isExecutionFlagSet FlagDisablePact54 + if p54Disabled then ensureOnCurve info p b2 + else do + unless (isOnCurve p b2 && (multiply p curveOrder == CurveInf)) $ throwExecutionError info PointNotOnCurve + args -> argsError info b args zkScalarMult :: (IsBuiltin b) => NativeFunction e b i