(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Binary_error

let n_length value =
  let bits = Z.numbits value in
  if bits = 0 then 1 else (bits + 6) / 7
let z_length value = (Z.numbits value + 1 + 6) / 7

let rec length : type x. x Encoding.t -> x -> int =
  fun e value ->
    let open Encoding in
    match e.encoding with
    (* Fixed *)
    | Null -> 0
    | Empty -> 0
    | Constant _ -> 0
    | Bool -> Binary_size.bool
    | Int8 -> Binary_size.int8
    | Uint8 -> Binary_size.uint8
    | Int16 -> Binary_size.int16
    | Uint16 -> Binary_size.uint16
    | Int31 -> Binary_size.int31
    | Int32 -> Binary_size.int32
    | Int64 -> Binary_size.int64
    | N -> n_length value
    | Z -> z_length value
    | RangedInt { minimum ; maximum } ->
        Binary_size.integer_to_size @@
        Binary_size.range_to_size ~minimum ~maximum
    | Float -> Binary_size.float
    | RangedFloat _ -> Binary_size.float
    | Bytes `Fixed n -> n
    | String `Fixed n -> n
    | Padded (e, n) -> length e value + n
    | String_enum (_, arr) ->
        Binary_size.integer_to_size @@ Binary_size.enum_size arr
    | Objs { kind = `Fixed n } -> n
    | Tups { kind = `Fixed n } -> n
    | Union { kind = `Fixed n } -> n
    (* Dynamic *)
    | Objs { kind = `Dynamic ; left ; right } ->
        let (v1, v2) = value in
        length left v1 + length right v2
    | Tups { kind = `Dynamic ; left ; right } ->
        let (v1, v2) = value in
        length left v1 + length right v2
    | Union { kind = `Dynamic ; tag_size ; cases } ->
        let rec length_case = function
          | [] -> raise (Write_error No_case_matched)
          | Case { tag = Json_only } :: tl -> length_case tl
          | Case { encoding = e ; proj ; _ } :: tl ->
              match proj value with
              | None -> length_case tl
              | Some value -> Binary_size.tag_size tag_size + length e value in
        length_case cases
    | Mu { kind = `Dynamic ; fix } -> length (fix e) value
    | Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin
        match value with
        | None -> 1
        | Some value -> 1 + length e value
      end
    (* Variable *)
    | Ignore -> 0
    | Bytes `Variable -> MBytes.length value
    | String `Variable -> String.length value
    | Array (Some max_length, _e) when Array.length value > max_length ->
        raise (Write_error Array_too_long)
    | Array (_, e) ->
        Array.fold_left
          (fun acc v -> length e v + acc)
          0 value
    | List (Some max_length, _e) when List.length value > max_length ->
        raise (Write_error List_too_long)
    | List (_, e) ->
        List.fold_left
          (fun acc v -> length e v + acc)
          0 value
    | Objs { kind = `Variable ; left ; right } ->
        let (v1, v2) = value in
        length left v1 + length right v2
    | Tups { kind = `Variable ; left ; right } ->
        let (v1, v2) = value in
        length left v1 + length right v2
    | Obj (Opt { kind = `Variable ; encoding = e }) -> begin
        match value with
        | None -> 0
        | Some value -> length e value
      end
    | Union { kind = `Variable ; tag_size ; cases } ->
        let rec length_case = function
          | [] -> raise (Write_error No_case_matched)
          | Case { tag = Json_only } :: tl -> length_case tl
          | Case { encoding = e ; proj ; _ } :: tl ->
              match proj value with
              | None -> length_case tl
              | Some value -> Binary_size.tag_size tag_size + length e value in
        length_case cases
    | Mu { kind = `Variable ; fix } -> length (fix e) value
    (* Recursive*)
    | Obj (Req { encoding = e }) -> length e value
    | Obj (Dft { encoding = e }) -> length e value
    | Tup e -> length e value
    | Conv  { encoding = e ; proj } ->
        length e (proj value)
    | Describe { encoding = e } -> length e value
    | Splitted { encoding = e } -> length e value
    | Dynamic_size { kind ; encoding = e } ->
        let length = length e value in
        Binary_size.integer_to_size kind + length
    | Check_size { limit ; encoding = e } ->
        let length = length e value in
        if length > limit then raise (Write_error Size_limit_exceeded) ;
        length
    | Delayed f -> length (f ()) value

let fixed_length e =
  match Encoding.classify e with
  | `Fixed n -> Some n
  | `Dynamic | `Variable -> None
let fixed_length_exn e =
  match fixed_length e with
  | Some n -> n
  | None -> invalid_arg "Data_encoding.Binary.fixed_length_exn"

