Fix: make entity field presence an error

examples/accounts/accounts.pact

@@ -107,7 +107,7 @@
 
   (defpact payment (payer payer-entity payee payee-entity amount date)
     "Debit PAYER at PAYER-ENTITY then credit PAYEE at PAYEE-ENTITY for AMOUNT on DATE"
-    (step-with-rollback payer-entity
+    (step-with-rollback 
       (with-capability (TRANSFER)
         (debit payer amount date
           { "payee": payee
@@ -118,7 +118,7 @@
         (credit payer amount date
           { "ref": (pact-id), "note": "rollback" })))
 
-    (step payee-entity
+    (step
       (with-capability (TRANSFER)
         (credit payee amount date
           { "payer": payer

pact-lsp/Pact/Core/LanguageServer/Utils.hs

@@ -105,6 +105,7 @@ topLevelTermAt p = \case
     goStep = \case
       Step tm -> TermMatch <$> termAt p tm
       StepWithRollback tm1 tm2 -> TermMatch <$> (termAt p tm1 <|> termAt p tm2)
+      _ -> Nothing
 
 -- | Check if a `Position` is contained within a `Span`
 inside :: Position -> SpanInfo -> Bool

pact-repl/Pact/Core/IR/Eval/Direct/Evaluator.hs

@@ -1130,12 +1130,18 @@ applyPact i pc ps cenv nested = use esDefPactExec >>= \case
       let sf = StackFrame (qualNameToFqn (pc ^. pcName) mh) (pc ^. pcArgs) SFDefPact i
 
       result <- case (ps ^. psRollback, step) of
-        (False, _) ->
-          evalWithStackFrame i sf Nothing $ evaluate cenv (ordinaryDefPactStepExec step)
+        (False, _) -> case ordinaryDefPactStepExec step of
+          Just stepExpr ->
+            evalWithStackFrame i sf Nothing $ evaluate cenv stepExpr
+          Nothing ->
+            throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
         (True, StepWithRollback _ rollbackExpr) ->
           evalWithStackFrame i sf Nothing $ evaluate cenv rollbackExpr
         (True, Step{}) ->
           throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithEntity{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithRBEntity{}) ->
+          throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
 
       -- After evaluation, check the result state
       use esDefPactExec >>= \case
@@ -1210,11 +1216,17 @@ applyNestedPact i pc ps cenv = use esDefPactExec >>= \case
       let contFqn = qualNameToFqn (pc ^. pcName) mh
           sf = StackFrame contFqn (pc ^. pcArgs) SFDefPact i
       result <- case (ps ^. psRollback, step) of
-        (False, _) ->
-          evalWithStackFrame i sf Nothing $ evaluate cenv' (ordinaryDefPactStepExec step)
+        (False, _) -> case ordinaryDefPactStepExec step of
+          Just stepExpr ->
+            evalWithStackFrame i sf Nothing $ evaluate cenv' stepExpr
+          Nothing ->
+            throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
         (True, StepWithRollback _ rollbackExpr) ->
           evalWithStackFrame i sf Nothing $ evaluate cenv' rollbackExpr
         (True, Step{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithEntity{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithRBEntity{}) ->
+          throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
 
       use esDefPactExec >>= \case
         Nothing -> failInvariant i $ InvariantPactExecNotInEnv Nothing

pact-tests/Pact/Core/Test/LexerParserTests.hs

@@ -246,10 +246,10 @@ defpactGen =
     Gen.choice [regularStepGen, stepWithRbGen]
   regularStepGen =
     -- Todo: models
-    Step <$> exprGen <*> pure Nothing
+    Step <$> pure Nothing <*> exprGen <*> pure Nothing
   stepWithRbGen =
     -- todo: models
-    StepWithRollback <$> exprGen <*> exprGen <*> pure Nothing
+    StepWithRollback <$> pure Nothing <*> exprGen <*> exprGen <*> pure Nothing
 
 defschemaGen :: Gen (DefSchema ())
 defschemaGen =

pact-tests/Pact/Core/Test/StaticErrorTests.hs

@@ -1098,6 +1098,20 @@ executionTests =
         )
       (install-capability (c "meh"))
     |])
+  , ("entity_not_allowed", isExecutionError _EntityNotAllowedInDefPact, [text|
+      (module m g (defcap g () true)
+        (defpact tester ()
+          (step 1 2)
+        )
+        )
+    |])
+  , ("entity_not_allowed_rb", isExecutionError _EntityNotAllowedInDefPact, [text|
+      (module m g (defcap g () true)
+        (defpact tester ()
+          (step-with-rollback 1 2 3)
+        )
+        )
+    |])
   ]
 
 builtinTests :: [(String, PactErrorI -> Bool, Text)]

pact-tests/constructor-tag-goldens/EvalError.golden

@@ -74,4 +74,5 @@
 {"conName":"ModuleAdminNotAcquired","conIndex":"49"}
 {"conName":"UnknownException","conIndex":"4a"}
 {"conName":"InvalidNumArgs","conIndex":"4b"}
+{"conName":"EntityNotAllowedInDefPact","conIndex":"4c"}
 

pact/Pact/Core/Errors.hs

@@ -185,6 +185,7 @@ module Pact.Core.Errors
  , _HyperlaneDecodeErrorInternal
  , _HyperlaneDecodeErrorBinary
  , _HyperlaneDecodeErrorParseRecipient
+ , _EntityNotAllowedInDefPact
  , _InvalidNumArgs
  , toPrettyLegacyError
  , BoundedText
@@ -727,6 +728,9 @@ data EvalError
   | UnknownException Text
   -- ^ An unknown exception was thrown and converted to text. Intentionally and crucially lazy.
   | InvalidNumArgs ErrorClosureType Int Int
+  -- ^ Invalid number of arguments for a function
+  | EntityNotAllowedInDefPact QualifiedName
+  -- ^ Entity field not allowed in defpact
   deriving (Eq, Show, Generic)
 
 data ErrorClosureType
@@ -941,6 +945,8 @@ instance Pretty EvalError where
       <+> pretty errCloType
       <+> "supplied; expected"
       <+> parens (pretty expected)
+    EntityNotAllowedInDefPact qn ->
+      "Pact 5 does not support entity expressions in defpact" <+> pretty qn <> ". Please ensure your defpact steps have the correct number of expressions"
 
 -- | Errors meant to be raised
 --   internally by a PactDb implementation
@@ -1597,6 +1603,10 @@ evalErrorToBoundedText = mkBoundedText . \case
       ErrClosureLambda -> "lambda"
       ErrClosureUserFun fqn -> thsep ["user function", tFqn fqn]
       ErrClosureNativeFun b -> thsep ["native function", _natName b]
+  EntityNotAllowedInDefPact qn ->
+      thsep [ "Pact 5 does not support entity expressions in defpact"
+            , renderQualName qn <> "."
+            , " Please ensure your defpact steps have the correct number of expressions"]
 
 
 -- | NOTE: Do _not_ change this function post mainnet release just to improve an error.

pact/Pact/Core/IR/Desugar.hs

@@ -485,12 +485,16 @@ desugarDefPact mn (Lisp.DefPact spec@(Lisp.MArg dpname _ _) margs (step :| steps
   let args' = toArg <$> margs
       spec' = toArg spec
   steps' <- forM (step :| steps) \case
-    Lisp.Step s _ ->
+    Lisp.Step mentity s _ -> do
+      when (isJust mentity) $
+        lift $ throwExecutionError i (EntityNotAllowedInDefPact (QualifiedName dpname mn))
       Step <$> desugarLispTerm s
-    Lisp.StepWithRollback s rb _ ->
+    Lisp.StepWithRollback mentity s rb _ -> do
+      when (isJust mentity) $
+        lift $ throwExecutionError i (EntityNotAllowedInDefPact (QualifiedName dpname mn))
       StepWithRollback
-      <$> desugarLispTerm s
-      <*> desugarLispTerm rb
+        <$> desugarLispTerm s
+        <*> desugarLispTerm rb
 
   -- In DefPacts, last step is not allowed to rollback.
   when (hasRollback $ NE.last steps') $
@@ -807,6 +811,7 @@ defPactStepSCC mn cd = \case
   Step step -> termSCC mn cd step
   StepWithRollback step rollback ->
     S.unions $ [termSCC mn cd step, termSCC mn cd rollback]
+  _ -> mempty
 
 -- | Get the set of dependencies from a defun signature defn
 -- Note: names will show up in:
@@ -1119,6 +1124,10 @@ renamePactStep = \case
     Step <$> renameTerm step
   StepWithRollback step rollback ->
     StepWithRollback <$> renameTerm step <*> renameTerm rollback
+  LegacyStepWithEntity e1 e2 ->
+    LegacyStepWithEntity <$> renameTerm e1 <*> renameTerm e2
+  LegacyStepWithRBEntity e1 e2 e3 ->
+    LegacyStepWithRBEntity <$> renameTerm e1 <*> renameTerm e2 <*> renameTerm e3
 
 renameDefPact
   :: (DesugarBuiltin b)

pact/Pact/Core/IR/Eval/CEK/Evaluator.hs

@@ -388,11 +388,17 @@ applyPact i pc ps cont handler cenv nested = use esDefPactExec >>= \case
           contFqn = qualNameToFqn (pc ^. pcName) mh
           sf = StackFrame contFqn (pc ^. pcArgs) SFDefPact i
       case (ps ^. psRollback, step) of
-        (False, _) ->
-          evalWithStackFrame i cont' handler cenv Nothing sf (ordinaryDefPactStepExec step)
+        (False, _) -> case ordinaryDefPactStepExec step of
+          Just stepExpr ->
+            evalWithStackFrame i cont' handler cenv Nothing sf stepExpr
+          Nothing ->
+            throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
         (True, StepWithRollback _ rollbackExpr) ->
           evalWithStackFrame i cont' handler cenv Nothing sf rollbackExpr
         (True, Step{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithEntity{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithRBEntity{}) ->
+          throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
     (_, mh) -> failInvariant i (InvariantExpectedDefPact (qualNameToFqn (pc ^. pcName) mh))
 
 emitXChainEvents
@@ -474,11 +480,17 @@ applyNestedPact i pc ps cont handler cenv = use esDefPactExec >>= \case
         sf = StackFrame contFqn (pc ^. pcArgs) SFDefPact i
 
       case (ps ^. psRollback, step) of
-        (False, _) ->
-          evalWithStackFrame i cont' handler cenv' Nothing sf (ordinaryDefPactStepExec step)
+        (False, _) -> case ordinaryDefPactStepExec step of
+          Just stepExpr ->
+            evalWithStackFrame i cont' handler cenv' Nothing sf stepExpr
+          Nothing ->
+            throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
         (True, StepWithRollback _ rollbackExpr) ->
           evalWithStackFrame i cont' handler cenv' Nothing sf rollbackExpr
         (True, Step{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithEntity{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
+        (True, LegacyStepWithRBEntity{}) ->
+          throwExecutionError i (EntityNotAllowedInDefPact (_pcName pc))
     (_, mh) -> failInvariant i (InvariantExpectedDefPact (qualNameToFqn (pc ^. pcName) mh))
 
 

pact/Pact/Core/IR/ModuleHashing.hs

@@ -73,6 +73,9 @@ updateDefHashes mname mhash = \case
   DPact d ->
     let updateStep (Step e1) = Step (updateTermHashes mname mhash e1)
         updateStep (StepWithRollback e1 e2) = StepWithRollback (updateTermHashes mname mhash e1) (updateTermHashes mname mhash e2)
+        -- Note: this last fallthrough case does not occur in the pact 5
+        -- module deploy execution path.
+        updateStep e = e
     in DPact $ over dpSteps (fmap updateStep) d
   DTable d -> DTable d
   DSchema s -> DSchema s

pact/Pact/Core/IR/Term.hs

@@ -222,6 +222,8 @@ data Step name ty builtin info
   | StepWithRollback
     (Term name ty builtin info)
     (Term name ty builtin info)
+  | LegacyStepWithEntity (Term name ty builtin info) (Term name ty builtin info)
+  | LegacyStepWithRBEntity (Term name ty builtin info) (Term name ty builtin info) (Term name ty builtin info)
   deriving (Show, Functor, Eq, Generic)
 
 -- | (defpact <name>:<ret_ty> (arglist*) <steps>)
@@ -265,10 +267,13 @@ data DefSchema ty info
 hasRollback :: Step n t b i -> Bool
 hasRollback Step{} = False
 hasRollback StepWithRollback{} = True
+hasRollback LegacyStepWithEntity{} = False
+hasRollback LegacyStepWithRBEntity{} = True
 
-ordinaryDefPactStepExec :: Step name ty builtin info -> Term name ty builtin info
-ordinaryDefPactStepExec (Step expr) = expr
-ordinaryDefPactStepExec (StepWithRollback expr _) = expr
+ordinaryDefPactStepExec :: Step name ty builtin info -> Maybe (Term name ty builtin info)
+ordinaryDefPactStepExec (Step expr) = Just expr
+ordinaryDefPactStepExec (StepWithRollback expr _) = Just expr
+ordinaryDefPactStepExec _ = Nothing
 
 -- | The type of our desugared table schemas
 -- TODO: This GADT is unnecessarily complicated and only really necessary
@@ -567,6 +572,9 @@ instance (Pretty name, Pretty builtin, Pretty ty) => Pretty (Step name ty builti
   pretty = \case
     Step t -> parens ("step" <+> pretty t)
     StepWithRollback t1 t2 -> parens ("step-with-rollback" <+> pretty t1 <+> pretty t2)
+    LegacyStepWithEntity t1 t2 -> parens ("step" <+> pretty t1 <+> pretty t2)
+    LegacyStepWithRBEntity t1 t2 t3 ->
+      parens ("step-with-rollback" <+> pretty t1 <+> pretty t2 <+> pretty t3)
 
 
 instance (Pretty name, Pretty ty, Pretty b) => Pretty (DefConst name ty b i) where
@@ -759,6 +767,10 @@ traverseDefPactStep f = \case
   Step t -> Step <$> f t
   StepWithRollback a1 a2 ->
     StepWithRollback <$> f a1 <*> f a2
+  LegacyStepWithEntity e1 e2 ->
+    LegacyStepWithEntity <$> f e1 <*> f e2
+  LegacyStepWithRBEntity e1 e2 e3 ->
+    LegacyStepWithRBEntity <$> f e1 <*> f e2 <*> f e3
 
 traverseDefPactTerm
   :: Traversal (DefPact name ty builtin info)

pact/Pact/Core/Serialise/CBOR_V1.hs

@@ -560,13 +560,19 @@ instance
       encodeListLen 2 <> encodeWord 0 <> encodeS t
     StepWithRollback t rb ->
       encodeListLen 3 <> encodeWord 1 <> encodeS t <> encodeS rb
+    LegacyStepWithEntity t e ->
+      encodeListLen 3 <> encodeWord 2 <> encodeS t <> encodeS e
+    LegacyStepWithRBEntity t e rb ->
+      encodeListLen 4 <> encodeWord 3 <> encodeS t <> encodeS e <> encodeS rb
   {-# INLINE encode #-}
 
   decode = do
     _ <- decodeListLen
     decodeWord >>= fmap SerialiseV1 . \case
       0 -> Step <$> decodeS
       1 -> StepWithRollback <$> decodeS <*> decodeS
+      2 -> LegacyStepWithEntity <$> decodeS <*> decodeS
+      3 -> LegacyStepWithRBEntity <$> decodeS <*> decodeS <*> decodeS
       _ -> fail "unexpected decoding"
   {-# INLINE decode #-}
 

pact/Pact/Core/Serialise/LegacyPact.hs

@@ -436,12 +436,15 @@ fromLegacyStep
   :: ModuleHash
   -> Legacy.Step (Legacy.Term (Either CorePreNormalizedTerm LegacyRef))
   -> TranslateM (Step (Name, DeBruijn) Type CoreBuiltin ())
-fromLegacyStep mh (Legacy.Step _ t mrb) = do
+fromLegacyStep mh (Legacy.Step entity t mrb) = do
+  entity' <- traverse (fromLegacyTerm mh) entity
   t' <- fromLegacyTerm mh t
-  case mrb of
-    Nothing -> pure (Step t')
-    Just rb ->
-      StepWithRollback t' <$> fromLegacyTerm mh rb
+  mrb' <- traverse (fromLegacyTerm mh) mrb
+  case (entity', mrb') of
+    (Nothing, Nothing) -> pure (Step t')
+    (Nothing, Just rb) -> pure (StepWithRollback t' rb)
+    (Just e, Nothing) -> pure (LegacyStepWithEntity e t')
+    (Just e, Just rb) -> pure (LegacyStepWithRBEntity e t' rb)
 
 debruijnize
   :: DeBruijn

pact/Pact/Core/Syntax/ParseTree.hs

@@ -285,17 +285,17 @@ instance Pretty (DefTable i) where
       <> maybe mempty (\d -> line <> pretty (uncurry (flip PactDoc) d)) docs
 
 data PactStep i
-  = Step (Expr i) (Maybe [PropertyExpr i])
-  | StepWithRollback (Expr i) (Expr i) (Maybe [PropertyExpr i])
+  = Step (Maybe (Expr i)) (Expr i) (Maybe [PropertyExpr i])
+  | StepWithRollback (Maybe (Expr i)) (Expr i) (Expr i) (Maybe [PropertyExpr i])
   deriving (Eq, Show, Functor, Generic, NFData)
 
 instance Pretty (PactStep i) where
   pretty = \case
-    Step e1 anns ->
+    Step _ e1 anns ->
       parens $
         "step" <+> pretty e1 <> nest 2
           (maybe mempty (\a -> line <> pretty (PactModel a)) anns)
-    StepWithRollback e1 e2 anns ->
+    StepWithRollback _ e1 e2 anns ->
       parens $
         "step-with-rollback" <+> pretty e1 <+> pretty e2 <> nest 2
           (maybe mempty (\a -> line <> pretty (PactModel a)) anns)

pact/Pact/Core/Syntax/Parser.y

@@ -224,15 +224,15 @@ Steps :: { [PactStep SpanInfo] }
   | Step { [$1] }
 
 Step :: { PactStep SpanInfo }
-  : '(' step Expr MModel ')' { Step $3 $4 }
+  : '(' step Expr MModel ')' { Step Nothing $3 $4 }
   -- Note: this production which ignores its input
   -- is due to the legacy form of:
   -- (step ENTITY EXPR)
-  | '(' step Expr Expr MModel ')' { Step $4 $5 }
-  | '(' steprb Expr Expr MModel ')' { StepWithRollback $3 $4 $5 }
+  | '(' step Expr Expr MModel ')' { Step (Just $3) $4 $5 }
+  | '(' steprb Expr Expr MModel ')' { StepWithRollback Nothing $3 $4 $5 }
   -- (step-with-rollback ENTITY EXPR ROLLBACK-EXPR)
   -- hence we ignore entity
-  | '(' steprb Expr Expr Expr MModel ')' { StepWithRollback $4 $5 $6 }
+  | '(' steprb Expr Expr Expr MModel ')' { StepWithRollback (Just $3) $4 $5 $6 }
 
 MDCapMeta :: { Maybe DCapMeta }
   : Managed { Just $1 }