fail on too big align value deserialization

src/Language/Wasm/Binary.hs

@@ -17,6 +17,7 @@ import Data.Bits
 import Data.Word (Word8, Word32, Word64)
 import Data.Int (Int8, Int32, Int64)
 import Data.Serialize
+import Control.Monad (when)
 import Data.Primitive.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
@@ -340,6 +341,7 @@ instance Serialize MemArg where
     put MemArg { align, offset } = putULEB128 align >> putULEB128 offset
     get = do
         align <- getULEB128 32
+        when (align >= 32) $ fail "malformed memop flags"
         offset <- getULEB128 32
         return $ MemArg { align, offset }
 

src/Language/Wasm/Validate.hs

@@ -193,10 +193,13 @@ getLabel lbl = do
 withLabel :: [ValueType] -> Checker a -> Checker a
 withLabel result = withReaderT (\ctx -> ctx { labels = result : labels ctx })
 
-isMemArgValid :: Int -> MemArg -> Checker ()
-isMemArgValid sizeInBytes MemArg { align } = if 2 ^ align <= sizeInBytes then return () else throwError AlignmentOverflow
+isMemArgValid :: Natural -> MemArg -> Checker ()
+isMemArgValid sizeInBytes MemArg { align } =
+    if 2 ^ align <= sizeInBytes
+    then return ()
+    else throwError AlignmentOverflow
 
-checkMemoryInstr :: Int -> MemArg -> Checker ()
+checkMemoryInstr :: Natural -> MemArg -> Checker ()
 checkMemoryInstr size memarg = do
     isMemArgValid size memarg
     Ctx { mems } <- ask 

tests/Test.hs

@@ -19,7 +19,7 @@ main = do
   files <-
     filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["table_grow.wast"]
+  -- let files = ["align.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do