move pactvalues to qualnames, fix serialise instances

pact-core-tests/Pact/Core/Gen/Serialise.hs

@@ -17,36 +17,19 @@ import qualified Data.Vector as Vec
 import Hedgehog hiding (Var)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
-
-import Pact.Core.Names (BareName(..), DefPactId(..), DynamicName(..),
-                        DynamicRef(..), Field(..), FQNameRef(FQName),
-                        FullyQualifiedName(..), ModuleName(..), Name(..),
-                        NameKind(NBound, NDynRef, NModRef, NTopLevel),
-                        NamespaceName(..), ParsedName(BN,DN,QN),
-                        QualifiedName(..))
-import Pact.Core.Guards (CapGovRef(UnresolvedGov, ResolvedGov),
-                         Governance(CapGov, KeyGov), Guard(GKeyset,GKeySetRef),
-                         KeySet(..), KeySetName(..),
-                         KSPredicate(KeysAll, Keys2, KeysAny), PublicKeyText(..),
-                         UserGuard(..))
+import Pact.Core.Names
+import Pact.Core.Guards
 import Pact.Core.Hash (Hash(..), ModuleHash(..))
-import Pact.Core.Type (Arg(..), PrimType(PrimBool, PrimDecimal, PrimGuard,
-                                         PrimInt, PrimString, PrimTime,
-                                         PrimUnit),
-                       Schema(Schema, _schema), Type(TyList, TyModRef, TyObject,
-                                                     TyPrim, TyTable))
+import Pact.Core.Type
 import Pact.Core.Imports (Import(..))
 import Pact.Core.IR.Term
 import Pact.Core.Info (SpanInfo)
-import Pact.Core.Builtin (RawBuiltin, BuiltinForm(CAnd, COr, CIf, CEnforce,
-                                                   CEnforceOne))
-import Pact.Core.Literal (Literal(LBool, LDecimal, LInteger, LString, LUnit))
-import Pact.Core.Capabilities (DefManagedMeta(DefManagedMeta, AutoManagedMeta),
-                               DefCapMeta(DefEvent, DefManaged, Unmanaged) )
-import Pact.Core.Persistence (ModuleData(ModuleData, InterfaceData))
-import Pact.Core.PactValue (PactValue(PGuard, PList, PLiteral))
-import Pact.Core.DefPacts.Types (DefPactContinuation(..), DefPactExec(..),
-                                 Provenance(..), Yield(..))
+import Pact.Core.Builtin
+import Pact.Core.Literal
+import Pact.Core.Capabilities
+import Pact.Core.Persistence
+import Pact.Core.PactValue
+import Pact.Core.DefPacts.Types
 import Pact.Core.ChainData (ChainId(..))
 import Pact.Core.Namespace (Namespace(..))
 import Pact.Core.Test.LexerParserTests (identGen)
@@ -57,8 +40,8 @@ namespaceNameGen = NamespaceName <$> identGen
 namespaceGen :: Gen Namespace
 namespaceGen = do
   name <- namespaceNameGen
-  user <- guardGen 3 fullyQualifiedNameGen
-  Namespace name user <$> guardGen 3 fullyQualifiedNameGen
+  user <- guardGen 3 qualifiedNameGen
+  Namespace name user <$> guardGen 3 qualifiedNameGen
 
 moduleNameGen :: Gen ModuleName
 moduleNameGen =  do
