Haskell rust ffi

.github/workflows/main-pull.yml

@@ -0,0 +1,114 @@
+name: CI Pull Request
+
+on:
+  pull_request:
+    branches: [main]
+
+permissions:
+  contents: write
+
+jobs:
+  install:
+    name: Rust (${{matrix.os}})
+    runs-on: ${{matrix.os}}
+    strategy:
+      fail-fast: false
+      max-parallel: 5
+      matrix:
+        os: [ubuntu-latest]
+        cabal: [3.10.2.1]
+        ghc: [9.6.3]
+        rust:
+          - null
+
+    steps:
+    - name: Checkout code
+      uses: actions/[email protected]
+
+    - name: Set up Haskell
+      uses: haskell-actions/[email protected]
+      id: setup
+      with:
+        ghc-version: ${{ matrix.ghc }}
+        cabal-version: ${{ matrix.cabal }}
+        cabal-update: true      
+
+    - name: Set up cbindgen
+      run: |
+        cargo install --force cbindgen
+
+    - name: Set up cargo-c
+      run: |
+        cargo install cargo-c
+
+    - name: Configure Cabal
+      run: |
+        cabal configure --enable-tests --enable-benchmarks --enable-documentation
+
+    - name: Build rust wrapper
+      run: |
+        source ./run.sh
+        echo $LD_LIBRARY_PATH 
+        echo $PKG_CONFIG_PATH
+        echo $(pkg-config --version)
+    - name: Generate cache key
+      # Creates plan.json file
+      run: |
+        cabal build all --dry-run
+
+    - name: Restore cached dependencies
+      uses: actions/cache/[email protected]
+      id: cache
+      env:
+        key: ${{ matrix.os }}-ghc-${{ matrix.ghc }}-cabal-${{ matrix.cabal }}
+      with:
+        path: ${{ steps.setup.outputs.cabal-store }}
+        key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }}
+        restore-keys: ${{ env.key }}-
+
+    - name: Install stylish-haskell
+      run: |
+        cabal install stylish-haskell
+
+    - name: Lint Haskell
+      run: |
+        find . -name '*.hs' -exec sh -c 'for file do stylish-haskell --inplace "$file"; done' sh {} +
+
+    - name: Auto-commit lint
+      uses: stefanzweifel/git-auto-commit-action@v4
+      with:
+        commit_message: stylish-haskell auto-commit
+        commit_user_name: GitHub Action
+        commit_user_email: [email protected]
+        branch: ${{ github.head_ref }}
+
+    - name: Install dependencies
+      # If we had an exact cache hit, the dependencies will be up to date.
+      if: steps.cache.outputs.cache-hit != 'true'
+      run: |
+        cabal build all --only-dependencies
+
+    # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail.
+    - name: Save cached dependencies
+      uses: actions/cache/[email protected]
+      # If we had an exact cache hit, trying to save the cache would error because of key clash.
+      if: steps.cache.outputs.cache-hit != 'true'
+      with:
+        path: ${{ steps.setup.outputs.cabal-store }}
+        key: ${{ steps.cache.outputs.cache-primary-key }}
+
+    - name: Build
+      run: |
+        cabal build all -f Pedantic
+
+    # - name: Test
+    #   run: cabal test all
+
+    # - name: Check cabal file
+    #   run: cabal check
+
+    # - name: Document package
+    #   run: cabal haddock all
+
+    # - name: Prepare package for publishing
+    #   run: cabal sdist all

.github/workflows/main-push.yml

