add first version of getLEB128

lvtrun/app/WasmMod/Header.hs

@@ -8,20 +8,20 @@
 module WasmMod.Header
   (
     ModHeader(..),
-    getModuleHeader,
+    getModHeader,
     isHeaderValid
   )
 where
 
-import qualified Data.ByteString as BS (ByteString, take, drop, pack)
+import qualified Data.ByteString.Lazy as BS (ByteString, take, drop, pack)
 
 data ModHeader = ModHeader {
   magicNumber :: BS.ByteString,
   version :: BS.ByteString
 } deriving (Show)
 
-getModuleHeader :: BS.ByteString -> ModHeader
-getModuleHeader bytes = ModHeader (BS.take 4 bytes) (BS.take 4 $ BS.drop 4 bytes)
+getModHeader :: BS.ByteString -> ModHeader
+getModHeader bytes = ModHeader (BS.take 4 bytes) (BS.take 4 $ BS.drop 4 bytes)
 
 isHeaderValid :: ModHeader -> Bool
 isHeaderValid header =

lvtrun/app/WasmMod/Module.hs

@@ -12,7 +12,7 @@ module WasmMod.Module
   )
 where
 
-import qualified Data.ByteString as BS (ByteString, unpack, readFile)
+import qualified Data.ByteString.Lazy as BS (ByteString, unpack, readFile)
 import Control.Monad (when)
 import Numeric (showHex)
 
@@ -26,20 +26,21 @@ data WasmModule = WasmModule {
 }
 
 instance Show WasmModule where
