contmsg and eval continuation

kadena-io · May 17, 2024 · 090fed9 · 090fed9
1 parent 18e8ea8
commit 090fed9
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 1 deletion.
diff --git a/pact/Pact/Core/Evaluate.hs b/pact/Pact/Core/Evaluate.hs
@@ -19,6 +19,8 @@ module Pact.Core.Evaluate
   , EvalBuiltinEnv
   , evalTermExec
   , allModuleExports
+  , ContMsg(..)
+  , evalContinuation
   ) where
 
 import Control.Lens
@@ -72,6 +74,14 @@ data MsgData = MsgData
 initMsgData :: Hash -> MsgData
 initMsgData h = MsgData (PObject mempty) def h mempty
 
+data ContMsg = ContMsg
+  { _cmPactId :: !DefPactId
+  , _cmStep :: !Int
+  , _cmRollback :: !Bool
+  , _cmData :: !PactValue
+  , _cmProof :: !(Maybe ContProof)
+  } deriving (Eq,Show)
+
 builtinEnv :: EvalBuiltinEnv
 builtinEnv = coreBuiltinEnv @Eval.CEKBigStep
 
@@ -292,3 +302,15 @@ evaluateTerms
   -> Eval [CompileValue ()]
 evaluateTerms tls = do
   traverse (interpretTopLevel builtinEnv) tls
+
+evalContinuation :: EvalEnv CoreBuiltin () -> EvalState CoreBuiltin () -> ContMsg -> IO (Either (PactError ()) (EvalResult [Lisp.TopLevel ()]))
+evalContinuation evalEnv evalSt cm = case _cmProof cm of
+  Nothing ->
+    interpret (setStep Nothing) evalSt (Left Nothing)
+  Just p -> do
+    etpe <- (_spvVerifyContinuation . _eeSPVSupport $ evalEnv) p
+    pe <- either contError return etpe
+    interpret (setStep (_peYield pe)) evalSt (Left $ Just pe)
+  where
+    contError spvErr = throw $ PEExecutionError (SPVVerificationFailure spvErr) [] ()
+    setStep y = set eeDefPactStep (Just $ DefPactStep (_cmStep cm) (_cmRollback cm) (_cmPactId cm) y) evalEnv
diff --git a/pact/Pact/Core/Serialise/LegacyPact.hs b/pact/Pact/Core/Serialise/LegacyPact.hs
@@ -1,7 +1,6 @@
 -- |
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE PartialTypeSignatures  #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Pact.Core.Serialise.LegacyPact
   ( decodeModuleData