Kwxm/bls12-381/prototype (PLT-192, PLT-1557, PLT-1554, etc). (#5231)

* Initial version of BLS pairing builtins * WIP * WIP * WIP: implementations of GT operations * Tidy up instances * More-or-less complete implementation for UPLC * Initial costing benchmarks for BLS builtins * Update benchmarks * Update R code * Forgot source files * Wrong denotation for GT_mul * Partial updates to CreateBuiltinCostModel * Fix typos in function names * Update memory models for BLS12_381 builtins * Update memory models for BLS12_381 builtins * WIP * Rename BLS (de)serialise -> (un)compress * Reformat * inline-r workaround; corrections to cost model generation code * inline-r workaround * Update cost model tests for BLS functions * Update benching results and cost model file for BLS * Update benching results and cost model file for BLS * Update comment * Update comment * Add some extra stuff for the benefit of the QuickCheck shrinker * Add new builtins to plutus-tx * Add a few Haskell BLS examples * WIP * Update cabal file * Merge master * WIP * Update BLS throughput benchmarks * Update cost model for uncompress vs deserialise * Update BSL benchmark program * WIP * Nix weirdness * Updates after merge * Add Groth16 verification example * Tidying up; get rid of SourceSpans * Minor updates * Minor updates * Add proper Criterion benchmarks * Tidying up * Moved file * Forgot cabal file * Fix typo * Update comment * Fix cabal version constraints * Add missing cases for geqStep * Update deriving methods * WIP: property tests * Add Plutus versions of most of the property tests * Tidy up the test code a bit * Use folds for repeated addition; adjust sizes of test inputs * Better folding * Update FFI code to new version * Name change: millerLoop -> pairing * Reorganise files * Tidy up * Tidy up * More tidying up * Add comment * Abstraction for BLS property tests * Tidying up * WIP * Incorporate Inigo's updates * Banish Hedgehog * Add conformance tests for BLS12-381 constants * Add BLS12-381 addition conformance tests * Add BLS12-381 equality conformance tests * Add BLS12-381 negation conformance tests * Update comment on cofactors * More conformance tests * Correct test name * Add BLS12-381 scalar multiplication conformance tests * Remark about source of data for Groth16 verification example * Add BLS12-381 pairing operation conformance tests * Update comment in BLS12-381 peoperty tests * Update comment in BLS12-381 peoperty tests * Typo in file name * Fix types in bls-sizes executable * Update names in costing benchmark CSV file * Update names of built-in types and functions in plutus-core * Update names in conformance tests * Update BLS names in plutus-tx-plugin * Remove parser for MlResult; fix Groth16 example * Tidy up the Groth16 example * Update versions in plutus-benchmark.cabal * applyCode -> unsafeApplyCode after PLT-1552 * Update comment * Minor formatting updates * Make plutus-metatheory work with the BLS builtins to some extent * Fix incorrect test * Exclude failing BLS12-381 Agda tests * Exclude failing BLS12-381 Agda tests * Add property test for periodicity of scalar multiplication * Minor code rearrangement * Import scalarPeriod for tests * Add more property tests for BLS compression * Add conformance tests for BLS scalar mulitplication periodicity * Add descirptive comments to the BLS conformance tests * Improve printing of known builtins when parser encounters an unknown one * Reorganise files containing cryptographic functions * Reorganise Crypto files * hashToCurve -> hashToGroup * Adjust spacing in print-builtin-signatures * Justification * Attempt to update to work with iohk-nix version of libblst * Merge Mauro's metatheory updates * Update to new version of BLS bindings * Update to new version of BLS bindings * Update to new version of BLS bindings * Merge Mauro's metatheory improvements * Still trying to get libblst to work with nix * More informative BLS names in metatheory * Update some comments * Get BSL sizes from blst * Pairing.pairing -> Pairing.millerLoop * Backpatch cost model * Turn on immediate warnings in R * Restore golden budget results after cost model backpatch * Attempt to fix plututs-ledger-api version tests * Restore comment * Add comment * Fix name of plutus-tx-plugin-tests * Improve comments * Extend comments * Reformat comments * Add comments to ignore cbits * Comments on costing benchmarks * Tidying up * Add some more comments * Add changelog entries for BLS12-381 modifications * Remove unnecessary changelog directories from unversioned packages * Update plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs Co-authored-by: Michael Peyton Jones <michael.peyton-jones@iohk.io> * Address some PR comments * Crypto -> PlutusCore.Crypto for stuff we've defined * Address some more PR comments * Update metatheory for package name change * Update metatheory for package name change * Update version numbers in cabal file * Update BLS branch to work with merged version of BLS bindings in cardano-base * Remove commented-out Haskell code in plutus-metatheory * Missing cases in metatheory * Missing cases in metatheory * Missing cases in metatheory * Missing cases in metatheory * Missing cases in metatheory * Reorder constructors in ledger-api cost model interface * Update the comments about wrapping BLS12-381 types * Remove Haskell property tests for BLS12-381 (tested in cardano-base) * Refactoring * Refactoring * Remove some stuff that was left in accidentally * Remove empty lines * Resolve merge problems * Fix comment * Delete unused boilerplate from changelog entry * Update cabal file * Fix alignment * Address some PR comments * Address some PR comments * fromIntegral -> fromSatInt * GHC.Tick -> GHC.HpcTick * Trying to get rid of wrong version of Expr.hs in plutus-tx-plugin * Add missing golden files * Fix weird results in TypeSynthesis/Golden/Bls12* * Try to fix blst * Add BLS builtins to metatheory * Fix Untyped/CEK.lagda; make Agda conformance tests pass * Correct spacing * Remove some remaining merge conflicts * Correct spacing * Correct formatting * Correct formatting * Some renaming * Update flake * Bump plutus-core at el from 1.5 -> 1.6 * Bump haskell.nix, iohk-nix, CHaP * bump cardano-base we needed to get proper blst discovery, until 2.2.0.0 is released. This also means we need to bring in cardano-mempool. * Fix missing blst symbols. This depends on IntersectMBO/cardano-base#412. * Agda fixes * liftCode -> liftCodeDef * Remove superlfuous dependencies * Add DST argument to hashToGroup builtins * Address a couple of PR comments * bump haskell.nix * Add NOINLINE to listOfSizedByteStrings * Address some PR comments * Bump haskell.nix To get input-output-hk/haskell.nix#1948 * Error type for overlong DSTs * Error type for overlong DSTs * Stuff about shrinking * Make CI happy. x is unused. * plutus windows cross 8.10 * Finish incomplete test * Typo * Address PR comments * Fix parser for bls12_381_mlresult type * WIP updating things * bump iohk-nix * Improve hash collision tests * Update benching.csv to new format to make merge easier * Resolve some remaining conflicts * Update ciJobs.nix * bump haskell.nix * Update nix/cells/automation/ciJobs.nix * Update nix/cells/automation/ciJobs.nix * Update plutus-metatheory/src/Algorithmic/Erasure.lagda --------- Co-authored-by: Michael Peyton Jones <michael.peyton-jones@iohk.io> Co-authored-by: Moritz Angermann <moritz.angermann@gmail.com> Co-authored-by: Hamish Mackenzie <Hamish.K.Mackenzie@gmail.com>
IntersectMBO · Jun 1, 2023 · 996c7fc · 996c7fc
1 parent 5f74a57
commit 996c7fc
Show file tree

Hide file tree

Showing 319 changed files with 7,709 additions and 583 deletions.
diff --git a/cabal.project b/cabal.project
@@ -16,7 +16,7 @@ index-state:
   -- Bump both the following dates if you need newer packages from Hackage
   , hackage.haskell.org 2023-05-23T01:25:23Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2023-05-16T08:53:30Z
+  , cardano-haskell-packages 2023-05-26T00:00:00Z
 
 packages: doc/read-the-docs-site
           marlowe-cardano-minimal

diff --git a/flake.lock b/flake.lock
diff --git a/nix/cells/plutus/library/make-plutus-project.nix b/nix/cells/plutus/library/make-plutus-project.nix
@@ -47,7 +47,7 @@ let
         package plutus-tx-plugin
           flags: +use-ghc-stub
 
-        -- Exclude test that use `doctest`.  They will not work for
+        -- Exclude tests that use `doctest`.  They will not work for
         -- cross compilation and `cabal` will not be able to make a plan.
         package prettyprinter-configurable
           tests: False

diff --git a/plutus-benchmark/bls-benchmarks/bench/Bench.hs b/plutus-benchmark/bls-benchmarks/bench/Bench.hs
@@ -0,0 +1,64 @@
+-- editorconfig-checker-disable-file
+{- | Plutus benchmarks measuring actual execution times of some BSL12-381
+   operations, mainly intended to give us an idea of what we can do within the
+   on-chain execution limits. -}
+module Main where
+
+import Criterion.Main
+
+import PlutusBenchmark.BLS12_381.Common
+import PlutusBenchmark.Common (benchTermCek)
+import PlutusTx.Prelude qualified as Tx
+import UntypedPlutusCore qualified as UPLC
+
+import Data.ByteString qualified as BS (empty)
+
+benchProgCek :: UProg -> Benchmarkable
+benchProgCek (UPLC.Program _ _ t) = benchTermCek t
+
+benchHashAndAddG1 :: Integer -> Benchmark
+benchHashAndAddG1 n =
+    let prog = mkHashAndAddG1Script (listOfSizedByteStrings n 4)
+    in bench (show n) $ benchProgCek prog
+
+benchHashAndAddG2 :: Integer -> Benchmark
+benchHashAndAddG2 n =
+    let prog = mkHashAndAddG2Script (listOfSizedByteStrings n 4)
+    in bench (show n) $ benchProgCek prog
+
+benchUncompressAndAddG1 :: Integer -> Benchmark
+benchUncompressAndAddG1 n =
+    let prog = mkUncompressAndAddG1Script (listOfSizedByteStrings n 4)
+    in bench (show n) $ benchProgCek prog
+
+benchUncompressAndAddG2 :: Integer -> Benchmark
+benchUncompressAndAddG2 n =
+    let prog = mkUncompressAndAddG2Script (listOfSizedByteStrings n 4)
+    in bench (show n) $ benchProgCek prog
+
+benchPairing :: Benchmark
+benchPairing =
+    case listOfSizedByteStrings 4 4 of
+      [b1, b2, b3, b4] ->
+          let emptyDst = Tx.toBuiltin BS.empty
+              p1 = Tx.bls12_381_G1_hashToGroup (Tx.toBuiltin b1) emptyDst
+              p2 = Tx.bls12_381_G2_hashToGroup (Tx.toBuiltin b2) emptyDst
+              q1 = Tx.bls12_381_G1_hashToGroup (Tx.toBuiltin b3) emptyDst
+              q2 = Tx.bls12_381_G2_hashToGroup (Tx.toBuiltin b4) emptyDst
+              prog = mkPairingScript p1 p2 q1 q2
+          in bench "pairing" $ benchProgCek prog
+      _ -> error "Unexpected list returned by listOfSizedByteStrings"
+
+benchGroth16Verify :: Benchmark
+benchGroth16Verify = bench "groth16Verify" $ benchProgCek mkGroth16VerifyScript
+
+main :: IO ()
+main = do
+  defaultMain [
+          bgroup "hashAndAddG1" $ fmap benchHashAndAddG1 [0, 10..150]
+        , bgroup "hashAndAddG2" $ fmap benchHashAndAddG2 [0, 10..150]
+        , bgroup "uncompressAndAddG1" $ fmap benchUncompressAndAddG1 [0, 10..150]
+        , bgroup "uncompressAndAddG2" $ fmap benchUncompressAndAddG2 [0, 10..150]
+        , benchPairing
+        , benchGroth16Verify
+       ]
diff --git a/plutus-benchmark/bls-benchmarks/exe/Main.hs b/plutus-benchmark/bls-benchmarks/exe/Main.hs
@@ -0,0 +1,170 @@
+-- editorconfig-checker-disable-file
+{-# LANGUAGE LambdaCase         #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+{- | Print out the costs of various test scripts involving the BLS12_381
+   primitives.  Most of these work on varying numbers of inputs so that we can
+   get an idea of what we can do within the on-chain execution limits.
+-}
+module Main (main)
+
+where
+
+import PlutusBenchmark.BLS12_381.Common
+
+import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (exBudgetCPU, exBudgetMemory))
+import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
+import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..))
+import PlutusTx.Prelude as Tx hiding (sort, (*))
+import UntypedPlutusCore qualified as UPLC
+import UntypedPlutusCore.Evaluation.Machine.Cek qualified as Cek
+
+import Data.ByteString qualified as BS
+import Data.SatInt (fromSatInt)
+import Flat qualified
+import Text.Printf (printf)
+
+import Prelude (Double, IO, Integral, String, fromIntegral, mapM_, show, (*), (/))
+
+-- Protocol parameters (November 2022)
+
+-- | This is the "maximum transaction size".  We're just comparing the size of
+-- the script with this, so our results may be a little optimistic if the
+-- transaction includes other stuff (I'm not sure exactly what "maximum
+-- transaction size" means).
+max_tx_size :: Integer
+max_tx_size = 16384
+
+max_tx_ex_steps :: Integer
+max_tx_ex_steps = 10_000_000_000
+
+max_tx_ex_mem :: Integer
+max_tx_ex_mem = 14_000_000
+
+-------------------------------- Printing --------------------------------
+
+data TestSize =
+    NoSize
+  | TestSize Integer
+
+stringOfTestSize :: TestSize -> String
+stringOfTestSize =
+    \case
+     NoSize     -> "-"
+     TestSize n -> show n
+
+-- Printing utilities
+percentage :: (Integral a, Integral b) => a -> b -> Double
+percentage a b =
+    let a' = fromIntegral a :: Double
+        b' = fromIntegral b :: Double
+    in (a'* 100) / b'
+
+percentTxt :: (Integral a, Integral b) => a -> b -> String
+percentTxt a b = printf "(%.1f%%)" (percentage a b)
+
+-- | Evaluate a script and return the CPU and memory costs (according to the cost model)
+evaluate :: UProg -> (Integer, Integer)
+evaluate (UPLC.Program _ _ prog) =
+    case Cek.runCekDeBruijn PLC.defaultCekParameters Cek.tallying Cek.noEmitter prog of
+      (_res, Cek.TallyingSt _ budget, _logs) ->
+          let ExCPU cpu = exBudgetCPU budget
+              ExMemory mem = exBudgetMemory budget
+          in (fromSatInt cpu, fromSatInt mem)
+
+-- | Evaluate a script and print out the serialised size and the CPU and memory
+-- usage, both as absolute values and percentages of the maxima specified in the
+-- protocol parameters.
+printStatistics :: TestSize -> UProg -> IO ()
+printStatistics n script = do
+    let serialised = Flat.flat (UPLC.UnrestrictedProgram $ toAnonDeBruijnProg script)
+        size = BS.length serialised
+        (cpu, mem) = evaluate script
+    printf "  %3s %7d %8s %15d %8s %15d %8s \n"
+           (stringOfTestSize n)
+           size (percentTxt size max_tx_size)
+           cpu  (percentTxt cpu  max_tx_ex_steps)
+           mem  (percentTxt mem  max_tx_ex_mem)
+
+------------------------------- Examples ---------------------------------
+
+printCosts_HashAndAddG1 :: Integer -> IO ()
+printCosts_HashAndAddG1 n =
+    let script = mkHashAndAddG1Script (listOfSizedByteStrings n 4)
+    in printStatistics (TestSize n) script
+
+
+printCosts_HashAndAddG2 :: Integer -> IO ()
+printCosts_HashAndAddG2 n =
+    let script = mkHashAndAddG2Script (listOfSizedByteStrings n 4)
+    in printStatistics (TestSize n) script
+
+
+printCosts_UncompressAndAddG1 :: Integer -> IO ()
+printCosts_UncompressAndAddG1 n =
+    let script = mkUncompressAndAddG1Script (listOfSizedByteStrings n 4)
+    in printStatistics (TestSize n) script
+
+printCosts_UncompressAndAddG2 :: Integer -> IO ()
+printCosts_UncompressAndAddG2 n =
+    let script = mkUncompressAndAddG2Script (listOfSizedByteStrings n 4)
+    in printStatistics (TestSize n) script
+
+printCosts_Pairing :: IO ()
+printCosts_Pairing = do
+    let emptyDST = toBuiltin BS.empty
+        p1 = Tx.bls12_381_G1_hashToGroup (toBuiltin . BS.pack $ [0x23, 0x43, 0x56, 0xf2]) emptyDST
+        p2 = Tx.bls12_381_G2_hashToGroup (toBuiltin . BS.pack $ [0x10, 0x00, 0xff, 0x88]) emptyDST
+        q1 = Tx.bls12_381_G1_hashToGroup (toBuiltin . BS.pack $ [0x11, 0x22, 0x33, 0x44]) emptyDST
+        q2 = Tx.bls12_381_G2_hashToGroup (toBuiltin . BS.pack $ [0xa0, 0xb1, 0xc2, 0xd3]) emptyDST
+        script = mkPairingScript p1 p2 q1 q2
+    printStatistics NoSize script
+
+printCosts_Groth16Verify :: IO ()
+printCosts_Groth16Verify = do
+  let script = mkGroth16VerifyScript
+  printStatistics NoSize script
+
+printHeader :: IO ()
+printHeader = do
+  printf "    n     script size             CPU usage               Memory usage\n"
+  printf "  ----------------------------------------------------------------------\n"
+
+main :: IO ()
+main = do
+
+  printf "Hash n bytestrings onto G1 and add points\n\n"
+  printHeader
+  mapM_ printCosts_HashAndAddG1 [0, 10..150]
+  printf "\n\n"
+
+  printf "Hash n bytestrings onto G2 and add points\n\n"
+  printHeader
+  mapM_ printCosts_HashAndAddG2 [0, 10..150]
+  printf "\n\n"
+
+  printf "Uncompress n G1 points and add the results\n\n"
+  printHeader
+  mapM_ printCosts_UncompressAndAddG1 [0, 10..150]
+  printf "\n\n"
+
+  printf "Uncompress n G2 points and add the results\n\n"
+  printHeader
+  mapM_ printCosts_UncompressAndAddG2 [0, 10..150]
+  printf "\n\n"
+
+  printf "Apply pairing to two pairs of points in G1 x G2 and run finalVerify on the results\n\n"
+  printHeader
+  printCosts_Pairing
+  printf "\n\n"
+
+  printf "Groth16 verification example\n\n"
+  printHeader
+  printCosts_Groth16Verify
+  printf "\n"
+
+  if checkGroth16Verify_Haskell
+  then printf "Groth16Verify succeeded\n"
+  else printf "Groth16Verify failed\n"
+
+