Merge pull request #32 from kadena-io/gr/ns-ks

Namespaced keysets

pact-core-tests/pact-tests/keysets.repl

@@ -51,3 +51,108 @@
  (read-keyset 'good2))
 
 (commit-tx)
+
+(begin-tx)
+;;
+;; namespaced keysets
+;;
+(env-exec-config ["RequireKeysetNs"])
+
+(env-data
+  { "alice-keys" : ["alice"]
+  , "bob-keys"   : ["bob"]
+  , "alice.alice-keys": ["alice"]
+  , "bob.bob-keys" : ["bob"]
+  })
+
+(env-keys ["alice", "bob"])
+
+; Define namespace using a keyset guard
+(define-namespace 'alice
+  (read-keyset 'alice-keys)
+  (read-keyset 'alice-keys))
+
+(define-namespace 'bob
+  (read-keyset 'bob-keys)
+  (read-keyset 'bob-keys))
+
+(expect-failure
+  "Defining un-namespaced keys fails - env keys, name failure"
+  "Cannot define a keyset outside of a namespace"
+  (define-keyset 'alice-keys))
+
+;; Show failure on lookup for keys
+(expect-failure
+  "Defining un-namespaced keys fails - actual keys, name failure"
+  "Cannot define a keyset outside of a namespace"
+  (define-keyset 'alice (read-keyset 'alice-keys)))
+
+(expect-failure
+  "Defining namespaced key fails - env keys, outside namespace"
+  "Cannot define a keyset outside of a namespace"
+  (define-keyset "alice.alice-keys"))
+
+(namespace 'alice)
+(expect
+  "Defining namespaced key succeeds - env keys, in namespace"
+  "Keyset write success"
+  (define-keyset "alice.alice-keys"))
+
+(expect-failure
+  "Defining namespaced key fails - env keys, in wrong namespace"
+  (define-keyset "bob.bob-keys"))
+
+(define-keyset "alice.alice-keys")
+(expect
+  "Rotating keyset within namespace succeeds"
+  "Keyset write success"
+  (define-keyset "alice.alice-keys" (read-keyset 'bob-keys)))
+
+(namespace 'bob)
+
+(expect
+  "Rotating keyset in wrong namespace succeeds if keys are present"
+  "Keyset write success"
+  (define-keyset "alice.alice-keys" (read-keyset 'bob-keys)))
+
+(commit-tx)
+
+(begin-tx)
+
+(env-data
+  { "TEST <2>." : ["test"]
+  , "" : ["test"]
+  })
+(env-keys ["test"])
+
+;; clear env - post fork
+(env-exec-config ["RequireKeysetNs"])
+
+(expect-failure
+  "keyset definition parsing is not permissive post-pact-4.4 - define-keyset"
+  "namespace"
+  (define-keyset "TEST <2>."))
+
+(expect-failure
+  "keyset definition parsing is permissive post-pact-4.4 - enforce-guard - keyset ref"
+  (enforce-guard (keyset-ref-guard "TEST <2>.")))
+
+(namespace 'alice)
+(expect-failure
+  "keyset name format is not permissive post-pact-4.4 - empty-keyset - define-keyset"
+  "incorrect keyset name format"
+  (define-keyset ""))
+
+(expect-failure
+  "keyset name format is not permissive post-pact-4.4 - empty-keyset - enforce-keyset"
+  "incorrect keyset name format"
+  (enforce-keyset ""))
+
+(expect-failure
+  "keyset name format is not permissive post-pact-4.4 - empty keyset - enforce-guard - keyset ref"
+  "incorrect keyset name format"
+  (enforce-guard (keyset-ref-guard "")))
+
+;; admin/user guard differentiation in keyset
+
+(commit-tx)

pact-core-tests/pact-tests/ops.repl

@@ -449,15 +449,16 @@
 (expect "!= keyset keyset" true (!= (read-keyset "k1") (read-keyset "k2")))
 
 "===== keyset ref equality"
-;  (env-exec-config ["DisablePact44"])
 (env-data { "k1": ["k1"], "k2": ["k2"] })
 (env-keys ["k1" "k2"])
-(define-keyset 'k1 (read-keyset "k1"))
-(define-keyset 'k2 (read-keyset "k2"))
-(expect "= keysetRef keysetRef" true (= (keyset-ref-guard "k1") (keyset-ref-guard "k1")))
-(expect "not = keysetRef keysetRef" false (= (keyset-ref-guard "k1") (keyset-ref-guard "k2")))
-(expect "not != keysetRef keysetRef" false (!= (keyset-ref-guard "k1") (keyset-ref-guard "k1")))
-(expect "!= keysetRef keysetRef" true (!= (keyset-ref-guard "k1") (keyset-ref-guard "k2")))
+(define-namespace 'alice (read-keyset 'k1) (read-keyset 'k1))
+(namespace 'alice)
+(define-keyset "alice.k1" (read-keyset "k1"))
+(define-keyset "alice.k2" (read-keyset "k2"))
+(expect "= keysetRef keysetRef" true (= (keyset-ref-guard "alice.k1") (keyset-ref-guard "alice.k1")))
+(expect "not = keysetRef keysetRef" false (= (keyset-ref-guard "alice.k1") (keyset-ref-guard "alice.k2")))
+(expect "not != keysetRef keysetRef" false (!= (keyset-ref-guard "alice.k1") (keyset-ref-guard "alice.k1")))
+(expect "!= keysetRef keysetRef" true (!= (keyset-ref-guard "alice.k1") (keyset-ref-guard "alice.k2")))
 
 (module tm G
   (defcap G () true)

pact-core.cabal

@@ -107,6 +107,7 @@ library
     Pact.Core.StableEncoding
     Pact.Core.Principal
     Pact.Core.Namespace
+    Pact.Core.RuntimeParsers
 
      -- Syntax modules
     Pact.Core.Syntax.ParseTree

pact-core/Pact/Core/Compile.hs

@@ -106,7 +106,7 @@ evalModuleGovernance interp tl = do
       lookupModule (Lisp._mInfo m) pdb mname >>= \case
         Just targetModule -> do
           term <- case _mGovernance targetModule of
-            KeyGov (KeySetName ksn) -> do
+            KeyGov (KeySetName ksn _mNs) -> do
               let ksnTerm = Constant (LString ksn) info
                   ksrg = App (Builtin (liftRaw RawKeysetRefGuard) info) (pure ksnTerm) info
                   term = App (Builtin (liftRaw RawEnforceGuard) info) (pure ksrg) info

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

@@ -86,6 +86,8 @@ data ExecutionFlag
   | FlagDisablePactEvents
   -- | Run the validity checks on keys
   | FlagEnforceKeyFormats
+  -- | Require keysets to be defined in namespaces
+  | FlagRequireKeysetNs
   deriving (Eq,Ord,Show,Enum,Bounded)
 
 -- | Flag string representation

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

@@ -22,14 +22,22 @@ module Pact.Core.Environment.Utils
  , throwExecutionError'
  , toFqDep
  , mangleNamespace
+ , getAllStackCaps
+ , checkSigCaps
+ , isKeysetInSigs
+ , isKeysetNameInSigs
+ , enforceKeysetNameAdmin
  ) where
 
 import Control.Lens
 import Control.Applicative((<|>))
+import Control.Monad(unless)
 import Control.Monad.Except
+import Control.Monad.IO.Class
 import Data.Default
 import Data.Maybe(mapMaybe)
 import qualified Data.Map.Strict as M
+import qualified Data.Set as S
 
 import Pact.Core.Names
 import Pact.Core.Persistence
@@ -38,6 +46,9 @@ import Pact.Core.Errors
 import Pact.Core.Environment.Types
 import Pact.Core.Hash
 import Pact.Core.Namespace
+import Pact.Core.Guards
+import Pact.Core.Capabilities
+import Pact.Core.PactValue
 
 viewEvalEnv :: (MonadEvalEnv b i m) => Lens' (EvalEnv b i) s -> m s
 viewEvalEnv l = view l <$> readEnv
@@ -168,3 +179,68 @@ mangleNamespace mn@(ModuleName mnraw ns) =
   useEvalState (esLoaded . loNamespace) >>= \case
     Nothing -> pure mn
     Just (Namespace currNs _ _) -> pure (ModuleName mnraw (ns <|> Just currNs))
+
+isKeysetInSigs
+  :: MonadEval b i m
+  => KeySet FullyQualifiedName
+  -> m Bool
+isKeysetInSigs (KeySet kskeys ksPred) = do
+  matchedSigs <- M.filterWithKey matchKey <$> viewEvalEnv eeMsgSigs
+  sigs <- checkSigCaps matchedSigs
+  runPred (M.size sigs)
+  where
+  matchKey k _ = k `elem` kskeys
+  atLeast t m = m >= t
+  count = S.size kskeys
+  runPred matched =
+    case ksPred of
+      KeysAll -> run atLeast
+      KeysAny -> run (\_ m -> atLeast 1 m)
+      Keys2 -> run (\_ m -> atLeast 2 m)
+    where
+    run p = pure (p count matched)
+
+getAllStackCaps
+  :: (MonadEval b i m)
+  => m (S.Set (CapToken QualifiedName PactValue))
+getAllStackCaps = do
+  S.fromList . concatMap capToList <$> useEvalState (esCaps . csSlots)
+  where
+  capToList (CapSlot c cs) = c:cs
+
+-- Todo: capautonomous
+checkSigCaps
+  :: (MonadEval b i m)
+  => M.Map PublicKeyText (S.Set (CapToken QualifiedName PactValue))
+  -> m (M.Map PublicKeyText (S.Set (CapToken QualifiedName PactValue)))
+checkSigCaps sigs = do
+  granted <- getAllStackCaps
+  autos <- useEvalState (esCaps . csAutonomous)
+  pure $ M.filter (match (S.null autos) granted) sigs
+  where
+  match allowEmpty granted sigCaps =
+    (S.null sigCaps && allowEmpty) ||
+    not (S.null (S.intersection granted sigCaps))
+
+isKeysetNameInSigs
+  :: (MonadEval b i m)
+  => i
+  -> PactDb b i
+  -> KeySetName
+  -> m Bool
+isKeysetNameInSigs info pdb ksn = do
+  liftIO (readKeyset pdb ksn) >>= \case
+    Just ks -> isKeysetInSigs ks
+    Nothing ->
+      throwExecutionError info (NoSuchKeySet ksn)
+
+enforceKeysetNameAdmin
+  :: MonadEval b i m
+  => i
+  -> ModuleName
+  -> KeySetName
+  -> m ()
+enforceKeysetNameAdmin i modName ksn = do
+  pdb <- viewEvalEnv eePactDb
+  signed <- isKeysetNameInSigs i pdb ksn
+  unless signed $ throwExecutionError i (ModuleGovernanceFailure modName)

pact-core/Pact/Core/Guards.hs

@@ -7,6 +7,8 @@ module Pact.Core.Guards
 , renderPublicKeyText
 , KeySetName(..)
 , renderKeySetName
+, keysetNameParser
+, parseAnyKeysetName
 , Governance(..)
 , KeySet(..)
 , enforceKeyFormats
@@ -24,12 +26,17 @@ 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
 import Data.Foldable
 import Data.String
 import Data.Text(Text)
-import Pact.Core.Pretty
+import Text.Parser.Token as P
 
+import Pact.Core.Pretty
 import Pact.Core.Names
+import Pact.Core.RuntimeParsers
 
 newtype PublicKeyText = PublicKeyText { _pubKey :: Text }
   deriving (Eq,Ord,Show)
@@ -40,14 +47,33 @@ instance Pretty PublicKeyText where
 renderPublicKeyText :: PublicKeyText -> Text
 renderPublicKeyText = _pubKey
 
-newtype KeySetName = KeySetName { _keysetName :: Text }
-    deriving (Eq,Ord,Show)
+data KeySetName = KeySetName
+  { _keysetName :: Text
+  , _keysetNs :: Maybe NamespaceName
+  } deriving (Eq, Ord, Show)
 
 instance Pretty KeySetName where
-  pretty (KeySetName ks) = "'" <> pretty ks
+  pretty (KeySetName ks Nothing) = "'" <> pretty ks
+  pretty (KeySetName ks (Just ns)) = "'" <> pretty ns <> "." <> pretty ks
 
 renderKeySetName :: KeySetName -> Text
-renderKeySetName = _keysetName
+renderKeySetName (KeySetName n Nothing) = n
+renderKeySetName (KeySetName n (Just ns)) = _namespaceName ns <> "." <> n
+
+keysetNameParser :: Parser KeySetName
+keysetNameParser = qualified <|> withoutNs
+  where
+    qualified = do
+      ns <- NamespaceName <$> ident style
+      kn <- P.dot *> ident style
+      pure $ KeySetName kn (Just ns)
+    withoutNs = do
+      t <- takeText
+      guard $ not $ T.null t
+      pure $ KeySetName t Nothing
+
+parseAnyKeysetName :: Text -> Either String KeySetName
+parseAnyKeysetName = parseOnly keysetNameParser
 
 data Governance name
   = KeyGov KeySetName

pact-core/Pact/Core/IR/Desugar.hs

@@ -1195,7 +1195,11 @@ renameModule (Module unmangled mgov defs blessed imports implements mhash i) = d
     pure (defn':defns, S.insert (defName defn) s, m')
 
   resolveGov mname = \case
-    KeyGov ksn -> pure (KeyGov ksn)
+    KeyGov rawKsn -> case parseAnyKeysetName (_keysetName rawKsn) of
+      Left {} -> lift $ throwExecutionError i (ModuleGovernanceFailure mname)
+      Right ksn -> do
+        lift $ enforceKeysetNameAdmin i mname ksn
+        pure (KeyGov ksn)
     CapGov (UnresolvedGov govName) ->
       case find (\d -> BN (BareName (defName d)) == govName) defs of
         Just (DCap d) -> do