add ticketing contract

ticketing/.gitignore

@@ -0,0 +1 @@
+compiled/

ticketing/Makefile

@@ -0,0 +1,55 @@
+SHELL := /bin/bash
+
+ligo_compiler?=docker run --rm -v "$(PWD)":"$(PWD)" -w "$(PWD)" ligolang/ligo:next
+
+project_root?=--project-root .
+# ^ required when using packages
+
+protocol_opt?=
+# ^ fill-in to test new features, see "Protocol Upgrades" section
+# on https://ligolang.org documentation
+
+help:
+	@grep -E '^[ a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | \
+	awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-15s\033[0m %s\n", $$1, $$2}'
+
+compile = $(ligo_compiler) compile contract $(project_root) ./src/$(1) -o ./compiled/$(2) $(3) $(protocol_opt)
+# ^ compile contract to michelson or micheline
+
+test = $(ligo_compiler) run test $(project_root) ./test/$(1) $(protocol_opt)
+# ^ run given test file
+
+compile: ## compile contracts
+	@if [ ! -d ./compiled ]; then mkdir ./compiled ; fi
+	@$(call compile,ticketer.mligo,ticketer.tz)
+	@$(call compile,ticketer.mligo,ticketer.json,--michelson-format json)
+
+clean: ## clean up
+	@rm -rf compiled
+
+deploy: ## deploy
+	@if [ ! -f ./scripts/metadata.json ]; then cp scripts/metadata.json.dist \
+        scripts/metadata.json ; fi
+	@npx ts-node ./scripts/deploy.ts
+
+install: ## install dependencies
+	@if [ ! -f ./.env ]; then cp .env.dist .env ; fi
+	@$(ligo_compiler) install
+	@npm i
+
+.PHONY: test
+test: ## run tests (SUITE=buy_ticket make test)
+ifndef SUITE
+	@$(call test,buy_ticket.test.mligo)
+else
+	@$(call test,$(SUITE).test.mligo)
+endif
+
+lint: ## lint code
+	@npx eslint ./scripts --ext .ts
+
+sandbox-start: ## start sandbox
+	@./scripts/run-sandbox
+
+sandbox-stop: ## stop sandbox
+	@docker stop sandbox

ticketing/README.md

@@ -0,0 +1,63 @@
+# Ticketing
+
+This smart contract intends to handle a subscription to a service of car parking. 
+
+The goal is to provide an example of implementation of tickets, which introduces 
+a permission-based access.
+
+Tickets are secure to use and resistant to tampering without setting up complex
+permissions management.  
+
+You can simply distribute tickets and control who accesses what and for how many times.
+
+## Functional Overview
+
+### Subscription
+
+User can spend XTZ to buy a subscription to a car parking system.  
+This subscription allow users to use a service (car parking for a day).
+
+```mermaid
+sequenceDiagram
+  actor User
+  participant Ticketer as Ticketer/Wallet
+  User->>Ticketer: buy_ticket()
+  Note right of Ticketer: The ticketer also manages a ledger
+```
+
+### Daily Subs
+
+User can use it subscription for parking a car for a day.
+
+```mermaid
+sequenceDiagram
+  actor User
+  participant Consumer
+  participant Ticketer as Ticketer/Wallet
+  User->>Consumer: consume()
+  Consumer->>Ticketer: get_balance_of(address)
+  Note right of Ticketer: The ticketer exposes an on-chain view<br>to provide ticket balance info
+  Ticketer-->>Consumer: nb tickets
+  Consumer->>Ticketer: consume_ticket(address, signature)
+  Note right of Ticketer: Signature is verified (address, callee)
+  Note right of Ticketer: A ticket is splitted from address<br>wallet and sent in the callback params
+  Ticketer->>Consumer: receive(address, ticket)
+  Note left of Consumer: The consumer updates its storage<br>according to the received ticket
+  Note left of Consumer: The ticket is burned
+```
+
+### Lending
+
+User can lend a certain amount of parking days to another subscription.
+
+### Recharging
+
+User can recharge its subscription by buying extra parking days.
+
+## Resources
+
+- <https://news.ecadlabs.com/how-to-use-tickets-with-ligo-e773422644b7>
+- <https://fredcy.com/posts/tezos-tickets/>
+- <https://hackmd.io/lutm_5JNRVW-nNFSFkCXLQ>
+- <https://ligolang.org/docs/advanced/testing/#transfers-and-originations-with-tickets>
+- <https://github.com/marigold-dev/training-dapp-3>

