Integration: Fixes for parity replay

pact-request-api/Pact/Core/Command/Server.hs

@@ -303,7 +303,8 @@ computeResultAndUpdateState runtime requestKey cmd =
             , mdSigners = signer
             , mdVerifiers = maybe [] (fmap void) mverif
             }
-      evalExec (RawCode (_pcCode code)) Transactional (_srDbEnv runtime) (_srSPVSupport runtime) freeGasModel GasLogsDisabled mempty SimpleNamespacePolicy
+      ge <- mkFreeGasEnv GasLogsDisabled
+      evalExec (RawCode (_pcCode code)) Transactional (_srDbEnv runtime) (_srSPVSupport runtime) ge mempty SimpleNamespacePolicy
         def msgData def parsedCode >>= \case
         Left pe ->
           pure $ pactErrorToCommandResult requestKey pe (Gas 0)
@@ -323,7 +324,8 @@ computeResultAndUpdateState runtime requestKey cmd =
             , _cRollback = _cmRollback contMsg
             , _cProof = _cmProof contMsg
             }
-      evalContinuation Transactional (_srDbEnv runtime) (_srSPVSupport runtime) freeGasModel GasLogsDisabled mempty
+      ge <- mkFreeGasEnv GasLogsDisabled
+      evalContinuation Transactional (_srDbEnv runtime) (_srSPVSupport runtime) ge mempty
         SimpleNamespacePolicy def msgData def cont >>= \case
           Left pe ->
             pure $ pactErrorToCommandResult requestKey pe (Gas 0)

pact-tests/gas-goldens/builtinGas.golden

@@ -25,7 +25,7 @@ compose: 4460
 concat: 920
 cond: 1202
 contains: 605
-continue: 441650
+continue: 441250
 create-capability-guard: 227850
 create-capability-pact-guard: 246800
 create-module-guard: 188300

pact-tests/legacy-serial-tests/coin-v5/coin-v5.repl

