Rosetta scaffold inverted operations

src/app/rosetta/lib/block.ml

@@ -4,13 +4,13 @@ open Models
 
 module Unsigned = struct
   module UInt64 = struct
-    include Unsigned.UInt64
+    include Unsigned_extended.UInt64
 
     let to_yojson i = `Intlit (to_string i)
   end
 
   module UInt32 = struct
-    include Unsigned.UInt32
+    include Unsigned_extended.UInt32
 
     let to_yojson i = `Intlit (to_string i)
   end
@@ -35,6 +35,12 @@ let account_id (`Pk pk) token_id =
   ; sub_account= None
   ; metadata= Some (Amount_of.Token_id.encode token_id) }
 
+let token_id_of_account (account : Account_identifier.t) =
+  let module Decoder = Amount_of.Token_id.T (Result) in
+  Decoder.decode account.metadata
+  |> Result.map ~f:(Option.value ~default:Amount_of.Token_id.default)
+  |> Result.ok
+
 module Block_query = struct
   type t = ([`Height of int64], [`Hash of string]) These.t option
 
@@ -78,20 +84,20 @@ module User_command_info = struct
   module Kind = struct
     type t =
       [`Payment | `Delegation | `Create_token | `Create_account | `Mint_tokens]
-    [@@deriving yojson]
+    [@@deriving yojson, eq, sexp, compare]
   end
 
   module Account_creation_fees_paid = struct
     type t =
       | By_no_one
       | By_fee_payer of Unsigned.UInt64.t
       | By_receiver of Unsigned.UInt64.t
-    [@@deriving eq, to_yojson]
+    [@@deriving eq, to_yojson, sexp, compare]
   end
 
   module Failure_status = struct
     type t = [`Applied of Account_creation_fees_paid.t | `Failed of string]
-    [@@deriving eq, to_yojson]
+    [@@deriving eq, to_yojson, sexp, compare]
   end
 
   type t =
@@ -106,15 +112,152 @@ module User_command_info = struct
     ; amount: Unsigned.UInt64.t option
     ; hash: string
     ; failure_status: Failure_status.t option }
