Welcome

This blog discusses various topics, mostly about tezos smart contracts, and software safety (verification). You can find a list of the latest posts here.

Articles (should) be sorted by the topics they discuss:

Latest

About Me

Hi. I'm Adrien Champion. I have a PhD in software safety and worked on critical embedded systems (systems controlling planes, nuclear plants, cars, etc.) during both my PhD and my first postdoc at the University of Iowa with Cesare Tinelli, where I worked on the Kind 2 model checker. I did my second postdoc at the University of Tokyo with Naoki Kobayashi. I worked on higher-order model-checking: I developed the hoice Horn Clause solver which proved quite efficient for problems stemming from higher-order program verification.

I now work at OCamlPro. Currently, most of my work there targets tezos smart contracts, Michelson which is tezos' language for smart contracts, and Liquidity, an OCaml-like (relatively) high-level language which (de)compiles to/from michelson.

I am interested in software safety and strongly-typed high-level languages such as Rust and OCaml. I still occasionally work on (critical) embedded system verification.

Michelson/Liquidity

Using Techelson With Liquidity

Techelson is a Test Execution Engine for Michelson smart contracts developed by myself at OCamlPro. With the (upcoming) release of Techelson, here is a relatively simple (although a bit dirty) setup to combine it with Liquidity locally, command-line style. Very little knowledge about Techelson is required. This post only assumes some familiarity with Liquidity.

NB: if you want to learn more about Techelson, make sure to read its user documentation.

Liquidity has a nice feature allowing to declare extensions to the language. Turns out they are powerful enough to generate Techelson's special instructions: you can write your tests directly in Liquidity, and tiny script run the tests for you.

First, make sure you have Liquidity and Techelson in your path. I'll assume they are called liquidity and techelson. Let's structure things a bit and have the working directory look like this:

.
├── test.sh
├── contracts
│   └── "contracts go here"
└── tests
    └── "tests go here"

The first step is to teach Liquidity to generate Techelson special instruction and setup a tiny test script in Liquidity Extensions. Then test our setup on a Basic Example. After I will show how to write a test for an external, non-trivial contract in External Contract Example, using more advanced Techelson commands. Finally, there's The End at the end.

There is a listing of all the files used in this post in the File Listing section. Also, they are available here.

Liquidity Extensions

The first step is to declare the Liquidity extensions we need. Let's create a tests/techel.liq to write our extensions into:

external get_balance :
    [%stack: address] -> [%stack: tez]
    = "GET_BALANCE"
external get_storage :
    [%type: 'a] -> [%stack: address] -> [%stack: 'a option]
    = "GET_STORAGE"
external apply_operations :
    [%stack: operation list] -> unit
    = "APPLY_OPERATIONS"
external start_set_source :
    [%stack: address] -> unit
    = "SET_SOURCE { #"
external end_set_source :
    unit -> unit
    = "}"
external must_fail :
    [%stack: string option] -> [%stack: operation] -> [%stack: operation]
    = "MUST_FAIL string"

