Merge pull request #285 from Concordium/verifiable-builds

Add support for verifiable builds.

ChangeLog.md

@@ -8,6 +8,10 @@
 - Add additional configuration options that use `validator` in place of `baker`.
   For example `concordium-client validator add`.
   The older options still exist, but are hidden.
+- The `module inspect` command now attempts to print any embedded verifiable
+  build information.
+- The `module deploy` command now warns if a module is being deployed that does
+  not have embedded verifiable build information.
 
 ## 6.1.0
 

concordium-client.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.24
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -47,9 +47,11 @@ library
       Concordium.Client.Runner.Helper
       Concordium.Client.RWLock
       Concordium.Client.Types.Account
+      Concordium.Client.Types.Contract.BuildInfo
       Concordium.Client.Types.Contract.Info
       Concordium.Client.Types.Contract.Parameter
       Concordium.Client.Types.Contract.Schema
+      Concordium.Client.Types.Contract.WasmParseHelpers
       Concordium.Client.Types.Transaction
       Concordium.Client.Types.TransactionStatus
       Concordium.Client.Utils

src/Concordium/Client/Output.hs

@@ -36,6 +36,7 @@ import qualified Concordium.Wasm as Wasm
 import Codec.CBOR.Decoding (decodeString)
 import Codec.CBOR.JSON
 import Codec.CBOR.Read
+import Concordium.Client.Types.Contract.BuildInfo (showBuildInfo)
 import Concordium.Common.Time (DurationSeconds (durationSeconds))
 import Concordium.Types.Execution (Event (ecEvents))
 import Control.Monad.Writer
@@ -472,6 +473,11 @@ printModuleInspectInfo CI.ModuleInspectInfo{..} = do
         ]
     tell $ showModuleInspectSigs miiModuleInspectSigs
     tell $ showWarnings miiExtraneousSchemas
+    tell [[]]
+    tell [[i|Module build information:|]]
+    case miiBuildInfo of
+        Nothing -> tell ["  - No build information embedded in the module."]
+        Just bi -> tell $ map (indentBy 2) (showBuildInfo bi)
   where
     -- \|Show all the contract init and receive functions including optional signatures from the schema.
     -- Only V1 contracts can have the Return value and Error section.

src/Concordium/Client/Runner.hs

@@ -79,6 +79,7 @@ import qualified Data.Char as Char
 import Codec.CBOR.Encoding
 import Codec.CBOR.JSON
 import Codec.CBOR.Write
+import Concordium.Client.Types.Contract.BuildInfo (extractBuildInfo)
 import Control.Arrow (Arrow (second))
 import Control.Concurrent (threadDelay)
 import Control.Exception
@@ -1934,7 +1935,12 @@ processModuleCmd action baseCfgDir verbose backend =
             wasmModule <- withClient backend $ getWasmModule namedModRef =<< readBlockHashOrDefault Best block
             let wasmVersion = Wasm.wasmVersion wasmModule
             (schema, exports) <- getSchemaAndExports schemaFile wasmModule
-            let moduleInspectInfo = CI.constructModuleInspectInfo namedModRef wasmVersion schema exports
+            mbi <- case extractBuildInfo wasmModule of
+                Left err -> do
+                    logWarn [[i|Error attempting to extract build information '#{err}'.|]]
+                    return Nothing
+                Right mbi -> return mbi
+            let moduleInspectInfo = CI.constructModuleInspectInfo namedModRef wasmVersion schema exports mbi
             runPrinter $ printModuleInspectInfo moduleInspectInfo
         ModuleName modRefOrFile modName mWasmVersion -> do
             baseCfg <- getBaseConfig baseCfgDir verbose
@@ -1964,6 +1970,22 @@ processModuleCmd action baseCfgDir verbose backend =
 getModuleDeployTransactionCfg :: BaseConfig -> TransactionOpts (Maybe Types.Energy) -> FilePath -> Maybe Wasm.WasmVersion -> IO ModuleDeployTransactionCfg
 getModuleDeployTransactionCfg baseCfg txOpts moduleFile mWasmVersion = do
     wasmModule <- getWasmModuleFromFile moduleFile mWasmVersion