ticketing/src/consumer.mligo

@@ -0,0 +1,17 @@
+module Constants =
+  struct
+    let no_operation : operation list = []
+  end
+
+module Errors =
+  struct
+  end
+
+type storage = {ticketer : address; owner : address}
+type result = operation list * storage
+
+let consume (s : storage) =
+  Constants.no_operation, s
+
+let main (_, store : unit * storage) : result =
+  consume (store)

ticketing/src/ticketer.mligo

@@ -0,0 +1,47 @@
+module Constants =
+  struct
+    let no_operation : operation list = []
+  end
+
+module Errors =
+  struct
+    let cannot_join_tickets = "CANNOT_JOIN_TICKETS"
+    let wrong_amount = "WRONG_AMOUNT"
+  end
+
+type tickets = (address, unit ticket) big_map
+type storage_data = {
+    price : tez;
+}
+type storage = {data : storage_data; tickets : tickets}
+type result = operation list * storage
+
+let buy_ticket ({data = data; tickets = tickets} : storage)
+: result =
+  let _check =
+    assert_with_error
+      (Tezos.get_amount () >= data.price && (Tezos.get_amount () mod data.price) = 0tez)
+      Errors.wrong_amount in
+  let nb_tickets = (Tezos.get_amount () / data.price) in
+  let owner = (Tezos.get_sender ()) in
+  let (owned_tickets_opt, tickets) =
+    Big_map.get_and_update
+      owner
+      (None : unit ticket option)
+      tickets in
+  let new_ticket = Tezos.create_ticket unit nb_tickets in
+  let join_tickets =
+    match owned_tickets_opt with
+      None -> new_ticket
+    | Some owned_tickets ->
+        (match Tezos.join_tickets
+                 (owned_tickets, new_ticket)
+         with
+           None -> failwith Errors.cannot_join_tickets
+         | Some joined_tickets -> joined_tickets) in
+  let (_, tickets) =
+    Big_map.get_and_update owner (Some join_tickets) tickets in
+  Constants.no_operation, {data = data; tickets = tickets}
+
+let main (_, store : unit * storage) : result =
+  buy_ticket (store)

ticketing/test/bootstrap/bootstrap.mligo

@@ -0,0 +1,13 @@
+#import "../helpers/ticketer.mligo" "Ticketer_helper"
+
+(* Boostrapping of the test environment *)
+let boot (initial_price: tez) =
+    let () = Test.reset_state 6n ([] : tez list) in
+
+    let accounts =
+        Test.nth_bootstrap_account 1,
+        Test.nth_bootstrap_account 2
+    in
+
+    let contr = Ticketer_helper.originate(Ticketer_helper.base_storage initial_price) in
+    (accounts, contr)

ticketing/test/buy_ticket.test.mligo

