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

cabal.project

@@ -10,6 +10,14 @@ repository cardano-haskell-packages
     c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
+-- A temporary source-repository-package so that we get the BLS bindings in cardano-base.
+-- FIXME: delete this when the version in CHaP is updated.
+source-repository-package
+    type: git
+    location: https://github.com/input-output-hk/cardano-base
+    tag: 56a71b150b7ff7fb6d6bf588f3e9d88822c9048c
+    subdir: cardano-crypto-class
+
 -- See CONTRIBUTING for some Nix commands you will need to run if you
 -- update either of these.
 

nix/cells/plutus/library/make-plutus-project.nix

@@ -32,7 +32,10 @@ let
 
     inputMap = { "https://input-output-hk.github.io/cardano-haskell-packages" = inputs.CHaP; };
     # No source-repository-packages right now
-    sha256map = { };
+    sha256map = {
+      "https://github.com/input-output-hk/cardano-base"."56a71b150b7ff7fb6d6bf588f3e9d88822c9048c" =
+        "sha256-mTRYnpjNATU8W9th9KTNDairJDnFiq12E58t6evHMD8";
+    };
 
     # TODO: move this into the cabal.project using the new conditional support?
     # Configuration settings needed for cabal configure to work when cross compiling
@@ -156,6 +159,7 @@ let
           cardano-crypto-class.components.library.pkgconfig = lib.mkForce [
             [ pkgs.libsodium-vrf pkgs.secp256k1 ]
           ];
+          cardano-crypto-class.components.library.libs = lib.mkForce [ pkgs.blst ];
         };
       })
 

plutus-benchmark/bls-benchmarks/bench/Bench.hs

@@ -0,0 +1,61 @@
+-- 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
+
+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 p1 = Tx.bls12_381_G1_hashToGroup $ Tx.toBuiltin b1
+              p2 = Tx.bls12_381_G2_hashToGroup $ Tx.toBuiltin b2
+              q1 = Tx.bls12_381_G1_hashToGroup $ Tx.toBuiltin b3
+              q2 = Tx.bls12_381_G2_hashToGroup $ Tx.toBuiltin b4
+              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
+       ]

plutus-benchmark/bls-benchmarks/exe/Main.hs

@@ -0,0 +1,161 @@
+-- editorconfig-checker-disable-file
+{-# LANGUAGE NumericUnderscores #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+{- | 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 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 --------------------------------
+
+-- Printing utilities
+percentage :: (Integral a, Integral b) => a -> b -> Double
+percentage a b =
+    let a' = fromIntegral a :: Double
+        b' = fromIntegral b :: Double
+    in (a'/b' * 100)
+
+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 (fromIntegral cpu, fromIntegral 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 :: Integer -> UProg -> IO ()
+printStatistics n script = do
+    let serialised = Flat.flat (UPLC.UnrestrictedProgram $ toAnonDeBruijnProg script)
+        size = BS.length serialised
+        (cpu, mem) = evaluate script
+    -- BS.writeFile "output" serialised
+    -- printf "%s\n" $ show $ PP.prettyClassicDebug script
+    printf "  %3s %7d %8s %15d %8s %15d %8s \n"
+           (if n > 0 then show n else "-")
+           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 n script
+
+
+printCosts_HashAndAddG2 :: Integer -> IO ()
+printCosts_HashAndAddG2 n =
+    let script = mkHashAndAddG2Script (listOfSizedByteStrings n 4)
+    in printStatistics n script
+
+
+printCosts_UncompressAndAddG1 :: Integer -> IO ()
+printCosts_UncompressAndAddG1 n =
+    let script = mkUncompressAndAddG1Script (listOfSizedByteStrings n 4)
+    in printStatistics n script
+
+printCosts_UncompressAndAddG2 :: Integer -> IO ()
+printCosts_UncompressAndAddG2 n =
+    let script = mkUncompressAndAddG2Script (listOfSizedByteStrings n 4)
+    in printStatistics n script
+
+printCosts_Pairing :: IO ()
+printCosts_Pairing = do
+    let p1 = Tx.bls12_381_G1_hashToGroup $ toBuiltin $ BS.pack [0x23, 0x43, 0x56, 0xf2]
+        p2 = Tx.bls12_381_G2_hashToGroup $ toBuiltin $ BS.pack [0x10, 0x00, 0xff, 0x88]
+        q1 = Tx.bls12_381_G1_hashToGroup $ toBuiltin $ BS.pack [0x11, 0x22, 0x33, 0x44]
+        q2 = Tx.bls12_381_G2_hashToGroup $ toBuiltin $ BS.pack [0xa0, 0xb1, 0xc2, 0xd3]
+        script = mkPairingScript p1 p2 q1 q2
+    printStatistics (-1) script
+
+printCosts_Groth16Verify :: IO ()
+printCosts_Groth16Verify = do
+  let script = mkGroth16VerifyScript
+  printStatistics (-1) 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"
+
+