+    case extractBuildInfo wasmModule of
+        Left err -> do
+            logWarn [[i|Error attempting to extract build information '#{err}'. The module is likely malformed.|]]
+            when (ioConfirm . toInteractionOpts $ txOpts) $ do
+                confirmed <- askConfirmation $ Just "proceed"
+                unless confirmed $ exitTransactionCancelled
+        Right Nothing -> do
+            logWarn
+                [ [i|The module does not have embedded build information|],
+                  [i|It will likely not be possible to match this module to source code.|]
+                ]
+            when (ioConfirm . toInteractionOpts $ txOpts) $ do
+                confirmed <- askConfirmation $ Just "proceed"
+                unless confirmed $ exitTransactionCancelled
+        Right (Just _) ->
+            return ()
     txCfg <- getTransactionCfg baseCfg txOpts $ moduleDeployEnergyCost wasmModule
     return $ ModuleDeployTransactionCfg txCfg wasmModule
 

src/Concordium/Client/Types/Contract/BuildInfo.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Concordium.Client.Types.Contract.BuildInfo (
+    BuildInfo (..),
+    extractBuildInfo,
+    showBuildInfo,
+) where
+
+import Concordium.Client.Types.Contract.WasmParseHelpers
+import Concordium.Crypto.SHA256
+import Concordium.Utils.Serialization (getMaybe)
+import qualified Concordium.Wasm as Wasm
+import Control.Monad (replicateM, unless)
+import Data.Maybe (isJust)
+import qualified Data.Serialize as S
+import Data.String.Interpolate (i)
+import Data.Text (Text)
+import qualified Data.Text as Text
+
+-- | Build information about the smart contract module. This is a Haskell type
+--  that corresponds to the data embedded by cargo-concordium. If the latter
+--  changes so must this type.
+data BuildInfo = BuildInfo
+    { -- | The SHA256 hash of the tar file used to build.
+      --  Note that this is the hash of the **tar** file alone, not of any
+      --  compressed version.
+      archiveHash :: Hash,
+      -- | The link to where the source code will be located.
+      sourceLink :: Maybe Text,
+      -- | The build image that was used.
+      image :: Text,
+      -- | The exact command invocation inside the image that was used to produce
+      --  the contract.
+      buildCommand :: [Text]
+    }
+
+showBuildInfo :: BuildInfo -> [String]
+showBuildInfo BuildInfo{..} =
+    [ "- Build image used: " ++ Text.unpack image,
+      "- Build command used: " ++ unwords (map Text.unpack buildCommand),
+      "- Hash of the archive: " ++ show archiveHash,
+      case sourceLink of
+        Nothing -> "- No link to the source code embedded."
+        Just link -> "- Link to source code: " ++ Text.unpack link
+    ]
+
+-- | Extract build information from the module if available.
+extractBuildInfo :: Wasm.WasmModule -> Either String (Maybe BuildInfo)
+extractBuildInfo = S.runGet parser . Wasm.wasmSource
+  where
+    parser = S.label "ModuleBuildInfo" $ do
+        ensureWasmModule
+        go Nothing
+
+    go :: Maybe BuildInfo -> S.Get (Maybe BuildInfo)
+    go mbi = do
+        isEmpty <- S.isEmpty
+        if isEmpty
+            then -- End of module reached; return the values found.
+                return mbi
+            else do
+                sectionId <- S.label "sectionId" S.getWord8
+                sectionSize <- S.label "sectionSize" $ fromIntegral <$> getLEB128Word32le
+                case sectionId of
+                    -- Custom section (which is where we store the build information)
+                    0 -> do
+                        -- Remember where we are since we might have to skip the section.
+                        curPos <- S.bytesRead
+                        name <- S.label "Custom Section Name" getTextWithLEB128Len
+                        if name == "concordium-build-info"
+                            then
+                                if isJust mbi
+                                    then fail [i|Module cannot contain multiple custom sections named 'concordium-build-info'.|]
+                                    else go . Just =<< getBuildInfo
+                            else do
+                                afterPos <- S.bytesRead
+                                -- Only skip the parts of the section we have not read yet.
+                                S.skip (sectionSize - (afterPos - curPos)) *> go mbi
+                    -- Any other type of section
+                    _ -> S.skip sectionSize *> go mbi
+
+    getBuildInfo :: S.Get BuildInfo
+    getBuildInfo = do
+        version <- S.getWord8
+        unless (version == 0) $ fail "Only V0 build informatio is supported."
+        archiveHash <- S.get
+        sourceLink <- getMaybe getTextLE
+        image <- getTextLE
+        buildCommandLen <- S.getWord32le
+        buildCommand <- replicateM (fromIntegral buildCommandLen) getTextLE
+        return BuildInfo{..}