-  [@@deriving to_yojson]
+  [@@deriving to_yojson, eq, sexp, compare]
+
+  module Partial = struct
+    type t =
+      { kind: Kind.t
+      ; fee_payer: [`Pk of string]
+      ; source: [`Pk of string]
+      ; receiver: [`Pk of string]
+      ; fee_token: Unsigned.UInt64.t
+      ; token: Unsigned.UInt64.t
+      ; fee: Unsigned.UInt64.t
+      ; amount: Unsigned.UInt64.t option }
+    [@@deriving to_yojson, sexp, compare]
+
+    module Reason = struct
+      type t =
+        | Length_mismatch
+        | Fee_payer_and_source_mismatch
+        | Amount_not_some
+        | Account_not_some
+        | Incorrect_token_id
+        | Amount_inc_dec_mismatch
+        | Status_not_pending
+        | Can't_find_kind of string
+      [@@deriving sexp]
+    end
+  end
+
+  let forget (t : t) : Partial.t =
+    { kind= t.kind
+    ; fee_payer= t.fee_payer
+    ; source= t.source
+    ; receiver= t.receiver
+    ; fee_token= t.fee_token
+    ; token= t.token
+    ; fee= t.fee
+    ; amount= t.amount }
+
+  let of_operations (ops : Operation.t list) :
+      (Partial.t, Partial.Reason.t) Validation.t =
+    (* TODO: If we care about DoS attacks, break early if length too large *)
+    (* For a payment we demand:
+      *
+      * ops = exactly 3
+      *
+      * payment_source_dec with account 'a, some amount 'x, status="Pending"
+      * fee_payer_dec with account 'a, some amount 'y, status="Pending"
+      * payment_receiver_inc with account 'b, some amount 'x, status="Pending"
+    *)
+    let payment =
+      let open Validation.Let_syntax in
+      let open Partial.Reason in
+      let module V = Validation in
+      (* Note: It's better to have nice errors with the validation than micro-optimize searching through a small list a minimal number of times. *)
+      let find_kind k (ops : Operation.t list) =
+        let name = Operation_types.name k in
+        List.find ops ~f:(fun op -> String.equal op.Operation._type name)
+        |> Result.of_option ~error:[Can't_find_kind name]
+      in
+      let%map () =
+        if Int.equal (List.length ops) 3 then V.return ()
+        else V.fail Length_mismatch
+      and account_a =
+        let open Result.Let_syntax in
+        let%bind {account; _} = find_kind `Payment_source_dec ops
+        and {account= account'; _} = find_kind `Fee_payer_dec ops in
+        match (account, account') with
+        | Some x, Some y when Account_identifier.equal x y ->
+            V.return x
+        | Some _, Some _ ->
+            V.fail Fee_payer_and_source_mismatch
+        | None, _ | _, None ->
+            V.fail Account_not_some
+      and token =
+        let open Result.Let_syntax in
+        let%bind {account; _} = find_kind `Payment_source_dec ops in
+        match account with
+        | Some account -> (
+          match token_id_of_account account with
+          | None ->
+              V.fail Incorrect_token_id
+          | Some token ->
+              V.return token )
+        | None ->
+            V.fail Account_not_some
+      and fee_token =
+        let open Result.Let_syntax in
+        let%bind {account; _} = find_kind `Fee_payer_dec ops in
+        match account with
+        | Some account -> (
+          match token_id_of_account account with
+          | Some token_id ->
+              V.return token_id
+          | None ->
+              V.fail Incorrect_token_id )
+        | None ->
+            V.fail Account_not_some
+      and account_b =
+        let open Result.Let_syntax in
+        let%bind {account; _} = find_kind `Payment_receiver_inc ops in
+        Result.of_option account ~error:[Account_not_some]
+      and () =
+        if List.for_all ops ~f:(fun op -> String.equal op.status "Pending")
+        then V.return ()
+        else V.fail Status_not_pending
+      and payment_amount_x =
+        let open Result.Let_syntax in
+        let%bind {amount; _} = find_kind `Payment_source_dec ops
+        and {amount= amount'; _} = find_kind `Payment_receiver_inc ops in
+        match (amount, amount') with
+        | Some x, Some y when Amount.equal (Amount_of.negated x) y ->
+            V.return y
+        | Some _, Some _ ->
+            V.fail Amount_inc_dec_mismatch
+        | None, _ | _, None ->
+            V.fail Amount_not_some
+      and payment_amount_y =
+        let open Result.Let_syntax in
+        let%bind {amount; _} = find_kind `Fee_payer_dec ops in
+        match amount with
+        | Some x ->
+            V.return (Amount_of.negated x)
+        | None ->
+            V.fail Amount_not_some
+      in
+      { Partial.kind= `Payment
+      ; fee_payer= `Pk account_a.address
+      ; source= `Pk account_a.address
+      ; receiver= `Pk account_b.address
+      ; fee_token
+      ; token (* TODO: Catch exception properly on these uint64 decodes *)
+      ; fee= Unsigned.UInt64.of_string payment_amount_y.Amount.value
+      ; amount= Some (Unsigned.UInt64.of_string payment_amount_x.Amount.value)
+      }
+    in
+    (* TODO: Handle delegation transactions *)
+    (* TODO: Handle all other  transactions *)
+    payment
 
   let to_operations (t : t) : Operation.t list =
     (* First build a plan. The plan specifies all operations ahead of time so
-     * we can later compute indices and relations when we're building the full
-     * models.
-     *
-     * For now, relations will be defined only on the two sides of a given
-     * transfer. ie. Source decreases, and receiver increases.
+       * we can later compute indices and relations when we're building the full
+       * models.
+       *
+       * For now, relations will be defined only on the two sides of a given
+       * transfer. ie. Source decreases, and receiver increases.
     *)
     let plan : 'a Op.t list =
       (* The dec side of a user command's fee transfer is here *)
@@ -276,6 +419,27 @@ module User_command_info = struct
                              (let (`Pk r) = t.source in
                               r) ) ])) } )
 
