Namespaces

docs/en/pact-functions.md

@@ -77,6 +77,19 @@ true
 ```
 
 
+### define-namespace {#define-namespace}
+
+*namespace* `string` *guard* `guard` *→* `string`
+
+
+Create a namespace called NAMESPACE for a given GUARD. All expressions that occur in a given transaction will be tied to NAMESPACE, and may be accessed using the toplevel call (namespace NAMESPACE) when GUARD is in scope. If NAMESPACE is already defined, then the guard previously defined in NAMESPACE will be enforced, and GUARD will be rotated in its place. 
+```lisp
+(define-namespace 'my-namespace (read-keyset 'my-keyset))
+```
+
+Top level only: this function will fail if used in module code.
+
+
 ### drop {#drop}
 
 *count*&nbsp;`integer` *list*&nbsp;`<a[[<l>],string]>` *&rarr;*&nbsp;`<a[[<l>],string]>`
@@ -271,6 +284,19 @@ pact> (map (+ 1) [1 2 3])
 ```
 
 
+### namespace {#namespace}
+
+*namespace*&nbsp;`string` *&rarr;*&nbsp;`string`
+
+
+Set the current namespace to NAMESPACE. All expressions that occur in a current transaction will be contained in NAMESPACE, and once committed, mayy be accessed via their fully qualified name, which will include the namespace. For example, if Alice were to define an interface named AbstractBob in the namespace Carl, then it would be referenced by the name Carl.AbstractBob. 
+```lisp
+(namespace 'my-namespace)
+```
+
+Top level only: this function will fail if used in module code.
+
+
 ### pact-id {#pact-id}
 
  *&rarr;*&nbsp;`integer`

examples/accounts/accounts.repl

@@ -19,23 +19,23 @@
 (env-data { "123-keyset": { "keys" : ["user123"], "pred": "keys-all" },
              "456-keyset": { "keys": ["user456"], "pred": "keys-any" } })
 (begin-tx)
