Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Sync calls #227

Merged
merged 54 commits into from
Feb 11, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
54 commits
Select commit Hold shift + click to select a range
3534f88
WIP: Code compiles after parametrizing modules and instances.
abizjak Dec 10, 2021
84d501e
WIP: Introduce handling of init V1 contracts.
abizjak Dec 12, 2021
19831e0
WIP: Introduce handling of inter-contract calls in the scheduler.
abizjak Dec 15, 2021
1c3e8dc
Allow deployment of V1 modules.
abizjak Dec 15, 2021
2c78a92
Implement serialization of V1 instances.
abizjak Dec 15, 2021
7079b80
Fix tests after changes to datatypes.
abizjak Dec 15, 2021
98111cb
Add V1 Wasm module version.
abizjak Dec 17, 2021
55ee729
Initial tests of V1 modules.
abizjak Dec 22, 2021
3ad4a23
More tests of contract invocations.
abizjak Dec 22, 2021
e5a0ec4
Add more checks to the call test.
abizjak Dec 22, 2021
c058152
Expose method to convert from return value to bytestring.
abizjak Dec 22, 2021
8a1e540
Add tests for transfers from a contract to an account in the synchron…
abizjak Dec 22, 2021
aac9385
Add V1 instances to globalstate tests.
abizjak Dec 23, 2021
6773577
Add tests for cross-version-contract calls.
abizjak Dec 23, 2021
cdd07b9
Make serialization of parameter size consistent, and revise tests acc…
abizjak Dec 23, 2021
e6c9ca1
Add documentation.
abizjak Dec 23, 2021
6e76821
Add P4 support for testing.
abizjak Dec 24, 2021
3e1917d
Remove needless use of lenses.
abizjak Dec 24, 2021
6dd1053
Haskell parts of invoking a contract as a query.
abizjak Dec 26, 2021
5b0e683
Expose invoke contract externally.
abizjak Dec 27, 2021
456babc
Use entrypoint names when specifying a call target for V1 contracts.
abizjak Jan 3, 2022
358ebee
Merge remote-tracking branch 'origin/main' into sync-calls
abizjak Jan 3, 2022
e802acb
Introduce an Interrupted event for transaction execution.
abizjak Jan 5, 2022
d69f485
Scope the calls.
abizjak Jan 6, 2022
8747175
Fix failure transfer through FFI.
abizjak Jan 6, 2022
eae7cec
Tell the invoker contract whether its state was updated by the call.
abizjak Jan 7, 2022
3714c92
Add a unit test for invoking a contract.
abizjak Jan 11, 2022
11cbbc6
Additional tests.
abizjak Jan 11, 2022
9d2d5a6
Fix bug in transferring failures to smart contracts.
abizjak Jan 11, 2022
76fadfe
Merge remote-tracking branch 'origin/main' into sync-calls
abizjak Jan 11, 2022
91a8e75
Add testing of error codes returned to contracts, and fix related iss…
abizjak Jan 15, 2022
2df594b
Streamline error handling a bit.
abizjak Jan 16, 2022
6e31609
Allow extra exports for V1 contracts, just don't use them.
abizjak Jan 16, 2022
0aa7fb1
Add some general documentation about contracts.
abizjak Jan 16, 2022
07da4ed
Documentation of invoking a contract.
abizjak Jan 16, 2022
8a0ff6b
Version module source as well in order to match versions.
abizjak Jan 16, 2022
8c18e07
Bump max transaction size in the network layer.
abizjak Jan 17, 2022
27607a8
Fix globalstate tests.
abizjak Jan 17, 2022
b7f5b6f
Improve JSON instances.
abizjak Jan 17, 2022
32d4a43
Improve documentation.
abizjak Jan 17, 2022
b15f4d8
Move InvokeContract types to Base
Bargsteen Jan 18, 2022
8ce1614
Fix tests after moving InvokeContract to Base
Bargsteen Jan 19, 2022
c6bc219
Return the updated balance to the resumed contract.
abizjak Jan 23, 2022
96eadd5
Documentation of some aspects of resume.
abizjak Jan 23, 2022
c136bfe
Retain P1-P3 semantics.
abizjak Jan 24, 2022
87c279b
Revise some naming for clarity.
abizjak Jan 25, 2022
bb910bc
Reverse order of returned events for V1 contracts, and fix bug in tra…
abizjak Jan 25, 2022
1bf1d68
Bump dependencies.
abizjak Jan 25, 2022
1d8ac05
Minor changes stemming from base update.
abizjak Feb 8, 2022
f414426
Merge remote-tracking branch 'origin/main' into sync-calls
abizjak Feb 8, 2022
24f76ff
Documentation, code style, and other minor fixes.
abizjak Feb 10, 2022
7da55e1
Document the new API.
abizjak Feb 11, 2022
23632f4
Bump base dependency after merge.
abizjak Feb 11, 2022
1342d1a
Improve documentation.
abizjak Feb 11, 2022
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion concordium-consensus/.diff-wat-wasm.sh
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down
1 change: 1 addition & 0 deletions concordium-consensus/lib.def
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ EXPORTS
getInstances
getAccountInfo
getInstanceInfo
invokeContract
getRewardStatus
getBirkParameters
getModuleList
Expand Down
24 changes: 24 additions & 0 deletions concordium-consensus/src/Concordium/External.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions concordium-consensus/src/Concordium/GlobalState/AccountMap.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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))

Expand Down Expand Up @@ -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'
Expand Down Expand Up @@ -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))
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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 {
Expand Down Expand Up @@ -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

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down
Original file line number Diff line number Diff line change
@@ -1,8 +1,9 @@
module Concordium.GlobalState.Basic.BlockState.Instances(
InstanceParameters(..),
Instance(..),
InstanceV(..),
HasInstanceAddress(..),
makeInstance,
iaddress,
Instances,
emptyInstances,
getInstance,
Expand Down Expand Up @@ -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
abizjak marked this conversation as resolved.
Show resolved Hide resolved
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.
Expand Down Expand Up @@ -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
Expand All @@ -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
abizjak marked this conversation as resolved.
Show resolved Hide resolved
_ -> fail "Bad instance list"
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading