Merge remote-tracking branch 'origin/jose/obj-tables' into rsoeldner/…

…defpact

pact-core/Pact/Core/Builtin.hs

@@ -245,8 +245,8 @@ data RawBuiltin
   | RawWithDefaultRead
   | RawWithRead
   | RawWrite
-  -- | RawTxIds
-  -- | RawTxLog
+  | RawTxIds
+  | RawTxLog
   -- Db QueryFunctions
   | RawAndQ
   | RawOrQ
@@ -358,6 +358,8 @@ rawBuiltinToText = \case
   RawWithDefaultRead -> "with-default-read"
   RawWithRead -> "with-read"
   RawWrite -> "write"
+  RawTxIds -> "txids"
+  RawTxLog -> "txlog"
   RawAndQ -> "and?"
   RawOrQ -> "or?"
   RawWhere -> "where?"
@@ -465,6 +467,8 @@ instance IsBuiltin RawBuiltin where
     RawWithDefaultRead -> 4
     RawWithRead -> 3
     RawWrite -> 3
+    RawTxIds -> 2
+    RawTxLog -> 2
     RawAndQ -> 3
     RawOrQ -> 3
     RawWhere -> 3
@@ -495,6 +499,7 @@ data ReplBuiltins
   | RBeginTx
   | RCommitTx
   | RRollbackTx
+  | RSigKeyset
   -- | RLoad
   -- | RLoadWithEnv
   -- | RExpect
@@ -546,6 +551,7 @@ instance IsBuiltin ReplBuiltins where
     RBeginTx -> 1
     RCommitTx -> 1
     RRollbackTx -> 1
+    RSigKeyset -> 1
     -- RLoad -> 1
     -- RLoadWithEnv -> 2
 -- Note: commented out natives are
@@ -606,6 +612,7 @@ replBuiltinsToText = \case
   RBeginTx -> "begin-tx"
   RCommitTx -> "commit-tx"
   RRollbackTx -> "rollback-tx"
+  RSigKeyset -> "sig-keyset"
   -- RLoad -> "load"
   -- RLoadWithEnv -> "load-with-env"
 

pact-core/Pact/Core/Capabilities.hs

@@ -27,19 +27,19 @@ import Data.Default
 
 
 import Pact.Core.Pretty
-import Pact.Core.Names ( ModuleName, FullyQualifiedName )
+import Pact.Core.Names
 import Pact.Core.Hash
 
 data DefManagedMeta name
   = DefManagedMeta
   { _dmManagedArgIx :: Int
-  , _dmManagerFn :: name
-  } deriving (Show, Functor, Foldable, Traversable)
+  , _dmManagerFn :: FQNameRef name
+  } deriving (Show)
 
 data DefCapMeta name
   = DefEvent
   | DefManaged (Maybe (DefManagedMeta name))
-  deriving (Show, Functor, Foldable, Traversable)
+  deriving (Show)
 
 data CapForm name e
   = WithCapability name [e] e

pact-core/Pact/Core/Compile.hs

@@ -3,15 +3,15 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 
 module Pact.Core.Compile where
 
 import Control.Lens
--- import Control.Monad.IO.Class(MonadIO)
 import Control.Monad.State.Strict ( MonadIO(..), MonadState )
-import Control.Monad.Except
+import Control.Monad.Except ( MonadError(throwError), liftEither )
 import Control.Monad
 import Data.Maybe(mapMaybe)
 import Data.Proxy
@@ -21,6 +21,7 @@ import qualified Data.ByteString as B
 import qualified Data.Set as Set
 
 import Pact.Core.Debug
+import Pact.Core.Builtin
 import Pact.Core.Info
 import Pact.Core.Persistence
 import Pact.Core.Names
@@ -32,9 +33,10 @@ import Pact.Core.IR.Term
 import Pact.Core.Interpreter
 import Pact.Core.Guards
 import Pact.Core.Environment
+import Pact.Core.Capabilities
+import Pact.Core.Literal
 
 
--- import qualified Pact.Core.Syntax.LexUtils as Lisp
 import qualified Pact.Core.Syntax.Lexer as Lisp
 import qualified Pact.Core.Syntax.Parser as Lisp
 import qualified Pact.Core.Syntax.ParseTree as Lisp