-(use 'accounts)
+(use accounts)
 (create-account "123" (read-keyset "123-keyset") "USD" (time "2016-07-22T11:26:35Z"))
 (create-account "456" (read-keyset "456-keyset") "USD" (time "2016-07-22T11:26:35Z"))
 (fund-account "123" 234.0 (time "2016-07-22T11:26:35Z"))
 (commit-tx)
 (begin-tx)
-(use 'accounts)
+(use accounts)
 (transfer "123" "456" 5.0 (time "2016-07-22T11:26:35Z"))
 (commit-tx)
 (begin-tx)
-(use 'accounts)
+(use accounts)
 ;;admin reads
 (expect "balance of 123 after transfer" 229.0 (with-read accounts "123" { "balance" := b } b))
 (expect "balance of 456 after transfer" 5.0 (with-read accounts "456" { "balance" := b } b))
 (commit-tx)
 (begin-tx)
-(use 'accounts)
+(use accounts)
 (env-keys ["user123" "user456"])
 (expect-failure "should not allow read" (with-read accounts "123" { "balance" := b } b))
 

src-ghc/Pact/Bench.hs

@@ -72,7 +72,7 @@ loadBenchModule db = do
            (object ["keyset" .= object ["keys" .= ["benchadmin"::Text], "pred" .= (">"::Text)]])
            Nothing
            initialHash
-  erRefStore <$> evalExec (setupEvalEnv db entity (Transactional 1) md initRefStore freeGasEnv) pc
+  erRefStore <$> evalExec (setupEvalEnv db entity (Transactional 1) md initRefStore freeGasEnv permissiveNamespacePolicy) pc
 
 parseCode :: Text -> IO ParsedCode
 parseCode m = ParsedCode m <$> eitherDie (parseExprs m)
@@ -83,7 +83,7 @@ benchNFIO bname = bench bname . nfIO
 runPactExec :: PactDbEnv e -> RefStore -> ParsedCode -> IO Value
 runPactExec dbEnv refStore pc = do
   t <- Transactional . fromIntegral <$> getCPUTime
-  toJSON . erOutput <$> evalExec (setupEvalEnv dbEnv entity t (initMsgData initialHash) refStore freeGasEnv) pc
+  toJSON . erOutput <$> evalExec (setupEvalEnv dbEnv entity t (initMsgData initialHash) refStore freeGasEnv permissiveNamespacePolicy) pc
 
 benchKeySet :: KeySet
 benchKeySet = KeySet [PublicKey "benchadmin"] (Name ">" def)

src-ghc/Pact/Interpreter.hs

@@ -23,6 +23,7 @@ import Control.Monad.Catch
 import Data.Maybe
 import qualified Data.HashMap.Strict as HM
 
+import Pact.Types.Term
 import Pact.Types.Runtime
 import Pact.Compile
 import Pact.Eval
@@ -68,9 +69,16 @@ evalContinuation :: EvalEnv e -> Term Name -> IO EvalResult
 evalContinuation ee pact = interpret ee [pact]
 
 
-setupEvalEnv :: PactDbEnv e -> Maybe EntityName -> ExecutionMode ->
-                MsgData -> RefStore -> GasEnv -> EvalEnv e
-setupEvalEnv dbEnv ent mode msgData refStore gasEnv =
+setupEvalEnv
+  :: PactDbEnv e
+  -> Maybe EntityName
+  -> ExecutionMode
+  -> MsgData
+  -> RefStore
+  -> GasEnv
+  -> NamespacePolicy
+  -> EvalEnv e
+setupEvalEnv dbEnv ent mode msgData refStore gasEnv np =
   EvalEnv {
     _eeRefStore = refStore
   , _eeMsgSigs = mdSigs msgData
@@ -83,6 +91,7 @@ setupEvalEnv dbEnv ent mode msgData refStore gasEnv =
   , _eePurity = PImpure
   , _eeHash = mdHash msgData
   , _eeGasEnv = gasEnv
+  , _eeNamespacePolicy = np
   }
   where modeToTx (Transactional t) = Just t
         modeToTx Local = Nothing

src-ghc/Pact/PersistPactDb/Regression.hs

@@ -31,7 +31,9 @@ runRegression p = do
   createUserTable' v user1 "someModule" "someKeyset"
   assertEquals' "output of commit 2"
     [TxLog "SYS_usertables" "user1" $
-     object [("utModule" .= String "someModule"),("utKeySet" .= String "someKeyset")]
+     object [ ("utModule" .= object [ ("name" .= String "someModule"), ("namespace" .= Null)])
+            , ("utKeySet" .= String "someKeyset")
+            ]
      ]
     (commit v)
   t3 <- begin v t2
@@ -57,7 +59,7 @@ runRegression p = do
               ,("blessed" .= ([]::[Text]))
               ,("keyset" .= String "mod-admin-keyset")
               ,("interfaces" .= ([]::[Text]))
-              ,("name" .= String "mod1")
+              ,("name" .= object [ ("name" .= String "mod1"), ("namespace" .= Null)])
               ,("code" .= String "code")
               ,("meta" .= object [("model" .= ([] :: [Text]))
                                  ,("docs" .= Null)])]

src-ghc/Pact/ReplTools.hs

@@ -55,7 +55,7 @@ completeFn = completeQuotedWord (Just '\\') "\"" listFiles $
     unName (Name    name _) = name
 
     nameOfModule :: ModuleName -> Text
-    nameOfModule (ModuleName name) = name
+    nameOfModule (ModuleName name _) = name
 
 replSettings :: (MonadIO m, MonadState ReplState m) => Settings m
 replSettings = Settings

src-ghc/Pact/Server/PactService.hs

@@ -101,7 +101,7 @@ applyExec rk (ExecMsg parsedCode edata) Command{..} = do
   (CommandState refStore pacts) <- liftIO $ readMVar _ceState
   let sigs = userSigsToPactKeySet _cmdSigs
       evalEnv = setupEvalEnv _ceDbEnv _ceEntity _ceMode
-                (MsgData sigs edata Nothing _cmdHash) refStore _ceGasEnv
+                (MsgData sigs edata Nothing _cmdHash) refStore _ceGasEnv permissiveNamespacePolicy
   pr <- liftIO $ evalExec evalEnv parsedCode
   newCmdPact <- join <$> mapM (handlePactExec (erInput pr)) (erExec pr)
   let newPacts = case newCmdPact of
@@ -145,15 +145,15 @@ applyContinuation rk msg@ContMsg{..} Command{..} = do
               pactStep = Just $ PactStep _cmStep _cmRollback (PactId $ pack $ show _cmTxId) _cpYield
               evalEnv = setupEvalEnv _ceDbEnv _ceEntity _ceMode
                         (MsgData sigs _cmData pactStep _cmdHash) _csRefStore
-                        _ceGasEnv
+                        _ceGasEnv permissiveNamespacePolicy
           res <- tryAny (liftIO  $ evalContinuation evalEnv _cpContinuation)
 
           -- Update pacts state
           case res of
             Left (SomeException ex) -> throwM ex
             Right EvalResult{..} -> do
               exec@PactExec{..} <- maybe (throwCmdEx "No pact execution in continuation exec!")
-                                   return erExec         
+                                   return erExec
               if _cmRollback
                 then rollbackUpdate env msg state
                 else continuationUpdate env msg state pact exec
@@ -162,7 +162,7 @@ applyContinuation rk msg@ContMsg{..} Command{..} = do
 rollbackUpdate :: CommandEnv p -> ContMsg -> CommandState -> CommandM p ()
 rollbackUpdate CommandEnv{..} ContMsg{..} CommandState{..} = do
   -- if step doesn't have a rollback function, no error thrown. Therefore, pact will be deleted
-  -- from state. 
+  -- from state.
   let newState = CommandState _csRefStore $ M.delete _cmTxId _csPacts
   liftIO $ logLog _ceLogger "DEBUG" $ "applyContinuation: rollbackUpdate: reaping pact "
     ++ show _cmTxId
@@ -172,7 +172,7 @@ continuationUpdate :: CommandEnv p -> ContMsg -> CommandState -> CommandPact ->
 continuationUpdate CommandEnv{..} ContMsg{..} CommandState{..} CommandPact{..} PactExec{..} = do
   let nextStep = _cmStep + 1
       isLast = nextStep >= _cpStepCount
-      updateState pacts = CommandState _csRefStore pacts -- never loading modules during continuations 
+      updateState pacts = CommandState _csRefStore pacts -- never loading modules during continuations
 
   if isLast
     then do
@@ -183,4 +183,4 @@ continuationUpdate CommandEnv{..} ContMsg{..} CommandState{..} CommandPact{..} P
       let newPact = CommandPact _cpTxId _cpContinuation _cpStepCount _cmStep _peYield
       liftIO $ logLog _ceLogger "DEBUG" $ "applyContinuation: updated state of pact "
         ++ show _cmTxId ++ ": " ++ show newPact
-      void $ liftIO $ swapMVar _ceState $ updateState $ M.insert _cmTxId newPact _csPacts 
+      void $ liftIO $ swapMVar _ceState $ updateState $ M.insert _cmTxId newPact _csPacts

src/Pact/Analyze/Remote/Server.hs

@@ -90,9 +90,9 @@ validateRequest = do
         Just mod' -> Right $ ValidRequest modsMap mod'
         Nothing   -> Left $ ClientError $
           case modName of
-            ModuleName nm ->
+            ModuleName mn _ ->
               let names = HM.keys modsMap
-              in show nm ++ " not found in list of provided modules: "
+              in show mn ++ " not found in list of provided modules: "
                    ++ show names
 
 initializeRepl :: IO ReplState
@@ -122,7 +122,7 @@ moduleNotFoundP = MP.string "<interactive>:"
                *> digitsP *> MP.char ':'
                *> digitsP *> MP.char ':'
                *> MP.string " Module \""
-               *> fmap (ModuleName . T.pack) (MP.some $ MP.notChar '"')
+               *> fmap (\a -> ModuleName (T.pack a) Nothing) (MP.some $ MP.notChar '"')
                <* MP.string "\" not found"
   where
     digitsP :: MP.Parsec Void String ()

src/Pact/Compile.hs

@@ -21,13 +21,10 @@
 --
 
 module Pact.Compile
-    (
-     compile,compileExps
-    ,MkInfo,mkEmptyInfo,mkStringInfo,mkTextInfo
-    ,Reserved(..)
-    )
-
-where
+  ( compile,compileExps
+  , MkInfo,mkEmptyInfo,mkStringInfo,mkTextInfo
+  , Reserved(..)
+  ) where
 
 import qualified Text.Trifecta as TF hiding (expected)
 import Control.Applicative hiding (some,many)
@@ -127,6 +124,9 @@ instance AsString Reserved where
 
 instance Show Reserved where show = unpack . asString
 
+checkReserved :: Text -> Compile ()
+checkReserved t = when (t `elem` reserved) $ unexpected' "reserved word"
+
 reserveds :: HM.HashMap Text Reserved
 reserveds = (`foldMap` [minBound .. maxBound]) $ \r -> HM.singleton (asString r) r
 
@@ -158,7 +158,7 @@ withModuleState :: ModuleState -> Compile a -> Compile (a,ModuleState)
 withModuleState ms0 act = do
   psUser . csModule .= Just ms0
   a <- act
-  ms1 <- state $ \s -> (view (psUser . csModule) s,set (psUser .csModule) Nothing s)
+  ms1 <- state $ \s -> (view (psUser . csModule) s, set (psUser . csModule) Nothing s)
   case ms1 of
     Nothing -> syntaxError "Invalid internal state, module data not found"
     Just ms -> return (a,ms)
@@ -167,6 +167,16 @@ withModuleState ms0 act = do
 currentModuleName :: Compile ModuleName
 currentModuleName = _msName <$> moduleState
 
+-- | Construct a potentially namespaced module name from qualified atom
+qualifiedModuleName :: Compile ModuleName
+qualifiedModuleName = do
+  AtomExp{..} <- atom
+  checkReserved _atomAtom
+  case _atomQualifiers of
+    []  -> return $ ModuleName _atomAtom Nothing
+    [n] -> return $ ModuleName _atomAtom (Just . NamespaceName $ n)
+    _   -> expected "qualified module name reference"
+
 freshTyVar :: Compile (Type (Term Name))
 freshTyVar = do
   c <- state (view (psUser . csFresh) &&& over (psUser . csFresh) succ)
@@ -219,7 +229,7 @@ moduleLevel = specialForm $ \r -> case r of
     RDefun -> returnl $ defunOrCap Defun
     RDefcap -> returnl $ defunOrCap Defcap
     RDefpact -> returnl defpact
-    RImplements -> return (implements >> return [])
+    RImplements -> return $ implements >> return []
     _ -> expected "module level form (use, def..., special form)"
     where returnl a = return (pure <$> a)
 
@@ -231,15 +241,13 @@ literals =
   <|> objectLiteral
 
 
--- | User-available atoms (excluding reserved words).
+-- | Bare atoms (excluding reserved words).
 userAtom :: Compile (AtomExp Info)
 userAtom = do
   a@AtomExp{..} <- bareAtom
-  when (_atomAtom `elem` reserved) $ unexpected' "reserved word"
+  checkReserved _atomAtom
   pure a
 
-
-
 app :: Compile (Term Name)
 app = do
   v <- varAtom
@@ -266,13 +274,16 @@ bindingForm = do
 varAtom :: Compile (Term Name)
 varAtom = do
   AtomExp{..} <- atom
-  when (_atomAtom `elem` reserved) $ unexpected' "reserved word"
+  checkReserved _atomAtom
   n <- case _atomQualifiers of
     [] -> return $ Name _atomAtom _atomInfo
     [q] -> do
-      when (q `elem` reserved) $ unexpected' "reserved word"
-      return $ QName (ModuleName q) _atomAtom _atomInfo
-    _ -> expected "single qualifier"
+      checkReserved q
+      return $ QName (ModuleName q Nothing) _atomAtom _atomInfo
+    [ns,q] -> do
+      checkReserved ns >> checkReserved q
+      return $ QName (ModuleName q (Just . NamespaceName $ ns)) _atomAtom _atomInfo
+    _ -> expected "bareword or qualified atom"
   commit
   return $ TVar n _atomInfo
 
@@ -310,8 +321,6 @@ withCapability = do
   i <- contextInfo
   return $ TApp (App wcVar [capApp,TList body TyAny (_tInfo top)] i) i
 
-
-
 deftable :: Compile (Term Name)
 deftable = do
   ModuleState{..} <- moduleState
@@ -335,7 +344,6 @@ defconst = do
   modName <- currentModuleName
   a <- arg
   v <- valueLevel
-
   m <- meta ModelNotAllowed
   TConst a modName (CVRaw v) m <$> contextInfo
 
@@ -414,7 +422,7 @@ moduleForm = do
   let code = case i of
         Info Nothing -> "<code unavailable>"
         Info (Just (c,_)) -> c
-      modName = ModuleName modName'
+      modName = ModuleName modName' Nothing
       modHash = hash $ encodeUtf8 $ _unCode code
   ((bd,bi),ModuleState{..}) <- withModuleState (initModuleState modName modHash) $ bodyForm' moduleLevel
   return $ TModule
@@ -423,8 +431,8 @@ moduleForm = do
 
 implements :: Compile ()
 implements = do
-  ifName <- (ModuleName . _atomAtom) <$> bareAtom
-  overModuleState msImplements (ifName:)
+  ifn <- qualifiedModuleName
+  overModuleState msImplements (ifn:)
 
 
 interface :: Compile (Term Name)
@@ -438,7 +446,7 @@ interface = do
   let code = case info of
         Info Nothing -> "<code unavailable>"
         Info (Just (c,_)) -> c
-      iname = ModuleName iname'
+      iname = ModuleName iname' Nothing
       ihash = hash $ encodeUtf8 (_unCode code)
   (bd,ModuleState{..}) <- withModuleState (initModuleState iname ihash) $
             bodyForm $ specialForm $ \r -> case r of
@@ -513,9 +521,9 @@ letsForm = do
 
 useForm :: Compile (Term Name)
 useForm = do
-  modName <- (_atomAtom <$> userAtom) <|> str <|> expected "bare atom, string, symbol"
-  i <- contextInfo
-  u <- Use (ModuleName modName) <$> optional hash' <*> pure i
+  mn <- qualifiedModuleName
+  i  <- contextInfo
+  u  <- Use mn <$> optional hash' <*> pure i
   -- this is the one place module may not be present, use traversal
   psUser . csModule . _Just . msImports %= (u:)
   return $ TUse u i