remove errro

kadena-io · Oct 18, 2023 · 01d6887 · 01d6887
1 parent 903b93f
commit 01d6887
Show file tree

Hide file tree

Showing 7 changed files with 181 additions and 83 deletions.
diff --git a/pact-core/Pact/Core/Builtin.hs b/pact-core/Pact/Core/Builtin.hs
@@ -585,6 +585,7 @@ data ReplBuiltins
   -- Defpact
   | RContinuePact
   | RContinuePactRollback
+  | RContinuePactRollbackYield
   | RPactState
   | RResetPactState
   deriving (Show, Enum, Bounded, Eq)
@@ -598,7 +599,6 @@ instance IsBuiltin ReplBuiltins where
     RExpectFailureMatch -> 3
     RExpectThat -> 3
     RPrint -> 1
-    RContinuePact -> 1 -- TODO: Continue has three different forms
     RPactState -> 1
     RResetPactState -> 1
     REnvStackFrame -> 0
@@ -614,7 +614,9 @@ instance IsBuiltin ReplBuiltins where
     RRollbackTx -> 0
     RSigKeyset -> 1
     RTestCapability -> 1
+    RContinuePact -> 1
     RContinuePactRollback -> 2
+    RContinuePactRollbackYield -> 3
     REnvExecConfig -> 1
     -- RLoad -> 1
     -- RLoadWithEnv -> 2
@@ -664,7 +666,6 @@ replBuiltinsToText = \case
   RExpectFailureMatch -> "expect-failure-match"
   RExpectThat -> "expect-that"
   RPrint -> "print"
-  RContinuePact -> "continue-pact"
   RPactState -> "pact-state"
   RResetPactState -> "reset-pact-state"
   REnvStackFrame -> "env-stackframe"
@@ -680,7 +681,9 @@ replBuiltinsToText = \case
   RRollbackTx -> "rollback-tx"
   RSigKeyset -> "sig-keyset"
   RTestCapability -> "test-capability"
+  RContinuePact -> "continue-pact"
   RContinuePactRollback -> "continue-pact-with-rollback"
+  RContinuePactRollbackYield -> "continue-pact-rollback-yield"
   REnvExecConfig -> "env-exec-config"
   -- RLoad -> "load"
   -- RLoadWithEnv -> "load-with-env"

diff --git a/pact-core/Pact/Core/Errors.hs b/pact-core/Pact/Core/Errors.hs
@@ -269,16 +269,46 @@ data EvalError
   | DefIsNotClosure Text
   -- ^ Def is not a closure
   | NoSuchKeySet KeySetName
+    -- ^ No such keyset
   | YieldOutsiteDefPact
+  -- ^ Yield a value outside a running PactExec
   | NoActivePactExec
-  | NoYieldInPactExec
-  | ContinuePactInvalidContext Integer Integer Integer
-  | MultipleOrNestedPactExecFound
-  | PactStepNotFound Int
-  | PactStepHasNoRollback
-  | StepNotInEnvironment
-  | StepResumeDbMismatch Text
-  -- ^ No such keyset
+  -- ^ No Active PactExec in the environment
+  | NoYieldInPactStep PactStep
+  -- ^ No Yield available in PactStep
+  | InvalidPactStepSupplied PactStep PactExec
+  -- ^ Supplied PactStep requests an invalid step
+  | DefPactIdMissmatch PactId PactId
+  -- ^ Requested PactId does not match context PactId
+  | CCDefPactContinuationError PactStep PactExec PactExec
+  -- ^ Crosschain DefPact contunation must be at least 2 steps before CC continuation step
+  --   with <ccExec> <dbExec>
+  | NoPreviousDefPactExecutionFound PactStep
+  -- ^ No previouse DefPact execution could be found in the environment or database
+  | DefPactAlreadyCompleted PactStep
+  -- ^ DefPact already completed
+  | NestedDefPactParentStepCountMissmatch PactId Int Int
+  -- ^ Nested DefPact <stepcount> does not match <parent step count>
+  | NestedDefPactParentRollbackMissmatch PactId Bool Bool
+  -- ^ Nested DefPact <rollback> does not match <parent rollback>
+  | NestedDefPactNeverStarted PactStep
+  -- ^ Nested DefPact never started at prior step
+  | NestedDefPactDoubleExecution PactStep
+  -- ^ Nested DefPact is executed twice
+  | MultipleOrNestedDefPactExecFound PactExec
+  -- ^ Unexpected PactExec found in the environment
+  | DefPactStepNotFound PactStep Int
+  -- ^ The expected step could not be found in the DefPact
+  | PactStepHasNoRollback PactStep
+  -- ^ The requested PactStep has no rollback
+  | PactStepNotInEnvironment
+  -- ^ PactStep is not in the environment
+  | NoDefPactIdAndExecEnvSupplied
+  -- ^ No PactId supplied and no PactExec found in the environment
+  | DefPactRollbackMissmatch PactStep PactExec
+  -- ^ DefPact rollback missmatch
+  | DefPactStepMissmatch PactStep PactExec
+  -- ^ DefPact missmatch
   | CannotUpgradeInterface ModuleName
   -- ^ Interface cannot be upgrade
   | ModuleGovernanceFailure ModuleName
