Enforce key format in keyset creation (#918)

* Enforce key format in keyset creation * more tests * review golf * only support lowercase hex Co-authored-by: Stuart Popejoy <[email protected]>
kadena-io · Nov 2, 2021 · 52eecf2 · 52eecf2
1 parent d4452cb
commit 52eecf2
Show file tree

Hide file tree

Showing 4 changed files with 91 additions and 5 deletions.
diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md
@@ -437,7 +437,7 @@ Return ID if called during current pact execution, failing if not.
 Obtain current pact build version.
 ```lisp
 pact> (pact-version)
-"4.1"
+"4.1.1"
 ```
 
 Top level only: this function will fail if used in module code.
@@ -1754,7 +1754,7 @@ Retreive any accumulated events and optionally clear event state. Object returne
  *&rarr;*&nbsp;`[string]`
 
 
-Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableModuleInstall","DisablePact40","DisablePactEvents","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
+Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableModuleInstall","DisablePact40","DisablePactEvents","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
 ```lisp
 pact> (env-exec-config ['DisableHistoryInTransactionalMode]) (env-exec-config)
 ["DisableHistoryInTransactionalMode"]

diff --git a/src/Pact/Native/Keysets.hs b/src/Pact/Native/Keysets.hs
@@ -9,10 +9,18 @@
 -- Builtins for working with keysets.
 --
 
-module Pact.Native.Keysets where
+module Pact.Native.Keysets
+  ( keyDefs
+  , readKeysetDef
+  )
 
-import Control.Lens
+where
 
+import Control.Lens
+import Control.Monad
+import Data.Foldable
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
 import Data.Text (Text)
 
 import Pact.Eval
@@ -60,7 +68,32 @@ keyDefs =
 
 
 readKeySet' :: FunApp -> Text -> Eval e KeySet
-readKeySet' i key = parseMsgKey i "read-keyset" key
+readKeySet' i key = do
+  ks <- parseMsgKey i "read-keyset" key
+  whenExecutionFlagSet FlagEnforceKeyFormats $ enforceKeyFormats i ks
+  return ks
+
+-- | A predicate for public key format validation.
+type KeyFormat = PublicKey -> Bool
+
+-- | Current "Kadena" ED-25519 key format: 64-length hex.
+ed25519Hex :: KeyFormat
+ed25519Hex (PublicKey k) = BS.length k == 64 && BS.all isHexDigitLower k
+
+-- | Lower-case hex numbers.
+isHexDigitLower :: Char -> Bool
+isHexDigitLower c =
+  -- adapted from GHC.Unicode#isHexDigit
+  isDigit c || (fromIntegral (ord c - ord 'a')::Word) <= 5
+
+-- | Supported key formats.
+keyFormats :: [KeyFormat]
+keyFormats = [ed25519Hex]
+
+enforceKeyFormats :: HasInfo i => i -> KeySet -> Eval e ()
+enforceKeyFormats i (KeySet ks _p) = traverse_ go ks
+  where
+    go k = unless (any ($ k) keyFormats) $ evalError' i "Invalid keyset"
 
 defineKeyset :: GasRNativeFun e
 defineKeyset g0 fi as = case as of

diff --git a/src/Pact/Types/Runtime.hs b/src/Pact/Types/Runtime.hs
@@ -150,6 +150,8 @@ data ExecutionFlag
   | FlagPreserveShowDefs
   -- | Disable Pact 4.0 features
   | FlagDisablePact40
+  -- | Enforce key formats. "Positive" polarity to not break legacy repl tests.
+  | FlagEnforceKeyFormats
   deriving (Eq,Ord,Show,Enum,Bounded)
 
 -- | Flag string representation

diff --git a/tests/pact/keysets.repl b/tests/pact/keysets.repl
@@ -203,3 +203,54 @@
  "Scoped acquire of O succeeds"
  "Capability acquired"
  (test-capability (O)))
+
+;;
+;; keyset formats
+;;
+
+(env-exec-config ["EnforceKeyFormats"])
+(env-data
+ { 'bad: ['foo]
+ , 'short: ["12440d374865bdf0a3349634a70d1317fc279e7e13db98f2199ac5e7378975"]
+ , 'long: ["12440d374865bdf0a3349634a70d1317fc279e7e13db98f2199ac5e7378975eaea"]
+ , 'badchars: ["x2440d374865bdf0a3349634a70 1317fc279e7e13db9!f2199ac5e7378975ea"]
+ , 'ucase:  ["12440D374865BDF0A3349634A70D1317FC279E7E13DB98F2199AC5E7378975EA"]
+ , 'good:  ["12440d374865bdf0a3349634a70d1317fc279e7e13db98f2199ac5e7378975ea"]
+ , 'mixed: ['foo "12440d374865bdf0a3349634a70d1317fc279e7e13db98f2199ac5e7378975ea"]
+ , 'good2: ["12440d374865bdf0a3349634a70d1317fc279e7e13db98f2199ac5e7378975ea"
+            "fdd198807260fa07b86f97a918ff7fe3542d98b9ca41a76f509e886dba3ae177"]
+
+ })
+(expect-failure
+ "enforce kadena key format with flag: fail single"
+ "Invalid keyset"
+ (read-keyset 'bad))
+(expect-failure
+ "enforce kadena key format with flag: fail short"
+ "Invalid keyset"
+ (read-keyset 'short))
+(expect-failure
+ "enforce kadena key format with flag: fail long"
+ "Invalid keyset"
+ (read-keyset 'long))
+(expect-failure
+ "enforce kadena key format with flag: fail badchars"
+ "Invalid keyset"
+ (read-keyset 'badchars))
+(expect-failure
+ "enforce kadena key format with flag: fail uppercase"
+ "Invalid keyset"
+ (read-keyset 'ucase))
+
+(expect-failure
+ "enforce kadena key format with flag: fail one bad one good"
+ "Invalid keyset"
+ (read-keyset 'mixed))
+(expect-that
+ "enforce kadena key format with flag: success single"
+ (constantly true)
+ (read-keyset 'good))
+(expect-that
+ "enforce kadena key format with flag: success 2"
+ (constantly true)
+ (read-keyset 'good2))