Cost model bench for SECP256k1

plutus-core/cost-model/budgeting-bench/Benchmarks/CryptoAndHashes.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE KindSignatures    #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Benchmarks.CryptoAndHashes (makeBenchmarks) where
@@ -7,13 +10,19 @@ import Generators
 
 import PlutusCore
 
+import Control.Monad (replicateM)
 import Criterion.Main
+import Crypto.Secp256k1 qualified as SECP
 import Data.ByteString qualified as BS
+import Data.Kind qualified as GHC
+import Data.Maybe (fromMaybe)
+import Data.Serialize (Serialize, put, runPut)
 import System.Random (StdGen)
 
 import Hedgehog qualified as H
 import Hedgehog.Internal.Gen qualified as G
 import Hedgehog.Internal.Range qualified as R
+import Hedgehog.Internal.Tree qualified as T
 
 byteStringSizes :: [Int]
 byteStringSizes = fmap (100*) [0..100]
@@ -61,8 +70,56 @@ benchVerifySignature =
 -- immediately if the key or signature has the wrong size.
 
 
+---------------- Verify SECP256k1 signature --------------------------
+
+-- Produces tuples of pubkey, signature and message
+-- These all have fixed lengths, and we technically derive the pubkey from a
+-- secret key, so we only need to generate two 32-byte values for each case.
+secpInputs :: H.Seed -> [(BS.ByteString, BS.ByteString, BS.ByteString)]
+secpInputs seed = fmap go skMsgs
+  where
+    go :: (BS.ByteString, BS.ByteString) ->
+          (BS.ByteString, BS.ByteString, BS.ByteString)
+    go (sk, msg) = fromMaybe (error "Error: could not generate SECP input") $ do
+      sk' <- SECP.secKey sk
+      let pk = SECP.derivePubKey sk'
+      msg' <- SECP.msg msg
+      let sig' = SECP.signMsg sk' msg'
+      pure (putting pk,
+            putting sig',
+            msg)
+    skMsgs :: [(BS.ByteString, BS.ByteString)]
+    skMsgs =
+      maybe (error "Couldn't create SECP sample") T.treeValue .
+      G.evalGen (R.Size 1) seed .
+      replicateM 100 $ (,) <$> G.bytes (R.singleton 32) <*> G.bytes (R.singleton 32)
+    -- Ideally, we'd use the cardano-base methods for raw serialisation, but we
+    -- can't do this due to a dependency cycle. Thus, the logic for that
+    -- functionality is replicated here. As this is quite unlikely to change in
+    -- the future, this is unlikely to become a problem, but just in case it
+    -- does, this note exists as a reminder.
+    putting :: forall (a :: GHC.Type) . (Serialize a) => a -> BS.ByteString
+    putting = runPut . put
+
+-- This is written with a bang-pattern to avoid profiling the code generating
+-- the inputs by accident.
+benchVerifySECP256k1Signature :: Benchmark
+benchVerifySECP256k1Signature = let !inputs = secpInputs seedA in
+  bgroup (show name) . fmap go $ inputs
+  where
+    name :: DefaultFun
+    name = VerifySECP256k1Signature
+    go :: (BS.ByteString, BS.ByteString, BS.ByteString) -> Benchmark
+    go (pk, sig', msg) =
+      benchDefault (showMem pk sig' msg) . mkApp3 name [] pk sig' $ msg
+    showMem :: BS.ByteString -> BS.ByteString -> BS.ByteString -> String
+    showMem pk sig' msg =
+      showMemoryUsage pk <> "\n" <>
+      showMemoryUsage sig' <> "\n" <>
+      showMemoryUsage msg
+
 makeBenchmarks :: StdGen -> [Benchmark]
-makeBenchmarks _gen =  [benchVerifySignature]
+makeBenchmarks _gen =  [benchVerifySignature, benchVerifySECP256k1Signature]
                     <> (benchByteStringOneArgOp <$> [ Sha2_256, Sha3_256, Blake2b_256 ])
 
 -- Sha3_256 takes about 2.65 times longer than Sha2_256, which in turn takes