@@ -329,18 +359,96 @@ instance Pretty EvalError where
       Pretty.hsep ["Native evaluation error for native", pretty n <> ",", "received incorrect argument(s) of type(s)", Pretty.commaSep tys]
     EvalError txt ->
       Pretty.hsep ["Program encountered an unhandled raised error:", pretty txt]
+    ModRefNotRefined _ -> error ""
+    InvalidDefKind _ _ -> error ""
+    NoSuchDef _ -> error ""
+    InvalidManagedCap _ -> error ""
+    CapNotInstalled _ -> error ""
+    NameNotInScope _ -> error ""
+    DefIsNotClosure _ -> error ""
+    NoSuchKeySet _ -> error ""
     YieldOutsiteDefPact ->
-      "Scope error: executed yield outsite a defpact"
+      "Try to yield a value outside a running DefPact execution"
     NoActivePactExec ->
-      "No active pactExec"
-    NoYieldInPactExec -> "No yield in pact exec"
-    ContinuePactInvalidContext userStep currStep maxStep ->
-      Pretty.hsep ["Continue pact step with invalid context: user: ", pretty userStep, ", current: ", pretty currStep, ", max: ", pretty maxStep]
-    MultipleOrNestedPactExecFound -> "Multiple or nested pact exec found"
-    PactStepNotFound s -> Pretty.hsep ["PactStep not found:", pretty s]
-    e -> pretty (show e)
-
-
+      "No active DefPact execution in the environment"
+    NoYieldInPactStep (PactStep step _ i _) ->
+      Pretty.hsep ["No yield in DefPactStep:", "Step: " <> pretty step, "DefPactId: " <> pretty i]
+    InvalidPactStepSupplied (PactStep step _ _ _) pe ->
+      Pretty.hsep
+      [ "PactStep does not match DefPact properties:"
+      , "requested: "<> pretty step
+      , "step count:" <> pretty (_peStepCount pe)]
+    DefPactIdMissmatch reqId envId ->
+      Pretty.hsep
+      [ "Requested PactId:", pretty reqId
+      , "does not match context PactId:", pretty envId
+      ]
+    CCDefPactContinuationError pactStep _ccExec _dbExec ->
+      Pretty.hsep
+      [ "Crosschain DefPact continuation error:"
+      , "PactId:" <> pretty (_psStep pactStep)
+      ]
+    NestedDefPactParentRollbackMissmatch pid rollback parentRollback ->
+      Pretty.hsep
+      [ "Nested DefPact execution failed, parameter missmatch:"
+      , "PactId: " <> pretty pid
+      , "Rollback: " <> pretty rollback
+      , "Parent rollback:" <> pretty parentRollback
+      ]
+    NestedDefPactParentStepCountMissmatch pid stepCount parentStepCount ->
+      Pretty.hsep
+      [ "Nested DefPact execution failed, parameter missmatch:"
+      , "PacId: " <> pretty pid
+      , "step count: " <> pretty stepCount
+      , "Parent step count: " <> pretty parentStepCount
+      ]
+    NoPreviousDefPactExecutionFound ps ->
+      Pretty.hsep ["No previous DefPact exeuction found for PactId: ", pretty (_psPactId ps)]
+    DefPactAlreadyCompleted ps -> Pretty.hsep
+      [ "Requested DefPact already completed: ", "PactId:" <> pretty (_psPactId ps)]
+    NestedDefPactNeverStarted ps -> Pretty.hsep
+      ["Requested nested DefPact never started:", "PactId: " <> pretty (_psPactId ps)]
+    NestedDefPactDoubleExecution ps -> Pretty.hsep
+      ["Requested nested DefPact double execution:", "PactId: " <> pretty (_psPactId ps)]
+    MultipleOrNestedDefPactExecFound pe -> Pretty.hsep
+      ["DefPact execution context already in the environment: ", "PactId: " <> pretty (_pePactId pe)]
+    DefPactStepNotFound ps maxSteps -> Pretty.hsep
+      [ "Requested DefPact step exceeds available steps:"
+      , "requested: " <> pretty (_psStep ps)
+      , "available: " <> pretty maxSteps
+      ]
+    PactStepHasNoRollback ps -> Pretty.hsep
+      ["Step has no rollback:", "PactId: " <> pretty (_psPactId ps)]
+    PactStepNotInEnvironment -> "No PactStep in the environment"
+    NoDefPactIdAndExecEnvSupplied -> "No PactId or execution environment supplied"
+    DefPactRollbackMissmatch ps pe -> Pretty.hsep
+      [ "Rollback missmatch in PactStep and DefPact exeuction environment:"
+      , "PactId: " <> pretty (_psPactId ps)
+      , "step rollback: " <> pretty (_psRollback ps)
+      , "PactExec rollback: " <> pretty (_peStepHasRollback pe)
+      ]
+    DefPactStepMissmatch ps pe -> Pretty.hsep
+      [ "Step missmatch in PactStep and DefPact exeuction environment:"
+      , "PactId: " <> pretty (_psPactId ps)
+      , "step: " <> pretty (_psStep ps)
+      , "PactExec step: " <> pretty (_peStep pe + 1)
+      ]
+    CannotUpgradeInterface _ -> error ""
+    ModuleGovernanceFailure _ -> error ""
+    DbOpFailure _ -> error ""
+    DynNameIsNotModRef _ -> error ""
+    ModuleDoesNotExist _ -> error ""
+    ExpectedModule _ -> error ""
+    HashNotBlessed _ _ -> error ""
+    CannotApplyPartialClosure -> error ""
+    ClosureAppliedToTooManyArgs -> error ""
+    FormIllegalWithinDefcap _ -> error ""
+    RunTimeTypecheckFailure _ _ -> error ""
+    NativeIsTopLevelOnly _ -> error ""
+    EventDoesNotMatchModule _ -> error ""
+    InvalidEventCap _ -> error ""
+    NestedDefpactsNotAdvanced _ -> error ""
+    ExpectedPactValue -> error ""
 
 instance Exception EvalError
 

