Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix re-enabling repl lines #1005

Merged
merged 5 commits into from Jul 15, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
2 changes: 1 addition & 1 deletion docs/en/pact-functions.md
Expand Up @@ -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"]
Expand Down
1 change: 1 addition & 0 deletions src-ghc/Pact/Interpreter.hs
Expand Up @@ -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
Expand Down
19 changes: 12 additions & 7 deletions src/Pact/Eval.hs
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/Pact/Native.hs
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
22 changes: 19 additions & 3 deletions src/Pact/Repl.hs
Expand Up @@ -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

Expand Down
12 changes: 12 additions & 0 deletions src/Pact/Types/PactValue.hs
Expand Up @@ -4,6 +4,8 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}


-- |
-- Module : Pact.Types.PactValue
Expand All @@ -29,6 +31,7 @@ module Pact.Types.PactValue
, _PGuard
, _PObject
, _PModRef
, stripPactValueInfo
-- | Helper functions for generating arbitrary pact values
, PactValueGeneratorSize(..)
, decreaseGenSize
Expand Down Expand Up @@ -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.
Expand Down
1 change: 1 addition & 0 deletions src/Pact/Types/Purity.hs
Expand Up @@ -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.
Expand Down
6 changes: 5 additions & 1 deletion src/Pact/Types/Runtime.hs
Expand Up @@ -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,
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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

Expand Down
6 changes: 4 additions & 2 deletions tests/GoldenSpec.hs
Expand Up @@ -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
Expand All @@ -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 $
Expand Down
1 change: 1 addition & 0 deletions tests/test-config-disable40.yaml
Expand Up @@ -18,3 +18,4 @@ verbose: False
execConfig:
- DisablePact40
- DisablePact43
- DisablePact44