Add three more bls test cases and refactor scripts to separate modules

e2e-tests/e2e-tests.cabal

@@ -123,6 +123,15 @@ test-suite antaeus-test
     OldPlutus.Scripts
     PlutusScripts.Always
     PlutusScripts.BLS
+    PlutusScripts.BLS.AggregateSigWithMultipleKeys
+    PlutusScripts.BLS.AggregateSigWithSameKey
+    PlutusScripts.BLS.Common
+    PlutusScripts.BLS.Groth16
+    PlutusScripts.BLS.SchnorrG1
+    PlutusScripts.BLS.SchnorrG2
+    PlutusScripts.BLS.SimpleSignAndVerify
+    PlutusScripts.BLS.VerifyOverG1
+    PlutusScripts.BLS.Vrf
     PlutusScripts.Helpers
     PlutusScripts.SECP256k1
     PlutusScripts.V1TxInfo

e2e-tests/test/PlutusScripts/BLS/AggregateSigWithMultipleKeys.hs

@@ -0,0 +1,127 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE NumericUnderscores  #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- Not using all CardanoEra
+{-# LANGUAGE DerivingStrategies  #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use underscore" #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module PlutusScripts.BLS.AggregateSigWithMultipleKeys (
+    verifyBlsAggregateSigMultiKeyG1AssetIdV2
+  , verifyBlsAggregateSigMultiKeyG2MintWitnessV2
+  ) where
+
+import Cardano.Api qualified as C
+import Data.ByteString as BS hiding (foldl, map)
+import Data.Word (Word8)
+import Helpers.ScriptUtils (IsScriptContext (mkUntypedMintingPolicy))
+import OldPlutus.Scripts (MintingPolicy, mkMintingPolicyScript)
+import PlutusCore (DefaultFun, DefaultUni)
+import PlutusLedgerApi.V1 qualified as PlutusV1
+import PlutusLedgerApi.V2 qualified as PlutusV2
+import PlutusScripts.BLS.Common
+import PlutusScripts.Helpers (bytesFromHex, mintScriptWitness, plutusL1, plutusL2, policyIdV1, policyIdV2, policyScript,
+                              toScriptData)
+import PlutusTx qualified
+import PlutusTx.Builtins qualified as BI
+import PlutusTx.Prelude qualified as P
+import UntypedPlutusCore qualified as UPLC
+
+data BlsParams = BlsParams
+    { message            :: P.BuiltinByteString
+    , pubKeys            :: [P.BuiltinByteString]
+    , aggregateSignature :: P.BuiltinByteString
+    }
+PlutusTx.unstableMakeIsData ''BlsParams
+
+redeemerParams :: BlsParams
+redeemerParams = BlsParams
+  { message = "e345b7f2c017b16bb335c696bc0cc302f3db897fa25365a2ead1f149d87a97e8"
+  , pubKeys = [
+      "83718f20d08471565b3a6ca6ea82c1928e8730f87e2afe460b74842f2880facd8e63b8abcdcd7350fe5813a08aa0efed" ++
+      "13216b10de1c56dc059c3a8910bd97ae133046ae031d2a53a44e460ab71ebda94bab64ed7478cf1a91b6d3981e32fc95",
+      "814f825911bd066855333b74a3cc564d512503ee29ea1ec3bd57a3c07fa5768ad27ea1ddd8047f43fbc9a4ebda897c14" ++
+      "06415fefbb8838b8782aa747e2fde7b1813d0f89fad06c8971041c9427abf848503e34e3ca033ba85d50b72ffac4be4a",
+      "9974c70513ed5538a8e55f5ce1a0267282b9e8431e25ae566950b2d0793a44a0a3c52110f4d83d694a5296615ee68573" ++
+      "098c14d255783a9b1a169d2be1baefbef914a4f830a9099f720063914cc919064d2244582bb9f302eac39c8b195cf3d2",
+      "894a3a01d38169a38bea13097cf904dd3ff9dceefb51e8b539725a237ae55a361758be1cdf0e21a7b8db3599adaf2305" ++
+      "050f1d8450b924a4b910ff536fc2f7960cd3251c2a457b975d46f7c0f74493cc9b5e8d2fed2e489363e641cc79933d1e",
+      "9646da0149ed140e33a99e1ffc5fe9c97c2368ca273544024993cdcb7aa04c0be936e6d4427747e62c4caea4fe1f69e5" ++
+      "162fad222e0487f5556524c9d3db74921e1c0f5893f0e26c759e3873e8fd6637e6051f70ef9a3363cf284e8eee67bcf3",
+      "b75743fb2f8321ac56cee19aacd7e141a3592b7230992ea84d8800d45ad71924a477f61cf9d4a2783df59dac21cd17e7" ++
+      "0e4ce5d526cbe73edc4a10b78fa56a2ef34d2009f2756d2d50188031e026a6a1dadcd5e753f5e7f7276048277d3819f1",
+      "873c1e7d525265afa8c037d33874261a90daaa2c6ed5e46ed043ec48a28b7111d0de65800aa72448c1fdb1026ba076bd" ++
+      "04193bd2d04e0de63e7a008b8417420eb4920767a1d32f6330ed25bdb4dc7726d989d6cf192db6b32728bb388195ba27",
+      "b993f867f9f1f84c3c5c3e5b80013055da7705491c36a80e1201a6a503d7364000c50bc27e03477646874a3074cc4e39" ++
+      "0febfea78a2b4d0e40c57d6deaf9fae430a19fcce0c03f43ff8f7e788de0c7b8ce1b69b69d1d026175c8f2730777866d",
+      "99836a204576636f34a4663cfa7e02a05cb2d4fd1b582427d199ac3ddac6f087968d2290198aa15e04f6e7e0d070b7dd" ++
+      "03607db9c2e4b17709853c30b2f6490261599408fbbc17371de74d0a2a76ff10cd8c9b55461c444bbebc82547bb40c9f",
+      "96f8d678f40dd83b2060e14372d0bc43a423fecac44f082afd89cb481b855885ac83fb366516dc74023cc41a0c606be2" ++
+      "067ba826ea612f84c9f0e895d02bc04d6c34e201ff8c26cc22cb4c426c53f503d8948eafceb12e2f4b6ad49b4e051690"
+      ]
+  , aggregateSignature =
+      "89d9757c2467dfd987f35c462b7a4adf8e7bfd6fb82edfd42a22f985083f4e6fc45ad2548093fb479b2bd1f48b446ae6"
+  }
+
+---- BLS aggregate signature with different keys and same message with public key over G2 ----
+
+{-
+-- * hashed_msg = G1HashToCurve(msg, "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_NUL_")
+-- * pk_deser_i = G1Decompress(pk_i) for i in [1, 10]
+-- * ds_scalar = SHA256(pk_1 || .. || pk_10)[..16] (where [..16] represent the first 16 bytes)
+-- * aggr_sig_deser = G2Decompress(aggr_sig)
+-- * aggr_pk = sum_{i\in[1,10]} ds_scalar^i * pk_deser_i
+-- * Check that pairing(aggr_pk, hashed_msg) = pairing(G1Generator, aggr_sig_deser)
+-}
+{-# INLINABLE mkAggregateSigMultiKeyG1 #-}
+mkBlsAggregateSigMultiKeyG2 :: BlsParams -> sc -> Bool
+mkBlsAggregateSigMultiKeyG2 BlsParams{..} _sc = do
+  let
+    hashedMsg = BI.bls12_381_G1_hashToGroup message blsSigBls12381G2XmdSha256SswuRoNul
+    pksDeser = BI.bls12_381_G1_uncompress <$> pubKeys
+    dsScalar = convertByteStringToInteger $ BI.sliceByteString 0 16
+      (BI.sha2_256 $ BI.foldl BI.appendByteString (head pubKeys) pubKeys) 0 0 -- PlutusTx.Foldable has no foldl1
+    aggrSigDeser = BI.bls12_381_G2_uncompress aggregateSignature
+    aggrPk = calcAggregatedPubkeys dsScalar pksDeser 0 0
+  BI.bls12_381_finalVerify (BI.bls12_381_millerLoop aggrPk hashedMsg) (BI.bls12_381_millerLoop g1 aggrSigDeser)
+    where
+      -- an inefficient workaround for lack of ByteString to Integer interpretation
+      -- to be addressed by byteStringToInteger in https://github.com/input-output-hk/plutus/pull/4733
+      convertByteStringToInteger :: BuiltinByteString -> Integer -> Integer -> Integer
+      convertByteStringToInteger bs i acc
+        | i >= lengthOfByteString bs = acc
+        | otherwise = convertByteStringToInteger bs (i + 1) (256 * acc + indexByteString bs i) -- (acc + (indexByteString bs i) * 256 ^ i)
+
+      calcAggregatedPubkeys :: Integer -> BI.BuiltinByteString -> Integer -> Integer -> Integer
+      calcAggregatedPubkeys dsScalar' pksDeser' i acc
+        | i >= length pksDeser' = acc
+        | otherwise = calcAggregatedPubkeys dsScalar' pksDeser' (i + 1)
+                      (acc + dsScalar' ^ (i + 1) `BI.bls12_381_G1_scalarMul` pksDeser' !! i)
+
+verifyBlsAggregateSigMultiKeyG2PolicyV2 :: MintingPolicy
+verifyBlsAggregateSigMultiKeyG2PolicyV2 = mkMintingPolicyScript
+  $$(PlutusTx.compile [|| wrap ||])
+  where
+    wrap = mkUntypedMintingPolicy @PlutusV2.ScriptContext mkBlsAggregateSigMultiKeyG2
+
+verifyBlsAggregateSigMultiKeyG2PolicyScriptV2 :: C.PlutusScript C.PlutusScriptV2
+verifyBlsAggregateSigMultiKeyG2PolicyScriptV2 = policyScript verifyBlsAggregateSigMultiKeyG2PolicyV2
+
+verifyBlsAggregateSigMultiKeyG1AssetIdV2 :: C.AssetId
+verifyBlsAggregateSigMultiKeyG1AssetIdV2 = C.AssetId (policyIdV2 verifyBlsAggregateSigMultiKeyG2PolicyV2) blsAssetName
+
+verifyBlsAggregateSigMultiKeyG2Redeemer :: C.HashableScriptData
+verifyBlsAggregateSigMultiKeyG2Redeemer = toScriptData redeemerParams
+
+verifyBlsAggregateSigMultiKeyG2MintWitnessV2 :: C.CardanoEra era
+  -> (C.PolicyId, C.ScriptWitness C.WitCtxMint era)
+verifyBlsAggregateSigMultiKeyG2MintWitnessV2 era =
+    (policyIdV2 verifyBlsAggregateSigG2PolicyV2,
+     mintScriptWitness era plutusL2
+       (Left verifyBlsAggregateSigMultiKeyG2PolicyScriptV2) verifyBlsAggregateSigMultiKeyG2Redeemer)

e2e-tests/test/PlutusScripts/BLS/AggregateSigWithSingleKey.hs

@@ -0,0 +1,107 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE NumericUnderscores  #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- Not using all CardanoEra
+{-# LANGUAGE DerivingStrategies  #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use underscore" #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module PlutusScripts.BLS.AggregateSigWithSingleKey (
+    verifyBlsAggregateSigSingleKeyG1AssetIdV2
+  , verifyBlsAggregateSigSingleKeyG1MintWitnessV2
+  ) where
+
+import Cardano.Api qualified as C
+import Data.ByteString as BS hiding (foldl, map)
+import Data.Word (Word8)
+import Helpers.ScriptUtils (IsScriptContext (mkUntypedMintingPolicy))
+import OldPlutus.Scripts (MintingPolicy, mkMintingPolicyScript)
+import PlutusCore (DefaultFun, DefaultUni)
+import PlutusLedgerApi.V1 qualified as PlutusV1
+import PlutusLedgerApi.V2 qualified as PlutusV2
+import PlutusScripts.BLS.Common
+import PlutusScripts.Helpers (bytesFromHex, mintScriptWitness, plutusL1, plutusL2, policyIdV1, policyIdV2, policyScript,
+                              toScriptData)
+import PlutusTx qualified
+import PlutusTx.Builtins qualified as BI
+import PlutusTx.Prelude qualified as P
+import UntypedPlutusCore qualified as UPLC
+
+data BlsParams = BlsParams
+    { messages           :: [P.BuiltinByteString]
+    , pubKey             :: P.BuiltinByteString
+    , aggregateSignature :: P.BuiltinByteString
+    }
+PlutusTx.unstableMakeIsData ''BlsParams
+
+redeemerParams :: BlsParams
+redeemerParams = BlsParams
+  { messages = [ "2ba037cdb63cb5a7277dc5d6dc549e4e28a15c70670f0e97787c170485829264"
+               , "ecbf14bddeb68410f423e8849e0ce35c10d20a802bbc3d9a6ca01c386279bf01"
+               , "e8f75f478cb0d159db767341602fa02d3e01c3d9aacf9b686eccf1bb5ff4c8fd"
+               , "21473e89d50f51f9a1ced2390c72ee7e37f15728e61d1fb2c8c839495e489052"
+               , "8c146d00fe2e1caec31b159fc42dcd7e06865c6fa5267c6ca9c5284e651e175a"
+               , "362f469b6e722347de959f76533315542ffa440d37cde8862da3b3331e53b60d"
+               , "73baeb620e63a2e646ea148974350aa337491e5f5fc087cb429173d1eeb74f5a"
+               , "73acc6c3d72b59b8bf5ab58cdcf76aa001689aac938a75b1bb25d77b5382898c"
+               , "4e73ba04bae3a083c8a2109f15b8c4680ae4ba1c70df5b513425349a77e95d3b"
+               , "565825a0227d45068e61eb90aa1a4dc414c0976911a52d46b39f40c5849e5abe"
+               ]
+  , pubKey = "97c919babda8d928d771d107a69adfd85a75cee2cedc4afa" ++
+             "4c0a7e902f38b340ea21a701a46df825210dd6942632b46c"
+  , aggregateSignature =
+      "b425291f423235b022cdd038e1a3cbdcc73b5a4470251634abb874c7585a3a05b8ea54ceb93286edb0e9184bf9a852a1" ++
+      "138c6dd860e4b756c63dff65c433a6c5aa06834f00ac5a1a1acf6bedc44bd4354f9d36d4f20f66318f39116428fabb88"
+  }
+
+---- Aggregate BLS signature with same key, different messages, with PK over G1 ----
+
+{-
+  * hashed_msg_i = G2HashToCurve(msg_i, "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_NUL_") for i in [1, 10]
+  * pk_deser = G1Decompress(pk)
+  * aggr_sig_deser = G2Decompress(aggr_sig)
+  * aggr_msg = sum_{i\in[1,10]} hashed_msg_i
+  * Check that pairing(pk_deser, aggr_msg) = pairing(G1Generator, aggr_sig_deser)
+-}
+{-# INLINABLE mkAggregateSigSingleKeyG1 #-}
+mkBlsAggregateSigSingleKeyG1 :: BlsParams -> sc -> Bool
+mkBlsAggregateSigSingleKeyG1 BlsParams{..} _sc = do
+  let
+    hashedMsgs =
+      mapWithConstSecondArg BI.bls12_381_G2_hashToGroup blsSigBls12381G2XmdSha256SswuRoNul messages
+    pkDeser = BI.bls12_381_G1_uncompress pubKey
+    aggrSigDeser = BI.bls12_381_G2_uncompress aggregateSignature
+    aggrMsg = BI.foldl BI.bls12_381_G2_add (head hashedMsgs) hashedMsgs -- PlutusTx.Foldable has no foldl1
+
+  BI.bls12_381_finalVerify (BI.bls12_381_millerLoop pkDeser aggrMsg) (BI.bls12_381_millerLoop g1 aggrSigDeser)
+    where
+      mapWithConstSecondArg :: (a -> b) -> a -> [c] -> [b]
+      mapWithConstSecondArg f arg2 = map (\x -> f x arg2)
+
+verifyAggregateSigSingleKeyG1PolicyV2 :: MintingPolicy
+verifyAggregateSigSingleKeyG1PolicyV2 = mkMintingPolicyScript
+  $$(PlutusTx.compile [|| wrap ||])
+  where
+    wrap = mkUntypedMintingPolicy @PlutusV2.ScriptContext mkBlsAggregateSigSingleKeyG1
+
+verifyAggregateSigSingleKeyG1PolicyScriptV2 :: C.PlutusScript C.PlutusScriptV2
+verifyAggregateSigSingleKeyG1PolicyScriptV2 = policyScript verifyAggregateSigSingleKeyG1PolicyV2
+
+verifyBlsAggregateSigSingleKeyG1AssetIdV2 :: C.AssetId
+verifyBlsAggregateSigSingleKeyG1AssetIdV2 = C.AssetId (policyIdV2 verifyAggregateSigSingleKeyG1PolicyV2) blsAssetName
+
+verifyAggregateSigSingleKeyG1Redeemer :: C.HashableScriptData
+verifyAggregateSigSingleKeyG1Redeemer = toScriptData redeemerParams
+
+verifyBlsAggregateSigSingleKeyG1MintWitnessV2 :: C.CardanoEra era
+  -> (C.PolicyId, C.ScriptWitness C.WitCtxMint era)
+verifyBlsAggregateSigSingleKeyG1MintWitnessV2 era =
+    (policyIdV2 verifyAggregateSigSingleKeyG1PolicyV2,
+     mintScriptWitness era plutusL2
+       (Left verifyAggregateSigSingleKeyG1PolicyScriptV2) verifyAggregateSigSingleKeyG1Redeemer)

e2e-tests/test/PlutusScripts/BLS/Common.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- Not using all CardanoEra
+{-# LANGUAGE DerivingStrategies  #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use underscore" #-}
+
+module PlutusScripts.BLS.Common where
+
+import Cardano.Api qualified as C
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as C8
+import PlutusTx.Builtins qualified as BI
+import PlutusTx.Prelude qualified as P
+
+blsAssetName :: C.AssetName
+blsAssetName = C.AssetName "BLS"
+
+-- hex value 424c535f5349475f424c53313233383147325f584d443a5348412d3235365f535357555f524f5f4e554c5f"
+blsSigBls12381G2XmdSha256SswuRoNul :: P.BuiltinByteString
+blsSigBls12381G2XmdSha256SswuRoNul = BI.toBuiltin $ C8.pack "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_NUL_"
+
+-- G1 and G2 generators
+{-# INLINABLE g1 #-}
+g1 = BI.bls12_381_G1_uncompress $ toBuiltin $ BS.pack
+  [151, 241, 211, 167, 49, 151, 215, 148, 38, 149, 99, 140, 79, 169, 172, 15, 195, 104, 140, 79, 151, 116, 185,
+   5, 161,78, 58, 63, 23, 27, 172, 88, 108, 85, 232, 63, 249, 122, 26, 239, 251, 58, 240, 10, 219, 34, 198, 187]
+{-# INLINABLE g2 #-}
+g2 = BI.bls12_381_G2_uncompress $ toBuiltin $ BS.pack
+  [147, 224, 43, 96, 82, 113, 159, 96, 125, 172, 211, 160, 136, 39, 79, 101, 89, 107, 208, 208, 153, 32, 182,
+   26, 181, 218, 97, 187, 220, 127, 80, 73, 51, 76, 241, 18, 19, 148, 93, 87, 229, 172, 125, 5, 93, 4, 43, 126,
+   2, 74, 162, 178, 240, 143, 10, 145, 38, 8, 5, 39, 45, 197, 16, 81, 198, 228, 122, 212, 250, 64, 59, 2, 180,
+   81, 11, 100, 122, 227, 209, 119, 11, 172, 3, 38, 168, 5, 187, 239, 212, 128, 86, 200, 193, 33, 189, 184]