@@ -437,7 +420,7 @@ pactValueGen' :: Int ->Gen PactValue
 pactValueGen' depth = Gen.choice
   [ PLiteral <$> literalGen
   , PList . Vec.fromList <$> Gen.list (Range.linear 0 depth) (pactValueGen' (depth - 1))
-  , PGuard <$> guardGen (depth - 1) fullyQualifiedNameGen
+  , PGuard <$> guardGen (depth - 1) qualifiedNameGen
   ]
 
 chainIdGen :: Gen ChainId
@@ -454,9 +437,9 @@ yieldGen = do
   p <- Gen.maybe provenanceGen
   Yield d p <$> Gen.maybe chainIdGen
 
-defPactContinuationGen :: Gen (DefPactContinuation FullyQualifiedName PactValue)
+defPactContinuationGen :: Gen (DefPactContinuation QualifiedName PactValue)
 defPactContinuationGen = do
-  ident <- fullyQualifiedNameGen
+  ident <- qualifiedNameGen
   DefPactContinuation ident <$> Gen.list (Range.linear 0 8) pactValueGen
 
 defPactExecGen :: Gen DefPactExec

pact-core-tests/Pact/Core/Test/PersistenceTests.hs

@@ -19,7 +19,7 @@ import Pact.Core.Guards (KeySet(KeySet), KeySetName(..), PublicKeyText(..), KSPr
 import Pact.Core.Gen.Serialise (keySetGen, keySetNameGen, moduleNameGen, moduleDataGen, builtinGen
                                ,defPactIdGen, defPactExecGen, namespaceNameGen, namespaceGen)
 import Pact.Core.Literal (Literal(LUnit))
-import Pact.Core.Names (Field(..), FullyQualifiedName, RowKey(..), TableName(..), ModuleName(..))
+import Pact.Core.Names 
 import Pact.Core.PactValue
 import qualified Pact.Core.PactValue as PactValue
 import Pact.Core.Persistence.SQLite
@@ -53,7 +53,7 @@ testsWithSerial serial b i =
  , testProperty "Namespace" $ namespaceRoundtrip serial
  ]
 
-keysetPersistRoundtrip :: PactSerialise b i -> Gen (KeySet FullyQualifiedName) -> Property
+keysetPersistRoundtrip :: PactSerialise b i -> Gen (KeySet QualifiedName) -> Property
 keysetPersistRoundtrip serial keysetGen =
   property $ do
     keysetName <- forAll keySetNameGen
@@ -130,7 +130,7 @@ sqliteRegression =
              , (Field "fh", PactValue.PInteger 1)
              ]
       row2Enc = _encodeRowData serialisePact_repl_spaninfo row2
-                 
+
     _pdbWrite pdb Update (DUserTables usert) (RowKey "key1") row2
     Just row2' <- _pdbRead pdb (DUserTables usert) (RowKey "key1")
     assertEqual "user update should overwrite with new value" row2 row2'
@@ -159,7 +159,7 @@ sqliteRegression =
       , TxLog "user1" "key1" row2Enc
       , TxLog "user1" "key1" rowEnc
       ]
- 
+
     -- begin tx
     _ <- _pdbBeginTx pdb Transactional
     tids <- _pdbTxIds pdb usert t1
@@ -183,7 +183,7 @@ sqliteRegression =
 
     rkeys2 <- _pdbKeys pdb (DUserTables usert)
     assertEqual "keys post-rollback [key1]" [RowKey "key1"] rkeys2
-    
+
     where
       loadModule = do
         let src = "(module test G (defcap G () true) (defun f (a: integer) 1))"
@@ -195,4 +195,4 @@ sqliteRegression =
         Right _ <- runReplT ref (interpretReplProgram (SourceCode "test" src) (const (pure ())))
         Just md <- readModule pdb (ModuleName "test" Nothing)
         pure md
-        
+

pact-core-tests/Pact/Core/Test/SerialiseTests.hs

@@ -102,7 +102,7 @@ serialiseModule = property $ do
 
 serialiseKeySet :: Property
 serialiseKeySet = property $ do
-  ks <- forAll (keySetGen fullyQualifiedNameGen)
+  ks <- forAll (keySetGen qualifiedNameGen)
   let
     encoded = _encodeKeySet serialisePact ks
   case _decodeKeySet serialisePact encoded of

pact-core/Pact/Core/DefPacts/Types.hs

@@ -56,7 +56,7 @@ data DefPactExec
   , _peYield :: Maybe Yield
   , _peStep :: Int
   , _peDefPactId :: DefPactId
-  , _peContinuation :: DefPactContinuation FullyQualifiedName PactValue
+  , _peContinuation :: DefPactContinuation QualifiedName PactValue
   , _peStepHasRollback :: Bool
   , _peNestedDefPactExec :: Map DefPactId DefPactExec
   } deriving (Show, Eq)

pact-core/Pact/Core/Environment/Utils.hs

@@ -182,7 +182,7 @@ mangleNamespace mn@(ModuleName mnraw ns) =
 
 isKeysetInSigs
   :: MonadEval b i m
-  => KeySet FullyQualifiedName
+  => KeySet QualifiedName
   -> m Bool
 isKeysetInSigs (KeySet kskeys ksPred) = do
   matchedSigs <- M.filterWithKey matchKey <$> viewEvalEnv eeMsgSigs

pact-core/Pact/Core/Guards.hs

@@ -23,9 +23,6 @@ module Pact.Core.Guards
 )
 where
 