@@ -0,0 +1,23 @@
+#import "./helpers/assert.mligo" "Assert"
+#import "./bootstrap/bootstrap.mligo" "Bootstrap"
+#import "./helpers/log.mligo" "Log"
+#import "./helpers/ticketer.mligo" "Ticketer_helper"
+#import "../src/ticketer.mligo" "Ticketer"
+
+let () = Log.describe("[Buy_ticket] test suite")
+
+let bootstrap () = Bootstrap.boot(400mutez)
+
+let test_success =
+    let (accounts, tckt) = bootstrap() in
+    let (alice, _bob) = accounts in
+    let () = Test.set_source alice in
+    let () = Ticketer_helper.buy_ticket_success(1200mutez, tckt.contr) in
+    Ticketer_helper.assert_has_tickets(tckt.addr, alice, 3n)
+
+let test_failure_wrong_amount =
+    let (accounts, tckt) = bootstrap() in
+    let (alice, _bob) = accounts in
+    let () = Test.set_source alice in
+    let r = Ticketer_helper.buy_ticket(300mutez, tckt.contr) in
+    Assert.string_failure r Ticketer.Errors.wrong_amount

ticketing/test/helpers/assert.mligo

@@ -0,0 +1,15 @@
+(* Assert contract call results in failwith with given string *)
+let string_failure (res : test_exec_result) (expected : string) : unit =
+    let expected = Test.eval expected in
+    match res with
+        | Fail (Rejected (actual,_)) -> assert (actual = expected)
+        | Fail (Balance_too_low _err) -> failwith "contract failed: balance too low"
+        | Fail (Other s) -> failwith s
+        | Success _ -> failwith "Transaction should fail"
+
+(* Assert contract result is successful *)
+let tx_success (res: test_exec_result) : unit =
+    match res with
+        | Success(_) -> ()
+        | Fail (Rejected (error,_)) -> let () = Test.log(error) in Test.failwith "Transaction should not fail"
+        | Fail _ -> failwith "Transaction should not fail"

ticketing/test/helpers/log.mligo

@@ -0,0 +1,18 @@
+(* Return str repeated n times *)
+let repeat (str, n : string * nat) : string =
+    let rec loop (n, acc: nat * string) : string = 
+        if n = 0n then acc else loop (abs(n - 1n), acc ^ str)
+    in loop(n, "")
+
+(* 
+    Log boxed lbl
+
+    "+-----------+"
+    "| My string |"
+    "+-----------+"
+*)
+let describe (lbl : string) =
+    let hr = "+" ^ repeat("-", String.length(lbl) + 2n) ^ "+" in 
+    let () = Test.log hr in
+    let () = Test.log ("| " ^ lbl ^ " |") in
+    Test.log hr

ticketing/test/helpers/proxy_ticket.mligo

@@ -0,0 +1,51 @@
+[@private] let proxy_transfer_contract (type vt whole_p)
+    ( mk_param : vt ticket -> whole_p)
+    ( (p,_)    : ((vt * nat) * address) * unit )
+    : operation list * unit =
+  let ((v,amt),dst_addr) = p in
+  let tx_param = mk_param (Tezos.create_ticket v amt) in
+  let c : whole_p contract = Tezos.get_contract_with_error dst_addr "Testing proxy: you provided a wrong address" in
+  let op = Tezos.transaction tx_param 1mutez c in
+  [op], ()
+
+[@private] let proxy_originate_contract (type vt whole_s vp)
+    ( mk_storage : vt ticket -> whole_s)
+    ( main       : vp * whole_s -> operation list * whole_s)
+    ( (p,_)      : (vt * nat) * address option )
+    : operation list * address option =
+  let (v,amt) = p in
+  let init_storage : whole_s = mk_storage (Tezos.create_ticket v amt) in
+  let op,addr = Tezos.create_contract main (None: key_hash option) 0mutez init_storage in
+  [op], Some addr
+
+
+
+type 'v proxy_address = (('v * nat) * address , unit) typed_address
+
+let init_transfer (type vt whole_p) (mk_param: vt ticket -> whole_p) : vt proxy_address =
+  let proxy_transfer : ((vt * nat) * address) * unit -> operation list * unit =
+    proxy_transfer_contract mk_param
+  in
+  let (taddr_proxy, _, _) = Test.originate proxy_transfer () 1tez in
+  taddr_proxy
+
+let transfer (type vt)
+    (taddr_proxy : vt proxy_address)
+    (info        : (vt * nat) * address) : test_exec_result = 
+  let ticket_info, dst_addr = info in
+  Test.transfer_to_contract (Test.to_contract taddr_proxy) (ticket_info , dst_addr) 1mutez
+
+let originate (type vt whole_s vp)
+    (ticket_info : vt * nat)
+    (mk_storage : vt ticket -> whole_s)
+    (contract: vp * whole_s -> operation list * whole_s) : address =
+  let proxy_origination : (vt * nat) * address option -> operation list * address option =
+    proxy_originate_contract mk_storage contract
+  in
+  let (taddr_proxy, _, _) = Test.originate proxy_origination (None : address option) 1tez in
+  let _ = Test.transfer_to_contract_exn (Test.to_contract taddr_proxy) ticket_info 0tez in
+  match Test.get_storage taddr_proxy with
+  | Some addr ->
+    let _taddr = (Test.cast_address addr : (vp,whole_s) typed_address) in
+    addr
+  | None -> failwith "internal error"