@@ -0,0 +1,51 @@
+name: CI Push
+
+on:
+  push:
+    branches: [ main ]
+
+  workflow_dispatch:
+
+permissions:
+  contents: read
+
+jobs:
+  on-main-update:
+
+    runs-on: ubuntu-latest
+
+    steps:
+    - uses: actions/[email protected]
+    - uses: haskell-actions/[email protected]
+      with:
+        ghc-version: '9.6.3'
+        cabal-version: '3.10.2.1'
+
+    - name: Cache
+      uses: actions/[email protected]
+      env:
+        cache-name: cache-cabal
+      with:
+        path: ~/.cabal
+        key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}
+        restore-keys: |
+          ${{ runner.os }}-build-${{ env.cache-name }}-
+          ${{ runner.os }}-build-
+          ${{ runner.os }}-
+
+    - name: Build package
+      shell: bash
+      run: |
+        cabal update
+        cabal new-build all -f Pedantic
+
+    - name: Upload package
+      env:
+        HACKAGE_PASSWORD: ${{ secrets.HACKAGE_PASSWORD }}
+      shell: bash
+      run: |
+        cabal sdist
+        cabal upload --username=VladimirSinyakov --password="$HACKAGE_PASSWORD" dist-newstyle/sdist/*.tar.gz
+
+        cabal v2-haddock --haddock-for-hackage --enable-doc
+        cabal upload --documentation --username=VladimirSinyakov --password="$HACKAGE_PASSWORD" dist-newstyle/*-docs.tar.gz

.vscode/settings.json

@@ -0,0 +1,4 @@
+{
+    "haskell.formattingProvider": "stylish-haskell",
+    "rust-analyzer.check.command": "clippy"
+}

README.md

@@ -59,7 +59,7 @@ Run benchmark:
 ```bash
 cabal run msm
 ```
-### Profiling and benchmarking
+### Haskell profiling and benchmarking
 
 Before you need install `ghc-prof-flamegraph`. Remember path to executable file
 ```bash
@@ -75,4 +75,27 @@ Run generating flamegraph. Make sure the path to `ghc-prof-flamegraph` is correc
 ```bash
 ~/.local/bin/ghc-prof-flamegraph msm.prof
 ```
-Flamegraph will be in `msm.svg` file
+Flamegraph will be in `msm.svg` file
+
+
+### Rust profiling and benchmarking
+
+To run benchmark install [cargo-criterion](https://github.com/bheisler/cargo-criterion)
+```bash
+cargo install cargo-criterion
+```
+And run
+```bash
+cargo criterion --bench msm_bench
+```
+
+For generate flamegraph install [flamegraph](https://github.com/flamegraph-rs/flamegraph) (require `perf`)
+```bash
+cargo install flamegraph
+```
+
+And generate flamegraph from bench:
+```bash
+cargo flamegraph --bench msm_bench
+```
+

bench/BenchMSM.hs

@@ -1,31 +1,38 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 module Main where
 
-import qualified Data.ByteString                             as BS
-import           Prelude                                     hiding (length, sum, (-))
+import qualified Data.Vector                                 as V
+import           Prelude                                     hiding (Num (..), length, sum, take, (-))
 import           RustFunctions                               (RustCore)
 import           Test.QuickCheck                             (Arbitrary (arbitrary), generate)
 import           Test.Tasty.Bench
 
-import           ZkFold.Base.Algebra.EllipticCurve.BLS12_381 (BLS12_381_G1, BLS12_381_G2)
-import           ZkFold.Base.Protocol.ARK.Plonk              (Plonk)
-import           ZkFold.Base.Protocol.NonInteractiveProof    (HaskellCore, NonInteractiveProof (..),
-                                                              NonInteractiveProofTestData (..))
-type PlonkSizeBS = 32
-type PlonkBS n = Plonk PlonkSizeBS n BLS12_381_G1 BLS12_381_G2 BS.ByteString
+import           ZkFold.Base.Algebra.EllipticCurve.BLS12_381 (BLS12_381_G1)
+import           ZkFold.Base.Algebra.EllipticCurve.Class     (EllipticCurve (ScalarField), Point)
+import           ZkFold.Base.Algebra.Polynomials.Univariate  (PolyVec, toPolyVec)
+import           ZkFold.Base.Data.Vector                     (Vector (..))
+import           ZkFold.Base.Protocol.NonInteractiveProof
+
+testMSM :: forall core size . (CoreFunction BLS12_381_G1 core) => V.Vector (Point BLS12_381_G1) -> PolyVec (ScalarField BLS12_381_G1) size -> Bool
+testMSM points scalars = let !_ = msm @BLS12_381_G1 @core points scalars in True
+
+type Length = 1024
 
 main :: IO ()
 main = do
-    (TestData a w) <- generate arbitrary :: IO (NonInteractiveProofTestData (PlonkBS 2) HaskellCore)
+    (Vector p) <- generate arbitrary :: IO (Vector Length (Point BLS12_381_G1))
+    (Vector s) <- generate arbitrary :: IO (Vector Length (ScalarField BLS12_381_G1))
 
-    let spHaskell = setupProve @(PlonkBS 2) @HaskellCore a
-        spRust    = setupProve @(PlonkBS 2) @RustCore    a
+    let
+        points = V.fromList p
+        scalars = toPolyVec @(ScalarField BLS12_381_G1) @Length $ V.fromList s
 
     defaultMain
         [
             bgroup "MSM group"
-
-            [ bench "Haskell core" $ nf (show . uncurry (prove @(PlonkBS 2) @HaskellCore)) (spHaskell, w)
-            , bcompare "Haskell core" $
-                bench "Rust core" $ nf (show . uncurry (prove @(PlonkBS 2) @RustCore)) (spRust, w)
+            [
+                bench "Haskell msm" $ nf (uncurry (testMSM @HaskellCore)) (points, scalars),
+                bcompare "Haskell msm" $
+                    bench "Rust-arkmsm" $ nf (uncurry (testMSM @RustCore)) (points, scalars)
             ]
         ]

bench/BenchPolyMul.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Main where
+
+import           Control.DeepSeq                             (force)
+import           Control.Exception                           (evaluate)
+import           Control.Monad                               (replicateM)
+import qualified Data.Vector                                 as V
+import           Foreign
+import           Prelude                                     hiding (sum, (*), (+), (-), (/), (^))
+import qualified Prelude                                     as P
+import           RustFunctions                               (rustMulFft)
+import           System.Random                               (randomIO)
+import           Test.Tasty.Bench
+
+import           ZkFold.Base.Algebra.Basic.Class
+import           ZkFold.Base.Algebra.Basic.Field
+import           ZkFold.Base.Algebra.Basic.Number            (Prime)
+import           ZkFold.Base.Algebra.EllipticCurve.BLS12_381
+import           ZkFold.Base.Algebra.Polynomials.Univariate
+
+-- | Generate random polynomials of given size
+--
+polynomials :: forall a. Prime a => Int -> IO (Poly (Zp a), Poly (Zp a))
+polynomials size = do
+    coeffs1 <- replicateM size (toZp @a <$> randomIO)
+    coeffs2 <- replicateM size (toZp @a <$> randomIO)
+    evaluatedCoeffs1 <- evaluate . force . V.fromList $ coeffs1
+    evaluatedCoeffs2 <- evaluate . force . V.fromList $ coeffs2
+    pure (toPoly evaluatedCoeffs1, toPoly evaluatedCoeffs2)
+
+sizes :: [Int]
+sizes = ((2 :: Int) P.^) <$> [10 .. 14 :: Int]
+
+ops :: forall a . (Eq a, Field a, Storable a) => [(String, Poly a -> Poly a -> Poly a)]
+ops = [ ("DFT multiplication", mulPolyDft)
+      , ("Adaptive multiplication", (*))
+      , ("Rust FFT", \x y -> toPoly (rustMulFft @a (fromPoly x) (fromPoly y)))
+      ]
+
+benchOps :: Prime a => Int -> [(String, Poly (Zp a) -> Poly (Zp a) -> Poly (Zp a))] -> Benchmark
+benchOps size testOps = env (polynomials size) $ \ ~(p1, p2) ->
+    bgroup ("Multiplying polynomials of size " <> show size) $
+            flip fmap testOps $ \(desc, op) -> bench desc $ nf (uncurry op) (p1, p2)
+
+main :: IO ()
+main = do
+  defaultMain
+      [ bgroup "Field without roots of unity"        $ flip fmap sizes $ \s -> benchOps @BLS12_381_Base s $ tail ops
+      , bgroup "Field with roots of unity"           $ flip fmap sizes $ \s -> benchOps @BLS12_381_Scalar s ops
+      ]

bench/BenchProve.hs

@@ -0,0 +1,31 @@
+module Main where
+
+import qualified Data.ByteString                             as BS
+import           Prelude                                     hiding (Num (..), length, sum, take, (-))
+import           RustFunctions                               (RustCore)
+import           Test.QuickCheck                             (Arbitrary (arbitrary), generate)
+import           Test.Tasty.Bench
+
+import           ZkFold.Base.Algebra.EllipticCurve.BLS12_381 (BLS12_381_G1, BLS12_381_G2)
+import           ZkFold.Base.Protocol.ARK.Plonk              (Plonk)
+import           ZkFold.Base.Protocol.NonInteractiveProof
+
+type PlonkSizeBS = 128
+type PlonkBS n = Plonk PlonkSizeBS n BLS12_381_G1 BLS12_381_G2 BS.ByteString
+
+main :: IO ()
+main = do
+    (TestData a w) <- generate arbitrary :: IO (NonInteractiveProofTestData (PlonkBS 2) HaskellCore)
+
+    let spHaskell = setupProve @(PlonkBS 2) @HaskellCore a
+        spRust    = setupProve @(PlonkBS 2) @RustCore    a
+
+    defaultMain
+        [
+            bgroup "Prove group"
+
+            [ bench "Haskell core" $ nf (show . uncurry (prove @(PlonkBS 2) @HaskellCore)) (spHaskell, w)
+            , bcompare "Haskell core" $
+                bench "Rust core" $ nf (show . uncurry (prove @(PlonkBS 2) @RustCore)) (spRust, w)
+            ]
+        ]

haskell-wrapper/src/Functions.chs

@@ -1,6 +1,7 @@
 module Functions where
 
 #include "rust_wrapper.h"
+import Foreign.C.String
 import Prelude
 import Data.ByteString (ByteString)
 import Foreign.Rust.Marshall.Variable
@@ -20,3 +21,30 @@ import Foreign.Rust.Marshall.Variable
      }
   -> `()'
 #}
+
+{# fun pure unsafe rust_wrapper_multi_scalar_multiplication_without_serialization as ^ 
+  { `CString'
+  , `Int' 
+
+  , `CString'
+  , `Int' 
+
+  , `Int' 
+  , `CString'
+  } 
+  -> `()'
+#}
+
+
+{# fun pure unsafe rust_wrapper_mul_fft as rustWrapperMulFFT
+  { `CString'
+  , `Int' 
+
+  , `CString'
+  , `Int' 
+
+  , `Int' 
+  , `CString'
+  } 
+  -> `()'
+#}