-import qualified Data.Char as Char
-import qualified Data.Set as S
-import qualified Data.Text as T
 import Control.Applicative
 import Control.Monad
 import Data.Attoparsec.Text
@@ -34,6 +31,10 @@ import Data.String
 import Data.Text(Text)
 import Text.Parser.Token as P
 
+import qualified Data.Char as Char
+import qualified Data.Set as S
+import qualified Data.Text as T
+
 import Pact.Core.Pretty
 import Pact.Core.Names
 import Pact.Core.RuntimeParsers
@@ -97,7 +98,7 @@ data KSPredicate name
   | Keys2
   | KeysAny
   -- | CustomPredicate name -- TODO: When this is brought back, fix up `keySetGen`!
-  deriving (Eq, Show, Ord)
+  deriving (Eq, Show, Ord, Functor, Foldable, Traversable)
 
 predicateToString :: IsString s => KSPredicate name -> s
 predicateToString = \case
@@ -112,7 +113,7 @@ data KeySet name
   = KeySet
   { _ksKeys :: !(S.Set PublicKeyText)
   , _ksPredFun :: KSPredicate name
-  } deriving (Eq, Show, Ord)
+  } deriving (Eq, Show, Ord, Functor, Foldable, Traversable)
 
 instance Pretty name => Pretty (KeySet name) where
   pretty (KeySet ks f) = "KeySet" <+> commaBraces

pact-core/Pact/Core/IR/Eval/CEK.hs

@@ -247,7 +247,7 @@ mkDefPactClosure info fqn dpact env = case _dpArgs dpact of
 initPact
   :: MonadEval b i m
   => i
-  -> DefPactContinuation FullyQualifiedName PactValue
+  -> DefPactContinuation QualifiedName PactValue
   -> Cont b i m
   -> CEKErrorHandler b i m
   -> CEKEnv b i m
@@ -272,7 +272,7 @@ initPact i pc cont handler cenv = do
 applyPact
   :: MonadEval b i m
   => i
-  -> DefPactContinuation FullyQualifiedName PactValue
+  -> DefPactContinuation QualifiedName PactValue
   -> DefPactStep
   -> Cont b i m
   -> CEKErrorHandler b i m
@@ -281,8 +281,8 @@ applyPact
   -> m (EvalResult b i m)
 applyPact i pc ps cont handler cenv nested = useEvalState esDefPactExec >>= \case
   Just pe ->  throwExecutionError i (MultipleOrNestedDefPactExecFound pe)
-  Nothing -> lookupFqName (pc ^. pcName) >>= \case
-    Just (DPact defPact) -> do
+  Nothing -> getModuleMember i (_cePactDb cenv) (pc ^. pcName) >>= \case
+    DPact defPact -> do
       let nSteps = NE.length (_dpSteps defPact)
 
       -- Check we try to apply the correct pact Step