ticketing/test/helpers/ticketer.mligo

@@ -0,0 +1,73 @@
+#import "../../src/ticketer.mligo" "Ticketer"
+#import "./assert.mligo" "Assert"
+
+(* Some types for readability *)
+type taddr = (unit, Ticketer.storage) typed_address
+type contr = unit contract
+type originated = {
+    addr: address;
+    taddr: taddr;
+    contr: contr;
+}
+
+(**
+    "unforged" storage type is used to decompile the storage while being able
+    to read its tickets
+*)
+type unforged_ticket = unit unforged_ticket
+type unforged_storage = {
+    data : { price : tez };
+    tickets : (address, unforged_ticket) big_map
+}
+
+(* Base Ticketer storage *)
+let base_storage (price: tez) : Ticketer.storage = {
+    data = {
+        price = price;
+    };
+    tickets = (Big_map.empty: (address, unit ticket) big_map);
+}
+
+(* Originate a Ticketer contract with given init_storage storage *)
+let originate (init_storage : Ticketer.storage) =
+    let (taddr, _, _) = Test.originate Ticketer.main init_storage 0mutez in
+    let contr = Test.to_contract taddr in
+    let addr = Tezos.address contr in
+    {addr = addr; taddr = taddr; contr = contr}
+
+(* Call entry point of Ticketer contr contract *)
+let call (contr : contr) =
+    Test.transfer_to_contract contr () 0mutez
+
+(* Call entry point of Ticketer contr contract with amount *)
+let call_with_amount (amount_, contr : tez * contr) =
+    Test.transfer_to_contract contr () amount_
+
+let call_success (contr: contr) =
+    Assert.tx_success (call(contr))
+
+(* Entry points call helpers *)
+(* let redeem_ticket (p, contr : Ticketer.redeem_ticket_params * contr) = *)
+(*     call(RedeemTicket(p), contr) *)
+
+let buy_ticket (amount_, contr : tez * contr) =
+    call_with_amount(amount_, contr)
+
+(* Asserter helper for successful entry point calls *)
+(* let redeem_ticket_success (p, contr : Ticketer.redeem_ticket_params * contr) = *)
+(*     Assert.tx_success (redeem_ticket(p, contr)) *)
+
+let buy_ticket_success (amount_, contr : tez * contr) =
+    Assert.tx_success (buy_ticket(amount_, contr))
+
+(* get "unforged" storage of contract at [addr] *)
+let get_unforged_storage (addr: address) : unforged_storage =
+    let storage : michelson_program = Test.get_storage_of_address addr in
+    Test.decompile storage
+
+(* assert that contract at [addr] has [owner] ticket for [amount_] amount *)
+let assert_has_tickets (addr, owner, amount_: address * address * nat) =
+    let storage = get_unforged_storage(addr) in
+    match Big_map.find_opt owner storage.tickets with
+        None -> Test.failwith "A ticket should have been found"
+        | Some ticket -> assert (ticket.amount = amount_)