<commit_before>(*
 * Copyright (c) 2013-2017 <NAME> <<EMAIL>>
 * and <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let ppe ~name ppv =
  Fmt.braces (fun ppf -> Fmt.pf ppf "%s %a" name (Fmt.hvbox ppv))


module BaseBytes :
sig
  include S.BASE with type t = Bytes.t

  val to_hex : t -> string
  val of_hex : string -> t
end = struct
  [@@@warning "-44"] (* XXX(dinosaure): shadowing of [compare] and [equal]. *)

  open Bytes

  type nonrec t = t

  let equal = equal
  let compare = compare
  let hash = Hashtbl.hash

  let pp = Fmt.iter Bytes.iter (Fmt.using Char.code (fun ppf -> Fmt.pf ppf "%02x"))

  module Set = Set.Make(struct type nonrec t = t let compare = compare end)
  module Map = Map.Make(struct type nonrec t = t let compare = compare end)

  let to_hex x =
    let `Hex v = Hex.of_string (Bytes.unsafe_to_string x) in v
  let of_hex x =
    Hex.to_string (`Hex x) |> Bytes.unsafe_of_string
end

module MakeDecoder (A : S.ANGSTROM)
  : S.DECODER with type t = A.t
               and type raw = Cstruct.t
               and type init = Cstruct.t
               and type error = [ `Decoder of string ]
= struct
  (* XXX(dinosaure): this decoder is on top of some assertion about
     the decoding of a git object. [Angstrom] can not consume all
     input (when we have an alteration specifically) and the client
     need to keep a part of the previous input but continue to feed
     the parser with a new input (to determine the choice of the
     alteration). In the git format, we can have this problem but for
     few bytes (something like ten bytes). So, we consider to use an
     internal buffer (than the size is bigger than what is needed) and
     we ensure than is not possible to keep more than the size of the
     internal buffer when we parse a Git object.

     However, this case appear in the code (when we don't have enough
     trailing space and writable space). This case appear when we
     don't parse a Git object but something else (which is not respect
     our assertions). And if this case appear, we can consider that
     someone try to cheat you. So we prefer to return an error.

     Obviously, in a better world with unicorn and pineapple pizza, we
     can just avoid this case. *)

  module Log =
  struct
    let src = Logs.Src.create "git.decoder" ~doc:"logs git's internal decoder"
    include (val Logs.src_log src : Logs.LOG)
  end

  type error = [ `Decoder of string ]
  type init = Cstruct.t
  type raw = Cstruct.t
  type t = A.t

  let pp_error ppf (`Decoder err) = ppe ~name:"`Decoder" Fmt.string ppf err

  type decoder =
    { state    : Angstrom.input -> Angstrom.Unbuffered.more -> A.t Angstrom.Unbuffered.state
    ; final    : Angstrom.Unbuffered.more
    ; internal : Cstruct.t
    ; max      : int }

  let kdone (consumed, value) =
    fun _ _ -> Angstrom.Unbuffered.Done (consumed, value)

  let kfail (consumed, path, err) =
    fun _ _ -> Angstrom.Unbuffered.Fail (consumed, path, err)

  let default raw =
    if Cstruct.len raw < 25 * 2
    then raise (Invalid_argument "The internal buffer is not enough to parse");
    (* XXX(dinosaure): So, if you read the comment before, you
       understand than the internal buffer need to be bigger than an
       alteration. I decide (because I'm the God) to accept only a
       buffer bigger than 25 bytes. Otherwise, we raise an
       [Invalid_argument]. *)

    Log.debug (fun l -> l "Starting to decode a Git object with \
                           a internal buffer (%d)." (Cstruct.len raw));

    let len = Cstruct.len raw in

    { state = (match Angstrom.Unbuffered.parse A.decoder with
          | Angstrom.Unbuffered.Done (committed, value) ->
            kdone (committed, value)
          | Angstrom.Unbuffered.Fail (committed, path, err) ->
            kfail (committed, path, err)
          | Angstrom.Unbuffered.Partial { Angstrom.Unbuffered.committed; continue; } ->
            Log.debug (fun l -> l "Retrieving Partial's angstrom result which \
                                   parsed %d byte(s) (= 0)." committed);
            assert (committed = 0);
            continue)
    ; final = Angstrom.Unbuffered.Incomplete
    ; internal = Cstruct.sub raw 0 0
    (* XXX(dinosaure): first, we consider than the internal buffer is empty. But
       keep calm, the physical buffer will not be free-ed. *)
    ; max      = len }

  let eval decoder =
    match decoder.state (`Bigstring (Cstruct.to_bigarray decoder.internal)) decoder.final with
    | Angstrom.Unbuffered.Done (consumed, value) -> `End (Cstruct.shift decoder.internal consumed, value)
    | Angstrom.Unbuffered.Fail (consumed, path, err) ->
      Log.err (fun l -> l "Retrieving an error in the current decoding: %s (%s)."
                  err (String.concat " > " path));
      `Error (Cstruct.shift decoder.internal consumed, `Decoder (String.concat " > " path ^ ": " ^ err))
    | Angstrom.Unbuffered.Partial
        { Angstrom.Unbuffered.committed; continue; } ->
      let decoder = { decoder with internal = Cstruct.shift decoder.internal committed
                                 ; state = continue } in
      `Await decoder

  let compress _ decoder =
    let off, len = 0, Cstruct.len decoder.internal in
    let buffer = Cstruct.of_bigarray ~off ~len decoder.internal.Cstruct.buffer in
    Log.debug (fun l -> l "Compressing the internal buffer of the current decoding.");
    Cstruct.blit decoder.internal 0 buffer 0 len;
    { decoder with internal = buffer }

  let refill input decoder =
    let len = Cstruct.len input in

    if len > decoder.max
    then begin
      (* XXX(dinosaure): it's to avoid to grow the internal buffer. *)
      Log.err (fun l -> l "The client want to refill the internal buffer by a bigger input.");

      Error (`Decoder (Fmt.strf "Input is too huge: we authorized only an \
                                 input lower or equal than %d" decoder.max))
    end else

      let _trailing_space =
        let { Cstruct.buffer; off; len } = decoder.internal in
        Bigarray.Array1.dim buffer - (off + len)
      in

      let _writable_space =
        let { Cstruct.buffer; len; _ } = decoder.internal in
        Bigarray.Array1.dim buffer - len
      in

      if _trailing_space >= len
      then Ok decoder
      else if _writable_space >= len
      then Ok (compress input decoder)
      else begin
        Log.err (fun l -> l "trailing space:%d and writable space:%d, \
                             the alteration is not done, the error could \
                             be the size of the internal buffer (%d) or the input \
                             is malicious."
                    _trailing_space
                    _writable_space
                    (Bigarray.Array1.dim decoder.internal.Cstruct.buffer));
        Error (`Decoder "Input does not respect assertion, it may be malicious");
      end

      |> function Error err -> Error err
                | Ok decoder ->
                  let internal = Cstruct.add_len decoder.internal len in

                  let off = Cstruct.len internal - len in
                  let ()  = Cstruct.blit input 0 internal off len in
<commit_msg>Fixed the application of an side-effect computation in OCaml<commit_after>(*
 * Copyright (c) 2013-2017 <NAME> <<EMAIL>>
 * and <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let ppe ~name ppv =
  Fmt.braces (fun ppf -> Fmt.pf ppf "%s %a" name (Fmt.hvbox ppv))


module BaseBytes :
sig
  include S.BASE with type t = Bytes.t

  val to_hex : t -> string
  val of_hex : string -> t
end = struct
  [@@@warning "-44"] (* XXX(dinosaure): shadowing of [compare] and [equal]. *)

  open Bytes

  type nonrec t = t

  let equal = equal
  let compare = compare
  let hash = Hashtbl.hash

  let pp = Fmt.iter Bytes.iter (Fmt.using Char.code (fun ppf -> Fmt.pf ppf "%02x"))

  module Set = Set.Make(struct type nonrec t = t let compare = compare end)
  module Map = Map.Make(struct type nonrec t = t let compare = compare end)

  let to_hex x =
    let `Hex v = Hex.of_string (Bytes.unsafe_to_string x) in v
  let of_hex x =
    Hex.to_string (`Hex x) |> Bytes.unsafe_of_string
end

module MakeDecoder (A : S.ANGSTROM)
  : S.DECODER with type t = A.t
               and type raw = Cstruct.t
               and type init = Cstruct.t
               and type error = [ `Decoder of string ]
= struct
  (* XXX(dinosaure): this decoder is on top of some assertion about
     the decoding of a git object. [Angstrom] can not consume all
     input (when we have an alteration specifically) and the client
     need to keep a part of the previous input but continue to feed
     the parser with a new input (to determine the choice of the
     alteration). In the git format, we can have this problem but for
     few bytes (something like ten bytes). So, we consider to use an
     internal buffer (than the size is bigger than what is needed) and
     we ensure than is not possible to keep more than the size of the
     internal buffer when we parse a Git object.

     However, this case appear in the code (when we don't have enough
     trailing space and writable space). This case appear when we
     don't parse a Git object but something else (which is not respect
     our assertions). And if this case appear, we can consider that
     someone try to cheat you. So we prefer to return an error.

     Obviously, in a better world with unicorn and pineapple pizza, we
     can just avoid this case. *)

  module Log =
  struct
    let src = Logs.Src.create "git.decoder" ~doc:"logs git's internal decoder"
    include (val Logs.src_log src : Logs.LOG)
  end

  type error = [ `Decoder of string ]
  type init = Cstruct.t
  type raw = Cstruct.t
  type t = A.t

  let pp_error ppf (`Decoder err) = ppe ~name:"`Decoder" Fmt.string ppf err

  type decoder =
    { state    : Angstrom.input -> Angstrom.Unbuffered.more -> A.t Angstrom.Unbuffered.state
    ; final    : Angstrom.Unbuffered.more
    ; internal : Cstruct.t
    ; max      : int }

  let kdone (consumed, value) =
    fun _ _ -> Angstrom.Unbuffered.Done (consumed, value)

  let kfail (consumed, path, err) =
    fun _ _ -> Angstrom.Unbuffered.Fail (consumed, path, err)

  let default raw =
    if Cstruct.len raw < 25 * 2
    then raise (Invalid_argument "The internal buffer is not enough to parse");
    (* XXX(dinosaure): So, if you read the comment before, you
       understand than the internal buffer need to be bigger than an
       alteration. I decide (because I'm the God) to accept only a
       buffer bigger than 25 bytes. Otherwise, we raise an
       [Invalid_argument]. *)

    Log.debug (fun l -> l "Starting to decode a Git object with \
                           a internal buffer (%d)." (Cstruct.len raw));

    let len = Cstruct.len raw in

    { state = (match Angstrom.Unbuffered.parse A.decoder with
          | Angstrom.Unbuffered.Done (committed, value) ->
            kdone (committed, value)
          | Angstrom.Unbuffered.Fail (committed, path, err) ->
            kfail (committed, path, err)
          | Angstrom.Unbuffered.Partial { Angstrom.Unbuffered.committed; continue; } ->
            Log.debug (fun l -> l "Retrieving Partial's angstrom result which \
                                   parsed %d byte(s) (= 0)." committed);
            assert (committed = 0);
            continue)
    ; final = Angstrom.Unbuffered.Incomplete
    ; internal = Cstruct.sub raw 0 0
    (* XXX(dinosaure): first, we consider than the internal buffer is empty. But
       keep calm, the physical buffer will not be free-ed. *)
    ; max      = len }

  let eval decoder =
    match decoder.state (`Bigstring (Cstruct.to_bigarray decoder.internal)) decoder.final with
    | Angstrom.Unbuffered.Done (consumed, value) -> `End (Cstruct.shift decoder.internal consumed, value)
    | Angstrom.Unbuffered.Fail (consumed, path, err) ->
      Log.err (fun l -> l "Retrieving an error in the current decoding: %s (%s)."
                  err (String.concat " > " path));
      `Error (Cstruct.shift decoder.internal consumed, `Decoder (String.concat " > " path ^ ": " ^ err))
    | Angstrom.Unbuffered.Partial
        { Angstrom.Unbuffered.committed; continue; } ->
      let decoder = { decoder with internal = Cstruct.shift decoder.internal committed
                                 ; state = continue } in
      `Await decoder

  let compress _ decoder =
    let off, len = 0, Cstruct.len decoder.internal in
    let buffer = Cstruct.of_bigarray ~off ~len decoder.internal.Cstruct.buffer in
    Log.debug (fun l -> l "Compressing the internal buffer of the current decoding.");
    Cstruct.blit decoder.internal 0 buffer 0 len;
    { decoder with internal = buffer }

  let refill input decoder =
    let len = Cstruct.len input in

    if len > decoder.max
    then begin
      (* XXX(dinosaure): it's to avoid to grow the internal buffer. *)
      Log.err (fun l -> l "The client want to refill the internal buffer by a bigger input.");

      Error (`Decoder (Fmt.strf "Input is too huge: we authorized only an \
                                 input lower or equal than %d" decoder.max))
    end else

      let _trailing_space =
        let { Cstruct.buffer; off; len } = decoder.internal in
        Bigarray.Array1.dim buffer - (off + len)
      in

      let _writable_space =
        let { Cstruct.buffer; len; _ } = decoder.internal in
        Bigarray.Array1.dim buffer - len
      in

      (if _trailing_space >= len
       then Ok decoder
       else if _writable_space >= len
       then Ok (compress input decoder)
       else begin
         Log.err (fun l -> l "trailing space:%d and writable space:%d, \
                              the alteration is not done, the error could \
                              be the size of the internal buffer (%d) or the input \
                              is malicious."
                     _trailing_space
                     _writable_space
                     (Bigarray.Array1.dim decoder.internal.Cstruct.buffer));
         Log.err (fun l -> l "Production of the error in Helper.MakeDecoder.refill.");
         Error (`Decoder "Input does not respect assertion, it may be malicious");
       end)
      |> function Error err -> Error err
                | Ok decoder ->
                  let internal = Cstruct.add_len decoder.internal len in

                  let off = Cstruct.len internal - len in
                  let ()  = Cstruct.blit input 0 internal off len in

{'fraction_non_alphanumeric': 0.0829133064516129, 'fraction_numerical': 0.003528225806451613, 'mean_word_length': 2.370779358674878, 'pattern_counts': {'":': 2, '<': 17, '<?xml version=': 0, '>': 74, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 11, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '303918', 'n_tokens_mistral': 4730, 'n_tokens_neox': 4363, 'n_words': 1890}