Another interaction mode for delegation_verify

src/app/delegation_verify/README.md

@@ -10,6 +10,8 @@ the time of each submission.
 The tool can work in two distinct modes:
 * **file system mode**, where all submission and blocks should be
   stored in files on a local file system;
+* **stdin mode**, where all data is passed in through **stdin**, while
+  results are output to **stdout**.
 * **cassandra mode**, where all the data is stored in a Cassandra
   database.
 
@@ -84,6 +86,43 @@ For each `<filename{i}>` parameter one line of output is printed to
 The stateless verification would check the protocol_state_proof in the
 block and the transaction_snark_proof in the snark_work.
 
+Stdin mode
+----------
+
+Usage:
+```
+./delegation_verify stdin
+```
+
+This mode does not require any special options, but it still accepts
+global options described below. It reads its **stdin** buffer, trying
+to parse a JSON list of objects. Objects don't need to follow any
+specific format; it's sufficient that they provide the essential data:
+
+* `submitted_at` – timestamp of the submission for indentification;
+* `block_hash` – needed to identify the block to verify;
+* `snark_work` (optional) – a base64-encoded SNARK proof to verify;
+* `submitter` – the submitter's public key;
+* `raw_block` – the block data which `block_hash` refers to.
+
+Each submission can contain arbitrary other fields, which will be
+ignored. The verifier will process submissions and for each it will
+output the same JSON object with the following additional fields:
+
+* `state_hash` – the hash of the blockchain's state at the block;
+* `parent` – the hash of the blockchain's state at the preceding block;
+* `slot` – the global slot since genesis at which submission was sent;
+* `height` – the height of the block in the blockchain;
+* `verified` – always `true`;
+* `error` – `null` if verification has passed, otherwise a string
+  describing the error.
+
+*NOTE*: Output objects are not on a list. Instead they are separated
+with newlines. This is because submissions are processed asynchronously
+and each thread outputs its results immediately as it finishes. For
+this reason the order in which submissions are output is unspecified
+and can vary between runs of the same inputs.
+
 Cassandra mode
 --------------
 

src/app/delegation_verify/delegation_verify.ml

@@ -86,12 +86,8 @@ module Make_verifier (Source : Submission.Data_source) = struct
     let block_hash = Source.block_hash sub in
     if Known_blocks.is_known block_hash then ()
     else
-      let load_block_action =
-        if Source.is_cassandra src then Source.load_block_from_submission sub
-        else Source.load_block src ~block_hash
-      in
       Known_blocks.add ?validate ~verify_blockchain_snarks ~block_hash
-        load_block_action
+        (Source.load_block sub src)
 
   let verify ~validate (submission : Source.submission) =
     let open Deferred.Result.Let_syntax in
@@ -100,7 +96,7 @@ module Make_verifier (Source : Submission.Data_source) = struct
     let%bind () = Known_blocks.is_valid block_hash in
     let%map () =
       if validate then
-        match Source.snark_work submission with
+        match%bind Deferred.return @@ Source.snark_work submission with
         | None ->
             Deferred.Result.return ()
         | Some
@@ -165,8 +161,6 @@ let filesystem_command =
         let module V = Make_verifier (struct
           include Submission.Filesystem
 
-          let is_cassandra _ = false
-
           let verify_blockchain_snarks = verify_blockchain_snarks
 
           let verify_transaction_snarks = verify_transaction_snarks
@@ -199,8 +193,6 @@ let cassandra_command =
         let module V = Make_verifier (struct
           include Submission.Cassandra
 
-          let is_cassandra _ = true
-
           let verify_blockchain_snarks = verify_blockchain_snarks
 
           let verify_transaction_snarks = verify_transaction_snarks
@@ -219,9 +211,37 @@ let cassandra_command =
             Output.display_error @@ Error.to_string_hum e ;
             exit 1)
 
+let stdin_command =
+  Command.async
+    ~summary:"Verify submissions and blocks read from standard input"
+    Command.Let_syntax.(
+      let%map_open config_file = config_flag and no_checks = no_checks_flag in
+      fun () ->
+        let open Deferred.Let_syntax in
+        let logger = Logger.create () in
+        let%bind.Deferred verify_blockchain_snarks, verify_transaction_snarks =
+          instantiate_verify_functions ~logger config_file
+        in
+        let module V = Make_verifier (struct
+          include Submission.Stdin
+
+          let verify_blockchain_snarks = verify_blockchain_snarks
+
+          let verify_transaction_snarks = verify_transaction_snarks
+        end) in
+        match%bind V.process ~validate:(not no_checks) () with
+        | Ok () ->
+            Deferred.unit
+        | Error e ->
+            Output.display_error @@ Error.to_string_hum e ;
+            exit 1)
+
 let command =
   Command.group
     ~summary:"A tool for verifying JSON payload submitted by the uptime service"
-    [ ("fs", filesystem_command); ("cassandra", cassandra_command) ]
+    [ ("fs", filesystem_command)
+    ; ("cassandra", cassandra_command)
+    ; ("stdin", stdin_command)
+    ]
 
 let () = Async.Command.run command

src/app/delegation_verify/json.ml

@@ -0,0 +1,35 @@
+open Core
+
+let assoc_pop ~equal key assoc =
+  let rec pop acc = function
+    | [] ->
+        None
+    | (k, v) :: kvs when equal k key ->
+        Some (v, List.rev_append acc kvs)
+    | pair :: kvs ->
+        pop (pair :: acc) kvs
+  in
+  pop [] assoc
+
+let is_empty = function [] -> true | _ -> false
+
+let assoc_replace_many ~equal replacements assoc =
+  let rec replace acc us = function
+    | [] ->
+        List.rev acc
+    | _ :: _ as kvs when is_empty us ->
+        List.rev_append acc kvs
+    | (k, v) :: kvs -> (
+        match assoc_pop ~equal k us with
+        | None ->
+            replace ((k, v) :: acc) us kvs
+        | Some (v', us') ->
+            replace ((k, v') :: acc) us' kvs )
+  in
+  replace [] replacements assoc
+
+let json_update updates = function
+  | `Assoc obj ->
+      `Assoc (assoc_replace_many ~equal:String.equal updates obj)
+  | json ->
+      raise (Yojson.Safe.Util.Type_error ("Expected object", json))