src/Concordium/Client/Types/Contract/Info.hs

@@ -31,6 +31,7 @@ import qualified Concordium.Wasm as Wasm
 import Concordium.Client.Cli
 import qualified Concordium.Client.Config as Config
 import Concordium.Client.GRPC2 (ClientMonad)
+import Concordium.Client.Types.Contract.BuildInfo
 import Control.Monad.Cont (MonadIO)
 import Data.Aeson ((.:))
 import qualified Data.Aeson as AE
@@ -367,13 +368,16 @@ constructModuleInspectInfo ::
     Maybe CS.ModuleSchema ->
     -- | Exported function names in module.
     [Text] ->
+    -- | Potentially build information embedded in the module.
+    Maybe BuildInfo ->
     ModuleInspectInfo
-constructModuleInspectInfo namedModRef wasmVersion moduleSchema exportedFuncNames =
+constructModuleInspectInfo namedModRef wasmVersion moduleSchema exportedFuncNames miiBuildInfo =
     ModuleInspectInfo
         { miiNamedModRef = namedModRef,
           miiWasmVersion = wasmVersion,
           miiModuleInspectSigs = moduleInspectSigs,
-          miiExtraneousSchemas = extraneousSchemas
+          miiExtraneousSchemas = extraneousSchemas,
+          ..
         }
   where
     (moduleInspectSigs, extraneousSchemas) = case moduleSchema of
@@ -662,7 +666,8 @@ data ModuleInspectInfo = ModuleInspectInfo
     { miiNamedModRef :: Config.NamedModuleRef,
       miiWasmVersion :: Wasm.WasmVersion,
       miiModuleInspectSigs :: ModuleInspectSigs,
-      miiExtraneousSchemas :: [CS.FuncName]
+      miiExtraneousSchemas :: [CS.FuncName],
+      miiBuildInfo :: Maybe BuildInfo
     }
 
 -- | Module signatures of a smart contract module with event schema V*.

src/Concordium/Client/Types/Contract/Schema.hs

@@ -32,13 +32,12 @@ module Concordium.Client.Types.Contract.Schema (
     putLenWithSizeLen,
 ) where
 
+import Concordium.Client.Types.Contract.WasmParseHelpers
 import qualified Concordium.Wasm as Wasm
 import Control.Arrow (Arrow (first))
-import Control.Monad (unless)
 import Data.Aeson ((.=))
 import qualified Data.Aeson as AE
 import qualified Data.Aeson.Key as AE
-import qualified Data.Bits as Bits
 import qualified Data.ByteString as BS
 import Data.Hashable (Hashable)
 import Data.List (group, sort)
@@ -50,7 +49,7 @@ import Data.String.Interpolate (i)
 import Data.Text (Text, pack)
 import qualified Data.Text.Encoding as Text
 import qualified Data.Vector as V
-import Data.Word (Word16, Word32, Word64, Word8)
+import Data.Word (Word16, Word32, Word8)
 import GHC.Generics
 
 -- | Try to find an embedded schema in a module and decode it.
@@ -574,7 +573,7 @@ instance S.Serialize SchemaType where
             18 -> S.label "Map" $ Map <$> S.get <*> S.get <*> S.get
             19 -> S.label "Array" $ Array <$> S.getWord32le <*> S.get
             20 -> S.label "Struct" $ Struct <$> S.get
-            21 -> S.label "Enum" $ Enum <$> getListOfWithSizeLen Four (S.getTwoOf getText S.get)
+            21 -> S.label "Enum" $ Enum <$> getListOfWithSizeLen Four (S.getTwoOf getTextLE S.get)
             22 -> S.label "String" $ String <$> S.get
             23 -> S.label "UInt128" $ pure UInt128
             24 -> S.label "Int128" $ pure Int128
@@ -587,7 +586,7 @@ instance S.Serialize SchemaType where
             31 ->
                 S.label "TaggedEnum" $
                     TaggedEnum