-  show wasmMod = "Wasm Module Header:\n" ++
-    "  Magic Number: " ++ (concat $ map (\x -> showHex x " ") $
+  show wasmMod = "\n[ Wasm Module Header ]\n" ++
+    "- Magic Number: " ++ (concat $ map (\x -> showHex x " ") $
       BS.unpack $ magicNumber $ header wasmMod) ++ "\n" ++
-    "  Version: " ++ (concat $ map (\x -> showHex x " ") $
+    "- Version: " ++ (concat $ map (\x -> showHex x " ") $
       BS.unpack $ version $ header wasmMod) ++ "\n" ++
-    "  Sections: " ++ (show $ sections wasmMod) ++ "\n"
+    "- Sections: " ++ (show $ sections wasmMod) ++ "\n"
 
 getFileContent :: String -> IO BS.ByteString
 getFileContent path = BS.readFile path
 
 loadModule :: String -> IO WasmModule
 loadModule filePath = do
-    bytes <- getFileContent filePath
-    let modHeader = getModuleHeader bytes
-    when (not $ isHeaderValid modHeader) $ exitWithError "Invalid header"
-    let modSections = []
-    return $ WasmModule modHeader modSections
+  bytes <- getFileContent filePath
+  let modHeader = getModHeader bytes
+  when (not $ isHeaderValid modHeader) $ exitWithError "Invalid header"
+  let modSections = getModSections bytes
+  when (not $ areSectionsValid modSections) $ exitWithError "Invalid sections"
+  return $ WasmModule modHeader modSections

lvtrun/app/WasmMod/Sections.hs

@@ -8,11 +8,18 @@
 module WasmMod.Sections
   (
     SectionID(..),
-    Section(..)
+    Section(..),
+    areSectionsValid,
+    getModSections
   )
 where
 
-import qualified Data.ByteString as BS (ByteString)
+import qualified Data.ByteString.Lazy as BS (ByteString, head, drop, take, null, unpack)
+import Data.Binary.Get
+import Data.Bits
+import Data.Word (Word8, Word64)
+import Data.Int (Int32, Int64)
+import Numeric (showHex)
 
 data SectionID =
   Custom
@@ -32,7 +39,85 @@ data SectionID =
   deriving (Show, Eq)
 
 data Section = Section {
-  id :: SectionID,
+  identifier :: SectionID,
   size :: Int,
   content :: BS.ByteString
-} deriving (Show)
+}
+
+instance Show Section where
+  show section =
+    "\nSection " ++ (show $ identifier section) ++
+    " Size: " ++ (show $ size section) ++
+    " Content: " ++ (concat $ map (\x -> showHex x " ") (BS.unpack $ content section))
+
+areSectionsValid :: [Section] -> Bool
+areSectionsValid sections = True
+
+getSectionID :: Word8 -> SectionID
+getSectionID 1 = Type
+getSectionID 2 = Import
+getSectionID 3 = Function
+getSectionID 4 = Table
+getSectionID 5 = Memory
+getSectionID 6 = Global
+getSectionID 7 = Export
+getSectionID 8 = Start
+getSectionID 9 = Element
+getSectionID 10 = Code
+getSectionID 11 = Data
+getSectionID 12 = DataCount
+getSectionID _ = Invalid
+
+getLEB128 :: Get Int
+getLEB128 = do
+  byte <- getWord8
+  let value = fromIntegral (byte .&. 0x7F)
+  if byte `testBit` 7
+    then do
+      next <- getLEB128
+      return $ value .|. (next `shiftL` 7)
+    else
+      return value
+
+getSectionSize :: BS.ByteString -> Int
+getSectionSize bytes = runGet getLEB128 bytes
+
+-- Returns the number of bytes used to encode the leb128
+getLEB128Size' :: Get Int64
+getLEB128Size' = do
+  byte <- getWord8
+  let value = fromIntegral (byte .&. 0x7F)
+  if byte `testBit` 7
+    then do
+      next <- getLEB128Size'
+      return (next + 1)
+    else
+      return 1
+
+getLEB128Size :: BS.ByteString -> Int64
+getLEB128Size bytes = runGet getLEB128Size' bytes
+
+getSection :: BS.ByteString -> (Section, BS.ByteString)
+getSection bytes = (Section id size content, rest)
+  where
+    id = getSectionID (BS.head bytes)
+    nbByteEncoded = getLEB128Size (BS.drop 1 bytes)
+    size = getSectionSize (BS.take (fromIntegral nbByteEncoded) (BS.drop 1 bytes))
+    content = BS.take (fromIntegral size) (BS.drop (fromIntegral nbByteEncoded + 1) bytes)
+    rest = BS.drop (nbByteEncoded + 1 + fromIntegral size) bytes
+
+removeHeader :: BS.ByteString -> BS.ByteString
+removeHeader bytes = BS.drop 8 bytes
+
+getModSections' :: BS.ByteString -> [Section]
+getModSections' = do
+  let getModSections'' bytes =
+        if BS.null bytes
+          then []
+          else
+            let (section, rest) = getSection bytes
+            in section : getModSections'' rest
+  getModSections''
+
+getModSections :: BS.ByteString -> [Section]
+getModSections bytes = getModSections' (removeHeader bytes)

lvtrun/lvtrun.cabal

@@ -35,6 +35,7 @@ library
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
+    , binary
     , bytestring
   default-language: Haskell2010
 
@@ -53,6 +54,7 @@ executable lvtrun-exe
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , binary
     , bytestring
     , lvtrun
   default-language: Haskell2010
@@ -69,6 +71,7 @@ test-suite lvtrun-test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , binary
     , bytestring
     , lvtrun
   default-language: Haskell2010

lvtrun/package.yaml

@@ -22,6 +22,7 @@ description:         Please see the README on GitHub at <https://github.com/gith
 dependencies:
 - base >= 4.7 && < 5
 - bytestring
+- binary
 
 ghc-options:
 - -Wall

lvtrun/stack.yaml

@@ -42,6 +42,7 @@ packages:
 #
 extra-deps:
   - bytestring-0.12.0.2
+  - binary-0.8.9.1
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

lvtrun/stack.yaml.lock

@@ -11,6 +11,13 @@ packages:
       size: 4355
   original:
     hackage: bytestring-0.12.0.2
+- completed:
+    hackage: binary-0.8.9.1@sha256:81f468c1c75fd6535152ab69b2d32ac6cfcc03e345267b069abe4da56ec95801,6523
+    pantry-tree:
+      sha256: 956ecd662408f69615977b87a92e042abcdc447b7824b8aabf5788c4393c10c5
+      size: 1976
+  original:
+    hackage: binary-0.8.9.1
 snapshots:
 - completed:
     sha256: e176944bc843f740e05242fa7a66ca1f440c127e425254f7f1257f9b19add23f