1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-15 01:52:11 +03:00
juvix/examples/token.mjuvix
2022-01-23 22:03:11 -05:00

418 lines
12 KiB
Plaintext

module Token;
import Data.Nat;
open Data.Nat using {<=};
import Data.String;
open Data.String using {compare};
--------------------------------------------------------------------------------
-- Boiler plate taken from previous code
--------------------------------------------------------------------------------
{-
total_order : (a:eqtype) (f: (a -> a -> Tot Bool)) =
(forall a1 a2. (f a1 a2 /\ f a2 a1) ==> a1 = a2) (* anti-symmetry *)
/\ (forall a1 a2 a3. f a1 a2 /\ f a2 a3 ==> f a1 a3) (* transitivity *)
/\ (forall a1 a2. f a1 a2 \/ f a2 a1) (* totality *)
string_cmp' s1 s2 = String.compare s1 s2 <= 0
(* The F* defn just calls down to OCaml, since we know comparison in OCaml is total
* just admit it
*)
string_cmpTotal : unit -> Lemma (total_order string string_cmp')
string_cmpTotal () = admit ()
// hack function so, the data structure doesn't forget the proof!
string_cmp : Map.cmp string
string_cmp = string_cmpTotal (); string_cmp'
-}
--------------------------------------------------------------------------------
-- Type definitions
--------------------------------------------------------------------------------
Address : Type;
Address := String;
-- Accounts : Map.ordmap Address Nat string_cmp
inductive Account {
mkAccount : Nat -> SortedMap Address Nat -> Account;
}
balance : Account -> Nat;
balance (mkAccount n _) := n;
allowances : Account -> SortedMap Address Nat ;
allowances (mkAccount _ s) := s;
add_account_values_acc : Accounts → Nat -> Nat
add_account_values_acc Accounts n =
MapProp.fold (fun _key (v : Nat) (acc : Nat) -> v + acc) Accounts n
// we have to specify they are Nats :(
add_account_values : Accounts -> Nat
add_account_values Accounts =
MapProp.fold (fun _key (v : Nat) (acc : Nat) -> v + acc) Accounts 0
inductive Storage {
mkStorage : Nat -> Accounts
total-supply : Nat;
Accounts : a : Accounts { total-supply = add_account_values a };
}
empty-storage : storage
empty-storage = {
total-supply = 0;
Accounts = Map.empty;
}
inductive Token {
mkToken :
Storage -> -- storage
Nat -> -- version
String -> -- name
Char -> -- symbol
Address -> -- owner
Token
}
storage : Token -> Storage;
storage (mkToken s _ _ _ _ _) := s;
version : Token -> Nat;
version (mkToken _ n _ _ _ _) := n;
name : Token -> String;
name (mkToken _ _ n _ _ _) := n;
symbol : Token -> Char;
symbol (mkToken _ _ _ s _ _) := s;
owner : Token -> Address;
owner (mkToken _ _ _ _ _ a) := a;
type txTransfer = {
from_account : Address;
to_account : Address;
transfer_amount : Nat
}
type tx_mint = {
mint_amount : Nat;
mintTo_account : Address
}
type tx_burn = {
burn_amount : Nat;
burn_from_account : Address
}
inductive txData {
transfer : txTransfer -> txData;
mint : txMint -> txData;
burn : txBurn -> txData;
}
type tx = {
tx_data : tx_data;
tx_authroized_account : Address;
}
--------------------------------------------------------------------------------
-- Begin Functions On Accounts
--------------------------------------------------------------------------------
has_n : Accounts -> Address -> Nat -> Bool
has_n accounts add toTransfer :=
match Map.select add Accounts {
(Some n) -> toTransfer <= n;
None -> false;
}
account-sub :
(acc : Accounts) ->
(add : Address) ->
(num : Nat {has_n acc add num}) ->
Accounts
account-sub Accounts add number =
match Map.select add Accounts with
{ Some balance -> Map.update add (balance - number) Accounts };
// No feedback given, so don't know next move :(
transfer-sub :
(acc : Accounts) ->
(add : Address) ->
(num : Nat) ->
Lemma ->
(requires (has_n acc add num)) ->
(ensures ( add_account_values acc - num
== add_account_values (account-sub acc add num)))
transfer-sub acc add num :=
match Map.select add acc {
Some balance ->;
remaining : Nat = balance - num in
admit ()
};
account_add : acc : Accounts
-> add : Address
-> num : Nat
-> Accounts
account_add acc add num =
match Map.select add acc with
Some b' -> Map.update add (b' + num) acc;
None -> Map.update add num acc;
--------------------------------------------------------------------------------
(**** Experimental Proofs on Transfer *)
--------------------------------------------------------------------------------
transfer_add_lemma : acc : Accounts
-> add : Address
-> num : Nat
-> Lemma
(ensures
(i =
match Map.select add acc with
None -> 0;
Some v -> v;
in i + num = Some?.v (Map.select add (account_add acc add num))))
transfer_add_lemma acc add num = ()
transfer_add_unaffect : acc : Accounts
-> add : Address
-> num : Nat
-> Lemma
(ensures
(forall x. Map.contains x acc /\ x <> add
==> Map.select x acc = Map.select x (account_add acc add num)))
transfer_add_unaffect acc add num = ()
transfer-same_when_remove : acc : Accounts
-> add : Address
-> num : Nat
-> Lemma
(ensures
(new_account = account_add acc add num in
add_account_values (Map.remove add acc)
== add_account_values (Map.remove add new_account)))
transfer-same_when_remove acc add num =
new_account = account_add acc add num in
assert (Map.equal (Map.remove add acc) (Map.remove add new_account))
// Useful stepping stone to the real answer!
// sadly admitted for now
transfer_acc_behavior : acc : Accounts
-> add : Address
-> Lemma
(ensures
(i =
match Map.select add acc with
None -> 0;
Some v -> v;
in add_account_values_acc (Map.remove add acc) i
== add_account_values acc))
transfer_acc_behavior acc add =
admit ()
// No feedback given, so don't know next move :(
transfer_add : acc : Accounts
-> add : Address
-> num : Nat
-> Lemma
(ensures ( add_account_values acc + num
== add_account_values (account_add acc add num)))
transfer_add acc add num =
admit ();
transfer-same_when_remove acc add num;
transfer_add_unaffect acc add num;
transfer_add_lemma acc add num
--------------------------------------------------------------------------------
(**** Failed Experimental Proofs Over *)
--------------------------------------------------------------------------------
transfer_acc : acc : Accounts
-> add_from : Address
-> addTo : Address
-> num : Nat {has_n acc add_from num}
-> Accounts
transfer_acc Accounts add_from addTo number =
new_Accounts = account-sub Accounts add_from number in
account_add new_Accounts addTo number
transfer_maintains-supply
: acc : Accounts
-> add_from : Address
-> addTo : Address
-> num : Nat
-> Lemma
(requires (has_n acc add_from num))
(ensures (add_account_values acc
== add_account_values (transfer_acc acc add_from addTo num)))
transfer_maintains-supply acc add_from addTo num =
transfer-sub acc add_from num;
transfer_add (account-sub acc add_from num) addTo num
transfer-stor
: stor : storage
-> add_from : Address
-> addTo : Address
-> num : Nat {has_n stor.Accounts add_from num}
-> storage
transfer-stor stor add_from addTo num =
new_acc = account_add (account-sub stor.Accounts add_from num) addTo num in
transfer_maintains-supply stor.Accounts add_from addTo num;
{ total-supply = stor.total-supply;
Accounts = new_acc
}
--------------------------------------------------------------------------------
(* End Type Definitions *)
(**** Begin Validations On Tokens *)
--------------------------------------------------------------------------------
validTransfer : token -> tx -> Bool
validTransfer token tx =
match tx.tx_data with
Transfer {from_account; transfer_amount} ->;
has_n token.storage.Accounts from_account transfer_amount
&& tx.tx_authroized_account = from_account
Mint _ Burn _ ->;
false
valid_mint : token -> tx -> Bool
valid_mint token tx =
match tx.tx_data with
Mint mint -> token.owner = tx.tx_authroized_account;
Transfer _ Burn _ -> false;
valid_burn : token -> tx -> Bool
valid_burn token tx =
match tx.tx_data with
Burn {burn_from_account; burn_amount} ->;
has_n token.storage.Accounts burn_from_account burn_amount
&& tx.tx_authroized_account = burn_from_account
Transfer _ Mint _ ->;
false
--------------------------------------------------------------------------------
(* End validations on tokens *)
(**** Begin Functions On Tokens *)
--------------------------------------------------------------------------------
tokenTransaction : (token -> tx -> Bool) -> Type0
tokenTransaction f =
tok : token -> tx : tx { f tok tx } -> token
transfer : tokenTransaction validTransfer
transfer token transaction =
match transaction.tx_data with
Transfer {from_account; to_account; transfer_amount} ->;
{ token
with storage = transfer-stor token.storage
from_account
to_account
transfer_amount
}
mint : tokenTransaction valid_mint
mint token transaction =
match transaction.tx_data with
Mint {mint_amount; mintTo_account} ->;
transfer_add token.storage.Accounts mintTo_account mint_amount;
{ token
with storage = {
total-supply = token.storage.total-supply + mint_amount;
Accounts = account_add token.storage.Accounts mintTo_account mint_amount
}}
burn : tokenTransaction valid_burn
burn token transaction =
match transaction.tx_data with
Burn {burn_from_account; burn_amount} ->;
transfer-sub token.storage.Accounts burn_from_account burn_amount;
{ token
with storage = {
total-supply = token.storage.total-supply - burn_amount;
Accounts = account-sub token.storage.Accounts burn_from_account burn_amount
}}
type transaction_error =
Not_enough_funds;
Not-same_account;
Not_ownerToken;
Not_enoughTokens;
executeTransaction : token -> tx -> c_or transaction_error token
executeTransaction token tx =
match tx.tx_data with
Transfer _ ->;
if validTransfer token tx
then Right (transfer token tx)
else Left Not_enough_funds // todo determine what the error is
Mint _ ->;
if valid_mint token tx
then Right (mint token tx)
else Left Not_ownerToken
Burn _ ->;
if valid_burn token tx
then Right (burn token tx)
else Left Not_enoughTokens
validTransferTransaction
: tok : token
-> tx : tx
-> Lemma (requires (validTransfer tok tx))
(ensures (
Right newTok = executeTransaction tok tx in
tok.storage.total-supply == newTok.storage.total-supply))
validTransferTransaction tok tx = ()
valid_mintTransaction
: tok : token
-> tx : tx
-> Lemma (requires (valid_mint tok tx))
(ensures (
Right newTok = executeTransaction tok tx in
Mint {mint_amount} = tx.tx_data in
tok.storage.total-supply + mint_amount == newTok.storage.total-supply))
valid_mintTransaction tok tx = ()
valid_burnTransaction
: tok : token
-> tx : tx
-> Lemma (requires (valid_burn tok tx))
(ensures (
Right newTok = executeTransaction tok tx in
Burn {burn_amount} = tx.tx_data in
tok.storage.total-supply - burn_amount == newTok.storage.total-supply))
valid_burnTransaction tok tx = ()
isLeft = function
Left _ -> true;
Right _ -> false;
non_validTransaction
: tok : token
-> tx : tx
-> Lemma (requires (not (valid_burn tok tx)
/\ not (valid_mint tok tx)
/\ not (validTransfer tok tx)))
(ensures (isLeft (executeTransaction tok tx)))
non_validTransaction tok tx = ()