add cli

marigold-dev · Oct 2, 2022 · 67abc5a · 67abc5a
1 parent a100f9a
commit 67abc5a
Show file tree

Hide file tree

Showing 6 changed files with 73 additions and 27 deletions.
diff --git a/dune-project b/dune-project
@@ -27,6 +27,9 @@
   wasm
   data-encoding
   tezos-micheline
+  core
+  core.unix
+  ppx_jane
   (ocamlformat-rpc :with-test)
   (ocamlformat :with-test)
   (ocaml-lsp-server :with-test)

diff --git a/nix/tuna.nix b/nix/tuna.nix
@@ -9,7 +9,9 @@
   wasm,
   data-encoding,
   tezos-micheline,
-  core_bench,
+  core, 
+  core_unix, 
+  ppx_jane,
   alcotest,
 }:
 buildDunePackage rec {
@@ -38,7 +40,9 @@ buildDunePackage rec {
 
   buildInputs = [
     yojson
-    core_bench
+   core
+  core_unix
+  ppx_jane
   ];
 
   checkInputs = [

diff --git a/packages/tunac/bin/dune b/packages/tunac/bin/dune
@@ -18,4 +18,9 @@
   wasm)
  (modules tunacc_test_operation)
  (preprocess
-  (pps ppx_deriving.ord ppx_deriving.show ppx_deriving.eq ppx_yojson_conv)))
+  (pps
+   ppx_deriving.ord
+   ppx_deriving.show
+   ppx_deriving.eq
+   ppx_yojson_conv
+   ppx_jane)))
diff --git a/packages/tunac/bin/tunacc_test_operation.ml b/packages/tunac/bin/tunacc_test_operation.ml
@@ -1,3 +1,5 @@
+[@@@warning "-32-69-37"]
+
 let read_file name =
   let f = open_in name in
   let buf = Bytes.create 100000 in
@@ -26,8 +28,12 @@ type invoke_payload =
 
 let originate contract init =
   let init = Tunac.Compiler.compile_value init |> Result.get_ok in
+  let inputs =
+    if Core.String.is_suffix ~suffix:"tz" contract then read_file contract
+    else contract
+  in
   let wat, constants, entrypoints =
-    contract |> read_file |> Tunac.Compiler.compile |> Result.get_ok
+    inputs |> Tunac.Compiler.compile |> Result.get_ok
   in
   let out = Tunac.Output.make wat constants entrypoints |> Result.get_ok in
   { type_ = "Originate"
@@ -47,26 +53,35 @@ let invoke address arg =
   { type_ = "Invoke"; content = { address; argument = init } }
   |> yojson_of_t yojson_of_invoke_payload
   |> Yojson.Safe.pretty_to_string |> print_endline
-(* pub enum Operation {
-       Originate {
-           module: String,
-           constants: Vec<(u32, Value)>,
-           initial_storage: Value,
-       },
-       Invoke {
-           address: ContractAddress,
-           argument: Value,
-           #[serde(default = "def")]
-           gas_limit: u64,
-       },
-       Transfer {
-           address: String,
-           tickets: Vec<(TicketId, usize)>,
-       },
-   } *)
 
-let () =
-  match (Sys.argv.(1), Sys.argv.(2), Sys.argv.(3)) with
-  | "invoke", address, arg -> invoke address arg
-  | "originate", contract, init -> originate contract init
-  | _ -> failwith "Invalid command"
+open Core
+
+let originate =
+  Command.basic
+    ~summary:
+      "Originate a smart contract with given [contract_code] and \
+       [initial_storage]"
+    ~readme:(fun () ->
+      "Contract code = valid michelson contract.\n\
+       Initial_storage = valid michelson value")
+    Command.Let_syntax.(
+      let%map_open base = anon ("contract_code" %: string)
+      and storage = anon ("initial_storage" %: string) in
+      fun () -> originate base storage)
+
+let invoke =
+  Command.basic
+    ~readme:(fun () ->
+      "Contract address = valid [DK1] address.\n\
+       Contract argument = valid michelson value")
+    ~summary:
+      "Invoke a contract with given [contract_address] and [contract_argument]"
+    (let%map_open.Command address = anon ("contract_address" %: string)
+     and argument = anon ("contract_argument" %: string) in
+     fun () -> invoke address argument)
+
+let command =
+  Command.group ~summary:"Manipulate dates"
+    [ ("originate", originate); ("invoke", invoke) ]
+
+let () = Command_unix.run command
diff --git a/packages/tunac/tests/increment_originate.t b/packages/tunac/tests/increment_originate.t
@@ -1,5 +1,5 @@
 Simple increment/decrement contract
-  $ ../bin/tunacc_test_operation.exe "originate" increment.tz "5"
+  $ ../bin/tunacc_test_operation.exe originate increment.tz "5"
   {
     "type_": "Originate",
     "content": {
@@ -24,3 +24,19 @@ Simple increment/decrement contract
       ]
     }
   }
