diff --git a/lib/unsafe/src/Data/Foldable/Unsafe.hs b/lib/unsafe/src/Data/Foldable/Unsafe.hs index fc65ddd8a..8bbb29ba3 100644 --- a/lib/unsafe/src/Data/Foldable/Unsafe.hs +++ b/lib/unsafe/src/Data/Foldable/Unsafe.hs @@ -6,7 +6,7 @@ -- | --- Module: unsafe.Data.Foldable.Unsafe +-- Module: Data.Foldable.Unsafe -- Copyright: Copyright © 2024 Kadena LLC. -- License: MIT -- Maintainer: Pact Team diff --git a/pact.cabal b/pact.cabal index 2fffc0766..fe4ab7d48 100644 --- a/pact.cabal +++ b/pact.cabal @@ -504,6 +504,7 @@ test-suite hspec Utils build-depends: + , pact:unsafe , Decimal , deepseq , directory diff --git a/src-tool/Pact/Analyze/Check.hs b/src-tool/Pact/Analyze/Check.hs index 7619414d5..3a436d0d2 100644 --- a/src-tool/Pact/Analyze/Check.hs +++ b/src-tool/Pact/Analyze/Check.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -50,7 +51,9 @@ import Control.Monad.State.Strict (evalStateT) import Control.Monad.Trans.Class (lift) import Data.Bifunctor (first) import Data.Either (partitionEithers) +#if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl') +#endif import qualified Data.HashMap.Strict as HM import Data.List (isPrefixOf,nub) import qualified Data.List as List @@ -1115,8 +1118,7 @@ getFunChecks env@(CheckEnv tables consts propDefs moduleData _cs _g de _) refs = case toplevel of TopFun fun _ -> withExceptT ModuleCheckFailure $ ExceptT $ verifyFunctionInvariants env (mkFunInfo fun) name checkType - _ -> error "invariant violation: anything but a TopFun is unexpected in \ - \invariantCheckable" + _ -> error "invariant violation: anything but a TopFun is unexpected in invariantCheckable" funChecks'' <- lift $ ifor funChecks' $ \name ((toplevel, checkType), checks) -> case toplevel of diff --git a/src-tool/Pact/Analyze/Eval/Term.hs b/src-tool/Pact/Analyze/Eval/Term.hs index 09b73d3a4..b72800e74 100644 --- a/src-tool/Pact/Analyze/Eval/Term.hs +++ b/src-tool/Pact/Analyze/Eval/Term.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} @@ -26,7 +27,12 @@ import Control.Monad.RWS.Strict (RWST (RWST, runRWST)) import Control.Monad.State.Strict (MonadState, modify', runStateT) import Data.Constraint (Dict (Dict), withDict) import Data.Default (def) +#if MIN_VERSION_base(4,20,0) +import Data.Foldable (foldlM) +#else import Data.Foldable (foldl', foldlM) +#endif +import Data.List.Unsafe (unsafeHead, unsafeTail) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.SBV (EqSymbolic ((.==), (./=)), @@ -906,5 +912,5 @@ format s tms = do then Left (AnalyzeFailure dummyInfo "format: not enough arguments for template") else Right $ foldl' (\r (e, t) -> r .++ rep e .++ t) - (head parts) - (zip tms (tail parts)) + (unsafeHead parts) + (zip tms (unsafeTail parts)) diff --git a/src/Pact/GasModel/GasModel.hs b/src/Pact/GasModel/GasModel.hs index f96a2e32f..43b752107 100644 --- a/src/Pact/GasModel/GasModel.hs +++ b/src/Pact/GasModel/GasModel.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-} @@ -5,7 +6,11 @@ module Pact.GasModel.GasModel where import Control.Exception (bracket) import Control.Monad (void, replicateM) +#if MIN_VERSION_base(4,20,0) +import Data.List (sortOn) +#else import Data.List (foldl', sortOn) +#endif import GHC.Conc (numCapabilities) import Statistics.Types (Estimate(..)) diff --git a/src/Pact/GasModel/GasTests.hs b/src/Pact/GasModel/GasTests.hs index abb10fb16..2d34a48cc 100644 --- a/src/Pact/GasModel/GasTests.hs +++ b/src/Pact/GasModel/GasTests.hs @@ -14,7 +14,6 @@ module Pact.GasModel.GasTests import Control.Lens hiding ((.=),DefName) import Data.Bool (bool) import Data.Default (def) -import Data.List (foldl') import Data.Maybe (fromMaybe) import NeatInterpolation (text) @@ -51,7 +50,7 @@ nonNatives = [NativeDefName "use", NativeDefName "interface"] untestedNatives :: [NativeDefName] -untestedNatives = foldl' untested [] allNatives +untestedNatives = F.foldl' untested [] allNatives where untested li nativeName = case (HM.lookup nativeName unitTests) of Nothing -> nativeName : li @@ -59,7 +58,7 @@ untestedNatives = foldl' untested [] allNatives unitTests :: HM.HashMap NativeDefName GasUnitTests -unitTests = HM.fromList $ foldl' getUnitTest [] allNatives +unitTests = HM.fromList $ F.foldl' getUnitTest [] allNatives where getUnitTest li nativeName = case unitTestFromDef nativeName of diff --git a/src/Pact/Interpreter.hs b/src/Pact/Interpreter.hs index 1de58dcfb..259f964d0 100644 --- a/src/Pact/Interpreter.hs +++ b/src/Pact/Interpreter.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -56,7 +57,9 @@ import Data.HashMap.Strict (HashMap) import Data.Monoid(Endo(..)) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M +#if !MIN_VERSION_base(4,20,0) import Data.Foldable(foldl') +#endif import Data.IORef import Data.Maybe import qualified Data.Set as S diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 2a1e2909a..34abbda5b 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -72,7 +73,9 @@ import qualified Data.Char as Char import Data.Bits import Data.Default import Data.Functor(($>)) +#if !MIN_VERSION_base(4,20,0) import Data.Foldable +#endif import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M import qualified Data.List as L (nubBy) @@ -217,12 +220,14 @@ tryDef :: NativeDef tryDef = defNative "try" try' (funType a [("default", a), ("action", a)]) ["(try 3 (enforce (= 1 2) \"this will definitely fail\"))" - ,LitExample "(expect \"impure expression fails and returns default\" \"default\" \ - \(try \"default\" (with-read accounts id {'ccy := ccy}) ccy))" + ,LitExample + "(expect \"impure expression fails and returns default\" \"default\" (try \"default\" (with-read accounts id {'ccy := ccy}) ccy))" ] - "Attempt a pure ACTION, returning DEFAULT in the case of failure. Pure expressions \ - \are expressions which do not do i/o or work with non-deterministic state in contrast \ - \to impure expressions such as reading and writing to a table." + $ T.unwords + [ "Attempt a pure ACTION, returning DEFAULT in the case of failure. Pure expressions" + , "are expressions which do not do i/o or work with non-deterministic state in contrast" + , "to impure expressions such as reading and writing to a table." + ] where try' :: NativeFun e try' i as@[da, action] = gasUnreduced i as $ isExecutionFlagSet FlagDisablePact44 >>= \case @@ -293,17 +298,22 @@ strToIntDef = defRNative "str-to-int" strToInt ,"(str-to-int \"123456\")" ,"(str-to-int 64 \"q80\")" ] - "Compute the integer value of STR-VAL in base 10, or in BASE if specified. \ - \STR-VAL can be up to 512 chars in length. \ - \BASE must be between 2 and 16, or 64 to perform unpadded base64url conversion. \ - \Each digit must be in the correct range for the base." + $ T.unwords + [ "Compute the integer value of STR-VAL in base 10, or in BASE if specified." + , "STR-VAL can be up to 512 chars in length." + , "BASE must be between 2 and 16, or 64 to perform unpadded base64url conversion." + , "Each digit must be in the correct range for the base." + ] intToStrDef :: NativeDef intToStrDef = defRNative "int-to-str" intToStr (funType tTyString [("base",tTyInteger),("val",tTyInteger)]) ["(int-to-str 16 65535)","(int-to-str 64 43981)"] - "Represent integer VAL as a string in BASE. BASE can be 2-16, or 64 for unpadded base64URL. \ - \Only positive values are allowed for base64URL conversion." + ( T.unwords + [ "Represent integer VAL as a string in BASE. BASE can be 2-16, or 64 for unpadded base64URL." + , "Only positive values are allowed for base64URL conversion." + ] + ) where intToStr _ [b'@(TLitInteger base),v'@(TLitInteger v)] | base >= 2 && base <= 16 = @@ -318,9 +328,11 @@ intToStrDef = defRNative "int-to-str" intToStr hashDef :: NativeDef hashDef = defRNative "hash" hash' (funType tTyString [("value",a)]) ["(hash \"hello\")", "(hash { 'foo: 1 })"] - "Compute BLAKE2b 256-bit hash of VALUE represented in unpadded base64-url. \ - \Strings are converted directly while other values are \ - \converted using their JSON representation. Non-value-level arguments are not allowed." + $ T.unwords + [ "Compute BLAKE2b 256-bit hash of VALUE represented in unpadded base64-url." + , "Strings are converted directly while other values are" + , "converted using their JSON representation. Non-value-level arguments are not allowed." + ] where hash' :: RNativeFun e hash' i as = case as of @@ -445,8 +457,10 @@ describeNamespaceDef = setTopLevelOnly $ defGasRNative "describe-namespace" describeNamespace (funType (tTyObject dnTy) [("ns", tTyString)]) [LitExample "(describe-namespace 'my-namespace)"] - "Describe the namespace NS, returning a row object containing \ - \the user and admin guards of the namespace, as well as its name." + $ T.unwords + [ "Describe the namespace NS, returning a row object containing" + , "the user and admin guards of the namespace, as well as its name." + ] where dnTy = TyUser (snd describeNamespaceSchema) @@ -470,9 +484,11 @@ defineNamespaceDef :: NativeDef defineNamespaceDef = setTopLevelOnly $ defGasRNative "define-namespace" defineNamespace (funType tTyString [("namespace", tTyString), ("user-guard", tTyGuard Nothing), ("admin-guard", tTyGuard Nothing)]) [LitExample "(define-namespace 'my-namespace (read-keyset 'user-ks) (read-keyset 'admin-ks))"] - "Create a namespace called NAMESPACE where ownership and use of the namespace is controlled by GUARD. \ - \If NAMESPACE is already defined, then the guard previously defined in NAMESPACE will be enforced, \ - \and GUARD will be rotated in its place." + $ T.unwords + [ "Create a namespace called NAMESPACE where ownership and use of the namespace is controlled by GUARD." + , "If NAMESPACE is already defined, then the guard previously defined in NAMESPACE will be enforced," + , "and GUARD will be rotated in its place." + ] where defineNamespace :: GasRNativeFun e defineNamespace i as = case as of @@ -536,11 +552,13 @@ namespaceDef :: NativeDef namespaceDef = setTopLevelOnly $ defGasRNative "namespace" namespace (funType tTyString [("namespace", tTyString)]) [LitExample "(namespace 'my-namespace)"] - "Set the current namespace to NAMESPACE. All expressions that occur in a current \ - \transaction will be contained in NAMESPACE, and once committed, may be accessed \ - \via their fully qualified name, which will include the namespace. Subsequent \ - \namespace calls in the same tx will set a new namespace for all declarations \ - \until either the next namespace declaration, or the end of the tx." + $ T.unwords + [ "Set the current namespace to NAMESPACE. All expressions that occur in a current" + , "transaction will be contained in NAMESPACE, and once committed, may be accessed" + , "via their fully qualified name, which will include the namespace. Subsequent" + , "namespace calls in the same tx will set a new namespace for all declarations" + , "until either the next namespace declaration, or the end of the tx." + ] where namespace :: GasRNativeFun e namespace i as = case as of @@ -607,8 +625,10 @@ chainDataDef :: NativeDef chainDataDef = defRNative "chain-data" chainData (funType (tTyObject pcTy) []) ["(chain-data)"] - "Get transaction public metadata. Returns an object with 'chain-id', 'block-height', \ - \'block-time', 'prev-block-hash', 'sender', 'gas-limit', 'gas-price', and 'gas-fee' fields." + $ T.unwords + [ "Get transaction public metadata. Returns an object with 'chain-id', 'block-height'," + , "'block-time', 'prev-block-hash', 'sender', 'gas-limit', 'gas-price', and 'gas-fee' fields." + ] where pcTy = TyUser (snd chainDataSchema) chainData :: RNativeFun e @@ -653,16 +673,16 @@ enumerateDef = defGasRNative "enumerate" enumerate ["(enumerate 0 10 2)" , "(enumerate 0 10)" , "(enumerate 10 0)"] - $ T.intercalate " " - [ "Returns a sequence of numbers from FROM to TO (both inclusive) as a list." - , "INC is the increment between numbers in the sequence." - , "If INC is not given, it is assumed to be 1." - , "Additionally, if INC is not given and FROM is greater than TO assume a value for INC of -1." - , "If FROM equals TO, return the singleton list containing FROM, irrespective of INC's value." - , "If INC is equal to zero, this function will return the singleton list containing FROM." - , "If INC is such that FROM + INC > TO (when FROM < TO) or FROM + INC < TO (when FROM > TO) return the singleton list containing FROM." - , "Lastly, if INC is such that FROM + INC < TO (when FROM < TO) or FROM + INC > TO (when FROM > TO), then this function fails." - ] + $ T.unwords + [ "Returns a sequence of numbers from FROM to TO (both inclusive) as a list." + , "INC is the increment between numbers in the sequence." + , "If INC is not given, it is assumed to be 1." + , "Additionally, if INC is not given and FROM is greater than TO assume a value for INC of -1." + , "If FROM equals TO, return the singleton list containing FROM, irrespective of INC's value." + , "If INC is equal to zero, this function will return the singleton list containing FROM." + , "If INC is such that FROM + INC > TO (when FROM < TO) or FROM + INC < TO (when FROM > TO) return the singleton list containing FROM." + , "Lastly, if INC is such that FROM + INC < TO (when FROM < TO) or FROM + INC > TO (when FROM > TO), then this function fails." + ] reverseDef :: NativeDef reverseDef = defRNative "reverse" reverse' (funType (TyList a) [("list",TyList a)]) @@ -678,9 +698,10 @@ distinctDef :: NativeDef distinctDef = defGasRNative "distinct" distinct (funType (TyList a) [("values", TyList a)]) ["(distinct [3 3 1 1 2 2])"] - $ T.intercalate " " - [ "Returns from a homogeneous list of VALUES a list with duplicates removed." - , "The original order of the values is preserved."] + $ T.unwords + [ "Returns from a homogeneous list of VALUES a list with duplicates removed." + , "The original order of the values is preserved." + ] sortDef :: NativeDef sortDef = defGasRNative "sort" sort' @@ -756,10 +777,12 @@ isCharsetDef = , "(is-charset CHARSET_ASCII \"I am nÖt ascii\")" , "(is-charset CHARSET_LATIN1 \"I am nÖt ascii, but I am latin1!\")" ] - "Check that a string INPUT conforms to the a supported character set CHARSET. \ - \Character sets currently supported are: 'CHARSET_LATIN1' (ISO-8859-1), and \ - \'CHARSET_ASCII' (ASCII). Support for sets up through ISO 8859-5 supplement will be \ - \added in the future." + $ T.unwords + [ "Check that a string INPUT conforms to the a supported character set CHARSET." + , "Character sets currently supported are: 'CHARSET_LATIN1' (ISO-8859-1), and" + , "'CHARSET_ASCII' (ASCII). Support for sets up through ISO 8859-5 supplement will be" + , "added in the future." + ] where isCharset :: RNativeFun e isCharset i as = case as of @@ -809,9 +832,11 @@ langDefs = ,readStringDef ,defRNative "read-msg" readMsg (funType a [] <> funType a [("key",tTyString)]) [LitExample "(defun exec ()\n (transfer (read-msg \"from\") (read-msg \"to\") (read-decimal \"amount\")))"] - "Read KEY from top level of message data body, or data body itself if not provided. \ - \Coerces value to their corresponding pact type: String -> string, Number -> integer, Boolean -> bool, \ - \List -> list, Object -> object." + $ T.unwords + [ "Read KEY from top level of message data body, or data body itself if not provided." + , "Coerces value to their corresponding pact type: String -> string, Number -> integer, Boolean -> bool," + , "List -> list, Object -> object." + ] ,defRNative "tx-hash" txHash (funType tTyString []) ["(tx-hash)"] "Obtain hash of current transaction as a string." ,defNative (specialForm Bind) bind @@ -829,19 +854,25 @@ langDefs = [ LitExample "(yield { \"amount\": 100.0 })" , LitExample "(yield { \"amount\": 100.0 } \"some-chain-id\")" ] - "Yield OBJECT for use with 'resume' in following pact step. With optional argument TARGET-CHAIN, \ - \target subsequent step to execute on targeted chain using automated SPV endorsement-based dispatch." + $ T.unwords + [ "Yield OBJECT for use with 'resume' in following pact step. With optional argument TARGET-CHAIN," + , "target subsequent step to execute on targeted chain using automated SPV endorsement-based dispatch." + ] ,defNative (specialForm Resume) resume (funType a [("binding",TySchema TyBinding (mkSchemaVar "r") def)]) [] - "Special form binds to a yielded object value from the prior step execution in a pact. \ - \If yield step was executed on a foreign chain, enforce endorsement via SPV." + $ T.unwords + [ "Special form binds to a yielded object value from the prior step execution in a pact." + , "If yield step was executed on a foreign chain, enforce endorsement via SPV." + ] ,pactVersionDef ,setTopLevelOnly $ defRNative "enforce-pact-version" enforceVersion (funType tTyBool [("min-version",tTyString)] <> funType tTyBool [("min-version",tTyString),("max-version",tTyString)]) ["(enforce-pact-version \"2.3\")"] - "Enforce runtime pact version as greater than or equal MIN-VERSION, and less than or equal MAX-VERSION. \ - \Version values are matched numerically from the left, such that '2', '2.2', and '2.2.3' would all allow '2.2.3'." + $ T.unwords + [ "Enforce runtime pact version as greater than or equal MIN-VERSION, and less than or equal MAX-VERSION." + , "Version values are matched numerically from the left, such that '2', '2.2', and '2.2.3' would all allow '2.2.3'." + ] ,defRNative "contains" contains (funType tTyBool [("value",a),("list",TyList a)] <> funType tTyBool [("key",a),("object",tTyObject (mkSchemaVar "o"))] <> diff --git a/src/Pact/PersistPactDb/Regression.hs b/src/Pact/PersistPactDb/Regression.hs index 91f3fe45d..d9ad2ac06 100644 --- a/src/Pact/PersistPactDb/Regression.hs +++ b/src/Pact/PersistPactDb/Regression.hs @@ -13,6 +13,7 @@ import Control.Lens hiding ((.=)) import Control.DeepSeq import Data.Text(pack) import Data.Foldable(for_) +import Data.List.Unsafe import qualified Data.Map.Strict as M import qualified Data.HashMap.Strict as HM @@ -115,7 +116,7 @@ runRegression p = do assertEquals' "user txlogs" [TxLog "USER_user1" "key1" row, TxLog "USER_user1" "key1" row'] $ - _getTxLog pactdb usert (head tids) v + _getTxLog pactdb usert (unsafeHead tids) v _writeRow pactdb Insert usert "key2" row v assertEquals' "user insert key2 pre-rollback" (Just row) (_readRow pactdb usert "key2" v) assertEquals' "keys pre-rollback" ["key1","key2"] $ _keys pactdb (UserTables user1) v diff --git a/src/Pact/Server/ApiServer.hs b/src/Pact/Server/ApiServer.hs index af5fefa65..5d936fb99 100644 --- a/src/Pact/Server/ApiServer.hs +++ b/src/Pact/Server/ApiServer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} @@ -35,6 +36,9 @@ import Control.Monad.Trans.Except import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as BSL8 +#if MIN_VERSION_base(4,19,0) +import Data.Functor as F +#endif import Data.List.NonEmpty (NonEmpty(..), (<|)) import qualified Data.List.NonEmpty as NEL import Data.Semigroup.Foldable (fold1) @@ -211,4 +215,9 @@ queueCmds rpcs = do liftIO . writeHistory hc . AddNew $ NEL.toList cmds return rks where +#if MIN_VERSION_base(4,19,0) + (rks, cmds) = F.unzip rpcs +#else (rks, cmds) = NEL.unzip rpcs +#endif + diff --git a/src/Pact/Server/History/Persistence.hs b/src/Pact/Server/History/Persistence.hs index 5bc6295c2..2861ad24a 100644 --- a/src/Pact/Server/History/Persistence.hs +++ b/src/Pact/Server/History/Persistence.hs @@ -21,6 +21,7 @@ import Data.Text.Encoding (encodeUtf8) import Data.ByteString (ByteString) import Data.List (sortBy) +import Data.List.Unsafe (unsafeHead) import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.HashMap.Strict (HashMap) @@ -148,7 +149,7 @@ selectCompletedCommands e v = foldM f HashMap.empty v rs <- qrys (_qryCompletedStmt e) [hashToField $ unRequestKey rk] [RText,RInt,RInt] if null rs then return m - else case head rs of + else case unsafeHead rs of [SText (Utf8 cr),SInt _, SInt _] -> return $ HashMap.insert rk (crFromField cr) m r -> dbError $ "Invalid result from query: " ++ show r diff --git a/tests/GasModelSpec.hs b/tests/GasModelSpec.hs index 9d8c0c9ad..951d187a5 100644 --- a/tests/GasModelSpec.hs +++ b/tests/GasModelSpec.hs @@ -28,7 +28,11 @@ import Data.Aeson import Data.Bifunctor (first) import Data.IORef import Data.Int (Int64) +#if MIN_VERSION_base(4,20,0) +import Data.List (sortOn) +#else import Data.List (foldl', sortOn) +#endif import Test.QuickCheck import Test.QuickCheck.Gen (Gen(..)) import Test.QuickCheck.Random (mkQCGen) diff --git a/tests/ZkSpec.hs b/tests/ZkSpec.hs index 03a0429fa..ba9783e6c 100644 --- a/tests/ZkSpec.hs +++ b/tests/ZkSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -6,7 +7,10 @@ module ZkSpec (spec) where import Data.Group (pow) import Data.Field(Field) +#if !MIN_VERSION_base(4,20,0) import Data.Foldable(foldl') +#endif +import Data.List.Unsafe import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range @@ -316,7 +320,7 @@ verify :: [Integer] -> Proof -> Bool verify inp p = let initial = CurveInf vk_x = foldl' (\pt (i, kpt) -> add pt (multiply kpt i)) initial (zip inp (drop 1 (_ic solVerifyingKey))) - vk_x' = add vk_x (head (_ic solVerifyingKey)) + vk_x' = add vk_x (unsafeHead (_ic solVerifyingKey)) in pairingCheck [ (negatePt (_proofA p), _proofB p) , (_alfa1 solVerifyingKey, _beta2 solVerifyingKey)