diff --git a/pact-core/Pact/Core/IR/Desugar.hs b/pact-core/Pact/Core/IR/Desugar.hs
@@ -243,8 +243,9 @@ instance DesugarBuiltin (ReplBuiltin RawBuiltin) where
     App (Builtin (RBuiltinRepl RExpectFailureMatch) i) [e1, e2, suspendTerm e3] i
   desugarAppArity i (RBuiltinRepl RContinuePact) [e1, e2] | isn't _Lam e2 =
     App (Builtin (RBuiltinRepl RContinuePactRollback) i) [e1, e2] i
-  -- desugarAppArity i (RBuiltinRepl RContinuePact) (e1 :| e2)  =
-  --   App (Builtin (RBuiltinRepl RContinuePact) i) (e1 :| e2) i
+  desugarAppArity i (RBuiltinRepl RContinuePact) [e1, e2, e3]
+    | isn't _Lam e2 && isn't _Lam e3 =
+      App (Builtin (RBuiltinRepl RContinuePactRollbackYield) i) [e1, e2, e3] i
   desugarAppArity i b ne =
     App (Builtin b i) ne i
 
@@ -422,14 +423,6 @@ desugarDefPact (Lisp.DefPact dpname _ _ [] _ _ i) =
 desugarDefPact (Lisp.DefPact dpname margs rt (step:steps) _ _ i) =
   view reCurrModule >>= \case
     Just (mn,_) -> do
-      -- let
-      --   args' = case margs of
-      --             [] -> pure unitFnArg
-      --             arg:args -> toArg <$> (arg :| args)
-      -- let desugarStep b = do
-      --       tm <- desugarLispTerm b
-      --       pure (Lam (TLDefPact mn dpname) args' tm i) -- TODO: add TLPactStep
-      --   desugarMSteps = maybe (pure Nothing) (fmap Just . traverse desugarStep)
       let args' = toArg <$> margs
       steps' <- forM (step :| steps) \case
         Lisp.Step s ms ->
@@ -440,23 +433,12 @@ desugarDefPact (Lisp.DefPact dpname margs rt (step:steps) _ _ i) =
           <*> desugarLispTerm rb
           <*> traverse (traverse desugarLispTerm) ms
 
-      -- In Pact, last steps are not allowed to roll back.
+      -- In DefPacts, last step is not allowed to rollback.
       when (hasRollback $ NE.last steps') $
         throwDesugarError (LastStepWithRollback (QualifiedName dpname mn)) i
 
       pure $ DefPact dpname args' rt steps' i
-    Nothing -> error "Defpact is module-less"
-    where
-      -- Todo: debruijn code should be isolated
-    -- bindArgs rEnv
-    --   | null argtys = rEnv
-    --   | otherwise = let
-    --     depth = view reVarDepth rEnv
-    --     len = fromIntegral (length argtys)
-    --     newDepth = depth + len
-    --     ixs = [depth .. newDepth - 1]
-    --     m = M.fromList $ zip (_argName <$> argtys) ((, Nothing) . NBound <$> ixs)
-    --     in over reBinds (M.union m) $ set reVarDepth newDepth rEnv
+    Nothing -> throwDesugarError (NotAllowedOutsideModule "defpact") i
 
 desugarDefConst
   :: (MonadDesugar raw reso i m)