Fix re-enabling repl lines (#1005)

* repl re-enable lines

* new flag + strip all past fork

* fix tests, strip infos in nested defpact

* address comments

docs/en/pact-functions.md

@@ -1861,7 +1861,7 @@ Retreive any accumulated events and optionally clear event state. Object returne
  *→* `[string]`
 
 
-Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePactEvents","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNamespaceUpgrade","PreserveNsModuleInstallBug","PreserveShowDefs"]
+Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePactEvents","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNamespaceUpgrade","PreserveNsModuleInstallBug","PreserveShowDefs"]
 ```lisp
 pact> (env-exec-config ['DisableHistoryInTransactionalMode]) (env-exec-config)
 ["DisableHistoryInTransactionalMode"]

src-ghc/Pact/Interpreter.hs

@@ -182,6 +182,7 @@ setupEvalEnv dbEnv ent mode msgData refStore gasEnv np spv pd ec =
   , _eePublicData = pd
   , _eeExecutionConfig = ec
   , _eeAdvice = def
+  , _eeInRepl = False
   }
   where
     mkMsgSigs ss = M.fromList $ map toPair ss

src/Pact/Eval.hs

@@ -257,11 +257,15 @@ evalNamespace info setter m = \case
 
 eval :: Term Name -> Eval e (Term Name)
 eval t =
-  ifExecutionFlagSet FlagDisableInlineMemCheck (eval' $!! t) (eval' $!! stripped)
+  ifExecutionFlagSet FlagDisableInlineMemCheck (eval' $!! t) (strippedEval t)
   where
-  stripped = case t of
-    TModule{} -> stripTermInfo t
-    _ -> t
+  strippedEval t' =
+    view eeInRepl >>= \case
+      True ->  eval' $!! t'
+      False ->  ifExecutionFlagSet FlagDisablePact44 (eval' $!! stripOnlyModule t') (eval' $!! stripTermInfo t')
+  stripOnlyModule t' = case t' of
+    TModule {} -> stripTermInfo t'
+    _ -> t'
 
 -- | Evaluate top-level term.
 eval' ::  Term Name ->  Eval e (Term Name)
@@ -1267,13 +1271,14 @@ reduceDirect (TLitString errMsg) _ i = evalError i $ pretty errMsg
 reduceDirect r _ ai = evalError ai $ "Unexpected non-native direct ref: " <> pretty r
 
 createNestedPactId :: HasInfo i => i -> PactContinuation -> PactId -> Eval e PactId
-createNestedPactId _ pc@(PactContinuation (QName _) _) (PactId parent) =
-  pure $ toPactId $ pactHash $ T.encodeUtf8 parent <> ":" <> (BL.toStrict (A.encode pc))
+createNestedPactId _ (PactContinuation (QName qn) pvs) (PactId parent) = do
+  let pc = PactContinuation (QName qn{_qnInfo = def}) pvs
+  pure $ toPactId $ pactHash $ T.encodeUtf8 parent <> ":" <> BL.toStrict (A.encode pc)
 createNestedPactId i n _ =
   evalError' i $ "Error creating nested pact id, name is not qualified: " <> pretty n
 
 initPact :: Info -> PactContinuation -> Term Ref -> Eval e (Term Name)
-initPact i app bod = view eePactStep >>= \es -> case es of
+initPact i app bod = view eePactStep >>= \case
   Just v@(PactStep step b parent _) -> do
     whenExecutionFlagSet FlagDisablePact43 $
       evalError i $ "initPact: internal error: step already in environment: " <> pretty v

src/Pact/Native.hs

@@ -160,7 +160,7 @@ enforceOneDef =
     enforceOne :: NativeFun e
     enforceOne i as@[msg,TList conds _ _] = runReadOnly i $
       gasUnreduced i as $ do
-        msg' <- reduce msg >>= \m -> case m of
+        msg' <- reduce msg >>= \case
           TLitString s -> return s
           _ -> argsError' i as
         let tryCond r@Just {} _ = return r
@@ -1303,7 +1303,7 @@ continueNested i as = gasUnreduced i as $ case as of
       (Just ps, Just pe) -> do
         contArgs <- traverse reduce args >>= enforcePactValue'
         let childName = QName (QualifiedName (_dModule d) (asString (_dDefName d)) def)
-            cont = PactContinuation childName contArgs
+            cont = PactContinuation childName (stripPactValueInfo <$> contArgs)
         newPactId <- createNestedPactId i cont (_psPactId ps)
         let newPs = PactStep (_psStep ps) (_psRollback ps) newPactId
         case _peNested pe ^. at newPactId of

src/Pact/Repl.hs

@@ -130,9 +130,25 @@ initPureEvalEnv verifyUri = do
 initEvalEnv :: LibState -> IO (EvalEnv LibState)
 initEvalEnv ls = do
   mv <- newMVar ls
-  return $ EvalEnv (RefStore nativeDefs) mempty Null Transactional
-    def def mv repldb def pactInitialHash freeGasEnv
-    permissiveNamespacePolicy (spvs mv) def def def
+  return $ EvalEnv
+    { _eeRefStore = RefStore nativeDefs
+    , _eeMsgSigs = mempty
+    , _eeMsgBody = Null
+    , _eeMode = Transactional
+    , _eeEntity = Nothing
+    , _eePactStep = Nothing
+    , _eePactDbVar = mv
+    , _eePactDb = repldb
+    , _eePurity = PImpure
+    , _eeHash = pactInitialHash
+    , _eeGasEnv = freeGasEnv
+    , _eeNamespacePolicy = permissiveNamespacePolicy
+    , _eeSPVSupport = spvs mv
+    , _eePublicData = def
+    , _eeExecutionConfig = def
+    , _eeAdvice = def
+    , _eeInRepl = True
+    }
   where
     spvs mv = set spvSupport (spv mv) noSPVSupport
 

src/Pact/Types/PactValue.hs

@@ -4,6 +4,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase #-}
+
 
 -- |
 -- Module      :  Pact.Types.PactValue
@@ -29,6 +31,7 @@ module Pact.Types.PactValue
   , _PGuard
   , _PObject
   , _PModRef
+  , stripPactValueInfo
   -- | Helper functions for generating arbitrary pact values
   , PactValueGeneratorSize(..)
   , decreaseGenSize
@@ -178,6 +181,15 @@ elideModRefInfo :: PactValue -> PactValue
 elideModRefInfo (PModRef m) = PModRef (set modRefInfo def m)
 elideModRefInfo p = p
 
+
+stripPactValueInfo :: PactValue -> PactValue
+stripPactValueInfo = \case
+  PLiteral lit -> PLiteral lit
+  PList vec -> PList (stripPactValueInfo <$> vec)
+  PObject om -> PObject (stripPactValueInfo <$> om)
+  PGuard gu -> PGuard gu
+  PModRef mr -> PModRef mr{_modRefInfo = def }
+
 -- | Lenient conversion, implying that conversion back won't necc. succeed.
 -- Integers are coerced to Decimal for simple representation.
 -- Non-value types are turned into their String representation.

src/Pact/Types/Purity.hs

@@ -98,6 +98,7 @@ mkPureEnv holder purity readRowImpl env@EvalEnv{..} = do
     _eePublicData
     _eeExecutionConfig
     _eeAdvice
+    _eeInRepl
 
 -- | Operationally creates the sysread-only environment.
 -- Phantom type and typeclass assigned in "runXXX" functions.

src/Pact/Types/Runtime.hs

@@ -23,7 +23,7 @@ module Pact.Types.Runtime
    PactId(..),
    PactEvent(..), eventName, eventParams, eventModule, eventModuleHash,
    RefStore(..),rsNatives,
-   EvalEnv(..),eeRefStore,eeMsgSigs,eeMsgBody,eeMode,eeEntity,eePactStep,eePactDbVar,
+   EvalEnv(..),eeRefStore,eeMsgSigs,eeMsgBody,eeMode,eeEntity,eePactStep,eePactDbVar,eeInRepl,
    eePactDb,eePurity,eeHash,eeGasEnv,eeNamespacePolicy,eeSPVSupport,eePublicData,eeExecutionConfig,
    eeAdvice,
    toPactId,
@@ -161,6 +161,8 @@ data ExecutionFlag
   | FlagDisablePact43
   -- | Disable pact 4.3 features
   | FlagDisablePact431
+  -- | Disable Pact 4.4 features
+  | FlagDisablePact44
   -- | Preserve old ns behavior for module upgrade
   | FlagPreserveNamespaceUpgrade
   deriving (Eq,Ord,Show,Enum,Bounded)
@@ -228,6 +230,8 @@ data EvalEnv e = EvalEnv {
     , _eeExecutionConfig :: ExecutionConfig
       -- | Advice bracketer
     , _eeAdvice :: !Advice
+      -- | Are we in the repl? If so, ignore info
+    , _eeInRepl :: Bool
     }
 makeLenses ''EvalEnv
 

tests/GoldenSpec.hs

@@ -62,7 +62,7 @@ spec = do
 goldenModule :: [ExecutionFlag] -> String -> FilePath -> ModuleName -> [(String, String -> ReplState -> Spec)] -> Spec
 goldenModule flags tn fp mn tests = after_ (cleanupActual tn (map fst tests)) $ do
   let ec = mkExecutionConfig flags
-  (r,s) <- runIO $ execScriptF' Quiet fp (\st -> st & rEnv . eeExecutionConfig .~ ec)
+  (r,s) <- runIO $ execScriptF' Quiet fp (set (rEnv . eeExecutionConfig) ec . set (rEnv . eeInRepl) False)
   it ("loads " ++ fp) $ r `shouldSatisfy` isRight
   mr <- runIO $ replLookupModule s mn
   case mr of
@@ -80,8 +80,10 @@ subTestName tn n = tn ++ "-" ++ n
 acctsSuccessCR :: String -> ReplState -> Spec
 acctsSuccessCR tn s = doCRTest tn s "1"
 
+-- Needs disablePact44 here, accts failure cr
+-- results in `interactive:0:0` which is an info that has been stripped
 acctsFailureCR :: String -> ReplState -> Spec
-acctsFailureCR tn s = doCRTest tn s "(accounts.transfer \"a\" \"b\" 1.0 true)"
+acctsFailureCR tn s = doCRTest' (mkExecutionConfig [FlagDisablePact44]) tn s "(accounts.transfer \"a\" \"b\" 1.0 true)"
 
 eventCR :: String -> ReplState -> Spec
 eventCR tn s = doCRTest' (mkExecutionConfig [FlagDisableInlineMemCheck, FlagDisablePact43]) tn s $

tests/test-config-disable40.yaml

@@ -18,3 +18,4 @@ verbose: False
 execConfig:
   - DisablePact40
   - DisablePact43
+  - DisablePact44