@@ -423,7 +423,7 @@
   (transfer 'emily 'doug 1.0))
 
 (expect-failure "No account for will"
-  "No value found in table coin:coin-table for key: will"
+  "No value found in table coin_coin-table for key: will"
   (get-balance 'will))
 
 (test-capability (TRANSFER 'doug 'will 1.0))
@@ -487,7 +487,7 @@
 (env-data { "miner2": ["miner2"] })
 
 (expect-failure "no account for miner2"
-  "No value found in table coin:coin-table for key: miner2"
+  "No value found in table coin_coin-table for key: miner2"
   (get-balance 'miner2))
 
 (test-capability (COINBASE))

pact-tests/pact-tests/caps.repl

@@ -956,3 +956,58 @@
 (expect "managed capabilities compose correctly" 111 (run))
 (commit-tx)
 
+; Test legacy events
+(begin-tx)
+(module A g
+  (defcap g () true)
+  (defconst A_VERSION:integer 1)
+  (defcap A_EVENT (a:integer)
+   @event
+   1
+   )
+
+   (defun emit-a(a:integer) (emit-event (A_EVENT a))))
+
+
+(module B g
+ (defcap g () true)
+ (use A)
+ (defun call-a () (emit-a 420)))
+
+
+(call-a)
+(expect "Event is emitted"
+  [ {"module-hash": "u5uyUYRiplR4zAyB3F2GCVwzpw0XIoxcujkCgW3CVDg"
+    ,"name": "A.A_EVENT"
+    ,"params": [ 420 ]} ] (env-events true))
+
+(commit-tx)
+
+(begin-tx)
+ (module A g
+  (defcap g () true)
+  (defconst A_VERSION:integer 2)
+  (defcap A_EVENT (a:integer b:integer)
+   @event
+   1
+   )
+
+   (defun emit-a(a:integer) (emit-event (A_EVENT a a))))
+
+
+(use B)
+(call-a)
+(expect "Without legacy events enabled, events are the same"
+  [ {"module-hash": "u5uyUYRiplR4zAyB3F2GCVwzpw0XIoxcujkCgW3CVDg"
+    ,"name": "A.A_EVENT"
+    ,"params": [ 420 ]} ] (env-events true))
+(commit-tx)
+
+(begin-tx)
+(env-exec-config ["EnableLegacyEventHashes"])
+(use B)
+(call-a)
+(expect "With legacy events, it always points to the latest module hash"
+[ {"module-hash": "8bdi-0ljmkBGMm06zxB4j4tziHY3qLT-d_UoUwxBDLw"
+  ,"name": "A.A_EVENT","params": [ 420 ]} ] (env-events true))
+(commit-tx)

pact-tests/pact-tests/coin-v1.repl

@@ -422,7 +422,7 @@
   (transfer 'emily 'doug 1.0))
 
 (expect-failure "No account for will"
-  "No value found in table coin:coin-table for key: will"
+  "No value found in table coin_coin-table for key: will"
   (get-balance 'will))
 
 (test-capability (TRANSFER 'doug 'will 1.0))
@@ -484,7 +484,7 @@
 (env-data { "miner2": ["miner2"] })
 
 (expect-failure "no account for miner2"
-  "No value found in table coin:coin-table for key: miner2"
+  "No value found in table coin_coin-table for key: miner2"
   (get-balance 'miner2))
 
 (coinbase 'miner2 (read-keyset 'miner2) 1.0)

pact-tests/pact-tests/coin-v5.repl

@@ -434,7 +434,7 @@
   (transfer 'emily 'doug 1.0))
 
 (expect-failure "No account for will"
-  "No value found in table coin:coin-table for key: will"
+  "No value found in table coin_coin-table for key: will"
   (get-balance 'will))
 
 (test-capability (TRANSFER 'doug 'will 1.0))
@@ -498,7 +498,7 @@
 (env-data { "miner2": ["miner2"] })
 
 (expect-failure "no account for miner2"
-  "No value found in table coin:coin-table for key: miner2"
+  "No value found in table coin_coin-table for key: miner2"
   (get-balance 'miner2))
 
 (test-capability (COINBASE))

pact-tests/pact-tests/db.repl

@@ -275,4 +275,15 @@
   [ {"key": "jose","value": {"a": 2,"b": 1}}
   , {"key": "robert","value": {"a": 3,"b": 1}} ]
   (m.all-elems))
+
+(commit-tx)
+
+; Regression for read with fields
+(begin-tx)
+(use m)
+(acquire-module-admin m)
+(expect "reading with a single field restricts the value to that field" {"a": 2} (read tbl "jose" ["a"]))
+(expect "reading with a no fields returns the full object" {"a": 2,"b": 1} (read tbl "jose" []))
+(expect "selecting with fields on empty fields" [{"a": 2} {"a": 3}] (select tbl ["a"] (constantly true)))
+(expect "selecting with fields with no fields results in empty objects" [{} {}] (select tbl [] (constantly true)))
 (commit-tx)

pact/Pact/Core/Builtin.hs

@@ -70,7 +70,7 @@ instance Pretty o => Pretty (BuiltinForm o) where
     CEnforce o o' ->
       parens ("enforce" <+> pretty o <+> pretty o')
     CWithCapability o o' ->
-      parens ("with-capability" <+> pretty o <+> pretty o')
+      parens ("with-capability" <+> pretty o <+> (nest 2 (line <> pretty o')))
     CCreateUserGuard o ->
       parens ("create-user-guard" <+> pretty o)
     CTry o o' ->

pact/Pact/Core/Capabilities.hs

@@ -46,6 +46,13 @@ data DefCapMeta name
   | Unmanaged
   deriving (Show, Functor, Foldable, Traversable, Eq, Generic)
 
+instance Pretty name => Pretty (DefCapMeta name) where
+  pretty = \case
+    DefEvent -> "@event"
+    DefManaged (DefManagedMeta (_, n1) n2) -> "@managed" <+> pretty n1 <+> pretty n2
+    DefManaged AutoManagedMeta -> "@managed"
+    Unmanaged -> mempty
+
 dcMetaFqName :: Traversal' (DefCapMeta (FQNameRef Name)) FullyQualifiedName
 dcMetaFqName f = \case
   DefManaged (DefManagedMeta i (FQName fqn)) ->

pact/Pact/Core/DefPacts/Types.hs

@@ -7,11 +7,14 @@ module Pact.Core.DefPacts.Types
  , DefPactStep(..)
  , psStep, psRollback, psDefPactId, psResume
  , DefPactExec(..)
+ , NestedDefPactExec(..)
  , peStepCount, peYield, peStep, peContinuation, peStepHasRollback, peDefPactId
  , peNestedDefPactExec
  , Yield(..)
  , yData, yProvenance, ySourceChain
  , Provenance(..)
+ , toNestedPactExec
+ , fromNestedPactExec
  ) where
 
 -- Todo: yield
@@ -59,6 +62,17 @@ data Yield
 
 makeLenses ''Yield
 
+data NestedDefPactExec
+  = NestedDefPactExec
+  { _npeStepCount :: Int
+  , _npeYield :: Maybe Yield
+  , _npeStep :: Int
+  , _npeDefPactId :: DefPactId
+  , _npeContinuation :: DefPactContinuation QualifiedName PactValue
+  , _npeNestedDefPactExec :: Map DefPactId NestedDefPactExec
+  } deriving (Show, Eq, Generic)
+
+
 -- | Internal representation of pacts
 data DefPactExec
   = DefPactExec
@@ -68,11 +82,19 @@ data DefPactExec
   , _peDefPactId :: DefPactId
   , _peContinuation :: DefPactContinuation QualifiedName PactValue
   , _peStepHasRollback :: Bool
-  , _peNestedDefPactExec :: Map DefPactId DefPactExec
+  , _peNestedDefPactExec :: Map DefPactId NestedDefPactExec
   } deriving (Show, Eq, Generic)
 
 makeLenses ''DefPactExec
 
+toNestedPactExec :: DefPactExec -> NestedDefPactExec
+toNestedPactExec (DefPactExec stepCount yield step pid cont _ nested) =
+  NestedDefPactExec stepCount yield step pid cont nested
+
+fromNestedPactExec :: Bool -> NestedDefPactExec -> DefPactExec
+fromNestedPactExec rollback (NestedDefPactExec stepCount yield step pid cont nested) =
+  DefPactExec stepCount yield step pid cont rollback nested
+
 data DefPactStep = DefPactStep
   { _psStep :: !Int
   , _psRollback :: !Bool
@@ -86,6 +108,7 @@ instance NFData Provenance
 instance NFData Yield
 instance NFData DefPactStep
 instance (NFData name, NFData v) => NFData (DefPactContinuation name v)
+instance NFData NestedDefPactExec
 instance NFData DefPactExec
 
 instance (Pretty name, Pretty v) => Pretty (DefPactContinuation name v) where

pact/Pact/Core/Environment/Types.hs

@@ -157,6 +157,8 @@ data ExecutionFlag
   | FlagRequireKeysetNs
   -- | Flag disabling return type checking
   | FlagDisableRuntimeRTC
+  -- | Flag Enable legacy events
+  | FlagEnableLegacyEventHashes
   deriving (Eq,Ord,Show,Enum,Bounded, Generic)
 
 instance NFData ExecutionFlag

pact/Pact/Core/Evaluate.hs

@@ -71,18 +71,35 @@ import qualified Pact.Core.Syntax.Parser as Lisp
 import qualified Pact.Core.Syntax.ParseTree as Lisp
 import qualified Data.Text as T
 
+import qualified Data.ByteString as BS
+import qualified Pact.Core.Serialise.LegacyPact as Legacy
+import Pact.Core.Pretty
+import Pact.Core.IR.Term
+
+-- | Function for debugging legacy serialized module data.
+--   feel free to delete after mainnet launch
+--   It's only useful for debugging some code paths in the legacy serialization.
+_decodeDbgModule :: FilePath -> IO ()
+_decodeDbgModule fp = do
+  x <- BS.readFile fp
+  let y = either error id $ Legacy.decodeModuleData' x
+  let m = unsafeAsModuleData y
+  let (ModuleCode code) = _mCode m
+  putStrLn $ T.unpack code
+  putStrLn "\n\nPRETTYIED REPR\n\n"
+  putStrLn $ show $ pretty m
+  where
+  unsafeAsModuleData = \case
+    ModuleData m _ -> m
+    _ -> error "not a module data"
+
 type Eval = EvalM ExecRuntime CoreBuiltin Info
 
 -- Our Builtin environment for evaluation in Chainweb prod
 type EvalBuiltinEnv = CEK.CoreBuiltinEnv Info
 type PactTxResult a =
   (Either (PactError Info) (a, [TxLog ByteString], Maybe TxId), EvalState CoreBuiltin Info)
 
-data EnableGasLogs
-  = GasLogsEnabled
-  | GasLogsDisabled
-  deriving (Eq, Show, Ord)
-
 evalInterpreter :: Interpreter ExecRuntime CoreBuiltin Info
 evalInterpreter =
   Interpreter runGuard runTerm resume evalWithCap
@@ -153,21 +170,13 @@ setupEvalEnv
   -> ExecutionMode -- <- we have this
   -> MsgData -- <- create at type for this
   -> Maybe Cont
-  -> GasModel CoreBuiltin
-  -> EnableGasLogs
+  -> GasEnv CoreBuiltin a
   -> NamespacePolicy
   -> SPVSupport
   -> PublicData
   -> S.Set ExecutionFlag
   -> IO (EvalEnv CoreBuiltin a)
-setupEvalEnv pdb mode msgData mCont gasModel' gasLogsEnabled np spv pd efs = do
-  gasRef <- newIORef mempty
-  gasLogs <- if gasLogsEnabled == GasLogsEnabled then Just <$> newIORef mempty else pure Nothing
-  let gasEnv = GasEnv
-        { _geGasRef = gasRef
-        , _geGasLog = gasLogs
-        , _geGasModel = gasModel'
-        }
+setupEvalEnv pdb mode msgData mCont gasEnv np spv pd efs = do
   pure $ EvalEnv
     { _eeMsgSigs = mkMsgSigs $ mdSigners msgData
     , _eeMsgVerifiers = mkMsgVerifiers $ mdVerifiers msgData
@@ -196,41 +205,38 @@ setupEvalEnv pdb mode msgData mCont gasModel' gasLogsEnabled np spv pd efs = do
 
 evalExec
   :: RawCode -> ExecutionMode -> PactDb CoreBuiltin Info
-  -> SPVSupport -> GasModel CoreBuiltin
-  -> EnableGasLogs
+  -> SPVSupport -> GasEnv CoreBuiltin Info
   -> Set ExecutionFlag -> NamespacePolicy
   -> PublicData -> MsgData
   -> CapState QualifiedName PactValue
   -> [Lisp.TopLevel SpanInfo] -> IO (Either (PactError Info) EvalResult)
-evalExec code execMode db spv gasModel gle flags nsp publicData msgData capState terms = do
-  evalEnv <- setupEvalEnv db execMode msgData Nothing gasModel gle nsp spv publicData flags
+evalExec code execMode db spv gasModel flags nsp publicData msgData capState terms = do
+  evalEnv <- setupEvalEnv db execMode msgData Nothing gasModel nsp spv publicData flags
   let evalState = def & esCaps .~ capState
   interpret code evalEnv evalState (Right terms)
 
 evalExecTerm
   :: ExecutionMode
   -> PactDb CoreBuiltin Info
-  -> SPVSupport -> GasModel CoreBuiltin
-  -> EnableGasLogs
+  -> SPVSupport -> GasEnv CoreBuiltin Info
   -> Set ExecutionFlag -> NamespacePolicy
   -> PublicData -> MsgData
   -> CapState QualifiedName PactValue
   -> Lisp.Expr SpanInfo -> IO (Either (PactError Info) EvalResult)
-evalExecTerm execMode db spv gasModel gle flags nsp publicData msgData capState term = do
-  evalEnv <- setupEvalEnv db execMode msgData Nothing gasModel gle nsp spv publicData flags
+evalExecTerm execMode db spv gasModel flags nsp publicData msgData capState term = do
+  evalEnv <- setupEvalEnv db execMode msgData Nothing gasModel nsp spv publicData flags
   let evalState = def & esCaps .~ capState
   interpret (RawCode mempty) evalEnv evalState (Right [Lisp.TLTerm term])
 
 evalContinuation
   :: ExecutionMode -> PactDb CoreBuiltin Info -> SPVSupport
-  -> GasModel CoreBuiltin
-  -> EnableGasLogs
+  -> GasEnv CoreBuiltin Info
   -> Set ExecutionFlag -> NamespacePolicy
   -> PublicData -> MsgData
   -> CapState QualifiedName PactValue
   -> Cont -> IO (Either (PactError Info) EvalResult)
-evalContinuation execMode db spv gasModel gle flags nsp publicData msgData capState cont = do
-  evalEnv <- setupEvalEnv db execMode msgData (Just cont) gasModel gle nsp spv publicData flags
+evalContinuation execMode db spv gasModel flags nsp publicData msgData capState cont = do
+  evalEnv <- setupEvalEnv db execMode msgData (Just cont) gasModel nsp spv publicData flags
   let evalState = def & esCaps .~ capState
   case _cProof cont of
     Nothing ->
@@ -251,14 +257,13 @@ evalContinuation execMode db spv gasModel gle flags nsp publicData msgData capSt
 evalGasPayerCap
   :: CapToken QualifiedName PactValue
   -> PactDb CoreBuiltin Info -> SPVSupport
-  -> GasModel CoreBuiltin
-  -> EnableGasLogs
+  -> GasEnv CoreBuiltin Info
   -> Set ExecutionFlag -> NamespacePolicy
   -> PublicData -> MsgData
   -> CapState QualifiedName PactValue
   -> Lisp.Expr Info -> IO (Either (PactError Info) EvalResult)
-evalGasPayerCap capToken db spv gasModel gle flags nsp publicData msgData capState body = do
-  evalEnv <- setupEvalEnv db Transactional msgData Nothing gasModel gle nsp spv publicData flags
+evalGasPayerCap capToken db spv gasModel flags nsp publicData msgData capState body = do
+  evalEnv <- setupEvalEnv db Transactional msgData Nothing gasModel nsp spv publicData flags
   let evalState = def & esCaps .~ capState
   interpretGasPayerTerm evalEnv evalState capToken body