Edmund/continue poseidon (#1313)

* add poseidon-hash * add poseidon-hash * add poseidon-hash * Performance and readability Co-authored-by: chessai <[email protected]> * reformat * Renames * Complete gas model * Fix tests * disable poseidon hash before pact 4.10 * Address review * remove redundant TODO * Comment constants and hexify them to match the original --------- Co-authored-by: Davi Bauer <[email protected]> Co-authored-by: chessai <[email protected]>
kadena-io · Nov 13, 2023 · 422cec4 · 422cec4
1 parent 9d8d097
commit 422cec4
Show file tree

Hide file tree

Showing 15 changed files with 3,368 additions and 13 deletions.
diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md
@@ -1785,6 +1785,25 @@ pact> (scalar-mult 'g1 {'x: 1, 'y: 2} 2)
 {"x": 1368015179489954701390400359078579693043519447331113978918064868415326638035,"y": 9918110051302171585080402603319702774565515993150576347155970296011118125764}
 ```
 
+## Poseidon Hash {#Poseidon Hash}
+
+### poseidon-hash-hack-a-chain {#poseidon-hash-hack-a-chain}
+
+*i*&nbsp;`integer` *j*&nbsp;`integer` *k*&nbsp;`integer` *l*&nbsp;`integer` *m*&nbsp;`integer` *n*&nbsp;`integer` *o*&nbsp;`integer` *p*&nbsp;`integer` *&rarr;*&nbsp;`integer`
+
+
+Poseidon Hash Function. Note: This is a reference version of the Poseidon hash function used by Hack-a-Chain.
+```lisp
+pact> (poseidon-hash-hack-a-chain 1)
+18586133768512220936620570745912940619677854269274689475585506675881198879027
+pact> (poseidon-hash-hack-a-chain 1 2)
+7853200120776062878684798364095072458815029376092732009249414926327459813530
+pact> (poseidon-hash-hack-a-chain 1 2 3 4 5 6)
+20400040500897583745843009878988256314335038853985262692600694741116813247201
+pact> (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8)
+18604317144381847857886385684060986177838410221561136253933256952257712543953
+```
+
 ## REPL-only functions {#repl-lib}
 
 The following functions are loaded automatically into the interactive REPL, or within script files with a `.repl` extension. They are not available for blockchain-based execution.
@@ -1928,7 +1947,7 @@ Retreive any accumulated events and optionally clear event state. Object returne
  *&rarr;*&nbsp;`[string]`
 
 
-Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePact49","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
+Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact410","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePact49","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
 ```lisp
 pact> (env-exec-config ['DisableHistoryInTransactionalMode]) (env-exec-config)
 ["DisableHistoryInTransactionalMode"]

diff --git a/golden/gas-model/golden b/golden/gas-model/golden
@@ -799,6 +799,10 @@
   - 3
 - - (/ smallNumber.0 smallNumber)
   - 3
+- - |-
+    (poseidon-hash-hack-a-chain 1 2)
+    (poseidon-hash-hack-a-chain 999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999 88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888)
+  - 752
 - - (enforce-pact-version "3.0")
   - 1
 - - |-

diff --git a/pact.cabal b/pact.cabal
@@ -96,6 +96,7 @@ library
     cbits/musl/sqrt_data.c
   exposed-modules:
     Crypto.Hash.Blake2Native
+    Crypto.Hash.PoseidonNative
     Pact.Analyze.Remote.Types
     Pact.ApiReq
     Pact.Compile
@@ -231,6 +232,7 @@ library
     , pact-time >=0.2
     , parsers >=0.12.4
     , poly >=0.5.0
+    , primitive >=0.8
     , quickcheck-instances >=0.3
     , reflection
     , safe-exceptions
@@ -465,6 +467,7 @@ test-suite hspec
       HistoryServiceSpec
       PactContinuationSpec
       PersistSpec
+      PoseidonSpec
       RemoteVerifySpec
       TypecheckSpec
       PactCLISpec

diff --git a/src/Crypto/Hash/PoseidonNative.hs b/src/Crypto/Hash/PoseidonNative.hs
diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs
@@ -53,6 +53,8 @@ data GasCostConfig = GasCostConfig
   , _gasCostConfig_principalCost :: Gas
   , _gasCostConfig_reverseElemsPerGas :: Gas
   , _gasCostConfig_formatBytesPerGas :: Gas
+  , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor :: Gas
+  , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas
   }
 
 defaultGasConfig :: GasCostConfig
@@ -77,6 +79,8 @@ defaultGasConfig = GasCostConfig
   , _gasCostConfig_principalCost = 5 -- matches 'hash' cost
   , _gasCostConfig_reverseElemsPerGas = 100
   , _gasCostConfig_formatBytesPerGas = 10
+  , _gasCostConfig_poseidonHashHackAChainLinearGasFactor = 50
+  , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38
   }
 
 defaultGasTable :: Map Text Gas
@@ -229,6 +233,8 @@ defaultGasTable =
   ,("scalar-mult", 1)
   ,("point-add", 1)
   ,("pairing-check", 1)
+
+  ,("poseidon-hash-hack-a-chain", 124)
   ]
 
 {-# NOINLINE defaultGasTable #-}
@@ -319,6 +325,10 @@ tableGasModel gasConfig =
         GFormatValues s args ->
           let totalBytesEstimate = estimateFormatText s + estimateFormatValues args
           in gasToMilliGas $ fromIntegral totalBytesEstimate `quot` _gasCostConfig_formatBytesPerGas gasConfig
+        GPoseidonHashHackAChain len ->
+          gasToMilliGas $
+            _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor gasConfig * fromIntegral (len * len) +
+            _gasCostConfig_poseidonHashHackAChainLinearGasFactor gasConfig * fromIntegral len
 
   in GasModel
       { gasModelName = "table"

diff --git a/src/Pact/GasModel/GasTests.hs b/src/Pact/GasModel/GasTests.hs
@@ -221,6 +221,7 @@ allTests = HM.fromList
     , ("point-add", pointAddTests)
     , ("scalar-mult", scalarMulTests)
     , ("pairing-check", pairingCheckTests)
+    , ("poseidon-hash-hack-a-chain", poseidonHashTests)
 
       -- Non-native concepts to benchmark
     , ("use", useTests)
@@ -2000,3 +2001,11 @@ pairingCheckTests = defGasUnitTests allExprs
     , 'y: [8495653923123431417604973247489272438418190587263600148770280649306958101930, 4082367875863433681332203403145435568316851327593401208105741076214120093531]}]
     )|]
   allExprs = fmap defPactExpression [pairingCheck]
+
+poseidonHashTests:: NativeDefName -> GasUnitTests
+poseidonHashTests = defGasUnitTest $ PactExpression poseidonHashExprText Nothing
+  where
+    poseidonHashExprText = [text|
+    (poseidon-hash-hack-a-chain 1 2)
+    (poseidon-hash-hack-a-chain 999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999 88888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888888)
+    |]
diff --git a/src/Pact/Interpreter.hs b/src/Pact/Interpreter.hs
@@ -242,6 +242,9 @@ disablePact46Natives = disablePactNatives pact46Natives FlagDisablePact46
 disablePact47Natives :: ExecutionConfig -> Endo RefStore
 disablePact47Natives = disablePactNatives pact47Natives FlagDisablePact47
 
+disablePact410Natives :: ExecutionConfig -> Endo RefStore
+disablePact410Natives = disablePactNatives pact410Natives FlagDisablePact410
+
 pact40Natives :: [Text]
 pact40Natives = ["enumerate" , "distinct" , "emit-event" , "concat" , "str-to-list"]
 
@@ -260,6 +263,9 @@ pact46Natives = ["point-add", "scalar-mult", "pairing-check"]
 pact47Natives :: [Text]
 pact47Natives = ["dec"]
 
+pact410Natives :: [Text]
+pact410Natives = ["poseidon-hash-hack-a-chain"]
+
 initRefStore :: RefStore
 initRefStore = RefStore nativeDefs
 
@@ -272,7 +278,9 @@ versionedNativesRefStore ec = versionNatives initRefStore
     , disablePact43Natives ec
     , disablePact431Natives ec
     , disablePact46Natives ec
-    , disablePact47Natives ec]
+    , disablePact47Natives ec
+    , disablePact410Natives ec
+    ]
 
 mkSQLiteEnv :: Logger -> Bool -> PSL.SQLiteConfig -> Loggers -> IO (PactDbEnv (DbEnv PSL.SQLite))
 mkSQLiteEnv initLog deleteOldFile c loggers = do

diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs
@@ -106,6 +106,7 @@ import Pact.Types.Purity
 import Pact.Types.Runtime
 import Pact.Types.Version
 import Pact.Types.Namespace
+import Crypto.Hash.PoseidonNative (poseidon)
 
 import qualified Pact.JSON.Encode as J
 
@@ -122,6 +123,7 @@ natives =
   , decryptDefs
   , guardDefs
   , zkDefs
+  , poseidonHackAChainDefs
   ]
 
 
@@ -1543,3 +1545,26 @@ base64DecodeWithShimmedErrors i txt = do
         return $ offsetI - (offsetI `rem` 4) + paddingAdjustment
       Nothing ->
         evalError i "Could not parse error message"
+
+poseidonHackAChainDefs :: NativeModule
+poseidonHackAChainDefs = ("Poseidon Hash", [ poseidonHackAChainDef ])
+
+poseidonHackAChainDef :: NativeDef
+poseidonHackAChainDef = defGasRNative
+  "poseidon-hash-hack-a-chain"
+  poseidon'
+  (funType tTyInteger [("i", tTyInteger), ("j", tTyInteger), ("k", tTyInteger), ("l", tTyInteger), ("m", tTyInteger), ("n", tTyInteger), ("o", tTyInteger), ("p", tTyInteger)])
+    ["(poseidon-hash-hack-a-chain 1)"
+    ,"(poseidon-hash-hack-a-chain 1 2)"
+    ,"(poseidon-hash-hack-a-chain 1 2 3 4 5 6)"
+    ,"(poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8)"
+    ]
+    "Poseidon Hash Function. Note: This is a reference version of the Poseidon hash function used by Hack-a-Chain."
+  where
+  poseidon' :: RNativeFun e
+  poseidon' i as
+    | not (null as) && length as <= 8,
+      Just intArgs <- traverse (preview _TLitInteger) as
+      = computeGas' i (GPoseidonHashHackAChain $ length as) $
+        return $ toTerm $ poseidon intArgs
+     | otherwise = argsError i as
diff --git a/src/Pact/Native/Pairing.hs b/src/Pact/Native/Pairing.hs
@@ -700,8 +700,8 @@ pairingCheckDef =
 toG1 :: HasInfo i => i -> Object Name -> Eval e G1
 toG1 i obj = maybe (evalError' i "unable to decode point in g1") pure $ do
   let om = _objectMap (_oObject obj)
-  px <- fromIntegral <$> preview (ix "x" . _TLiteral . _1 . _LInteger) om
-  py <- fromIntegral <$> preview (ix "y" . _TLiteral . _1 . _LInteger) om
+  px <- fromIntegral <$> preview (ix "x" . _TLitInteger) om
+  py <- fromIntegral <$> preview (ix "y" . _TLitInteger) om
   if px == 0 && py == 0 then pure CurveInf
   else pure (Point px py)
 
@@ -723,9 +723,9 @@ toG2 ::  HasInfo i => i -> Object Name -> Eval e G2
 toG2 i obj = maybe (evalError' i "unable to decode point in g2") pure $ do
   let om = _objectMap (_oObject obj)
   pxl <- preview (ix "x" . _TList . _1 ) om
-  px <- traverse (preview (_TLiteral . _1 . _LInteger . to fromIntegral)) pxl
+  px <- traverse (preview (_TLitInteger . to fromIntegral)) pxl
   pyl <- preview (ix "y" . _TList . _1) om
-  py <- traverse (preview (_TLiteral . _1 . _LInteger . to fromIntegral)) pyl
+  py <- traverse (preview (_TLitInteger . to fromIntegral)) pyl
   let px' = fromList (G.toList px)
       py' = fromList (G.toList py)
   if px' == 0 && py' == 0 then pure CurveInf

diff --git a/src/Pact/Types/Gas.hs b/src/Pact/Types/Gas.hs
@@ -178,6 +178,8 @@ data GasArgs
   -- ^ Cost of reversing a list of a given length
   | GFormatValues !Text !(V.Vector PactValue)
   -- ^ Cost of formatting with the given format string and args
+  | GPoseidonHashHackAChain !Int
+  -- ^ Cost of the hack-a-chain poseidon hash on this given number of inputs
 
 data IntOpThreshold
   = Pact43IntThreshold
@@ -245,6 +247,7 @@ instance Pretty GasArgs where
     GZKArgs arg -> "GZKArgs:" <> pretty arg
     GReverse len -> "GReverse:" <> pretty len
     GFormatValues s args -> "GFormatValues:" <> pretty s <> pretty (V.toList args)
+    GPoseidonHashHackAChain len -> "GPoseidonHashHackAChain:" <> pretty len
 
 newtype GasLimit = GasLimit ParsedInteger
   deriving (Eq,Ord,Generic)

diff --git a/src/Pact/Types/Runtime.hs b/src/Pact/Types/Runtime.hs
@@ -200,6 +200,8 @@ data ExecutionFlag
   | FlagDisablePact48
   -- | Disable Pact 4.9 Features
   | FlagDisablePact49
+  -- | Disable Pact 4.10 Features
+  | FlagDisablePact410
   deriving (Eq,Ord,Show,Enum,Bounded)
 
 -- | Flag string representation

diff --git a/src/Pact/Types/Term.hs b/src/Pact/Types/Term.hs
@@ -88,6 +88,7 @@ module Pact.Types.Term
    typeof,typeof',guardTypeOf,
    canUnifyWith,
    prettyTypeTerm,
+   _TLitString,_TLitInteger,_TLitBool,
    pattern TLitString,pattern TLitInteger,pattern TLitBool,
    tLit,tStr,termEq,termEq1,termRefEq,canEq,refEq,
    Gas(..), MilliGas(..),
@@ -1026,7 +1027,6 @@ pattern TLitInteger i <- TLiteral (LInteger i) _
 pattern TLitBool :: Bool -> Term t
 pattern TLitBool b <- TLiteral (LBool b) _
 
-
 -- | Equality dictionary for term-level equality
 --
 canEq :: Term n -> Term n -> Bool
@@ -1084,11 +1084,12 @@ makeLenses ''Object
 makeLenses ''Term
 makePrisms ''Term
 
--- This noop TH splice is required to ensure that all types that are defined
--- above in this module are available in the type environment of the following
--- TH splices.
---
-return []
+_TLitString :: Traversal' (Term t) Text
+_TLitString = _TLiteral . _1 . _LString
+_TLitInteger :: Traversal' (Term t) Integer
+_TLitInteger = _TLiteral . _1 . _LInteger
+_TLitBool :: Traversal' (Term t) Bool
+_TLitBool = _TLiteral . _1 . _LBool
 
 -- -------------------------------------------------------------------------- --
 -- Eq1 Instances
@@ -1113,4 +1114,3 @@ instance Show1 Object where
   liftShowsPrec = $(makeLiftShowsPrec ''Object)
 instance Show1 Term where
   liftShowsPrec = $(makeLiftShowsPrec ''Term)
-
diff --git a/tests/PactTests.hs b/tests/PactTests.hs
@@ -31,6 +31,7 @@ import qualified TypecheckSpec
 import qualified PactCLISpec
 import qualified ZkSpec
 import qualified ReplSpec
+import qualified PoseidonSpec
 import qualified CoverageSpec
 #endif
 
@@ -66,6 +67,7 @@ main = hspec $ parallel $ do
   describe "PactCLISpec" PactCLISpec.spec
   describe "ZkSpec" ZkSpec.spec
   describe "ReplSpec" ReplSpec.spec
+  describe "PoseidonSpec" PoseidonSpec.spec
   describe "CoverageSpec" CoverageSpec.spec
 
 #endif
diff --git a/tests/PoseidonSpec.hs b/tests/PoseidonSpec.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+
+module PoseidonSpec (spec) where
+
+import Test.Hspec
+import Crypto.Hash.PoseidonNative
+
+spec :: Spec
+spec = describe "poseidon" $ do
+  describe "poseidon-hash" $ do
+    it "computes the poseidon hash for two integers" $ do
+      poseidon [1] `shouldBe` 18586133768512220936620570745912940619677854269274689475585506675881198879027
+      poseidon [1, 2] `shouldBe` 7853200120776062878684798364095072458815029376092732009249414926327459813530
+      poseidon [1, 2, 3] `shouldBe` 6542985608222806190361240322586112750744169038454362455181422643027100751666
+      poseidon [1, 2, 3, 4] `shouldBe` 18821383157269793795438455681495246036402687001665670618754263018637548127333
+      poseidon [1, 2, 3, 4, 5] `shouldBe` 6183221330272524995739186171720101788151706631170188140075976616310159254464
+      poseidon [1, 2, 3, 4, 5, 6] `shouldBe` 20400040500897583745843009878988256314335038853985262692600694741116813247201
+      poseidon [1, 2, 3, 4, 5, 6, 7] `shouldBe` 12748163991115452309045839028154629052133952896122405799815156419278439301912
+      poseidon [1, 2, 3, 4, 5, 6, 7, 8] `shouldBe` 18604317144381847857886385684060986177838410221561136253933256952257712543953
diff --git a/tests/pact/poseidon-hash.repl b/tests/pact/poseidon-hash.repl
@@ -0,0 +1,10 @@
+;; Test poseidon-hash
+
+(expect "1 should equal 18586133768512220936620570745912940619677854269274689475585506675881198879027" 18586133768512220936620570745912940619677854269274689475585506675881198879027 (poseidon-hash-hack-a-chain 1))
+(expect "1 2 should equal 7853200120776062878684798364095072458815029376092732009249414926327459813530" 7853200120776062878684798364095072458815029376092732009249414926327459813530 (poseidon-hash-hack-a-chain 1 2))
+(expect "1 2 3 should equal 6542985608222806190361240322586112750744169038454362455181422643027100751666" 6542985608222806190361240322586112750744169038454362455181422643027100751666 (poseidon-hash-hack-a-chain 1 2 3))
+(expect "1 2 3 4 should equal 18821383157269793795438455681495246036402687001665670618754263018637548127333" 18821383157269793795438455681495246036402687001665670618754263018637548127333 (poseidon-hash-hack-a-chain 1 2 3 4))
+(expect "1 2 3 4 5 should equal 6183221330272524995739186171720101788151706631170188140075976616310159254464" 6183221330272524995739186171720101788151706631170188140075976616310159254464 (poseidon-hash-hack-a-chain 1 2 3 4 5))
+(expect "1 2 3 4 5 6 should equal 20400040500897583745843009878988256314335038853985262692600694741116813247201" 20400040500897583745843009878988256314335038853985262692600694741116813247201 (poseidon-hash-hack-a-chain 1 2 3 4 5 6))
+(expect "1 2 3 4 5 6 7 should equal 12748163991115452309045839028154629052133952896122405799815156419278439301912" 12748163991115452309045839028154629052133952896122405799815156419278439301912 (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7))
+(expect "1 2 3 4 5 6 7 8 should equal 18604317144381847857886385684060986177838410221561136253933256952257712543953" 18604317144381847857886385684060986177838410221561136253933256952257712543953 (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8))