@@ -82,6 +84,7 @@ compileProgram source pdb interp = do
     >=> runDesugarTopLevel Proxy pdb lo
     >=> interpretTopLevel pdb interp
 
+-- | Evaluate module governance
 evalModuleGovernance
   :: (HasCompileEnv b s m)
   => PactDb b SpanInfo
@@ -92,17 +95,18 @@ evalModuleGovernance pdb interp = \case
   tl@(Lisp.TLModule m) -> liftIO (readModule pdb (Lisp._mName m)) >>= \case
     Just (ModuleData md _) ->
       case _mGovernance md of
-        KeyGov _ksn -> error "TODO: implement enforcing keyset names"
-        CapGov (Name n nk) -> case nk of
-          NTopLevel mn mh ->
-            use (evalState . loaded . loAllLoaded . at (FullyQualifiedName mn n mh)) >>= \case
-              Just (DCap d) ->
-                _interpret interp (_dcapTerm d) >>= \case
-                  IPV{} -> pure tl
-                  _ -> error "governance failure"
-              -- Todo: Definitely fixable with a GADT
-              _ -> error "invalid governance: not a defcap"
-          _ -> error "invariant failure: governance is not a fully qualified name"
+        KeyGov (KeySetName ksn) -> do
+          let info = Lisp._mInfo m
+              ksnTerm = Constant (LString ksn) info
+              ksrg = App (Builtin (liftRaw RawKeysetRefGuard) info) (pure ksnTerm) info
+              term = App (Builtin (liftRaw RawEnforceGuard) info) (pure ksrg) info
+          _interpret interp term *> pure tl
+        CapGov (ResolvedGov fqn) ->
+          use (evalState . loaded . loAllLoaded . at fqn) >>= \case
+            Just (DCap d) ->
+              _interpret interp (_dcapTerm d) *> pure tl
+            -- Todo: Definitely fixable with a GADT
+            _ -> throwError (PEExecutionError (ModuleGovernanceFailure (Lisp._mName m)) (Lisp._mInfo m))
     Just (InterfaceData iface _) ->
       throwError (PEExecutionError (CannotUpgradeInterface (_ifName iface)) (_ifInfo iface))
     Nothing -> pure tl
@@ -127,6 +131,7 @@ interpretTopLevel pdb interp (DesugarOutput ds lo0 deps) = do
             over loModules (M.insert (_mName m) mdata) .
             over loAllLoaded (M.union newLoaded)
       evalState . loaded %= loadNewModule
+      evalState . esCaps . csModuleAdmin %= Set.union (Set.singleton (_mName m))
       pure (LoadedModule (_mName m))
     TLInterface iface -> do
       let deps' = M.filterWithKey (\k _ -> Set.member (_fqModule k) deps) (_loAllLoaded lo0)
@@ -140,6 +145,7 @@ interpretTopLevel pdb interp (DesugarOutput ds lo0 deps) = do
       evalState . loaded %= loadNewModule
       pure (LoadedInterface (view ifName iface))
     TLTerm term -> InterpretValue <$> _interpret interp term
+    TLUse _ -> error "todo: use statements"
   where
   toFqDep modName mhash defn =
     let fqn = FullyQualifiedName modName (defName defn) mhash

pact-core/Pact/Core/Environment.hs

@@ -17,7 +17,8 @@ module Pact.Core.Environment
  ( EvalEnv(..)
  , eeMsgSigs, eePactDb
  , eeHash, eeMsgBody
- , eePublicData, eePactStep
+ , eePactStep
+ , eePublicData, eeMode
  , PactState(..)
  , psLoaded
  , TxCreationTime(..)
@@ -52,7 +53,7 @@ import Pact.Core.Guards
 import Pact.Core.PactValue ( PactValue, EnvData )
 import Pact.Core.Hash
 import Pact.Core.Names
-import Pact.Core.Pacts.Types (PactExec, PactStep)
+import Pact.Core.Pacts.Types
 
 -- | Wrapper for 'PublicMeta' ttl field in seconds since offset
 --
@@ -133,12 +134,8 @@ data EvalEnv b i
   , _eeHash :: Hash
   , _eePublicData :: PublicData
   , _eePactStep :: Maybe PactStep
-  -- Todo: `PactWarning`
-  -- , _eeWarning :: IORef (Set Text)
-  -- , _eePactStep :: !(Maybe PactStep)
-  --   _cekGas :: IORef Gas
-  -- , _cekEvalLog :: IORef (Maybe [(Text, Gas)])
-  -- , _ckeData :: EnvData PactValue
+  , _eeMode :: ExecutionMode
+  -- ^ The pact execution mode: local or transactional
   }
 
 makeLenses ''EvalEnv

