finish validation phase

src/Language/Wasm/Validate.hs

@@ -35,6 +35,7 @@ data ValidationResult =
     | TypeMismatch
     | InvalidConstantExpr
     | InvalidStartFunctionType
+    | ImportedGlobalIsNotConst
     | Valid
     deriving (Show, Eq)
 
@@ -142,6 +143,9 @@ maybeToEither :: ValidationResult -> Maybe a -> Checker a
 maybeToEither _ (Just a) = return a
 maybeToEither l Nothing = throwError l
 
+isIndexValid :: (Integral idx, Integral len) => idx -> len -> ValidationResult
+isIndexValid idx len = if fromIntegral idx < fromIntegral len then Valid else IndexOutOfRange
+
 asType :: GlobalType -> VType
 asType (Const v) = Val v
 asType (Mut v) = Val v
@@ -571,8 +575,33 @@ startShouldBeValid m@Module { start = Just (StartFunction idx) } =
     then if FuncType [] [] == types !! i then Valid else InvalidStartFunctionType
     else IndexOutOfRange
 
-exportNamesShouldBeDifferent :: Validator
+exportsShouldBeValid :: Validator
-exportNamesShouldBeDifferent Module { exports } =
+exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals } =
+    areExportNamesUnique <> foldMap isExportValid exports
+    where
+        funcImports = filter isFuncImport imports
+        tableImports = filter isTableImport imports
+        memImports = filter isMemImport imports
+        globalImports = filter isGlobalImport imports
+
+        isFuncImport (Import _ _ (ImportFunc _)) = True
+        isFuncImport _ = False
+
+        isGlobalImport (Import _ _ (ImportGlobal _)) = True
+        isGlobalImport _ = False
+
+        isExportValid :: Export -> ValidationResult
+        isExportValid (Export _ (ExportFunc funIdx)) =
+            isIndexValid funIdx $ length funcImports + length functions
+        isExportValid (Export _ (ExportTable tableIdx)) =
+            isIndexValid tableIdx $ length tableImports + length tables
+        isExportValid (Export _ (ExportMemory memIdx)) =
+            isIndexValid memIdx $ length memImports + length mems
+        isExportValid (Export _ (ExportGlobal globalIdx)) =
+            isIndexValid globalIdx $ length globalImports + length globals
+
+        areExportNamesUnique :: ValidationResult
+        areExportNamesUnique =
             case foldl' go (Set.empty, []) exports of
                 (_, []) -> Valid
                 (_, dup) -> DuplicatedExportNames dup
@@ -583,6 +612,17 @@ exportNamesShouldBeDifferent Module { exports } =
                     then (set, show name : dup)
                     else (Set.insert name set, dup)
 
+importsShouldBeValid :: Validator
+importsShouldBeValid Module { imports, types } =
+    foldMap isImportValid imports
+    where
+        isImportValid :: Import -> ValidationResult
+        isImportValid (Import _ _ (ImportFunc typeIdx)) = isIndexValid typeIdx $ length types
+        isImportValid (Import _ _ (ImportTable _)) = Valid -- checked in tables section
+        isImportValid (Import _ _ (ImportMemory _)) = Valid -- checked in mems section
+        isImportValid (Import _ _ (ImportGlobal (Const _))) = Valid
+        isImportValid (Import _ _ (ImportGlobal (Mut _))) = ImportedGlobalIsNotConst
+
 validate :: Validator
 validate mod = foldMap ($ mod) validators
     where
@@ -595,5 +635,6 @@ validate mod = foldMap ($ mod) validators
                 elemsShouldBeValid,
                 datasShouldBeValid,
                 startShouldBeValid,
-                exportNamesShouldBeDifferent
+                exportsShouldBeValid,
+                importsShouldBeValid
             ]