It is not crucial to understand these rules precisely, only the power they give us. And that power is the following functions. What they do precisely will become clear when we use them later on.

  • get_balance address: takes an address as parameter, and returns the balance of the contract at that address
  • get_storage [%type: 'g] address: takes a type and an address as parameter, and returns
    • Some of the storage of the contract at that address, if it has type 'g
    • None otherwise
  • apply_operations ops: takes a list of operations and applies them right away
  • start_set_source address and end_set_source (): a very, very dirty hack to define a scope where all operations created appear to have been created by whatever is at address
  • must_fail msg_opt op: tells techelson that the operation op must fail; this succeeds iff op fails and
    • msg_opt is None, or
    • msg_opt is Some msg and op failed precisely with string msg.

Thanks to Liquidity's file import mechanism, we can use these functions in any Liquidity file test.liq with Techel.get_balance, Techel.get_storage etc. by simply calling Liquidity as follows:

$ liquidity tests/techel.liq test.liq

NB: you only need to write tests/techel.liq once, and make sure you pass it to Liquidity when compiling your testcases, as in test.sh below.

So let's fill in the test.sh file so that it runs our tests. It takes the path to our (future) Liquidity test file(s) as argument, and compiles it/them along with all the contracts in contracts/ and the extensions we just defined. So, given some file tests/test.liq, the script

  • generates tests/test.liq.techel: contains the testcase and the contract(s) to test, and
  • runs techelson on tests/test.liq.techel.
#! /bin/bash

set -e

test_file="$1"

this_script_dir="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )"
techel_lib="$this_script_dir/tests/techel.liq"

# List of all the contracts.
contracts=""
for file in `find "$this_script_dir/contracts" -iname "*.liq"` ; do
    contracts="$contracts $file"
done

# File liquidity will compile to.
target="$test_file.techel"

echo "Compiling $test_file..."
echo
liquidity --no-annot --no-simplify --no-peephole $techel_lib $contracts -o $target $test_file
echo

# Running techelson on the target.
echo "Running test $target"
echo
techelson $target

Warning: function start_set_source uses a dirty hack so that it works as a Liquidity extension (similar to a SQL injection). This is a temporary solution, eventually this hack will not be necessary.

Basic Example

Our test is going to be a contract with a unit (empty) storage. Its (only) entry point will take a parameter of type unit and inside that entry point will be our test. Entry points must return a list of operation and the new value of the storage. It is not relevant for the test: it will just run and perform tests. Let's have a nothing helper which is the pair of the empty list of operations and unit.

So the simplest test tests/empty.liq we can write is:

type storage = unit

let nothing : operation list * unit = [], ()

let%entry test (_param : unit) (_storage : unit) =
    nothing

Which we can compile, and run with the test.sh script from the previous section.

$ ./../test.sh ../tests/empty.liq
Compiling ../tests/empty.liq...

Module Techel
Contract Multi
Main contract Empty
File "../tests/empty.liq.techel" generated
If tezos is compiled, you may want to typecheck with:
  tezos-client typecheck script ../tests/empty.liq.techel

Running test ../tests/empty.liq.techel

Running test `Empty`

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

Done running test `Empty`

That was boring. Let's write something slightly more interesting. This new test tests/basic.liq will

  • create an account with 13 tez,
  • check that its balance after deployment is 13 tez,
  • make a transfer of 29 tez,
  • check that the new balance is 42 tez.
type storage = unit

let nothing : operation list * unit = [], ()

let%entry test (_param : unit) (_storage : unit) =
    let delegate : key_hash option = None in
    let operation, address =
        Account.create
            ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
            ~delegate
            ~delegatable:true
            ~amount:13tz
    in
    (* Apply the operation so that we can interact with the account. *)
    Techel.apply_operations [operation];

    (* Contract is now live. *)
    let balance = Techel.get_balance address in
    if balance <> 13tz then (
        failwith "balance should be 13tz"
    );

    let account_contract =
        match UnitContract.at address with
        | None -> failwith "could not retrieve account"
        | Some c -> c
    in

    let operation = Contract.call ~dest:account_contract ~amount:29tz ~parameter:() in
    Techel.apply_operations [operation];

    let balance = Techel.get_balance address in
    if balance <> 42tz then (
        failwith "balance should be 42tz"
    );

    nothing

and run it

$ ./../test.sh ../tests/basic.liq
Compiling ../tests/basic.liq...

Module Techel
Contract Multi
Main contract Basic
File "../tests/basic.liq.techel" generated
If tezos is compiled, you may want to typecheck with:
  tezos-client typecheck script ../tests/basic.liq.techel

Running test ../tests/basic.liq.techel

Running test `Basic`

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:0] (@address[1], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 13000000utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: none
=> live contracts: <anonymous> (13000000utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation TRANSFER[uid:1] address[0]@Basic -> address[1] 29000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (13000000utz) address[1]

running TRANSFER[uid:1] address[0]@Basic -> address[1] 29000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (42000000utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

Done running test `Basic`

Let's make sure we are actually testing something. Let's change the final check of tests/basic.liq to

    let balance = Techel.get_balance address in
    if balance <> 12tz then (
        failwith "balance should be 12tz"
    );

in tests/basic_err.liq. The test fails indeed:

$ ./../test.sh ../tests/basic_err.liq
Compiling ../tests/basic_err.liq...

Module Techel
Contract Multi
Main contract Basic_err
File "../tests/basic_err.liq.techel" generated
If tezos is compiled, you may want to typecheck with:
  tezos-client typecheck script ../tests/basic_err.liq.techel

Running test ../tests/basic_err.liq.techel

Running test `Basic_err`

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:0] (@address[1], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 13000000utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: none
=> live contracts: <anonymous> (13000000utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation TRANSFER[uid:1] address[0]@Basic_err -> address[1] 29000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (13000000utz) address[1]

running TRANSFER[uid:1] address[0]@Basic_err -> address[1] 29000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (42000000utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

Test `Basic_err` failed:
    Tezos protocol error
        Failure on value "balance should be 12tz" : string

Error
    1 of the 1 testcase failed

External Contract Example

Let's give ourselves an external contract that we can write a test for. We will use contracts/multi.liq. It's whole code is available in the listing, but for writing a test we only need a high-level understanding of what it does.

Multi, in contracts/multi.liq, offers its clients to store tokens for them. It has some administrators, which are the only one able to add new clients. First, the contract's storage is

type storage = {
    admins : (string, address) map ;
    users : (string, (address * tez * UnitContract.instance)) map ;
}

Multi stores some named administrators in a map admins from names to administrator addresses. It also stores some named clients in a map clients. It maps the name of a client to

  • its address
  • the amount of money it has stored on this contract
  • an account which will receive all the money the client has if the client asks to drains it.

Entry Points

The entry points of Multi we are interested in are

let%entry add_client (
    (admin_name, user_name, user,     c) :
     string *    string *   address * UnitContract.instance
) (storage : storage) =
    ...

Adds a new user. Only administrators can do this.

let%entry drain (name : string) (storage : storage) =
    ...

Transfers all the money of a user to the account provided on creation. Only the client can call this entry point (with the right name).

Testing Multi (and failing to do so)

Let's first write a test which creates an instance of Multi with an admin named root. It then adds a new administrator:

let nothing : operation list * unit = [], ()

(* Creates a storage for Multi with one administrator. *)
let one_admin (root : string) (address : address) : Multi.storage = {
    Multi.admins =
        Map.add root address (Map : (string, address) map) ;
    Multi.users =
        (Map : (string, (address * tez * UnitContract.instance)) map) ;
}

(* Deploys an account with an arbitrary manager. *)
let deploy_account_op (amount: tez) : operation * address =
    let delegate : key_hash option = None in
    Account.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~amount

(* Deploys an instance of multi with an arbitrary manager. *)
let deploy_contract_op (storage : Multi.storage) : operation * address =
    let delegate : key_hash option = None in
    Contract.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~spendable:false
        ~amount:0tz
        ~storage
        ~code:(contract Multi)

(* Storage of the test is irrelevant. *)
type storage = unit

(* Actual test. *)
let%entry test (_param : unit) (_storage : unit) =
    let root_op, root = deploy_account_op 0tz in
    let storage = one_admin "root" root in
    let main_op, main = deploy_contract_op storage in
    (* ask techelson to apply these operations. *)
    Techel.apply_operations [ root_op ; main_op ];
    (* root and main are live now *)

    (* let's check root is an admin, and that the address is correct *)
    let storage =
        match Techel.get_storage [%type: Multi.storage] main with
        | Some storage -> storage
        | None -> failwith "can't retrieve contract's storage"
    in
    (
        match Map.find "root" storage.Multi.admins with
        | None -> failwith "no root in storage"
        | Some address -> (
            if address <> root then (
                failwith "wrong address for root"
            )
        )
    );

    let client_op, client = deploy_account_op 15tz in
    (* deploy the client *)
    Techel.apply_operations [ client_op ];
    (* client is live now *)

    (* retrieve client instance for registration *)
    let client_instance =
        match (Contract.at client : UnitContract.instance option) with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in
    (* retrieve multi's instance to call it *)
    let main_instance =
        match Multi.at main with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in

    (* let's add a client *)
    let add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    Techel.apply_operations [ add_client ];

    nothing

Let's run this test. It will fail though, as it should. So we will call it tests/test1_err.liq. The relevant part of the output is

$ ./../test.sh ../tests/test1_err.liq
[....]
Test `Test1_err` failed:
    Error
        operation TRANSFER[uid:3] address[0]@Test1_err -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))) was expected to succeed
        but failed on operation TRANSFER[uid:3] address[0]@Test1_err -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
        operation failed on "illegal access to admin account" : string

The reason this test failed is because only administrator can add clients. So here, only root can add a new client. Hence, we need to pretend to be root. More precisely, we need to pretend to be root when we create the operation.

But this test is not worthless. It shows that an outsider cannot add new clients even by using the name of an existing outsider. What we should do is say that this transfer must fail. This is what tests/test1.liq does. Only the apply_operations changes:

    let must_fail = Techel.must_fail None bad_add_client in
    Techel.apply_operations [ must_fail ];

Extension must_fail None op produces an operation that succeeds iff op fails. Techelson notifies you that the failure was confirmed in its output:

failure confirmed on test operation
  MUST_FAIL[uid:4] _ (TRANSFER[uid:3] address[0]@Test1 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
while running operation TRANSFER[uid:3] address[0]@Test1 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
failed with value "illegal access to admin account" : string

We can do better than this: we can ask Techelson to verify the error message is the one we expect. This is exactly what the first argument of must_fail does. must_fail (Some msg) op succeeds iff op fails with exactly the string msg.

Test tests/test1_better.liq only changes in the error message:

    let error_message = Some "illegal access to admin account" in
    let must_fail = Techel.must_fail error_message bad_add_client in
    Techel.apply_operations [ must_fail ];

Techelson confirms the failure and its error message (see the output):

failure confirmed on test operation
  MUST_FAIL[uid:4] "illegal access to admin account" : string (TRANSFER[uid:3] address[0]@Test1_better -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
while running operation TRANSFER[uid:3] address[0]@Test1_better -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
failed with value "illegal access to admin account" : string

Testing Multi

Let's now make the transfer work by pretending to be root. The current solution for this is not very satisfactory, but it will do the job until techelson is more tightly integrated in Liquidity. The result is tests/test2.liq, where we add:

    Techel.start_set_source root ;
        (* all operations created in here will appear to have been created by `root` *)
        let add_client =
            Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
                "root", "lucy", client, client_instance
            )
        in
    Techel.end_set_source () ;

The test is now successful:

$ ./../test.sh ../tests/test1.liq
Compiling ../tests/test1.liq...

Module Techel
Contract Multi
Main contract Test1
File "../tests/test1.liq.techel" generated
If tezos is compiled, you may want to typecheck with:
  tezos-client typecheck script ../tests/test1.liq.techel

Running test ../tests/test1.liq.techel

Running test `Test1`

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:0] (@address[1], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 0utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: none
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:2] (@address[3], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 15000000utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (0utz) address[1]
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation MUST_FAIL[uid:4] _ (TRANSFER[uid:3] address[0]@Test1 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:3] address[0]@Test1 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]
failure confirmed on test operation
  MUST_FAIL[uid:4] _ (TRANSFER[uid:3] address[0]@Test1 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
while running operation TRANSFER[uid:3] address[0]@Test1 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
failed with value "illegal access to admin account" : string

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

Done running test `Test1`

Finally, let's add more tests. We will have the client ("lucy") deposit 10tz on her account, which should leave her with 5tz (remember she was created with 15tz). She will then drain her account, which will trigger Multi to send her all of her money, at which point she should have 15tz.

The additional code, in tests/test3.liq, is

    Techel.start_set_source client ;
        let deposit_money =
            Contract.call ~dest:main_instance ~amount:10tz ~entry:deposit ~parameter:"lucy"
        in
    Techel.end_set_source () ;
    Techel.apply_operations [ deposit_money ];
    let balance_lucy = Techel.get_balance client in
    if balance_lucy <> 5tz then (
        failwith "lucy should have 5tz now"
    );

    (* lucy walks out of the whole thing *)
    Techel.start_set_source client ;
        let drain =
            Contract.call ~dest:main_instance ~amount:0tz ~entry:drain ~parameter:"lucy"
        in
    Techel.end_set_source () ;
    Techel.apply_operations [ drain ] ;

    (* lucy should have her money back *)
    let balance_lucy = Techel.get_balance client in
    if balance_lucy <> 15tz then (
        failwith "lucy should have 15tz now"
    );

which is successful:

$ ./../test.sh ./../tests/test3.liq
Compiling ./../tests/test3.liq...

Module Techel
Contract Multi
Main contract Test3
File "./../tests/test3.liq.techel" generated
If tezos is compiled, you may want to typecheck with:
  tezos-client typecheck script ./../tests/test3.liq.techel

Running test ./../tests/test3.liq.techel

Running test `Test3`

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:0] (@address[1], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 0utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: none
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:2] (@address[3], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 15000000utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (0utz) address[1]
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation MUST_FAIL[uid:4] "illegal access to admin account" : 
string (TRANSFER[uid:3] address[0]@Test3 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:3] address[0]@Test3 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

applying operation TRANSFER[uid:5] address[1] -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]
failure confirmed on test operation
  MUST_FAIL[uid:4] "illegal access to admin account" : string (TRANSFER[uid:3] address[0]@Test3 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
while running operation TRANSFER[uid:3] address[0]@Test3 -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
failed with value "illegal access to admin account" : string

running TRANSFER[uid:5] address[1] -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation TRANSFER[uid:6] address[3] -> address[2] 10000000utz (Right (Right (Right (Left "lucy"))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:6] address[3] -> address[2] 10000000utz (Right (Right (Right (Left "lucy"))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation TRANSFER[uid:7] address[3] -> address[2] 0utz (Right (Right (Right (Right (Right "lucy")))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:7] address[3] -> address[2] 0utz (Right (Right (Right (Right (Right "lucy")))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

applying operation TRANSFER[uid:8] address[2] -> address[3] 10000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:8] address[2] -> address[3] 10000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

Done running test `Test3`

Last, let's again make sure we're actually testing something by checking that, at the end, lucy's balance is 2tz (it's not) in tests/test3_err.liq:

    (* lucy should have her money back *)
    let balance_lucy = Techel.get_balance client in
    if balance_lucy <> 2tz then (
        failwith "lucy should have 2tz now"
    );

This fails:

$ ./../test.sh ../tests/test3_err.liq
Compiling ../tests/test3_err.liq...

Module Techel
Contract Multi
Main contract Test3_err
File "../tests/test3_err.liq.techel" generated
If tezos is compiled, you may want to typecheck with:
  tezos-client typecheck script ../tests/test3_err.liq.techel

Running test ../tests/test3_err.liq.techel

Running test `Test3_err`

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:0] (@address[1], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 0utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: none
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation CREATE[uid:2] (@address[3], "tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc", None, true, true, 15000000utz) 
                       {
                           storage unit ;
                           parameter unit ;
                           code ...;
                       }
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (0utz) address[1]
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation MUST_FAIL[uid:4] "illegal access to admin account" : 
string (TRANSFER[uid:3] address[0]@Test3_err -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:3] address[0]@Test3_err -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

applying operation TRANSFER[uid:5] address[1] -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]
failure confirmed on test operation
  MUST_FAIL[uid:4] "illegal access to admin account" : string (TRANSFER[uid:3] address[0]@Test3_err -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3])))))))
while running operation TRANSFER[uid:3] address[0]@Test3_err -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
failed with value "illegal access to admin account" : string

running TRANSFER[uid:5] address[1] -> address[2] 0utz (Right (Right (Left ("root", ("lucy", (address[3], address[3]))))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation TRANSFER[uid:6] address[3] -> address[2] 10000000utz (Right (Right (Right (Left "lucy"))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:6] address[3] -> address[2] 10000000utz (Right (Right (Right (Left "lucy"))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

applying operation TRANSFER[uid:7] address[3] -> address[2] 0utz (Right (Right (Right (Right (Right "lucy")))))
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:7] address[3] -> address[2] 0utz (Right (Right (Right (Right (Right "lucy")))))
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

applying operation TRANSFER[uid:8] address[2] -> address[3] 10000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
   live contracts: <anonymous> (10000000utz) address[2]
                   <anonymous> (5000000utz) address[3]
                   <anonymous> (0utz) address[1]

running TRANSFER[uid:8] address[2] -> address[3] 10000000utz Unit
   timestamp: 1970-01-01 00:00:00 +00:00
=> live contracts: <anonymous> (0utz) address[2]
                   <anonymous> (15000000utz) address[3]
                   <anonymous> (0utz) address[1]

running test script...
   timestamp: 1970-01-01 00:00:00 +00:00

Test `Test3_err` failed:
    Tezos protocol error
        Failure on value "lucy should have 2tz now" : string

Error
    1 of the 1 testcase failed

The End

That's it. I believe this is enough to get some Liquidity enthusiasts interested in techelson and its future integration in the Liquidity ecosystem. The process will be much more streamlined soon and will most likely remove the need for defining Liquidity extensions.

The next section is a listing of all the scripts, contracts and test files used in this post.

File Listing

Including all files mentioned in this post, the layout should look like this

test.sh

 
#! /bin/bash

set -e

test_file="$1"

this_script_dir="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )"
techel_lib="$this_script_dir/tests/techel.liq"

# List of all the contracts.
contracts=""
for file in `find "$this_script_dir/contracts" -iname "*.liq"` ; do
    contracts="$contracts $file"
done

# File liquidity will compile to.
target="$test_file.techel"

echo "Compiling $test_file..."
echo
liquidity --no-annot --no-simplify --no-peephole $techel_lib $contracts -o $target $test_file
echo

# Running techelson on the target.
echo "Running test $target"
echo
techelson $target

tests/

tests/basic.liq

 
type storage = unit

let nothing : operation list * unit = [], ()

let%entry test (_param : unit) (_storage : unit) =
    let delegate : key_hash option = None in
    let operation, address =
        Account.create
            ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
            ~delegate
            ~delegatable:true
            ~amount:13tz
    in
    (* Apply the operation so that we can interact with the account. *)
    Techel.apply_operations [operation];

    (* Contract is now live. *)
    let balance = Techel.get_balance address in
    if balance <> 13tz then (
        failwith "balance should be 13tz"
    );

    let account_contract =
        match UnitContract.at address with
        | None -> failwith "could not retrieve account"
        | Some c -> c
    in

    let operation = Contract.call ~dest:account_contract ~amount:29tz ~parameter:() in
    Techel.apply_operations [operation];

    let balance = Techel.get_balance address in
    if balance <> 42tz then (
        failwith "balance should be 42tz"
    );

    nothing

tests/basic_err.liq

 
type storage = unit

let nothing : operation list * unit = [], ()

let%entry test (_param : unit) (_storage : unit) =
    let delegate : key_hash option = None in
    let operation, address =
        Account.create
            ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
            ~delegate
            ~delegatable:true
            ~amount:13tz
    in
    (* Apply the operation so that we can interact with the account. *)
    Techel.apply_operations [operation];

    (* Contract is now live. *)
    let balance = Techel.get_balance address in
    if balance <> 13tz then (
        failwith "balance should be 13tz"
    );

    let account_contract =
        match UnitContract.at address with
        | None -> failwith "could not retrieve account"
        | Some c -> c
    in

    let operation = Contract.call ~dest:account_contract ~amount:29tz ~parameter:() in
    Techel.apply_operations [operation];

    let balance = Techel.get_balance address in
    if balance <> 12tz then (
        failwith "balance should be 12tz"
    );

    nothing

tests/empty.liq

 
type storage = unit

let nothing : operation list * unit = [], ()

let%entry test (_param : unit) (_storage : unit) =
    nothing

tests/techel.liq

 
external get_balance :
    [%stack: address] -> [%stack: tez]
    = "GET_BALANCE"
external get_storage :
    [%type: 'a] -> [%stack: address] -> [%stack: 'a option]
    = "GET_STORAGE"
external apply_operations :
    [%stack: operation list] -> unit
    = "APPLY_OPERATIONS"
external start_set_source :
    [%stack: address] -> unit
    = "SET_SOURCE { #"
external end_set_source :
    unit -> unit
    = "}"
external must_fail :
    [%stack: string option] -> [%stack: operation] -> [%stack: operation]
    = "MUST_FAIL string"
external print_stack :
    unit -> unit
    = "PRINT_STACK"
external step :
    unit -> unit
    = "STEP"

tests/test1.liq

 
let nothing : operation list * unit = [], ()

(* Creates a storage for Multi with one administrator. *)
let one_admin (root : string) (address : address) : Multi.storage = {
    Multi.admins =
        Map.add root address (Map : (string, address) map) ;
    Multi.users =
        (Map : (string, (address * tez * UnitContract.instance)) map) ;
}

(* Deploys an account with an arbitrary manager. *)
let deploy_account_op (amount: tez) : operation * address =
    let delegate : key_hash option = None in
    Account.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~amount

(* Deploys an instance of multi with an arbitrary manager. *)
let deploy_contract_op (storage : Multi.storage) : operation * address =
    let delegate : key_hash option = None in
    Contract.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~spendable:false
        ~amount:0tz
        ~storage
        ~code:(contract Multi)

(* Storage of the test is irrelevant. *)
type storage = unit

(* Actual test. *)
let%entry test (_param : unit) (_storage : unit) =
    let root_op, root = deploy_account_op 0tz in
    let storage = one_admin "root" root in
    let main_op, main = deploy_contract_op storage in
    (* ask techelson to apply these operations. *)
    Techel.apply_operations [ root_op ; main_op ];
    (* root and main are live now *)

    (* let's check root is an admin, and that the address is correct *)
    let storage =
        match Techel.get_storage [%type: Multi.storage] main with
        | Some storage -> storage
        | None -> failwith "can't retrieve contract's storage"
    in
    (
        match Map.find "root" storage.Multi.admins with
        | None -> failwith "no root in storage"
        | Some address -> (
            if address <> root then (
                failwith "wrong address for root"
            )
        )
    );

    let client_op, client = deploy_account_op 15tz in
    (* deploy the client *)
    Techel.apply_operations [ client_op ];
    (* client is live now *)

    (* retrieve client instance for registration *)
    let client_instance =
        match (Contract.at client : UnitContract.instance option) with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in
    (* retrieve multi's instance to call it *)
    let main_instance =
        match Multi.at main with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in

    (* let's add a client *)
    let bad_add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    let must_fail = Techel.must_fail None bad_add_client in
    Techel.apply_operations [ must_fail ];

    nothing

tests/test1_better.liq

 
let nothing : operation list * unit = [], ()

(* Creates a storage for Multi with one administrator. *)
let one_admin (root : string) (address : address) : Multi.storage = {
    Multi.admins =
        Map.add root address (Map : (string, address) map) ;
    Multi.users =
        (Map : (string, (address * tez * UnitContract.instance)) map) ;
}

(* Deploys an account with an arbitrary manager. *)
let deploy_account_op (amount: tez) : operation * address =
    let delegate : key_hash option = None in
    Account.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~amount

(* Deploys an instance of multi with an arbitrary manager. *)
let deploy_contract_op (storage : Multi.storage) : operation * address =
    let delegate : key_hash option = None in
    Contract.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~spendable:false
        ~amount:0tz
        ~storage
        ~code:(contract Multi)

(* Storage of the test is irrelevant. *)
type storage = unit

(* Actual test. *)
let%entry test (_param : unit) (_storage : unit) =
    let root_op, root = deploy_account_op 0tz in
    let storage = one_admin "root" root in
    let main_op, main = deploy_contract_op storage in
    (* ask techelson to apply these operations. *)
    Techel.apply_operations [ root_op ; main_op ];
    (* root and main are live now *)

    (* let's check root is an admin, and that the address is correct *)
    let storage =
        match Techel.get_storage [%type: Multi.storage] main with
        | Some storage -> storage
        | None -> failwith "can't retrieve contract's storage"
    in
    (
        match Map.find "root" storage.Multi.admins with
        | None -> failwith "no root in storage"
        | Some address -> (
            if address <> root then (
                failwith "wrong address for root"
            )
        )
    );

    let client_op, client = deploy_account_op 15tz in
    (* deploy the client *)
    Techel.apply_operations [ client_op ];
    (* client is live now *)

    (* retrieve client instance for registration *)
    let client_instance =
        match (Contract.at client : UnitContract.instance option) with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in
    (* retrieve multi's instance to call it *)
    let main_instance =
        match Multi.at main with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in

    (* let's add a client *)
    let bad_add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    let error_message = Some "illegal access to admin account" in
    let must_fail = Techel.must_fail error_message bad_add_client in
    Techel.apply_operations [ must_fail ];

    nothing

tests/test1_err.liq

 
let nothing : operation list * unit = [], ()

(* Creates a storage for Multi with one administrator. *)
let one_admin (root : string) (address : address) : Multi.storage = {
    Multi.admins =
        Map.add root address (Map : (string, address) map) ;
    Multi.users =
        (Map : (string, (address * tez * UnitContract.instance)) map) ;
}

(* Deploys an account with an arbitrary manager. *)
let deploy_account_op (amount: tez) : operation * address =
    let delegate : key_hash option = None in
    Account.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~amount

(* Deploys an instance of multi with an arbitrary manager. *)
let deploy_contract_op (storage : Multi.storage) : operation * address =
    let delegate : key_hash option = None in
    Contract.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~spendable:false
        ~amount:0tz
        ~storage
        ~code:(contract Multi)

(* Storage of the test is irrelevant. *)
type storage = unit

(* Actual test. *)
let%entry test (_param : unit) (_storage : unit) =
    let root_op, root = deploy_account_op 0tz in
    let storage = one_admin "root" root in
    let main_op, main = deploy_contract_op storage in
    (* ask techelson to apply these operations. *)
    Techel.apply_operations [ root_op ; main_op ];
    (* root and main are live now *)

    (* let's check root is an admin, and that the address is correct *)
    let storage =
        match Techel.get_storage [%type: Multi.storage] main with
        | Some storage -> storage
        | None -> failwith "can't retrieve contract's storage"
    in
    (
        match Map.find "root" storage.Multi.admins with
        | None -> failwith "no root in storage"
        | Some address -> (
            if address <> root then (
                failwith "wrong address for root"
            )
        )
    );

    let client_op, client = deploy_account_op 15tz in
    (* deploy the client *)
    Techel.apply_operations [ client_op ];
    (* client is live now *)

    (* retrieve client instance for registration *)
    let client_instance =
        match (Contract.at client : UnitContract.instance option) with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in
    (* retrieve multi's instance to call it *)
    let main_instance =
        match Multi.at main with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in

    (* let's add a client *)
    let add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    Techel.apply_operations [ add_client ];

    nothing

tests/test2.liq

 
let nothing : operation list * unit = [], ()

(* Creates a storage for Multi with one administrator. *)
let one_admin (root : string) (address : address) : Multi.storage = {
    Multi.admins =
        Map.add root address (Map : (string, address) map) ;
    Multi.users =
        (Map : (string, (address * tez * UnitContract.instance)) map) ;
}

(* Deploys an account with an arbitrary manager. *)
let deploy_account_op (amount: tez) : operation * address =
    let delegate : key_hash option = None in
    Account.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~amount

(* Deploys an instance of multi with an arbitrary manager. *)
let deploy_contract_op (storage : Multi.storage) : operation * address =
    let delegate : key_hash option = None in
    Contract.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~spendable:false
        ~amount:0tz
        ~storage
        ~code:(contract Multi)

(* Storage of the test is irrelevant. *)
type storage = unit

(* Actual test. *)
let%entry test (_param : unit) (_storage : unit) =
    let root_op, root = deploy_account_op 0tz in
    let storage = one_admin "root" root in
    let main_op, main = deploy_contract_op storage in
    (* ask techelson to apply these operations. *)
    Techel.apply_operations [ root_op ; main_op ];
    (* root and main are live now *)

    (* let's check root is an admin, and that the address is correct *)
    let storage =
        match Techel.get_storage [%type: Multi.storage] main with
        | Some storage -> storage
        | None -> failwith "can't retrieve contract's storage"
    in
    (
        match Map.find "root" storage.Multi.admins with
        | None -> failwith "no root in storage"
        | Some address -> (
            if address <> root then (
                failwith "wrong address for root"
            )
        )
    );

    let client_op, client = deploy_account_op 15tz in
    (* deploy the client *)
    Techel.apply_operations [ client_op ];
    (* client is live now *)

    (* retrieve client instance for registration *)
    let client_instance =
        match (Contract.at client : UnitContract.instance option) with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in
    (* retrieve multi's instance to call it *)
    let main_instance =
        match Multi.at main with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in

    (* let's add a client and fail *)
    let bad_add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    let error_message = Some "illegal access to admin account" in
    let must_fail = Techel.must_fail error_message bad_add_client in
    (* let's really add a client now *)
    Techel.start_set_source root ;
        (* all operations created in here will appear to have been created by `root` *)
        let add_client =
            Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
                "root", "lucy", client, client_instance
            )
        in
    Techel.end_set_source () ;

    Techel.apply_operations [ must_fail ; add_client ];

    nothing

tests/test3.liq

 
let nothing : operation list * unit = [], ()

(* Creates a storage for Multi with one administrator. *)
let one_admin (root : string) (address : address) : Multi.storage = {
    Multi.admins =
        Map.add root address (Map : (string, address) map) ;
    Multi.users =
        (Map : (string, (address * tez * UnitContract.instance)) map) ;
}

(* Deploys an account with an arbitrary manager. *)
let deploy_account_op (amount: tez) : operation * address =
    let delegate : key_hash option = None in
    Account.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~amount

(* Deploys an instance of multi with an arbitrary manager. *)
let deploy_contract_op (storage : Multi.storage) : operation * address =
    let delegate : key_hash option = None in
    Contract.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~spendable:false
        ~amount:0tz
        ~storage
        ~code:(contract Multi)

(* Storage of the test is irrelevant. *)
type storage = unit

(* Actual test. *)
let%entry test (_param : unit) (_storage : unit) =
    let root_op, root = deploy_account_op 0tz in
    let storage = one_admin "root" root in
    let main_op, main = deploy_contract_op storage in
    (* ask techelson to apply these operations. *)
    Techel.apply_operations [ root_op ; main_op ];
    (* root and main are live now *)

    (* let's check root is an admin, and that the address is correct *)
    let storage =
        match Techel.get_storage [%type: Multi.storage] main with
        | Some storage -> storage
        | None -> failwith "can't retrieve contract's storage"
    in
    (
        match Map.find "root" storage.Multi.admins with
        | None -> failwith "no root in storage"
        | Some address -> (
            if address <> root then (
                failwith "wrong address for root"
            )
        )
    );

    let client_op, client = deploy_account_op 15tz in
    (* deploy the client *)
    Techel.apply_operations [ client_op ];
    (* client is live now *)

    (* retrieve client instance for registration *)
    let client_instance =
        match (Contract.at client : UnitContract.instance option) with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in
    (* retrieve multi's instance to call it *)
    let main_instance =
        match Multi.at main with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in

    (* let's add a client and fail *)
    let bad_add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    let error_message = Some "illegal access to admin account" in
    let must_fail = Techel.must_fail error_message bad_add_client in
    (* let's really add a client now *)
    Techel.start_set_source root ;
        (* all operations created in here will appear to have been created by `root` *)
        let add_client =
            Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
                "root", "lucy", client, client_instance
            )
        in
    Techel.end_set_source () ;

    Techel.apply_operations [ must_fail ; add_client ];

    (* lucy deposits `10tz` *)
    Techel.start_set_source client ;
        let deposit_money =
            Contract.call ~dest:main_instance ~amount:10tz ~entry:deposit ~parameter:"lucy"
        in
    Techel.end_set_source () ;
    Techel.apply_operations [ deposit_money ];
    let balance_lucy = Techel.get_balance client in
    if balance_lucy <> 5tz then (
        failwith "lucy should have 5tz now"
    );

    (* lucy walks out of the whole thing *)
    Techel.start_set_source client ;
        let drain =
            Contract.call ~dest:main_instance ~amount:0tz ~entry:drain ~parameter:"lucy"
        in
    Techel.end_set_source () ;
    Techel.apply_operations [ drain ] ;

    (* lucy should have her money back *)
    let balance_lucy = Techel.get_balance client in
    if balance_lucy <> 15tz then (
        failwith "lucy should have 15tz now"
    );

    nothing

tests/test3_err.liq

 
let nothing : operation list * unit = [], ()

(* Creates a storage for Multi with one administrator. *)
let one_admin (root : string) (address : address) : Multi.storage = {
    Multi.admins =
        Map.add root address (Map : (string, address) map) ;
    Multi.users =
        (Map : (string, (address * tez * UnitContract.instance)) map) ;
}

(* Deploys an account with an arbitrary manager. *)
let deploy_account_op (amount: tez) : operation * address =
    let delegate : key_hash option = None in
    Account.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~amount

(* Deploys an instance of multi with an arbitrary manager. *)
let deploy_contract_op (storage : Multi.storage) : operation * address =
    let delegate : key_hash option = None in
    Contract.create
        ~manager:tz1YLtLqD1fWHthSVHPD116oYvsd4PTAHUoc
        ~delegate
        ~delegatable:true
        ~spendable:false
        ~amount:0tz
        ~storage
        ~code:(contract Multi)

(* Storage of the test is irrelevant. *)
type storage = unit

(* Actual test. *)
let%entry test (_param : unit) (_storage : unit) =
    let root_op, root = deploy_account_op 0tz in
    let storage = one_admin "root" root in
    let main_op, main = deploy_contract_op storage in
    (* ask techelson to apply these operations. *)
    Techel.apply_operations [ root_op ; main_op ];
    (* root and main are live now *)

    (* let's check root is an admin, and that the address is correct *)
    let storage =
        match Techel.get_storage [%type: Multi.storage] main with
        | Some storage -> storage
        | None -> failwith "can't retrieve contract's storage"
    in
    (
        match Map.find "root" storage.Multi.admins with
        | None -> failwith "no root in storage"
        | Some address -> (
            if address <> root then (
                failwith "wrong address for root"
            )
        )
    );

    let client_op, client = deploy_account_op 15tz in
    (* deploy the client *)
    Techel.apply_operations [ client_op ];
    (* client is live now *)

    (* retrieve client instance for registration *)
    let client_instance =
        match (Contract.at client : UnitContract.instance option) with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in
    (* retrieve multi's instance to call it *)
    let main_instance =
        match Multi.at main with
        | None -> failwith "could not retrieve main contract"
        | Some instance -> instance
    in

    (* let's add a client and fail *)
    let bad_add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    let error_message = Some "illegal access to admin account" in
    let must_fail = Techel.must_fail error_message bad_add_client in
    (* let's really add a client now *)
    Techel.start_set_source root ;
    (* all operations created in here will appear to have been created by `root` *)
    let add_client =
        Contract.call ~dest:main_instance ~amount:0tz ~entry:add_client ~parameter:(
            "root", "lucy", client, client_instance
        )
    in
    Techel.end_set_source () ;

    Techel.apply_operations [ must_fail ; add_client ];

    (* lucy deposits `10tz` *)
    Techel.start_set_source client ;
        let deposit_money =
            Contract.call ~dest:main_instance ~amount:10tz ~entry:deposit ~parameter:"lucy"
        in
    Techel.end_set_source () ;
    Techel.apply_operations [ deposit_money ];
    let balance_lucy = Techel.get_balance client in
    if balance_lucy <> 5tz then (
        failwith "lucy should have 5tz now"
    );

    (* lucy walks out of the whole thing *)
    Techel.start_set_source client ;
        let drain =
            Contract.call ~dest:main_instance ~amount:0tz ~entry:drain ~parameter:"lucy"
        in
    Techel.end_set_source () ;
    Techel.apply_operations [ drain ] ;

    (* lucy should have her money back *)
    let balance_lucy = Techel.get_balance client in
    if balance_lucy <> 2tz then (
        failwith "lucy should have 2tz now"
    );

    nothing

contracts/

contracts/multi.liq

 
type storage = {
    admins : (string, address) map ;
    users : (string, (address * tez * UnitContract.instance)) map ;
}

let admin_check (storage : storage) (name : string) (a : address) : unit =
    match Map.find name storage.admins with
    | None -> failwith "only admins can perform administrative tasks"
    | Some address ->
        if address <> a then
            failwith "illegal access to admin account"

let%entry add_admin
    (
        (admin_name, nu_admin_name, nu_admin_address) :
         string *    string *       address
    ) (
        storage : storage
    )
  : operation list * storage 
=
    admin_check storage admin_name (Current.sender ()); 
    let storage =
        storage.admins <- Map.update nu_admin_name (Some nu_admin_address) storage.admins
    in
    [], storage
  
let%entry rm_admin (admin_name, user_name : string * string) (storage : storage) =
    admin_check storage admin_name (Current.sender ());
    let storage = storage.admins <- Map.update user_name None storage.admins in
    [], storage
    
let%entry add_client (
    (admin_name, user_name, user,     c) :
     string *    string *   address * UnitContract.instance
) (storage : storage) =
    admin_check storage admin_name (Current.sender ());
    if Map.mem user_name storage.users then (
        failwith "username already taken"
    );
    let data = Some (user, 0tz, c) in
    let storage = storage.users <- Map.update user_name data storage.users in
    [], storage
  
let data_of (storage : storage) (name : string) (user : address) : tez * UnitContract.instance =
    match Map.find name storage.users with
    | None -> failwith "unknown user"
    | Some (address, tez, c) ->
        if user <> address then
            failwith "illegal access to account"
        else (tez, c)

let%entry deposit (name : string) (storage : storage) =
    let user = Current.sender () in
    let money, c = data_of storage name user in
    let amount = Current.amount () in
    let nu_data = Some (user, money + amount, c) in
    [], storage.users <- Map.update name nu_data storage.users 
          
          
let%entry withdraw (name, amount : string * tez) (storage : storage) =
    let user = Current.sender () in
    let money, c = data_of storage name user in
    if amount > money then
        failwith "insufficient balance"
    else (
        let nu_data = Some (user, money - amount, c) in
        [], storage.users <- Map.update name nu_data storage.users
    )
        
let%entry drain (name : string) (storage : storage) =
    let user = Current.sender () in
    let money, c = data_of storage name user in
    let storage = storage.users <- Map.update name None storage.users in
    let ops = [Contract.call ~dest:c ~amount:money ~parameter:()] in
    ops, storage

Software Safety

There is no post in this category yet.