+
+Originate with string 
+  $ ../bin/tunacc_test_operation.exe originate '{ parameter (or (or (int %decrement) (int %increment)) (unit %reset)) ; storage int ; code { UNPAIR ; IF_LEFT { IF_LEFT { SWAP ; SUB } { ADD } } { DROP 2 ; PUSH int 0 } ;  NIL operation ; PAIR } }' 5
+  {
+    "type_": "Originate",
+    "content": {
+      "module_": "\n(module\n  (import \"env\" \"dup_host\" (func $dup_host (param i64 ) (result)))\n(import \"env\" \"pair\" (func $pair (param i64 i64) (result i64)))\n(import \"env\" \"unpair\" (func $unpair (param i64)))\n(import \"env\" \"z_add\" (func $z_add (param i64 i64) (result i64)))\n(import \"env\" \"z_sub\" (func $z_sub (param i64 i64) (result i64)))\n(import \"env\" \"z_mul\" (func $z_mul (param i64 i64) (result i64)))\n(import \"env\" \"neg\" (func $neg (param i64) (result i64)))\n(import \"env\" \"lsl\" (func $lsl (param i64 i64) (result i64)))\n(import \"env\" \"concat\" (func $concat (param i64 i64) (result i64)))\n(import \"env\" \"lsr\" (func $lsr (param i64 i64) (result i64)))\n(import \"env\" \"compare\" (func $compare (param i64 i64) (result i64)))\n(import \"env\" \"car\" (func $car (param i64) (result i64)))\n(import \"env\" \"cdr\" (func $cdr (param i64) (result i64)))\n(import \"env\" \"some\" (func $some (param i64) (result i64)))\n(import \"env\" \"nil\" (func $nil (result i64)))\n(import \"env\" \"true\" (func $true (result i64)))\n(import \"env\" \"false\" (func $false (result i64)))\n(import \"env\" \"none\" (func $none (result i64)))\n(import \"env\" \"unit\" (func $unit (result i64)))\n(import \"env\" \"zero\" (func $zero (result i64)))\n(import \"env\" \"empty_map\" (func $empty_map (result i64)))\n(import \"env\" \"empty_set\" (func $empty_set (result i64)))\n(import \"env\" \"empty_big_map\" (func $empty_big_map (result i64)))\n(import \"env\" \"sender\" (func $sender (result i64)))\n(import \"env\" \"source\" (func $source (result i64)))\n(import \"env\" \"map_get\" (func $map_get (param i64 i64) (result i64)))\n(import \"env\" \"mem\" (func $mem (param i64 i64) (result i64)))\n(import \"env\" \"update\" (func $update (param i64 i64 i64) (result i64)))\n(import \"env\" \"iter\" (func $iter (param i64 i32) (result )))\n(import \"env\" \"map\" (func $map (param i64 i32) (result i64)))\n(import \"env\" \"if_left\" (func $if_left (param i64) (result i32)))\n(import \"env\" \"if_none\" (func $if_none (param i64) (result i32)))\n(import \"env\" \"if_cons\" (func $if_cons (param i64) (result i32)))\n(import \"env\" \"isnat\" (func $isnat (param i64) (result i64)))\n(import \"env\" \"not\" (func $not (param i64) (result i64)))\n(import \"env\" \"or\" (func $or (param i64 i64) (result i64)))\n(import \"env\" \"and\" (func $and (param i64 i64) (result i64)))\n(import \"env\" \"xor\" (func $xor (param i64 i64) (result i64)))\n(import \"env\" \"deref_bool\" (func $deref_bool (param i64) (result i32)))\n(import \"env\" \"neq\" (func $neq (param i64) (result i64)))\n(import \"env\" \"failwith\" (func $failwith (param i64)))\n(import \"env\" \"get_n\" (func $get_n (param i32 i64) (result i64)))\n(import \"env\" \"exec\" (func $exec (param i64 i64) (result i64)))\n(import \"env\" \"apply\" (func $apply (param i64 i64) (result i64)))\n(import \"env\" \"const\" (func $const (param i32) (result i64)))\n(import \"env\" \"abs\" (func $abs (param i64) (result i64)))\n(import \"env\" \"eq\" (func $eq (param i64) (result i64)))\n(import \"env\" \"gt\" (func $gt (param i64) (result i64)))\n(import \"env\" \"lt\" (func $lt (param i64) (result i64)))\n(import \"env\" \"closure\" (func $closure (param i32) (result i64)))\n(import \"env\" \"left\" (func $left (param i64) (result i64)))\n(import \"env\" \"right\" (func $right (param i64) (result i64)))\n(import \"env\" \"cons\" (func $cons (param i64 i64) (result i64)))\n(import \"env\" \"transfer_tokens\" (func $transfer_tokens (param i64 i64 i64) (result i64)))\n(import \"env\" \"address\" (func $address (param i64) (result i64)))\n(import \"env\" \"contract\" (func $contract (param i64) (result i64)))\n(import \"env\" \"self\" (func $self (result i64)))\n(import \"env\" \"self_address\" (func $self_address (result i64)))\n(import \"env\" \"get_and_update\" (func $get_and_update (param i64 i64 i64)))\n(import \"env\" \"read_ticket\" (func $read_ticket (param i64)))\n(import \"env\" \"ticket\" (func $ticket (param i64 i64) (result i64)))\n(import \"env\" \"join_tickets\" (func $join_tickets (param i64) (result i64)))\n(import \"env\" \"split_ticket\" (func $split_ticket (param i64 i64) (result i64)))\n(import \"env\" \"amount\" (func $amount (result i64)))\n(import \"env\" \"balance\" (func $balance (result i64)))\n(import \"env\" \"ediv\" (func $ediv (param i64 i64) (result i64)))\n(import \"env\" \"ge\" (func $ge (param i64) (result i64)))\n(import \"env\" \"le\" (func $le (param i64) (result i64)))\n(import \"env\" \"size\" (func $size (param i64) (result i64)))\n(import \"env\" \"int\" (func $int (param i64) (result i64)))\n(import \"env\" \"implicit_account\" (func $implicit_account (param i64) (result i64)))\n(import \"env\" \"blake2b\" (func $blake2b (param i64) (result i64)))\n(import \"env\" \"pack\" (func $pack (param i64) (result i64)))\n(import \"env\" \"unpack\" (func $unpack (param i64) (result i64)))\n(import \"env\" \"keccak\" (func $keccak (param i64) (result i64)))\n(import \"env\" \"sha256\" (func $sha256 (param i64) (result i64)))\n(import \"env\" \"sha3\" (func $sha3 (param i64) (result i64)))\n(import \"env\" \"sha512\" (func $sha512 (param i64) (result i64)))\n\n  (global $mode i32 (i32.const 0))\n\n  (memory 4)\n  (global $sp (mut i32) (i32.const 4000)) ;; stack pointer\n  (global $sh_sp (mut i32) (i32.const 1000)) ;;shadow_stack stack pointer\n\n  (global $__stack_base i32 (i32.const 32768))\n\n  (type $callback_t (func (param i64) (result i64)))\n  (func $call_callback (param $arg1 i64) (param $idx i32) (result i64)\n    (call_indirect (type $callback_t) (local.get $arg1) (local.get $idx)))\n\n  (type $callback_t_unit (func (param i64) (result)))\n  (func $call_callback_unit (param $arg1 i64) (param $idx i32) (result )\n    (call_indirect (type $callback_t_unit)\n      (local.get $arg1)\n      (local.get $idx)))\n\n  (func $dip (param $n i32) (result)\n    (local $stop i32)\n    (local $sp' i32)\n    (local $sh_sp' i32)\n    (local.set $stop (i32.const 0))\n    (local.set $sp'  (global.get $sp))\n    (local.tee $sh_sp' (i32.sub (global.get $sh_sp) (local.get $n)))\n    global.set $sh_sp\n    (loop $l\n      (i32.mul (i32.const 8) (i32.add (global.get $__stack_base) (i32.add (local.get $sh_sp') (local.get $stop))))\n      (i64.load (i32.mul (i32.const 8) (i32.add (local.get $sp') (local.get $stop))))\n      i64.store\n      (local.tee $stop (i32.add (local.get $stop) (i32.const 1)))\n      (local.get $n)\n      i32.ne\n      br_if $l)\n\n    (global.set $sp\n    (i32.add\n      (local.get $sp') (local.get $n))))\n\n  (func $undip (param $n i32) (result)\n    (local $stop i32)\n    (local $sp' i32)\n    (local $sh_sp' i32)\n    (local.tee $sp'  (i32.sub (global.get $sp) (local.get $n)))\n    global.set $sp\n    (local.set $sh_sp' (global.get $sh_sp))\n    (local.set $stop (i32.const 0))\n    (loop $l\n      (i32.mul (i32.const 8) (i32.add (local.get $sp') (local.get $stop)))\n      (i64.load\n        (i32.add\n          (global.get $__stack_base)\n          (i32.mul (i32.const 8) (i32.add (local.get $sh_sp') (local.get $stop)))))\n      (i64.store)\n      (local.tee $stop (i32.add (local.get $stop) (i32.const 1)))\n      (local.get $n)\n      i32.ne\n      br_if $l)\n    (global.set $sh_sp (i32.add (local.get $sh_sp') (local.get $n))))\n\n  (func $dup (param $n i32) (result)\n    (i64.load (i32.mul (i32.const 8) (i32.add (global.get $sp) (local.get $n))))\n    (call $dup_host))\n\n  (func $swap (param) (result)\n    (local $v1 i64)\n    (local $v2 i64)\n    (local.set $v1 (call $pop))\n    (local.set $v2 (call $pop))\n    (call $push (local.get $v1))\n    (call $push (local.get $v2)))\n\n  (func $dug (param $n i32) (result)\n    (local $idx i32)\n    (local $loop_idx i32)\n    (local $sp' i32)\n    (local $top i64)\n    (local.set $sp' (i32.add (global.get $sp) (local.get $n)))\n    (local.tee $idx (global.get $sp))\n    (local.tee $loop_idx)\n    (i32.mul (i32.const 8))\n    i64.load\n    local.set $top\n    (loop $loop\n      (i32.mul (i32.const 8) (local.get $idx))\n      (i32.add (local.get $loop_idx) (i32.const 1))\n      local.tee $loop_idx\n      (i32.mul (i32.const 8))\n      i64.load\n      i64.store\n      (local.set $idx (i32.add (local.get $idx) (i32.const 1)))\n      (local.get $idx)\n      (local.get $sp')\n      i32.lt_u\n      br_if $loop)\n\n    (i64.store (i32.mul (i32.const 8) (local.get $sp')) (local.get $top)))\n\n  (func $dig (param $n i32) (result)\n    (local $idx i32) (local $t i32) (local $digged i64)\n\n    (local.set $digged\n      (i64.load\n        (i32.mul (i32.const 8)\n          (local.tee $idx (i32.add (global.get $sp) (local.get $n))))))\n\n    (loop $loop\n      (local.set $t (i32.mul (i32.const 8) (local.get $idx)))\n\n      (i64.store (local.get $t)\n        (i64.load\n          (i32.mul\n            (i32.const 8)\n            (local.tee $idx (i32.sub (local.get $idx) (i32.const 1))))))\n\n      (br_if $loop\n        (i32.lt_u (global.get $sp) (local.get $idx))))\n\n    (i64.store (i32.mul (i32.const 8) (local.get $idx)) (local.get $digged)))\n\n  (func $pop (result i64)\n    (local $spp i32)\n    (i32.mul (i32.const 8) (local.tee $spp (global.get $sp)))\n    i64.load\n    (global.set $sp (i32.add (local.get $spp) (i32.const 1))))  ;;set stackptr\n\n  (func $push (param $value i64) (result)\n    (local $spp i32)\n    (i32.mul (i32.const 8) (local.tee $spp (i32.sub (global.get $sp) (i32.const 1)) ))\n    (i64.store (local.get $value))\n    (global.set $sp (local.get $spp)))  ;;set stackptr\n\n  (func $drop (param $n i32) (result)\n    (global.set $sp (i32.add (global.get $sp) (local.get $n))))  ;;set stackptr\n\n  (table $closures funcref (elem ))\n\n\n  (func $main (param $v1 i64) (result i64)\n    (local $1 i64)\n    (call $push (local.get $v1))\n    (call $unpair (call $pop)) ;; implicit return\n(call $if_left (call $pop)) (if (then (call $if_left (call $pop)) (if (then (call $swap)\n(call $push (call $z_sub (call $pop) (call $pop)))) (else (call $push (call $z_add (call $pop) (call $pop)))))) (else (call $drop (i32.const 2))\n(call $push (call $zero)) (; 0 ;)))\n(call $push (call $nil))\n(call $push (call $pair (call $pop) (call $pop)))\n    (call $pop))\n\n  (export \"push\" (func $push))\n  (export \"pop\" (func $push))\n  (export \"main\" (func $main))\n  (export \"closures\" (table $closures))\n  (export \"call_callback\" (func $call_callback))\n  (export \"call_callback_unit\" (func $call_callback_unit))\n  )\n",
+      "constants": [],
+      "initial_storage": [ "Int", "5" ],
+      "entrypoints": {
+        "%decrement": [ "Left", "Left" ],
+        "%increment": [ "Left", "Right" ],
+        "%reset": [ "Right" ]
+      }
+    }
+  }
diff --git a/tunac.opam b/tunac.opam
@@ -15,6 +15,9 @@ depends: [
   "wasm"
   "data-encoding"
   "tezos-micheline"
+  "core"
+  "core.unix"
+  "ppx_jane"
   "ocamlformat-rpc" {with-test}
   "ocamlformat" {with-test}
   "ocaml-lsp-server" {with-test}