Replicate FlagEnforceKeyFormats behavior

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

@@ -0,0 +1,53 @@
+(begin-tx)
+;;
+;; 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))
+
+(commit-tx)

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

@@ -84,7 +84,8 @@ data ExecutionFlag
   | FlagAllowReadInLocal
   -- | Disable emission of pact events
   | FlagDisablePactEvents
-  -- | FlagEnforceKeyFormats
+  -- | Run the validity checks on keys
+  | FlagEnforceKeyFormats
   deriving (Eq,Ord,Show,Enum,Bounded)
 
 -- | Flag string representation

pact-core/Pact/Core/Guards.hs

@@ -7,6 +7,7 @@ module Pact.Core.Guards
 , KeySetName(..)
 , Governance(..)
 , KeySet(..)
+, enforceKeyFormats
 , Guard(..)
 , UserGuard(..)
 , CapabilityGuard(..)
@@ -16,8 +17,11 @@ module Pact.Core.Guards
 )
 where
 
-import Data.Text(Text)
+import qualified Data.Char as Char
 import qualified Data.Set as S
+import qualified Data.Text as T
+import Data.Foldable
+import Data.Text(Text)
 import Pact.Core.Pretty
 
 import Pact.Core.Names
@@ -76,6 +80,25 @@ instance Pretty name => Pretty (KeySet name) where
     , "pred: " <> pretty f
     ]
 
+type KeyFormatValidator = PublicKeyText -> Bool
+
+ed22519Hex :: KeyFormatValidator
+ed22519Hex (PublicKeyText k) = T.length k == 64 && T.all isHexDigitLower k
+  where
+  isHexDigitLower c = Char.isDigit c || (fromIntegral (Char.ord c - Char.ord 'a') :: Word) <= 5
+
+keyFormats :: [KeyFormatValidator]
+keyFormats = [ed22519Hex]
+
+isValidKeyFormat :: PublicKeyText -> Bool
+isValidKeyFormat k = any ($ k) keyFormats
+
+enforceKeyFormats :: (PublicKeyText -> err) -> KeySet a -> Either err ()
+enforceKeyFormats onErr (KeySet keys _pred) = traverse_ validateKey keys
+  where
+  validateKey k = if isValidKeyFormat k then pure () else Left $ onErr k
+
+
 data UserGuard name term
   = UserGuard
   { _ugFunction :: name

pact-core/Pact/Core/IR/Eval/RawBuiltin.hs

@@ -28,6 +28,7 @@ import Control.Monad(when, unless, foldM)
 import Control.Monad.IO.Class
 import Data.Containers.ListUtils(nubOrd)
 import Data.Bits
+import Data.Either(isLeft)
 import Data.Foldable(foldl', traverse_)
 import Data.Decimal(roundTo', Decimal)
 import Data.Vector(Vector)
@@ -721,7 +722,11 @@ coreReadKeyset :: (IsBuiltin b, MonadEval b i m) => NativeFunction b i m
 coreReadKeyset = \info b cont handler _env -> \case
   [VString ksn] ->
     readKeyset' ksn >>= \case
-      Just ks -> returnCEKValue cont handler (VGuard (GKeyset ks))
+      Just ks -> do
+        shouldEnforce <- isExecutionFlagSet FlagEnforceKeyFormats
+        if shouldEnforce && isLeft (enforceKeyFormats (const ()) ks)
+           then returnCEK cont handler (VError "Invalid keyset" info)
+           else returnCEKValue cont handler (VGuard (GKeyset ks))
       Nothing -> returnCEK cont handler (VError "read-keyset failure" info)
   args -> argsError info b args