+  let%test_unit "payment_round_trip" =
+    let start =
+      { kind= `Payment (* default token *)
+      ; fee_payer= `Pk "Alice"
+      ; source= `Pk "Alice"
+      ; token= Unsigned.UInt64.of_int 1
+      ; fee= Unsigned.UInt64.of_int 2_000_000_000
+      ; receiver= `Pk "Bob"
+      ; fee_token= Unsigned.UInt64.of_int 1
+      ; nonce= Unsigned.UInt32.of_int 3
+      ; amount= Some (Unsigned.UInt64.of_int 5_000_000_000)
+      ; failure_status= None
+      ; hash= "TXN_1_HASH" }
+    in
+    let ops = to_operations start in
+    match of_operations ops with
+    | Ok partial ->
+        [%test_eq: Partial.t] partial (forget start)
+    | Error e ->
+        failwithf !"Mismatch because %{sexp: Partial.Reason.t list}" e ()
+
   let dummies =
     [ { kind= `Payment (* default token *)
       ; fee_payer= `Pk "Alice"

src/app/rosetta/lib/dune

@@ -18,6 +18,7 @@
     yojson
     archive_lib
     signature_lib
+    unsigned_extended
     )
   (preprocess (pps
     graphql_ppx

src/app/rosetta/models/account_identifier.ml

@@ -12,7 +12,7 @@ type t =
   ; sub_account: Sub_account_identifier.t option [@default None]
   ; (* Blockchains that utilize a username model (where the address is not a derivative of a cryptographic public key) should specify the public key(s) owned by the address in metadata. *)
     metadata: Yojson.Safe.t option [@default None] }
-[@@deriving yojson {strict= false}, show]
+[@@deriving yojson {strict= false}, show, eq]
 
 (** The account_identifier uniquely identifies an account within a network. All fields in the account_identifier are utilized to determine this uniqueness (including the metadata field, if populated). *)
 let create (address : string) : t = {address; sub_account= None; metadata= None}

src/app/rosetta/models/amount.ml

@@ -11,7 +11,7 @@ type t =
     value: string
   ; currency: Currency.t
   ; metadata: Yojson.Safe.t option [@default None] }
-[@@deriving yojson {strict= false}, show]
+[@@deriving yojson {strict= false}, show, eq]
 
 (** Amount is some Value of a Currency. It is considered invalid to specify a Value without a Currency. *)
 let create (value : string) (currency : Currency.t) : t =

src/app/rosetta/models/currency.ml

@@ -13,7 +13,7 @@ type t =
     decimals: int32
   ; (* Any additional information related to the currency itself. For example, it would be useful to populate this object with the contract address of an ERC-20 token. *)
     metadata: Yojson.Safe.t option [@default None] }
-[@@deriving yojson {strict= false}, show]
+[@@deriving yojson {strict= false}, show, eq]
 
 (** Currency is composed of a canonical Symbol and Decimals. This Decimals value is used to convert an Amount.Value from atomic units (Satoshis) to standard units (Bitcoins). *)
 let create (symbol : string) (decimals : int32) : t =

src/app/rosetta/models/dune

@@ -9,4 +9,5 @@
     ppx_deriving_yojson
     ppx_deriving.show
     ppx_version
+    ppx_deriving.eq
   )))

src/app/rosetta/models/sub_account_identifier.ml

@@ -11,7 +11,7 @@ type t =
     address: string
   ; (* If the SubAccount address is not sufficient to uniquely specify a SubAccount, any other identifying information can be stored here. It is important to note that two SubAccounts with identical addresses but differing metadata will not be considered equal by clients. *)
     metadata: Yojson.Safe.t option [@default None] }
-[@@deriving yojson {strict= false}, show]
+[@@deriving yojson {strict= false}, show, eq]
 
 (** An account may have state specific to a contract address (ERC-20 token) and/or a stake (delegated balance). The sub_account_identifier should specify which state (if applicable) an account instantiation refers to. *)
 let create (address : string) : t = {address; metadata= None}