Add check for G2 membership in pairing-check, and test

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

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)
+)

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)

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