wip

kadena-io · Oct 11, 2023 · 3c67f2b · 3c67f2b
2 parents 18bfcef + ea25849
commit 3c67f2b
Show file tree

Hide file tree

Showing 32 changed files with 1,581 additions and 649 deletions.
diff --git a/pact-core-tests/Pact/Core/Test/LexerParserTests.hs b/pact-core-tests/Pact/Core/Test/LexerParserTests.hs
@@ -110,6 +110,15 @@ parsedNameGen = Gen.choice [qn, bn]
       mn   <- moduleNameGen
       let qname = QualifiedName name mn
       pure (QN qname)
+parsedTyNameGen :: Gen ParsedTyName
+parsedTyNameGen = Gen.choice [qn, bn]
+  where
+    bn = TBN . BareName <$> identGen
+    qn = do
+      name <- identGen
+      mn   <- moduleNameGen
+      let qname = QualifiedName name mn
+      pure (TQN qname)
 
 moduleNameGen :: Gen ModuleName
 moduleNameGen = do
@@ -175,7 +184,7 @@ exprGen = Gen.recursive Gen.choice
       ,Lisp.TyModRef <$> moduleNameGen
       ,pure Lisp.TyGuard
       ,pure Lisp.TyKeyset
-      ,Lisp.TyObject <$> parsedNameGen
+      ,Lisp.TyObject <$> parsedTyNameGen
       ,pure Lisp.TyTime
       ,pure Lisp.TyPolyObject]
 

diff --git a/pact-core-tests/Pact/Core/Test/ReplTests.hs b/pact-core-tests/Pact/Core/Test/ReplTests.hs
@@ -5,6 +5,7 @@ import Test.Tasty.HUnit
 
 import Control.Monad(when)
 import Data.IORef
+import Data.Default
 import Data.ByteString(ByteString)
 import Data.Foldable(traverse_)
 import Data.Text.Encoding(decodeUtf8)
@@ -23,6 +24,8 @@ import Pact.Core.Repl.Utils
 import Pact.Core.Compile
 import Pact.Core.Repl.Compile
 import Pact.Core.PactValue
+import Pact.Core.Environment
+import Pact.Core.Hash
 import Pact.Core.Errors (PactError(..), EvalError (..))
 
 tests :: IO TestTree
@@ -46,13 +49,16 @@ runReplTest file src = do
   gasRef <- newIORef (Gas 0)
   gasLog <- newIORef Nothing
   pdb <- mockPactDb
+  let ee = EvalEnv mempty pdb (EnvData mempty) (Hash "default") def
   let rstate = ReplState
             { _replFlags =  mempty
-            , _replLoaded = mempty
+            , _replEvalState = def
             , _replPactDb = pdb
             , _replGas = gasRef
             , _replEvalLog = gasLog
-            , _replCurrSource = SourceCode mempty}
+            , _replCurrSource = SourceCode mempty
+            , _replEvalEnv = ee
+            }
   stateRef <- newIORef rstate
   runReplT stateRef (interpretReplProgram (SourceCode src)) >>= \case
     Left e -> let

diff --git a/pact-core-tests/pact-tests/lists.repl b/pact-core-tests/pact-tests/lists.repl
@@ -81,20 +81,20 @@
 
 ; distinct tests
 
