From caf40656445d1cab01591e16da34406c0e0bfbf5 Mon Sep 17 00:00:00 2001
From: Paul Cadman <git@paulcadman.dev>
Date: Fri, 8 Apr 2022 16:45:19 +0100
Subject: [PATCH] [test] Add Anoma Haskell backend for VP

---
 tests/positive/VP/Anoma.hs                   | 16 +++++
 tests/positive/VP/SimpleFungibleToken.mjuvix | 65 +++++++++++++++++---
 2 files changed, 74 insertions(+), 7 deletions(-)
 create mode 100644 tests/positive/VP/Anoma.hs

diff --git a/tests/positive/VP/Anoma.hs b/tests/positive/VP/Anoma.hs
new file mode 100644
index 000000000..fc4ae542d
--- /dev/null
+++ b/tests/positive/VP/Anoma.hs
@@ -0,0 +1,16 @@
+module Anoma where
+
+import Prelude
+
+readPre :: String -> Int
+readPre "change1-key" = 100
+readPre "change2-key" = 90
+readPre _ = -1
+
+readPost :: String -> Int
+readPost "change1-key" = 90
+readPost "change2-key" = 100
+readPost _ = -1
+
+isBalanceKey :: String -> String -> String
+isBalanceKey _ _ = "owner-address"
diff --git a/tests/positive/VP/SimpleFungibleToken.mjuvix b/tests/positive/VP/SimpleFungibleToken.mjuvix
index 603afa6da..6494155e8 100644
--- a/tests/positive/VP/SimpleFungibleToken.mjuvix
+++ b/tests/positive/VP/SimpleFungibleToken.mjuvix
@@ -210,21 +210,19 @@ unwrap-default o ≔ maybe-int 0 o;
 change-from-key : String → Int;
 change-from-key key ≔ unwrap-default (read-post key) - unwrap-default (read-pre key);
 
-check-vp : ListString → String → String → Int → PairIntBool;
-check-vp verifiers key owner change ≔
+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-vp' : ListString → String → Int → String → PairIntBool;
-check-vp' verifiers key change owner ≔ check-vp verifiers key owner change;
-
 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))
+        (pair-from-optionString (check-vp verifiers key change) (is-balance-key token key))
         (MakePair 0 false);
 
 check-result : PairIntBool → Bool;
@@ -235,6 +233,59 @@ vp token keys-changed verifiers ≔
     check-result
         (foldl
             (check-keys token verifiers)
-            (MakePair 0 false) keys-changed);
+            (MakePair 0 true)
+            keys-changed);
+
+--------------------------------------------------------------------------------
+-- IO
+--------------------------------------------------------------------------------
+
+axiom Action : Type {
+ ghc ↦ "IO ()";
+};
+
+axiom putStr : String → Action {
+  ghc ↦ "putStr";
+};
+
+axiom putStrLn : String → Action {
+  ghc ↦ "putStrLn";
+};
+
+infixl 1 >>;
+axiom >> : Action → Action → Action {
+  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;