Merge pull request #227 from Concordium/sync-calls

Introduce V1 smart contracts with synchronous contract call semantics.

concordium-consensus/.diff-wat-wasm.sh

@@ -11,7 +11,7 @@ pushd testdata/contracts
 
 RET=0
 
-for wat in *wat;do
+for wat in $(find -name '*.wat'); do
    OUT=$(mktemp)
    wat2wasm $wat -o $OUT;
    if ! $(diff $OUT "${wat%.wat}.wasm")

concordium-consensus/lib.def

@@ -22,6 +22,7 @@ EXPORTS
  getInstances
  getAccountInfo
  getInstanceInfo
+ invokeContract
  getRewardStatus
  getBirkParameters
  getModuleList

concordium-consensus/src/Concordium/External.hs

@@ -33,6 +33,7 @@ import Concordium.Crypto.ByteStringHelpers
 import Concordium.GlobalState
 import Concordium.GlobalState.Persistent.LMDB (addDatabaseVersion)
 import Concordium.GlobalState.Persistent.TreeState (InitException (..))
+import qualified Concordium.Types.InvokeContract as InvokeContract
 import Concordium.MultiVersion (
     Callbacks (..),
     CatchUpConfiguration (..),
@@ -907,6 +908,10 @@ decodeInstanceAddress inststr = AE.decodeStrict <$> BS.packCString inststr
 decodeModuleRef :: CString -> IO (Maybe ModuleRef)
 decodeModuleRef modstr = readMaybe <$> peekCString modstr
 
+-- |Decode the context passed to the @invokeContract@ method.
+decodeContractContext :: CString -> IO (Maybe InvokeContract.ContractContext)
+decodeContractContext ctxStr = AE.decodeStrict <$> BS.packCString ctxStr
+
 -- |Decode a transaction hash from a null-terminated base-16 string.
 decodeTransactionHash :: CString -> IO (Maybe TransactionHash)
 decodeTransactionHash trHashStr = readMaybe <$> peekCString trHashStr
@@ -1085,6 +1090,24 @@ getInstanceInfo cptr blockcstr instcstr = do
         (Just bh, Just inst) -> jsonQuery cptr (Q.getInstanceInfo bh inst)
         _ -> jsonCString AE.Null
 
+-- |Run the smart contract entrypoint in a given context and in the state at the
+-- end of the given block.
+-- The block must be given as a null-terminated base16 encoding of the block
+-- hash and the context (second CString) must be given as a null-terminated
+-- JSON-encoded value.
+-- The return value is a null-terminated, json encoded information. It is either null
+-- in case the input cannot be decoded, or the block does not exist,
+-- or the JSON encoding of InvokeContract.InvokeContractResult.
+-- The returned string should be freed by calling 'freeCStr'.
+invokeContract :: StablePtr ConsensusRunner -> CString -> CString -> IO CString
+invokeContract cptr blockcstr ctxcstr = do
+    mblock <- decodeBlockHash blockcstr
+    mctx <- decodeContractContext ctxcstr
+    case (mblock, mctx) of
+        (Just bh, Just ctx) -> jsonQuery cptr (Q.invokeContract bh ctx)
+        _ -> jsonCString AE.Null
+
+
 -- |Get the source code of a module as deployed on the chain at a particular block.
 -- The block must be given as a null-terminated base16 encoding of the block hash.
 -- The module is referenced by a null-terminated base16 encoding of the module hash.
@@ -1319,6 +1342,7 @@ foreign export ccall getAccountList :: StablePtr ConsensusRunner -> CString -> I
 foreign export ccall getInstances :: StablePtr ConsensusRunner -> CString -> IO CString
 foreign export ccall getAccountInfo :: StablePtr ConsensusRunner -> CString -> CString -> IO CString
 foreign export ccall getInstanceInfo :: StablePtr ConsensusRunner -> CString -> CString -> IO CString
+foreign export ccall invokeContract :: StablePtr ConsensusRunner -> CString -> CString -> IO CString
 foreign export ccall getRewardStatus :: StablePtr ConsensusRunner -> CString -> IO CString
 foreign export ccall getBirkParameters :: StablePtr ConsensusRunner -> CString -> IO CString
 foreign export ccall getModuleList :: StablePtr ConsensusRunner -> CString -> IO CString

concordium-consensus/src/Concordium/GlobalState/AccountMap.hs

@@ -116,7 +116,7 @@ lookup addr (AccountMap am) = case protocolVersion @pv of
   -- addresses with the same prefix created in protocol versions 1 and 2 we have
   -- a fallback. If such a situation does occur then those accounts can only be
   -- referred to by the exact address. This is what the logic below implements.
-  SP3 -> Trie.lookupPrefix (mkPrefix addr) am >>= \case
+  _ -> Trie.lookupPrefix (mkPrefix addr) am >>= \case
     [] -> return Nothing
     [(_, v)] -> return (Just v)
     fs -> case filter ((== addr) . fst) fs of
@@ -129,7 +129,7 @@ addressWouldClash :: forall pv fix m . (IsProtocolVersion pv, TrieGetContext fix
 addressWouldClash addr (AccountMap am) = case protocolVersion @pv of
   SP1 -> isJust <$> Trie.lookup addr am
   SP2 -> isJust <$> Trie.lookup addr am
-  SP3 -> not . null <$> Trie.lookupPrefix (mkPrefix addr) am
+  _ -> not . null <$> Trie.lookupPrefix (mkPrefix addr) am
 
 -- |Insert a new key value pair if it is fresh. If the key already exists in the
 -- map no changes are made and the existing 'AccountIndex' is returned.

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState.hs

@@ -33,6 +33,7 @@ import qualified Concordium.Genesis.Data as GenesisData
 import qualified Concordium.Genesis.Data.P1 as P1
 import qualified Concordium.Genesis.Data.P2 as P2
 import qualified Concordium.Genesis.Data.P3 as P3
+import qualified Concordium.Genesis.Data.P4 as P4
 import qualified Concordium.GlobalState.Types as GT
 import Concordium.GlobalState.BakerInfo
 import Concordium.GlobalState.Parameters
@@ -223,6 +224,7 @@ hashBlockState = case protocolVersion :: SProtocolVersion pv of
   SP1 -> hashBlockStateP1
   SP2 -> hashBlockStateP1
   SP3 -> hashBlockStateP1
+  SP4 -> hashBlockStateP1
     -- For protocol versions P1, P2, and P3, convert a @BlockState pv@ to a
     -- @HashedBlockState pv@ by computing the state hash. The state and hashing
     -- is the same. This function was introduced in protocol version 1 which is
@@ -305,7 +307,7 @@ getBlockState = do
     (_blockAccounts :: Accounts.Accounts pv) <- Accounts.deserializeAccounts cryptoParams
     let resolveModule modRef initName = do
             mi <- Modules.getInterface modRef _blockModules
-            return (GSWasm.miExposedReceive mi ^. at initName . non Set.empty, mi)
+            return (GSWasm.exposedReceive mi ^. at initName . non Set.empty, mi)
     _blockInstances <- Instances.getInstancesV0 resolveModule
     _blockUpdates <- getUpdatesV0
     _blockEpochBlocksBaked <- getHashedEpochBlocksV0
@@ -375,6 +377,10 @@ instance (IsProtocolVersion pv, Monad m) => BS.BlockStateQuery (PureBlockStateMo
     getModule bs mref =
         return $ bs ^. blockModules . to (Modules.getSource mref)
 
+    {-# INLINE getModuleInterface #-}
+    getModuleInterface bs mref =
+        return $ bs ^. blockModules . to (Modules.getInterface mref)
+
     {-# INLINE getContractInstance #-}
     getContractInstance bs caddr = return (Instances.getInstance caddr (bs ^. blockInstances))
 
@@ -551,10 +557,9 @@ instance (IsProtocolVersion pv, Monad m) => BS.BlockStateOperations (PureBlockSt
             accounts = bs ^. blockAccounts
             newAccounts = Accounts.putAccountWithRegIds acct accounts
 
-    bsoPutNewInstance bs mkInstance = return (instanceAddress, bs')
+    bsoPutNewInstance bs mkInstance = return (Instances.instanceAddress inst, bs')
         where
             (inst, instances') = Instances.createInstance mkInstance (bs ^. blockInstances)
-            Instances.InstanceParameters{..} = Instances.instanceParameters inst
             bs' = bs
                 -- Add the instance
                 & blockInstances .~ instances'
@@ -932,6 +937,9 @@ genesisState gd = case protocolVersion @pv of
                     SP3 -> case gd of
                       GDP3 P3.GDP3Initial{..} -> mkGenesisStateInitial genesisCore genesisInitialState
                       GDP3 P3.GDP3Regenesis{..} -> mkGenesisStateRegenesis genesisRegenesis
+                    SP4 -> case gd of
+                      GDP4 P4.GDP4Initial{..} -> mkGenesisStateInitial genesisCore genesisInitialState
+                      GDP4 P4.GDP4Regenesis{..} -> mkGenesisStateRegenesis genesisRegenesis
     where
         mkGenesisStateInitial GenesisData.CoreGenesisParameters{..} GenesisData.GenesisState{..} = do
             accounts <- mapM mkAccount (zip [0..] (toList genesisAccounts))

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs

@@ -46,6 +46,7 @@ showAccountPersisting spv = case spv of
   SP1 -> show
   SP2 -> show
   SP3 -> show
+  SP4 -> show
 
 -- |An (in-memory) account.
 data Account (pv :: ProtocolVersion) = Account {
@@ -163,6 +164,7 @@ instance (IsProtocolVersion pv) => HashableTo Hash.Hash (Account pv) where
       SP1 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
       SP2 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
       SP3 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
+      SP4 -> makeAccountHashP1 _accountNonce _accountAmount _accountEncryptedAmount (getHash _accountReleaseSchedule) (getHash _accountPersisting) bkrHash
     where
       bkrHash = maybe nullAccountBakerHash getHash _accountBaker
 

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/InstanceTable.hs

@@ -82,7 +82,7 @@ type instance IxValue InstanceTable = Instance
 
 instance Ixed InstanceTable where
     ix _ _ t@Empty = pure t
-    ix i upd (Tree s t) = Tree s <$> (ix (contractIndex i) . filtered ((== i) . instanceAddress . instanceParameters)) upd t
+    ix i upd (Tree s t) = Tree s <$> (ix (contractIndex i) . filtered ((== i) . instanceAddress)) upd t
 
 -- |Determine if an 'IT' is a full binary tree.
 isFull :: IT -> Bool
@@ -127,7 +127,7 @@ deleteContractInstance _ Empty = Empty
 deleteContractInstance i0 (Tree s0 t0) = uncurry Tree $ dci i0 t0
     where
         dci i l@(Leaf inst)
-            | i == 0 = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress $ instanceParameters inst)
+            | i == 0 = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress inst)
             | otherwise = (s0, l)
         dci _ vl@(VacantLeaf _) = (s0, vl)
         dci i b@(Branch h f _ _ l r)
@@ -143,8 +143,8 @@ deleteContractInstanceExact _ Empty = Empty
 deleteContractInstanceExact addr (Tree s0 t0) = uncurry Tree $ dci (contractIndex addr) t0
     where
         dci i l@(Leaf inst)
-            | i == 0 && addr == instanceAddress (instanceParameters inst)
-                        = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress $ instanceParameters inst)
+            | i == 0 && addr == instanceAddress inst
+                        = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress inst)
             | otherwise = (s0, l)
         dci _ vl@(VacantLeaf _) = (s0, vl)
         dci i b@(Branch h f _ _ l r)

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Instances.hs

@@ -1,8 +1,9 @@
 module Concordium.GlobalState.Basic.BlockState.Instances(
     InstanceParameters(..),
     Instance(..),
+    InstanceV(..),
+    HasInstanceAddress(..),
     makeInstance,
-    iaddress,
     Instances,
     emptyInstances,
     getInstance,
@@ -37,14 +38,17 @@ emptyInstances = Instances Empty
 getInstance :: ContractAddress -> Instances -> Maybe Instance
 getInstance addr (Instances iss) = iss ^? ix addr
 
--- |Update the instance at the specified address with an amount delta and value.
--- If there is no instance with the given address, this does nothing.
-updateInstanceAt :: ContractAddress -> AmountDelta -> Wasm.ContractState -> Instances -> Instances
+-- |Update the instance at the specified address with an amount delta and
+-- potentially a new state. If new state is not provided the state of the
+-- instance is not changed. If there is no instance with the given address, this
+-- does nothing.
+updateInstanceAt :: ContractAddress -> AmountDelta -> Maybe Wasm.ContractState -> Instances -> Instances
 updateInstanceAt ca amt val (Instances iss) = Instances (iss & ix ca %~ updateInstance amt val)
 
--- |Update the instance at the specified address with a __new amount__ and value.
--- If there is no instance with the given address, this does nothing.
-updateInstanceAt' :: ContractAddress -> Amount -> Wasm.ContractState -> Instances -> Instances
+-- |Update the instance at the specified address with a __new amount__ and
+-- potentially a new state. If new state is not provided the state of the instance is not changed. If
+-- there is no instance with the given address, this does nothing.
+updateInstanceAt' :: ContractAddress -> Amount -> Maybe Wasm.ContractState -> Instances -> Instances
 updateInstanceAt' ca amt val (Instances iss) = Instances (iss & ix ca %~ updateInstance' amt val)
 
 -- |Create a new smart contract instance.
@@ -76,8 +80,13 @@ putInstancesV0 (Instances (Tree _ t)) = do
             putWord8 1
             put si
         putOptInstance (Right inst) = do
-            putWord8 2
-            putInstanceV0 inst
+            case inst of
+              InstanceV0 i -> do
+                putWord8 2
+                putV0InstanceV0 i
+              InstanceV1 i -> do
+                putWord8 3
+                putV1InstanceV0 i
 
 -- |Deserialize 'Instances' in V0 format.
 getInstancesV0
@@ -88,5 +97,6 @@ getInstancesV0 resolve = Instances <$> constructM buildInstance
         buildInstance idx = getWord8 >>= \case
             0 -> return Nothing
             1 -> Just . Left <$> get
-            2 -> Just . Right <$> getInstanceV0 resolve idx
+            2 -> Just . Right . InstanceV0 <$> getV0InstanceV0 resolve idx
+            3 -> Just . Right . InstanceV1 <$> getV1InstanceV0 resolve idx
             _ -> fail "Bad instance list"

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Invariants.hs

@@ -80,7 +80,8 @@ invariantBlockState bs extraBalance = do
         checkEpochBakers EpochBakers{..} = do
             checkBinary (==) (Vec.length _bakerInfos) (Vec.length _bakerStakes) "==" "#baker infos" "#baker stakes"
             checkBinary (==) _bakerTotalStake (sum _bakerStakes) "==" "baker total stake" "sum of baker stakes"
-        checkInstance amount Instance{..} = return $! (amount + instanceAmount)
+        checkInstance amount (InstanceV0 InstanceV{..}) = return $! (amount + _instanceVAmount)
+        checkInstance amount (InstanceV1 InstanceV{..}) = return $! (amount + _instanceVAmount)
 
         -- check that the two credential maps are the same, the one recorded in block state and the model one.
         checkCredentialResults modelCreds actualCreds = do