mirror of
https://github.com/anoma/juvix.git
synced 2024-12-14 17:32:00 +03:00
311 lines
7.8 KiB
Plaintext
311 lines
7.8 KiB
Plaintext
module MonoSimpleFungibleToken;
|
|
|
|
foreign ghc {
|
|
import Anoma
|
|
};
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Booleans
|
|
--------------------------------------------------------------------------------
|
|
|
|
type Bool :=
|
|
true : Bool
|
|
| false : Bool;
|
|
|
|
infixr 2 ||;
|
|
|| : Bool → Bool → Bool;
|
|
|| false a := a;
|
|
|| true _ := true;
|
|
|
|
infixr 3 &&;
|
|
&& : Bool → Bool → Bool;
|
|
&& false _ := false;
|
|
&& true a := a;
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Backend Booleans
|
|
--------------------------------------------------------------------------------
|
|
|
|
axiom BackendBool : Type;
|
|
compile BackendBool {
|
|
ghc ↦ "Bool";
|
|
};
|
|
|
|
axiom backend-true : BackendBool;
|
|
compile backend-true {
|
|
ghc ↦ "True";
|
|
};
|
|
|
|
axiom backend-false : BackendBool;
|
|
compile backend-false {
|
|
ghc ↦ "False";
|
|
};
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Backend Bridge
|
|
--------------------------------------------------------------------------------
|
|
|
|
foreign ghc {
|
|
bool :: Bool -> a -> a -> a
|
|
bool True x _ = x
|
|
bool False _ y = y
|
|
};
|
|
|
|
axiom bool : BackendBool → Bool → Bool → Bool;
|
|
compile bool {
|
|
ghc ↦ "bool";
|
|
};
|
|
|
|
from-backend-bool : BackendBool → Bool;
|
|
from-backend-bool bb := bool bb true false;
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Integers
|
|
--------------------------------------------------------------------------------
|
|
|
|
axiom Int : Type;
|
|
compile Int {
|
|
ghc ↦ "Int";
|
|
};
|
|
|
|
axiom Int_0 : Int;
|
|
compile Int_0 {
|
|
ghc ↦ "0";
|
|
};
|
|
|
|
axiom lt : Int → Int → BackendBool;
|
|
compile lt {
|
|
ghc ↦ "(<)";
|
|
};
|
|
|
|
infix 4 <;
|
|
< : Int → Int → Bool;
|
|
< i1 i2 := from-backend-bool (lt i1 i2);
|
|
|
|
axiom eqInt : Int → Int → BackendBool;
|
|
compile eqInt {
|
|
ghc ↦ "(==)";
|
|
};
|
|
|
|
infix 4 ==Int;
|
|
==Int : Int → Int → Bool;
|
|
==Int i1 i2 := from-backend-bool (eqInt i1 i2);
|
|
|
|
infixl 6 -;
|
|
axiom - : Int -> Int -> Int;
|
|
compile - {
|
|
ghc ↦ "(-)";
|
|
};
|
|
|
|
infixl 6 +;
|
|
axiom + : Int -> Int -> Int;
|
|
compile + {
|
|
ghc ↦ "(+)";
|
|
};
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Strings
|
|
--------------------------------------------------------------------------------
|
|
|
|
builtin string axiom String : Type;
|
|
compile String {
|
|
ghc ↦ "[Char]";
|
|
};
|
|
|
|
axiom eqString : String → String → BackendBool;
|
|
compile eqString {
|
|
ghc ↦ "(==)";
|
|
};
|
|
|
|
infix 4 ==String;
|
|
==String : String → String → Bool;
|
|
==String s1 s2 := from-backend-bool (eqString s1 s2);
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Lists
|
|
--------------------------------------------------------------------------------
|
|
|
|
type ListString :=
|
|
Nil : ListString |
|
|
Cons : String → ListString → ListString;
|
|
|
|
elem : String → ListString → Bool;
|
|
elem s Nil := false;
|
|
elem s (Cons x xs) := (s ==String x) || elem s xs;
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Pair
|
|
--------------------------------------------------------------------------------
|
|
|
|
type PairIntBool :=
|
|
MakePair : Int → Bool → PairIntBool;
|
|
|
|
if-pairIntBool : Bool → PairIntBool → PairIntBool → PairIntBool;
|
|
if-pairIntBool true x _ := x;
|
|
if-pairIntBool false _ y := y;
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Optionals
|
|
--------------------------------------------------------------------------------
|
|
|
|
type OptionInt :=
|
|
NothingInt : OptionInt |
|
|
JustInt : Int -> OptionInt;
|
|
|
|
if-optionInt : Bool → OptionInt → OptionInt → OptionInt;
|
|
if-optionInt true x _ := x;
|
|
if-optionInt false _ y := y;
|
|
|
|
from-int : Int → OptionInt;
|
|
from-int i := if-optionInt (i < Int_0) NothingInt (JustInt i);
|
|
|
|
maybe-int : Int → OptionInt → Int;
|
|
maybe-int d NothingInt := d;
|
|
maybe-int _ (JustInt i) := i;
|
|
|
|
type OptionString :=
|
|
NothingString : OptionString |
|
|
JustString : String -> OptionString;
|
|
|
|
if-optionString : Bool → OptionString → OptionString → OptionString;
|
|
if-optionString true x _ := x;
|
|
if-optionString false _ y := y;
|
|
|
|
from-string : String → OptionString;
|
|
from-string s := if-optionString (s ==String "") NothingString (JustString s);
|
|
|
|
pair-from-optionString : (String → PairIntBool) → OptionString → PairIntBool;
|
|
pair-from-optionString _ NothingString := MakePair Int_0 false;
|
|
pair-from-optionString f (JustString o) := f o;
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- foldl
|
|
--------------------------------------------------------------------------------
|
|
|
|
foldl : (PairIntBool → String → PairIntBool) → PairIntBool → ListString → PairIntBool;
|
|
foldl f z Nil := z;
|
|
foldl f z (Cons h hs) := foldl f (f z h) hs;
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Anoma
|
|
--------------------------------------------------------------------------------
|
|
|
|
axiom readPre : String → Int;
|
|
compile readPre {
|
|
ghc ↦ "readPre";
|
|
};
|
|
|
|
axiom readPost : String → Int;
|
|
compile readPost {
|
|
ghc ↦ "readPost";
|
|
};
|
|
|
|
axiom isBalanceKey : String → String → String;
|
|
compile isBalanceKey {
|
|
ghc ↦ "isBalanceKey";
|
|
};
|
|
|
|
read-pre : String → OptionInt;
|
|
read-pre s := from-int (readPre s);
|
|
|
|
read-post : String → OptionInt;
|
|
read-post s := from-int (readPost s);
|
|
|
|
is-balance-key : String → String → OptionString;
|
|
is-balance-key token key := from-string (isBalanceKey token key);
|
|
|
|
unwrap-default : OptionInt → Int;
|
|
unwrap-default o := maybe-int Int_0 o;
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Validity Predicate
|
|
--------------------------------------------------------------------------------
|
|
|
|
change-from-key : String → Int;
|
|
change-from-key key := unwrap-default (read-post key) - unwrap-default (read-pre key);
|
|
|
|
check-vp : ListString → String → Int → String → PairIntBool;
|
|
check-vp verifiers key change owner :=
|
|
if-pairIntBool
|
|
(change-from-key key < Int_0)
|
|
-- make sure the spender approved the transaction
|
|
(MakePair (change + (change-from-key key)) (elem owner verifiers))
|
|
(MakePair (change + (change-from-key key)) true);
|
|
|
|
check-keys : String → ListString → PairIntBool → String → PairIntBool;
|
|
check-keys token verifiers (MakePair change is-success) key :=
|
|
if-pairIntBool
|
|
is-success
|
|
(pair-from-optionString (check-vp verifiers key change) (is-balance-key token key))
|
|
(MakePair Int_0 false);
|
|
|
|
check-result : PairIntBool → Bool;
|
|
check-result (MakePair change all-checked) := (change ==Int Int_0) && all-checked;
|
|
|
|
vp : String → ListString → ListString → Bool;
|
|
vp token keys-changed verifiers :=
|
|
check-result
|
|
(foldl
|
|
(check-keys token verifiers)
|
|
(MakePair Int_0 true)
|
|
keys-changed);
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- IO
|
|
--------------------------------------------------------------------------------
|
|
|
|
axiom Action : Type;
|
|
compile Action {
|
|
ghc ↦ "IO ()";
|
|
};
|
|
|
|
axiom putStr : String → Action;
|
|
compile putStr {
|
|
ghc ↦ "putStr";
|
|
};
|
|
|
|
axiom putStrLn : String → Action;
|
|
compile putStrLn {
|
|
ghc ↦ "putStrLn";
|
|
};
|
|
|
|
infixl 1 >>;
|
|
axiom >> : Action → Action → Action ;
|
|
|
|
compile >> {
|
|
ghc ↦ "(>>)";
|
|
};
|
|
|
|
show-result : Bool → String;
|
|
show-result true := "OK";
|
|
show-result false := "FAIL";
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Testing VP
|
|
--------------------------------------------------------------------------------
|
|
|
|
token : String;
|
|
token := "owner-token";
|
|
|
|
owner-address : String;
|
|
owner-address := "owner-address";
|
|
|
|
change1-key : String;
|
|
change1-key := "change1-key";
|
|
|
|
change2-key : String;
|
|
change2-key := "change2-key";
|
|
|
|
verifiers : ListString;
|
|
verifiers := Cons owner-address Nil;
|
|
|
|
keys-changed : ListString;
|
|
keys-changed := Cons change1-key (Cons change2-key Nil);
|
|
|
|
main : Action;
|
|
main :=
|
|
(putStr "VP Status: ")
|
|
>> (putStrLn (show-result (vp token keys-changed verifiers)));
|
|
|
|
end;
|