juvix/tests/positive/VP/SimpleFungibleToken.mjuvix

module SimpleFungibleToken;

foreign ghc {
  import Anoma
};

--------------------------------------------------------------------------------
-- Booleans
--------------------------------------------------------------------------------

inductive 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 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
--------------------------------------------------------------------------------

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

inductive 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
--------------------------------------------------------------------------------

inductive PairIntBool {
  MakePair : Int → Bool → PairIntBool;
};

if-pairIntBool : Bool → PairIntBool → PairIntBool → PairIntBool;
if-pairIntBool true x _ ≔ x;
if-pairIntBool false _ y ≔ y;

--------------------------------------------------------------------------------
-- Optionals
--------------------------------------------------------------------------------

inductive 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 < 0) NothingInt (JustInt i);

maybe-int : Int → OptionInt → Int;
maybe-int d NothingInt ≔ d;
maybe-int _ (JustInt i) ≔ i;

inductive 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 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 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 < 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 0 false);

check-result : PairIntBool → Bool;
check-result (MakePair change all-checked) ≔ (change ==Int 0) && all-checked;

vp : String → ListString → ListString → Bool;
vp token keys-changed verifiers ≔
    check-result
        (foldl
            (check-keys token verifiers)
            (MakePair 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;