make interface to switch to naive dot product approach for a certain threshold

Author: perturbing

cardano-crypto-class/src/Cardano/Crypto/EllipticCurve/BLS12_381/Internal.hs

@@ -1000,8 +1000,8 @@ scalarCanonical scalar =
 -- by means of a modulo operation over the 'scalarPeriod'.
 -- Negative numbers will also be brought to the range
 -- [0, 'scalarPeriod' - 1] via modular reduction.
-blsMSM :: forall curve. BLS curve => [Integer] -> [Point curve] -> Point curve
-blsMSM ss ps = unsafePerformIO $ do
+blsMSM :: forall curve. BLS curve => Int -> [Integer] -> [Point curve] -> Point curve
+blsMSM threshold ss ps = unsafePerformIO $ do
   zeroScalar <- scalarFromInteger 0
   filteredPoints <-
     foldM
@@ -1026,6 +1026,12 @@ blsMSM ss ps = unsafePerformIO $ do
     [(scalar, pt)] -> do
       i <- scalarToInteger scalar
       return (blsMult pt i)
+    _ | length filteredPoints <= threshold -> do
+      return $
+        foldr
+          (\(scalar, pt) acc -> blsAddOrDouble acc (blsMult pt (unsafePerformIO $ scalarToInteger scalar)))
+          blsZero
+          filteredPoints
     _ -> do
       let (scalars, points) = unzip filteredPoints
           numPoints = length points

cardano-crypto-tests/src/Test/Crypto/EllipticCurve.hs

@@ -135,7 +135,7 @@ testBLSCurve name _ =
     , testProperty "MSM matches naive approach" $ \((ps, ss) :: ([BLS.Point curve], [BigInteger])) ->
         let pairs = [(p, i) | (BigInteger i, p) <- zip ss ps]
             (ps', ss') = unzip pairs
-         in BLS.blsMSM ss' ps'
+         in BLS.blsMSM 10 ss' ps'
               === foldr (\(p, s) acc -> BLS.blsAddOrDouble acc (BLS.blsMult p s)) (BLS.blsZero @curve) pairs
     , testProperty "scalar mult distributive right" $ \(a :: BLS.Point curve) (b :: BLS.Point curve) (BigInteger c) ->
         BLS.blsMult (BLS.blsAddOrDouble a b) c === BLS.blsAddOrDouble (BLS.blsMult a c) (BLS.blsMult b c)