diff --git a/ChangeLog.md b/ChangeLog.md index 899356ef..cc9954cd 100644 --- a/ChangeLog.md +++ b/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 diff --git a/concordium-client.cabal b/concordium-client.cabal index 5402de7f..ca88bf7e 100644 --- a/concordium-client.cabal +++ b/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 diff --git a/src/Concordium/Client/Output.hs b/src/Concordium/Client/Output.hs index 67251d5e..6dc0b266 100644 --- a/src/Concordium/Client/Output.hs +++ b/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. diff --git a/src/Concordium/Client/Runner.hs b/src/Concordium/Client/Runner.hs index de229303..7c8b27ad 100644 --- a/src/Concordium/Client/Runner.hs +++ b/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 diff --git a/src/Concordium/Client/Types/Contract/BuildInfo.hs b/src/Concordium/Client/Types/Contract/BuildInfo.hs new file mode 100644 index 00000000..ac5ec9f5 --- /dev/null +++ b/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{..} diff --git a/src/Concordium/Client/Types/Contract/Info.hs b/src/Concordium/Client/Types/Contract/Info.hs index ac71ee0a..5e593137 100644 --- a/src/Concordium/Client/Types/Contract/Info.hs +++ b/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*. diff --git a/src/Concordium/Client/Types/Contract/Schema.hs b/src/Concordium/Client/Types/Contract/Schema.hs index 9e6d9e32..944e0d50 100644 --- a/src/Concordium/Client/Types/Contract/Schema.hs +++ b/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 diff --git a/src/Concordium/Client/Types/Contract/WasmParseHelpers.hs b/src/Concordium/Client/Types/Contract/WasmParseHelpers.hs new file mode 100644 index 00000000..ed2af9ad --- /dev/null +++ b/src/Concordium/Client/Types/Contract/WasmParseHelpers.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | A number of utility functions for parsing Wasm modules in the context of +-- Concordium smart contract tooling. +module Concordium.Client.Types.Contract.WasmParseHelpers ( + getTextLE, + getTextWithLEB128Len, + getListOfWithLEB128Len, + getLEB128Word32le, + wasmMagicHash, + wasmSpecVersion, + ensureWasmModule, +) where + +import Control.Monad (replicateM, unless) +import qualified Data.Bits as Bits +import qualified Data.ByteString as BS +import qualified Data.Serialize as S +import Data.String.Interpolate (i) +import Data.Text (Text) +import qualified Data.Text.Encoding as Text +import Data.Word (Word32, Word64, Word8) + +-- | 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] + +-- | Parses 8 bytes and checks that the Wasm magic hash and versions are as +-- expected. +ensureWasmModule :: S.Get () +ensureWasmModule = 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." + +-- | Parse a UTF8 encoded string where the length prefix is encoded as 32-bit +-- little endian value. This is the default serialization of Strings produced by +-- Concordium smart contract libraries. +getTextLE :: S.Get Text +getTextLE = do + len <- S.getWord32le + txt <- Text.decodeUtf8' . BS.pack <$> replicateM (fromIntegral len) S.get + case txt of + Left err -> fail [i|Could not decode Text with LEB128 len: #{err}|] + Right txt' -> pure txt' + +-- | 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 + +-- | Nearly identical to Data.Serialize.getListOf implementation (except for length). +getListOfWithKnownLen :: (Integral len, Show len) => len -> S.Get a -> S.Get [a] +getListOfWithKnownLen len ga = S.label ("List of known length " ++ show len) $ go [] len + where + go as 0 = return $! reverse as + go as l = do + x <- ga + x `seq` go (x : as) (l - 1)