Modify hashlock to use commit-reveal and add non-working commit test

src/stages/ast_simplified/combinators.ml

@@ -33,6 +33,7 @@ let t_address      : type_expression = make_t @@ T_constant (TC_address)
 let t_signature    : type_expression = make_t @@ T_constant (TC_signature)
 let t_key          : type_expression = make_t @@ T_constant (TC_key)
 let t_key_hash     : type_expression = make_t @@ T_constant (TC_key_hash)
+let t_timestamp    : type_expression = make_t @@ T_constant (TC_timestamp)
 let t_option  o    : type_expression = make_t @@ T_operator (TC_option o)
 let t_list  t      : type_expression = make_t @@ T_operator (TC_list t)
 let t_variable n   : type_expression = make_t @@ T_variable (Var.of_name n)

src/stages/ast_simplified/combinators.mli

@@ -21,6 +21,7 @@ val t_unit      : type_expression
 val t_address   : type_expression
 val t_key       : type_expression
 val t_key_hash  : type_expression
+val t_timestamp : type_expression
 val t_signature : type_expression
 (*
 val t_option    : type_expression -> type_expression

src/test/contracts/hashlock.mligo

@@ -1,19 +1,50 @@
+type commit = {
+  date: timestamp;
+  hashed: bytes;
+}
+
+type commit_set = (address, commit) big_map
+
 type storage = {
   hashed: bytes;
   unused: bool;
+  commits: commit_set;
 }
 
-type parameter = {
+type reveal = {
   hashable: bytes;
   message: unit -> operation list;
 }
 
-let main ((p,s): parameter * storage) : operation list * storage =
+type parameter =
-  (* We have to use a hash salted with the solvers address, otherwise a baker
+| Commit of unit
-     could steal *)
+| Reveal of reveal
-  let salted: bytes = Bytes.concat p.hashable (Bytes.pack sender) in
+
-  if ((Crypto.sha256 p.hashable) = s.hashed) && s.unused
+(* We use hash-commit so that a baker can't steal *)
+let commit ((p,s): unit * storage) : operation list * storage =
+  let salted: bytes = Bytes.concat s.hashed (Bytes.pack sender) in
+  let commit: commit = {date = Current.time + 86400; hashed = salted;} in
+  let updated_map: commit_set = Big_map.update sender (Some commit) s.commits in
+  let s = {hashed = s.hashed; unused = s.unused; commits = updated_map} in
+  (([]: operation list), s)
+
+let reveal ((p,s): reveal * storage) : operation list * storage =
+  let commit: commit =
+    match (Big_map.find_opt sender s.commits) with
+    | Some c -> c
+    | None -> (failwith "You haven't made a commitment to hash against yet.": commit)
+  in
+  if Current.time < commit.date
+  then (failwith "It hasn't been 24 hours since your commit yet.": operation list * storage)
+  else
+  let salted = Bytes.concat (Crypto.sha256 p.hashable) (Bytes.pack sender) in
+  if ((Crypto.sha256 salted) = commit.hashed) && s.unused
   then
-    let s: storage = {hashed = s.hashed; unused = false} in
+    let s: storage = {hashed = s.hashed; unused = false; commits = s.commits} in
     ((p.message ()), s)
   else (([]: operation list), s)
+
+let main ((p,s): parameter * storage) : operation list * storage =
+  match p with
+  | Commit -> commit ((), s)
+  | Reveal r -> reveal (r, s)

src/test/hash_lock_tests.ml

@@ -0,0 +1,89 @@
+open Trace
+open Test_helpers
+open Ast_simplified
+
+let type_file f =
+  let%bind simplified  = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in
+  let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
+  ok @@ (typed,state)
+
+let get_program =
+  let s = ref None in
+  fun () -> match !s with
+    | Some s -> ok s
+    | None -> (
+        let%bind program = type_file "./contracts/hashlock.mligo" in
+        s := Some program ;
+        ok program
+      )
+
+let compile_main () =
+  let%bind simplified      = Ligo.Compile.Of_source.compile "./contracts/hashlock.mligo" (Syntax_name "cameligo") in
+  let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
+  let%bind mini_c_prg      = Ligo.Compile.Of_typed.compile typed_prg in
+  let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
+  let%bind (_contract: Tezos_utils.Michelson.michelson) =
+    (* fails if the given entry point is not a valid contract *)
+    Ligo.Compile.Of_michelson.build_contract michelson_prg in
+  ok ()
+
+let empty_op_list =
+  (e_typed_list [] t_operation)
+let empty_message = e_lambda (Var.of_name "arguments")
+  (Some t_unit) (Some (t_list t_operation))
+  empty_op_list
+
+let call msg = e_constructor "Call" msg
+let mk_time st =
+  match Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation st with
+  | Some s -> ok s
+  | None -> simple_fail "bad timestamp notation"
+let to_sec t = Tezos_utils.Time.Protocol.to_seconds t
+let storage hashed commits =
+  e_ez_record [("hashed", hashed);
+               ("unused", e_bool false);
+               ("commits", commits)]
+
+let (first_committer , first_contract) =
+  let open Proto_alpha_utils.Memory_proto_alpha in
+  let id = List.nth dummy_environment.identities 0 in
+  let kt = id.implicit_contract in
+  Protocol.Alpha_context.Contract.to_b58check kt , kt
+
+let commit () =
+  let%bind program,_ = get_program () in
+  let%bind predecessor_timestamp = mk_time "2000-01-01T00:10:10Z" in
+  let%bind lock_time = mk_time "2000-01-02T00:10:11Z" in
+  let test_hash = e_bytes_raw (sha_256_hash (Bytes.of_string "hello world")) in
+  let salted_hash = e_bytes_raw (sha_256_hash
+                                   (Bytes.concat
+                                      Bytes.empty
+                                      [Bytes.of_string first_committer;
+                                       (sha_256_hash (Bytes.of_string "hello world"))]
+                                   ))
+  in
+  let pre_commits = e_typed_big_map [] t_address (t_record_ez [("date", t_timestamp);
+                                                              ("hashed", t_bytes)])
+  in
+  let init_storage = storage test_hash pre_commits in
+  let commit =
+    e_ez_record [("date", e_timestamp
+                    (Int64.to_int (to_sec lock_time)));
+                 ("hashed", salted_hash)]
+  in
+  let post_commits = e_big_map [((e_address first_committer), commit)]
+  in
+  let post_storage = storage salted_hash post_commits in
+  let options =
+    Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~predecessor_timestamp
+      ~payer:first_contract
+      ()
+  in
+  expect_eq ~options program "commit"
+    (e_pair (e_unit ()) init_storage) (e_pair empty_op_list post_storage)
+
+let main = test_suite "Hashlock" [
+    test "compile" compile_main ;
+    test "commit" commit ;
+]

src/test/test.ml

@@ -14,5 +14,6 @@ let () =
     Multisig_v2_tests.main ;
     Replaceable_id_tests.main ;
     Time_lock_tests.main ;
+    Hash_lock_tests.main ;
   ] ;
   ()