-                        <$> getMapOfWithSizeLenAndPred tEnumPred Four S.getWord8 (S.getTwoOf getText S.get)
+                        <$> getMapOfWithSizeLenAndPred tEnumPred Four S.getWord8 (S.getTwoOf getTextLE S.get)
             x -> fail [i|Invalid SchemaType tag: #{x}|]
       where
         -- Predicate for tagged enums. Tags and variant names should be unique.
@@ -675,10 +674,7 @@ data FuncName
 --  names from inside a Wasm module.
 getEmbeddedSchemaAndExportsFromModule :: Wasm.WasmVersion -> S.Get (Maybe ModuleSchema, [Text])
 getEmbeddedSchemaAndExportsFromModule wasmVersion = do
-    mhBs <- S.getByteString 4
-    unless (mhBs == wasmMagicHash) $ fail "Unknown magic value. This is likely not a Wasm module."
-    vBs <- S.getByteString 4
-    unless (vBs == wasmSpecVersion) $ fail "Unsupported Wasm standard version."
+    ensureWasmModule
     go (Nothing, [])
   where
     schemaIdentifierUnversioned = case wasmVersion of
@@ -706,6 +702,8 @@ getEmbeddedSchemaAndExportsFromModule wasmVersion = do
                     case sectionId of
                         -- Custom section (which is where we store the schema).
                         0 -> do
+                            -- Remember where we are since we might have to skip the section.
+                            curPos <- S.bytesRead
                             name <- S.label "Custom Section Name" getTextWithLEB128Len
                             if name == schemaIdentifierUnversioned || name == "concordium-schema"
                                 then
@@ -717,7 +715,10 @@ getEmbeddedSchemaAndExportsFromModule wasmVersion = do
                                             if not $ null mFuncNames
                                                 then return (Just schemaFound, mFuncNames)
                                                 else go (Just schemaFound, mFuncNames)
-                                else S.skip sectionSize *> go schemaAndFuncNames
+                                else do
+                                    afterPos <- S.bytesRead
+                                    -- Only skip the parts of the section we have not read yet.
+                                    S.skip (sectionSize - (afterPos - curPos)) *> go schemaAndFuncNames
                         -- Export section
                         7 -> do
                             exports <- getListOfWithLEB128Len (S.getTwoOf getTextWithLEB128Len getExportDescription)
@@ -745,44 +746,6 @@ getEmbeddedSchemaAndExportsFromModule wasmVersion = do
             3 -> return Global
             _ -> fail [i|"Invalid Export Description Tag: #{tag}"|]
 
-    -- \|Get Text where the length is encoded as LEB128-Word32.
-    getTextWithLEB128Len :: S.Get Text
-    getTextWithLEB128Len = S.label "Text with LEB128 Length" $ do
-        txt <- Text.decodeUtf8' . BS.pack <$> getListOfWithLEB128Len S.get
-        case txt of
-            Left err -> fail [i|Could not decode Text with LEB128 len: #{err}|]
-            Right txt' -> pure txt'
-
-    -- \|Get a list of items where the length of the list is encoded as LEB128-Word32.
-    getListOfWithLEB128Len :: S.Get a -> S.Get [a]
-    getListOfWithLEB128Len getElem = S.label "List with LEB128 length" $ do
-        len <- getLEB128Word32le
-        getListOfWithKnownLen len getElem
-
-    -- \|Get a LEB128-encoded Word32. This uses an encoding compatible with the Wasm standard,
-    -- which means that the encoding will use at most 5 bytes.
-    getLEB128Word32le :: S.Get Word32
-    getLEB128Word32le = S.label "Word32LEB128" $ decode7 0 5 1
-      where
-        decode7 :: Word64 -> Word8 -> Word64 -> S.Get Word32
-        decode7 acc left multiplier = do
-            unless (left > 0) $ fail "Section size byte overflow"
-            byte <- S.getWord8
-            if Bits.testBit byte 7
-                then decode7 (acc + multiplier * fromIntegral (Bits.clearBit byte 7)) (left - 1) (multiplier * 128)
-                else do
-                    let value = acc + multiplier * fromIntegral byte
-                    unless (value <= fromIntegral (maxBound :: Word32)) $ fail "Section size value overflow"
-                    return . fromIntegral $ value
-
-    -- \|4 bytes that start every valid Wasm module in binary.
-    wasmMagicHash :: BS.ByteString
-    wasmMagicHash = BS.pack [0x00, 0x61, 0x73, 0x6D]
-
-    -- \|The currently supported version of the Wasm specification.
-    wasmSpecVersion :: BS.ByteString
-    wasmSpecVersion = BS.pack [0x01, 0x00, 0x00, 0x00]
-
 -- | The four types of exports allowed in WASM.
 data ExportDescription
     = Func