@@ -311,14 +311,14 @@ applyPact i pc ps cont handler cenv nested = useEvalState esDefPactExec >>= \cas
         (True, StepWithRollback _ rollbackExpr) ->
           evalWithStackFrame i cont' handler cenv sf Nothing rollbackExpr
         (True, Step{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
-    _otherwise -> failInvariant i "DefPact not found"
+    _otherwise -> failInvariant i "defpact continuation does not point to defun"
   where
-  sf = StackFrame (view (pcName . fqName) pc) (view (pcName . fqModule) pc) SFDefPact
+  sf = StackFrame (view (pcName . qnName) pc) (view (pcName . qnModName) pc) SFDefPact
 
 applyNestedPact
   :: MonadEval b i m
   => i
-  -> DefPactContinuation FullyQualifiedName PactValue
+  -> DefPactContinuation QualifiedName PactValue
   -> DefPactStep
   -> Cont b i m
   -> CEKErrorHandler b i m
@@ -328,8 +328,8 @@ applyNestedPact i pc ps cont handler cenv = useEvalState esDefPactExec >>= \case
   Nothing -> failInvariant i $
     "applyNestedPact: Nested DefPact attempted but no pactExec found" <> T.pack (show pc)
 
-  Just pe -> lookupFqName (pc ^. pcName) >>= \case
-    Just (DPact defPact) -> do
+  Just pe -> getModuleMember i (_cePactDb cenv) (pc ^. pcName) >>= \case
+    DPact defPact -> do
       step <- maybe (failInvariant i "Step not found") pure
         $ _dpSteps defPact ^? ix (ps ^. psStep)
 
@@ -377,7 +377,7 @@ applyNestedPact i pc ps cont handler cenv = useEvalState esDefPactExec >>= \case
         (True, Step{}) -> throwExecutionError i (DefPactStepHasNoRollback ps)
     _otherwise -> failInvariant i "applyNestedPact: Expected a DefPact bot got something else"
   where
-  sf = StackFrame (view (pcName . fqName) pc) (view (pcName . fqModule) pc) SFDefPact
+  sf = StackFrame (view (pcName . qnName) pc) (view (pcName . qnModName) pc) SFDefPact
 
 resumePact
   :: MonadEval b i m
@@ -538,7 +538,7 @@ evalCap
   -> (CEKEnv b i m -> Maybe (CapToken QualifiedName PactValue) -> Maybe (PactEvent PactValue) -> EvalTerm b i -> Cont b i m -> Cont b i m)
   -> EvalTerm b i
   -> m (EvalResult b i m)
-evalCap info currCont handler env origToken@(CapToken fqn args) modCont contbody = isCapInStack origToken >>= \case
+evalCap info currCont handler env origToken@(CapToken fqn args) modCont contbody = isCapInStack' origToken >>= \case
   False -> do
     lookupFqName fqn >>= \case
       Just (DCap d) -> do
@@ -715,20 +715,26 @@ requireCap
   -> CEKErrorHandler b i m
   -> FQCapToken
   -> m (EvalResult b i m)
-requireCap info cont handler ct@(CapToken fqn _) = do
-  capInStack <- isCapInStack ct
+requireCap info cont handler (CapToken fqn args) = do
+  capInStack <- isCapInStack (CapToken (fqnToQualName fqn) args)
   if capInStack then returnCEKValue cont handler (VBool True)
   else returnCEK cont handler $ VError ("cap not in scope " <> renderQualName (fqnToQualName fqn)) info
 
 isCapInStack
   :: (MonadEval b i m)
-  => FQCapToken
+  => CapToken QualifiedName PactValue
   -> m Bool
-isCapInStack (CapToken fqn args) = do
-  let ct = CapToken (fqnToQualName fqn) args
+isCapInStack ct = do
   capSet <- getAllStackCaps
   pure $ S.member ct capSet
 
+isCapInStack'
+  :: (MonadEval b i m)
+  => CapToken FullyQualifiedName PactValue
+  -> m Bool
+isCapInStack' (CapToken fqn args) =
+  isCapInStack (CapToken (fqnToQualName fqn) args)
+
 composeCap
   :: (MonadEval b i m)
   => i
@@ -738,7 +744,7 @@ composeCap
   -> FQCapToken
   -> m (EvalResult b i m)
 composeCap info cont handler env origToken =
-  isCapInStack origToken >>= \case
+  isCapInStack' origToken >>= \case
     False ->
       evalCap info cont handler env origToken (CapBodyC PopCapComposed) (Constant (LBool True) info)
       -- let ct = CapToken (fqnToQualName fqn) args
@@ -814,7 +820,7 @@ createUserGuard
 createUserGuard info cont handler fqn args =
   lookupFqName fqn >>= \case
     Just (Dfun _) ->
-      returnCEKValue cont handler (VGuard (GUserGuard (UserGuard fqn args)))
+      returnCEKValue cont handler (VGuard (GUserGuard (UserGuard (fqnToQualName fqn) args)))
     Just _ ->
       returnCEK cont handler (VError "create-user-guard pointing to non-guard" info)
     Nothing ->
@@ -1166,11 +1172,11 @@ applyLam (DPC (DefPactClosure fqn argtys arity env i)) args cont handler
     ArgClosure cloargs -> do
       args' <- traverse (enforcePactValue i) args
       tcArgs <- zipWithM (\arg ty -> maybeTCType i arg ty) args' (NE.toList cloargs)
-      let pc = DefPactContinuation fqn tcArgs
+      let pc = DefPactContinuation (fqnToQualName fqn) tcArgs
           env' = set ceLocal (RAList.fromList (reverse (VPactValue <$> tcArgs))) env
       initPact i pc cont handler env'
     NullaryClosure -> do
-      let pc = DefPactContinuation fqn []
+      let pc = DefPactContinuation (fqnToQualName fqn) []
           env' = set ceLocal mempty env
       initPact i pc cont handler env'
   | otherwise = throwExecutionError i ClosureAppliedToTooManyArgs