pact-core/Pact/Core/Errors.hs

@@ -28,6 +28,7 @@ import Pact.Core.Names
 import Pact.Core.Guards
 import Pact.Core.Info
 import Pact.Core.Pretty(Pretty(..))
+import Pact.Core.Hash
 import Pact.Core.Persistence
 
 import qualified Pact.Core.Pretty as Pretty
@@ -136,6 +137,8 @@ data DesugarError
   -- ^ Defpact without steps
   | LastStepWithRollback QualifiedName
   -- ^ Last Step has Rollback error
+  | ExpectedFreeVariable Text
+  -- ^ Expected free variable
   deriving Show
 
 instance Exception DesugarError
@@ -191,6 +194,8 @@ instance Pretty DesugarError where
     EmptyDefPact dp -> Pretty.hsep ["Defpact has no steps:", pretty dp]
     LastStepWithRollback mn ->
       Pretty.hsep ["rollbacks aren't allowed on the last step in:", pretty mn]
+    ExpectedFreeVariable t ->
+      Pretty.hsep ["Expected free variable in expression, found locally bound: ", pretty t]
 
 -- data TypecheckError
 --   = UnificationError (Type Text) (Type Text)
@@ -305,7 +310,17 @@ data EvalError
   -- ^ No such keyset
   | CannotUpgradeInterface ModuleName
   -- ^ Interface cannot be upgrade
+  | ModuleGovernanceFailure ModuleName
+  -- ^ Failed to acquire module governance
   | DbOpFailure DbOpException
+  -- ^ DynName is not a module ref
+  | DynNameIsNotModRef Text
+  | ModuleDoesNotExist ModuleName
+  | ExpectedModule ModuleName
+  -- ^ Module does not exist
+  | HashNotBlessed ModuleName ModuleHash
+  | CannotApplyPartialClosure
+  | ClosureAppliedToTooManyArgs
   deriving Show
 
 instance Pretty EvalError where
@@ -344,7 +359,7 @@ instance Pretty EvalError where
       Pretty.hsep ["Continue pact step with invalid context: user: ", pretty userStep, ", current: ", pretty currStep, ", max: ", pretty maxStep]
     MultipleOrNestedPactExecFound -> "Multiple or nested pact exec found"
     PactStepNotFound s -> Pretty.hsep ["PactStep not found:", pretty s]
-    err -> error ("todo: render" ++ show err)
+    e -> pretty (show e)
 
 
 

pact-core/Pact/Core/Guards.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE GADTs #-}
 
 
 module Pact.Core.Guards
@@ -11,6 +12,7 @@ module Pact.Core.Guards
 , CapabilityGuard(..)
 , KSPredicate(..)
 , ModuleGuard(..)
+, CapGovRef(..)
 )
 where
 
@@ -22,13 +24,25 @@ import Pact.Core.Names
 newtype PublicKeyText = PublicKeyText { _pubKey :: Text }
   deriving (Eq,Ord,Show)
 
-newtype KeySetName = KeySetName Text
+newtype KeySetName = KeySetName { _keysetName :: Text }
     deriving (Eq,Ord,Show)
 
 data Governance name
   = KeyGov KeySetName
-  | CapGov name
-  deriving (Eq, Show, Functor, Foldable, Traversable)
+  | CapGov (CapGovRef name)
+  deriving (Eq, Show)
+
+data CapGovRef name where
+  UnresolvedGov :: ParsedName -> CapGovRef ParsedName
+  ResolvedGov :: FullyQualifiedName -> CapGovRef Name
+
+instance Eq (CapGovRef name) where
+  (UnresolvedGov g1) == (UnresolvedGov g2) = g1 == g2
+  (ResolvedGov g1) == (ResolvedGov g2) = g1 == g2
+
+instance Show (CapGovRef name) where
+  show (UnresolvedGov ksn) = "(UnresolvedGov " <> show ksn <> ")"
+  show (ResolvedGov g) = "(ResolvedGov" <> show g <> ")"
 
 data KSPredicate name
   = KeysAll