-;  (expect
-;      "distinct: remove duplicates"
-;      [1 2 3]
-;      (distinct [1 1 2 2 3 3]))
-
-;  (expect
-;      "distinct: preserve original order"
-;      [3 1 2]
-;      (distinct [3 1 3 2 2 1 3]))
-
-;  (expect
-;      "distinct: work on empty list"
-;      []
-;      (distinct []))
+(expect
+    "distinct: remove duplicates"
+    [1 2 3]
+    (distinct [1 1 2 2 3 3]))
+
+(expect
+    "distinct: preserve original order"
+    [3 1 2]
+    (distinct [3 1 3 2 2 1 3]))
+
+(expect
+    "distinct: work on empty list"
+    []
+    (distinct []))
 
 (expect
   "zip combines properly"

diff --git a/pact-core-tests/pact-tests/ops.repl b/pact-core-tests/pact-tests/ops.repl
@@ -441,31 +441,31 @@
 (expect "not != object object" false (!= { "a": 1 } { "a": 1 }))
 (expect "!= object object" true (!= { "a": 1 } { "a": 1, "b": 2 }))
 
-;  "===== keyset equality"
-;  (env-data { "k1": ["k1"], "k2": ["k2"] })
-;  (expect "= keyset keyset" true (= (read-keyset "k1") (read-keyset "k1")))
-;  (expect "not = keyset keyset" false (= (read-keyset "k1") (read-keyset "k2")))
-;  (expect "not != keyset keyset" false (!= (read-keyset "k1") (read-keyset "k1")))
-;  (expect "!= keyset keyset" true (!= (read-keyset "k1") (read-keyset "k2")))
-
-;  "===== keyset ref equality"
+"===== keyset equality"
+(env-data { "k1": ["k1"], "k2": ["k2"] })
+(expect "= keyset keyset" true (= (read-keyset "k1") (read-keyset "k1")))
+(expect "not = keyset keyset" false (= (read-keyset "k1") (read-keyset "k2")))
+(expect "not != keyset keyset" false (!= (read-keyset "k1") (read-keyset "k1")))
+(expect "!= keyset keyset" true (!= (read-keyset "k1") (read-keyset "k2")))
+
+"===== keyset ref equality"
 ;  (env-exec-config ["DisablePact44"])
-;  (env-data { "k1": ["k1"], "k2": ["k2"] })
-;  (env-keys ["k1" "k2"])
-;  (define-keyset 'k1 (read-keyset "k1"))
-;  (define-keyset 'k2 (read-keyset "k2"))
-;  (expect "= keysetRef keysetRef" true (= (keyset-ref-guard "k1") (keyset-ref-guard "k1")))
-;  (expect "not = keysetRef keysetRef" false (= (keyset-ref-guard "k1") (keyset-ref-guard "k2")))
-;  (expect "not != keysetRef keysetRef" false (!= (keyset-ref-guard "k1") (keyset-ref-guard "k1")))
-;  (expect "!= keysetRef keysetRef" true (!= (keyset-ref-guard "k1") (keyset-ref-guard "k2")))
-
-;  (module tm G
-;    (defcap G () true)
-;    (defun mk (id) (create-module-guard id))
-;    (defpact p (id1 id2)
-;      (step [(create-pact-guard id1) (create-pact-guard id2)]))
-;    (defun ug (id) true)
-;    )
+(env-data { "k1": ["k1"], "k2": ["k2"] })
+(env-keys ["k1" "k2"])
+(define-keyset 'k1 (read-keyset "k1"))
+(define-keyset 'k2 (read-keyset "k2"))
+(expect "= keysetRef keysetRef" true (= (keyset-ref-guard "k1") (keyset-ref-guard "k1")))
+(expect "not = keysetRef keysetRef" false (= (keyset-ref-guard "k1") (keyset-ref-guard "k2")))
+(expect "not != keysetRef keysetRef" false (!= (keyset-ref-guard "k1") (keyset-ref-guard "k1")))
+(expect "!= keysetRef keysetRef" true (!= (keyset-ref-guard "k1") (keyset-ref-guard "k2")))
+
+(module tm G
+  (defcap G () true)
+  ;  (defun mk (id) (create-module-guard id))
+  ;  (defpact p (id1 id2)
+  ;    (step [(create-pact-guard id1) (create-pact-guard id2)]))
+  (defun ug (id) true)
+  )
 
 ;  "===== module guard equality"
 ;  (expect "= moduleGuard moduleGuard" true (= (tm.mk "1") (tm.mk "1")))
@@ -483,11 +483,11 @@
 ;    )
 
 
-;  "===== userGuard equality"
-;  (expect "= userGuard userGuard" true (= (create-user-guard (tm.ug "1")) (create-user-guard (tm.ug "1"))))
-;  (expect "not = userGuard userGuard" false (= (create-user-guard (tm.ug "2")) (create-user-guard (tm.ug "1"))))
-;  (expect "not != userGuard userGuard" false (!= (create-user-guard (tm.ug "1")) (create-user-guard (tm.ug "1"))))
-;  (expect "!= userGuard userGuard" true (!= (create-user-guard (tm.ug "2")) (create-user-guard (tm.ug "1"))))
+"===== userGuard equality"
+(expect "= userGuard userGuard" true (= (create-user-guard (tm.ug "1")) (create-user-guard (tm.ug "1"))))
+(expect "not = userGuard userGuard" false (= (create-user-guard (tm.ug "2")) (create-user-guard (tm.ug "1"))))
+(expect "not != userGuard userGuard" false (!= (create-user-guard (tm.ug "1")) (create-user-guard (tm.ug "1"))))
+(expect "!= userGuard userGuard" true (!= (create-user-guard (tm.ug "2")) (create-user-guard (tm.ug "1"))))
 
 
 "===== bitwise"

diff --git a/pact-core/Pact/Core/Builtin.hs b/pact-core/Pact/Core/Builtin.hs
@@ -197,24 +197,23 @@ data RawBuiltin
   | RawMap
   | RawFilter
   | RawZip
-  -- | RawIf
   | RawIntToStr
   | RawStrToInt
+  | RawStrToIntBase
   | RawFold
   | RawDistinct
   | RawEnforce
   | RawEnforceOne
   | RawEnumerate
   | RawEnumerateStepN
-  -- Show
+  -- Guards + read functions
   | RawShow
   | RawReadInteger
   | RawReadDecimal
   | RawReadString
   | RawReadKeyset
   | RawEnforceGuard
   | RawKeysetRefGuard
-  -- | RawCreateUserGuard
   | RawAt
   | RawMakeList
   | RawB64Encode
@@ -223,11 +222,19 @@ data RawBuiltin
   | RawYield
   | RawResume
   | RawBind
+  | RawRequireCapability
+  | RawComposeCapability
+  | RawInstallCapability
+  | RawEmitEvent
+  | RawCreateCapabilityGuard
+  | RawCreateModuleGuard
   -- Database functions
   | RawCreateTable
   | RawDescribeKeyset
   | RawDescribeModule
   | RawDescribeTable
+  | RawDefineKeySet
+  | RawDefineKeysetData
   | RawFoldDb
   | RawInsert
   | RawKeyLog
@@ -245,6 +252,7 @@ data RawBuiltin
   | RawOrQ
   | RawWhere
   | RawNotQ
+  | RawHash
   deriving (Eq, Show, Ord, Bounded, Enum)
 
 instance HasObjectOps RawBuiltin where
@@ -305,6 +313,7 @@ rawBuiltinToText = \case
   -- RawIf -> "if"
   RawIntToStr -> "int-to-str"
   RawStrToInt -> "str-to-int"
+  RawStrToIntBase -> "str-to-int-base"
   RawFold -> "fold"
   RawZip -> "zip"
   RawDistinct -> "distinct"
@@ -319,7 +328,8 @@ rawBuiltinToText = \case
   RawReadKeyset -> "read-keyset"
   RawEnforceGuard -> "enforce-guard"
   RawKeysetRefGuard -> "keyset-ref-guard"
-  -- RawCreateUserGuard -> "create-user-guard"
+  RawCreateCapabilityGuard -> "create-capability-guard"
+  RawCreateModuleGuard -> "create-module-guard"
   RawAt -> "at"
   RawMakeList -> "make-list"
   RawB64Encode -> "base64-encode"
@@ -328,10 +338,16 @@ rawBuiltinToText = \case
   RawYield -> "yield"
   RawResume -> "resume"
   RawBind -> "bind"
+  RawRequireCapability -> "require-capability"
+  RawComposeCapability -> "compose-capability"
+  RawInstallCapability -> "install-capability"
+  RawEmitEvent -> "emit-event"
   RawCreateTable -> "create-table"
   RawDescribeKeyset -> "describe-keyset"
   RawDescribeModule -> "describe-module"
   RawDescribeTable -> "describe-table"
+  RawDefineKeySet -> "define-keyset"
+  RawDefineKeysetData -> "define-read-keyset"
   RawFoldDb -> "fold-db"
   RawInsert -> "insert"
   RawKeyLog -> "keylog"
@@ -346,6 +362,7 @@ rawBuiltinToText = \case
   RawOrQ -> "or?"
   RawWhere -> "where?"
   RawNotQ -> "not?"
+  RawHash -> "hash"
 
 instance IsBuiltin RawBuiltin where
   builtinName = NativeName . rawBuiltinToText
@@ -402,7 +419,8 @@ instance IsBuiltin RawBuiltin where
     RawZip -> 3
     -- RawIf -> 3
     RawIntToStr -> 2
-    RawStrToInt -> 2
+    RawStrToInt -> 1
+    RawStrToIntBase -> 2
     RawFold -> 3
     RawDistinct -> 1
     RawEnforce -> 2
@@ -417,7 +435,8 @@ instance IsBuiltin RawBuiltin where
     RawReadKeyset -> 1
     RawEnforceGuard -> 1
     RawKeysetRefGuard -> 1
-    -- RawCreateUserGuard -> 1
+    RawCreateCapabilityGuard -> 1
+    RawCreateModuleGuard -> 1
     RawAt -> 2
     RawMakeList -> 2
     RawB64Encode -> 1
@@ -426,10 +445,16 @@ instance IsBuiltin RawBuiltin where
     RawYield -> 1
     RawResume -> 1
     RawBind -> 2
+    RawRequireCapability -> 1
+    RawComposeCapability -> 1
+    RawInstallCapability -> 1
+    RawEmitEvent -> 1
     RawCreateTable -> 1
     RawDescribeKeyset -> 1
     RawDescribeModule -> 1
     RawDescribeTable -> 1
+    RawDefineKeySet -> 2
+    RawDefineKeysetData -> 1
     RawFoldDb -> 3
     RawInsert -> 3
     RawKeyLog -> 3
@@ -444,6 +469,7 @@ instance IsBuiltin RawBuiltin where
     RawOrQ -> 3
     RawWhere -> 3
     RawNotQ -> 2
+    RawHash -> 1
 
 
 rawBuiltinNames :: [Text]
@@ -460,15 +486,17 @@ data ReplBuiltins
   | RExpectThat
   | RPrint
   | REnvStackFrame
-  -- | REnvChainData
-  -- | REnvData
-  -- | REnvDynRef
-  -- | REnvEntity
-  -- | REnvEvents
-  -- | REnvHash
-  -- | REnvKeys
-  -- | REnvSigs
+  | REnvChainData
+  | REnvData
+  | REnvEvents
+  | REnvHash
+  | REnvKeys
+  | REnvSigs
+  | RBeginTx
+  | RCommitTx
+  | RRollbackTx
   -- | RLoad
+  -- | RLoadWithEnv
   -- | RExpect
   -- | RExpectFailure
   -- | RExpectThat
@@ -509,7 +537,17 @@ instance IsBuiltin ReplBuiltins where
     RPactState -> 1
     RResetPactState -> 1
     REnvStackFrame -> 1
-
+    REnvChainData -> 1
+    REnvData -> 1
+    REnvEvents -> 1
+    REnvHash -> 1
+    REnvKeys -> 1
+    REnvSigs -> 1
+    RBeginTx -> 1
+    RCommitTx -> 1
+    RRollbackTx -> 1
+    -- RLoad -> 1
+    -- RLoadWithEnv -> 2
 -- Note: commented out natives are
 -- to be implemented later
 data ReplBuiltin b
@@ -559,7 +597,17 @@ replBuiltinsToText = \case
   RPactState -> "pact-state"
   RResetPactState -> "reset-pact-state"
   REnvStackFrame -> "env-stackframe"
+  REnvChainData -> "env-chain-data"
+  REnvData -> "env-data"
+  REnvEvents -> "env-events"
+  REnvHash -> "env-hash"
+  REnvKeys -> "env-keys"
+  REnvSigs -> "env-sigs"
+  RBeginTx -> "begin-tx"
+  RCommitTx -> "commit-tx"
+  RRollbackTx -> "rollback-tx"
   -- RLoad -> "load"
+  -- RLoadWithEnv -> "load-with-env"
 
 replBuiltinToText :: (t -> Text) -> ReplBuiltin t -> Text
 replBuiltinToText f = \case