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).

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

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

Blog

External Contract Example

Entry Points

Testing Multi (and failing to do so)

Testing Multi