Fix the consistency of name validity between Haskell and Rust.

concordium-base.cabal

@@ -319,6 +319,7 @@ test-suite test
       Types.TransactionSerializationSpec
       Types.TransactionSummarySpec
       Types.UpdatesSpec
+      Types.ValidName
       Paths_concordium_base
   autogen-modules:
       Paths_concordium_base

haskell-src/Concordium/Wasm.hs

@@ -80,6 +80,7 @@ module Concordium.Wasm (
 
     --
 
+    isValidNameChar,
     -- | A contract has one init method and several receive methods. A module can
     -- contain several contracts.
     InitName (..),
@@ -153,7 +154,6 @@ import qualified Data.ByteString.Base16 as BS16
 import Data.ByteString.Short (ShortByteString)
 import qualified Data.ByteString.Short as BSS
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
-import Data.Char (isAlphaNum, isAscii, isPunctuation)
 import qualified Data.HashMap.Strict as HM
 import Data.Hashable
 import Data.Int (Int32)
@@ -399,6 +399,21 @@ instance HashableTo H.Hash (WasmModuleV V1) where
 
 --------------------------------------------------------------------------------
 
+-- | Check whether the given character is an ascii alphanumeric or punctuation character.
+--  Only these characters can appear in init, receive or entrypoint names.
+--  Note: this is more permissive in terms of punctuation than 'Data.Char.isPunctuation'.
+--  It is intended to align with Rust @char::is_ascii_punctuation@ instead.
+isValidNameChar :: Char -> Bool
+isValidNameChar c
+    | 'A' <= c && c <= 'Z' = True
+    | 'a' <= c && c <= 'z' = True
+    | '0' <= c && c <= '9' = True
+    | '!' <= c && c <= '/' = True
+    | ':' <= c && c <= '@' = True
+    | '[' <= c && c <= '`' = True
+    | '{' <= c && c <= '~' = True
+    | otherwise = False
+
 -- | Name of an init method inside a module.
 newtype InitName = InitName {initName :: Text}
     deriving (Eq, Ord)
@@ -419,7 +434,7 @@ isValidInitName proposal =
     -- The limit is specified in bytes, but Text.length returns the number of chars.
     -- This is not a problem, as we only allow ASCII.
     let hasValidLength = Text.length proposal <= maxFuncNameSize
-        hasValidCharacters = Text.all (\c -> isAscii c && (isAlphaNum c || isPunctuation c)) proposal
+        hasValidCharacters = Text.all isValidNameChar proposal
         hasDot = Text.any (== '.') proposal
     in  "init_" `Text.isPrefixOf` proposal && hasValidLength && hasValidCharacters && not hasDot
 
@@ -481,7 +496,7 @@ isValidReceiveName proposal =
     -- The limit is specified in bytes, but Text.length returns the number of chars.
     -- This is not a problem, as we only allow ASCII.
     let hasValidLength = Text.length proposal <= maxFuncNameSize
-        hasValidCharacters = Text.all (\c -> isAscii c && (isAlphaNum c || isPunctuation c)) proposal
+        hasValidCharacters = Text.all isValidNameChar proposal
         hasDot = Text.any (== '.') proposal
     in  hasValidLength && hasValidCharacters && hasDot
 
@@ -503,7 +518,7 @@ isValidEntrypointName proposal =
     -- The limit is specified in bytes, but Text.length returns the number of chars.
     -- This is not a problem, as we only allow ASCII.
     let hasValidLength = Text.length proposal < maxFuncNameSize
-        hasValidCharacters = Text.all (\c -> isAscii c && (isAlphaNum c || isPunctuation c)) proposal
+        hasValidCharacters = Text.all isValidNameChar proposal
     in  hasValidLength && hasValidCharacters
 
 instance Serialize EntrypointName where

haskell-tests/Spec.hs

@@ -26,6 +26,7 @@ import qualified Types.PayloadSpec
 import qualified Types.TransactionSerializationSpec
 import qualified Types.TransactionSummarySpec
 import qualified Types.UpdatesSpec
+import qualified Types.ValidName
 
 main :: IO ()
 main = hspec $ parallel $ do
@@ -56,3 +57,4 @@ main = hspec $ parallel $ do
     Types.ParametersSpec.tests
     Types.PayloadSpec.tests
     Genesis.ParametersSpec.tests
+    Types.ValidName.tests

haskell-tests/Types/ValidName.hs

@@ -0,0 +1,96 @@
+module Types.ValidName where
+
+import qualified Data.Text as Text
+import Test.Hspec
+
+import Concordium.Wasm
+
+-- | Check that the valid name characters are as expected.
+testValidNameChars :: Expectation
+testValidNameChars = filter isValidNameChar [minBound .. maxBound] `shouldBe` validNameChars
+  where
+    validNameChars = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
+
+-- | Test valid init names.
+testValidInitName :: Spec
+testValidInitName = describe "valid init names" $ do
+    testIt "init_contract"
+    -- Max allowed length
+    testIt "init_01234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234"
+    -- Shortest possible
+    testIt "init_"
+    -- All allowed symbols
+    testIt "init_!\"#$%&'()*+,-/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
+  where
+    testIt name = it name $ isValidInitName (Text.pack name)
+
+-- | Test invalid init names.
+testInvalidInitName :: Spec
+testInvalidInitName = describe "invalid init names" $ do
+    testIt "init"
+    testIt "init_ "
+    -- Incorrect prefix
+    testIt "no_init_prefix"
+    -- 1 character too long.
+    testIt "init_012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345"
+    testIt "init_!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
+  where
+    testIt name = it name $ not $ isValidInitName (Text.pack name)
+
+-- | Test valid receive names.
+testValidReceiveName :: Spec
+testValidReceiveName = describe "valid receive names" $ do
+    testIt "contract.receive"
+    -- Max allowed length
+    testIt ".012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678"
+    -- Shortest possible
+    testIt "."
+    -- All allowed symbols
+    testIt "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
+  where
+    testIt name = it name $ isValidReceiveName (Text.pack name)
+
+-- | Test invalid receive names.
+testInvalidReceiveName :: Spec
+testInvalidReceiveName = describe "invalid receive names" $ do
+    -- No dot
+    testIt "no_dot_separator"
+    -- Too long
+    testIt ".0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789"
+    -- Contains space
+    testIt "contract. receive"
+  where
+    testIt name = it name $ not $ isValidReceiveName (Text.pack name)
+
+-- | Test valid entrypoint names.
+testValidEntrypointName :: Spec
+testValidEntrypointName = describe "valid entrypoint names" $ do
+    testIt "entrypoint"
+    -- Max allowed length
+    testIt "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678"
+    -- Shortest possible
+    testIt ""
+    -- All allowed symbols
+    testIt "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
+  where
+    testIt name = it name $ isValidEntrypointName (Text.pack name)
+
+-- | Test invalid entrypoint names.
+testInvalidEntrypointName :: Spec
+testInvalidEntrypointName = describe "invalid entrypoint names" $ do
+    -- Too long
+    testIt "0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789"
+    -- Contains space
+    testIt "entry point"
+  where
+    testIt name = it name $ not $ isValidEntrypointName (Text.pack name)
+
+tests :: Spec
+tests = describe "Contract name validation" $ do
+    it "isValidNameChar" testValidNameChars
+    testValidInitName
+    testInvalidInitName
+    testValidReceiveName
+    testInvalidReceiveName
+    testValidEntrypointName
+    testInvalidEntrypointName