From 52eecf26fb94c4e41fb2417c046255fe614fb20f Mon Sep 17 00:00:00 2001 From: Stuart Popejoy <8353613+sirlensalot@users.noreply.github.com> Date: Mon, 1 Nov 2021 23:42:32 -0400 Subject: [PATCH] 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 --- docs/en/pact-functions.md | 4 +-- src/Pact/Native/Keysets.hs | 39 ++++++++++++++++++++++++++--- src/Pact/Types/Runtime.hs | 2 ++ tests/pact/keysets.repl | 51 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 91 insertions(+), 5 deletions(-) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index 4a2db9785..d5f6f4323 100644 --- 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 *→* `[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 index 8b687086c..cfc11d708 100644 --- 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 index 1666eb6da..273f9ba60 100644 --- 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 index 4e800e63b..ad882ffb7 100644 --- 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))