diff --git a/cabal.project b/cabal.project index 1608b5e1d..c85b1b765 100644 --- a/cabal.project +++ b/cabal.project @@ -24,6 +24,7 @@ if os(darwin) package pact ghc-options: -Wno-missed-extra-shared-lib + flags: -with-crypto source-repository-package type: git diff --git a/pact.cabal b/pact.cabal index 841c44308..0669290ae 100644 --- a/pact.cabal +++ b/pact.cabal @@ -42,6 +42,11 @@ flag tests-in-lib default: False manual: True +flag with-crypto + description: Enable crypto primitives + manual: True + default: True + -- -------------------------------------------------------------------------- -- -- Internal: prettyprinter-1.6.0 and prettyprinter-ansi-terminal-1.1.2 @@ -94,6 +99,12 @@ library cbits/musl/pow_data.c cbits/musl/sqrt.c cbits/musl/sqrt_data.c + + if flag(with-crypto) + build-depends: poly >=0.5.0 + else + cpp-options: -DWITHOUT_CRYPTO + exposed-modules: Crypto.Hash.Blake2Native Crypto.Hash.Keccak256Native @@ -237,7 +248,6 @@ library , pact-json >=0.1 , pact-time >=0.2 , parsers >=0.12.4 - , poly >=0.5.0 , primitive >=0.8 , quickcheck-instances >=0.3 , reflection diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 15ba79a18..3e7f3505d 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -9,6 +9,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE CPP #-} -- | -- Module : Pact.Native -- Copyright : (C) 2016 Stuart Popejoy @@ -106,7 +107,9 @@ import Pact.Native.Keysets import Pact.Native.Ops import Pact.Native.SPV import Pact.Native.Time +#ifndef WITHOUT_CRYPTO import Pact.Native.Pairing(zkDefs) +#endif import Pact.Parse import Pact.Runtime.Utils(lookupFreeVar) import Pact.Types.Hash @@ -136,7 +139,9 @@ natives = , spvDefs , decryptDefs , guardDefs +#ifndef WITHOUT_CRYPTO , zkDefs +#endif , hashDefs , hyperlaneDefs ] @@ -226,8 +231,7 @@ 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 \ @@ -302,17 +306,13 @@ 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." + "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." + "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 = @@ -327,9 +327,7 @@ 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." + "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 @@ -454,8 +452,7 @@ 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." + "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) @@ -479,9 +476,7 @@ 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." + "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 @@ -545,11 +540,7 @@ 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." + "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 @@ -616,8 +607,7 @@ 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." + "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 @@ -765,10 +755,7 @@ 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." + "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 @@ -818,9 +805,7 @@ 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." + "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 @@ -838,19 +823,16 @@ 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." + "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." + "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'." + "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/Native/Pairing.hs b/src/Pact/Native/Pairing.hs index 2ede0ed7a..67b255c88 100644 --- a/src/Pact/Native/Pairing.hs +++ b/src/Pact/Native/Pairing.hs @@ -18,9 +18,16 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} +#ifdef WITHOUT_CRYPTO + +module Pact.Native.Pairing where + +#else + module Pact.Native.Pairing ( pairing , CurvePoint(..) @@ -749,3 +756,5 @@ fromG2 (Point x y) = Object pts TyAny Nothing def HM.fromList [ ("x", x') , ("y", y')] + +#endif \ No newline at end of file