(* SPDX-License-Identifier: LGPL-3.0-only WITH OCaml-LGPL-linking-exception *)

open OUnit

module U64 = Stdint.Uint64
module U32 = Stdint.Uint32

(*
let () = Printexc.record_backtrace true ;;
 *)

(* S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14 *)
let max_sid =
      Sid.create_unsafe
         [| U32.zero      ; U32.one       ; U32.of_int  2
          ; U32.of_int  3 ; U32.of_int  4 ; U32.of_int  5
          ; U32.of_int  6 ; U32.of_int  7 ; U32.of_int  8
          ; U32.of_int  9 ; U32.of_int 10 ; U32.of_int 11
          ; U32.of_int 12 ; U32.of_int 13 ; U32.of_int 14
         |]
         U64.one

let create_ok () =
  let w = Sid.WellKnown.everyone
  and s =
    match Sid.create ~sa:[| U32.zero |] U64.one with
      | None -> assert_failure "Sid.create failed for S-1-0"
      | Some s -> s
  in
  assert_bool
    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string w))
    (Sid.equal s w)

let create_fail () =
  let sas = Array.make 16 U32.one in
  match Sid.create ~sa:sas U64.zero with
    | None -> ()
    | Some s -> assert_failure ("Sid.create succeeded on invalid sa array")

let unwrap_of_string s =
  match Sid.of_string s with
    | Error e ->
      assert_failure
        (Printf.sprintf "error parsing assumed well-formed sid [%s]: %s" s e)
    | Ok r -> r

let sf_parse_ok () =
  let s = unwrap_of_string "S-1-1-0"
  and z = Sid.create_unsafe [| U32.zero |] U64.one in
  assert_bool
    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string z))
    (Sid.equal s z);
  let w = Sid.WellKnown.world in
  assert_bool
    (Printf.sprintf "[%s] ≠ [well known: %s]"
       (Sid.to_string s) (Sid.to_string w))
    (Sid.equal s w)

let sf_parse_empty_fail () =
  match Sid.of_string "" with
    | Ok _ -> assert_failure "unexpectedly parsed the empty string"
    | Error e ->
      assert_equal e "Invalid SID: ‘’ too short to be a SID in string format"

let sf_parse_junk_fail () =
  match Sid.of_string "not a sid" with
    | Ok _ -> assert_failure "unexpectedly parsed junk inputs as SID"
    | Error e ->
      assert_equal
        e "Invalid SID [not a sid]: expected ‘S’ at position 0, found ‘n’"

let sf_parse_ver_junk_fail () =
  match Sid.of_string "S-I-3-3-7" with
    | Ok _ -> assert_failure "unexpectedly parsed junk inputs as SID"
    | Error e ->
      assert_equal
        e "Invalid SID [S-I-3-3-7]: expected ‘1’ at position 2, found ‘I’"

let sf_parse_ver_inval_fail () =
  match Sid.of_string "S-2-3-3-7" with
    | Ok _ -> assert_failure "unexpectedly parsed junk inputs as SID"
    | Error e ->
      assert_equal
        e "Invalid SID [S-2-3-3-7]: expected ‘1’ at position 2, found ‘2’"

let sf_parse_ver_inval2_fail () =
  match Sid.of_string "S-10-0" with
    | Ok _ -> assert_failure "unexpectedly parsed junk inputs as SID"
    | Error e ->
      assert_equal
        e "Invalid SID [S-10-0]: expected ‘-’ at position 3, found ‘0’"

let sf_parse_trailing_ok () =
  let s = unwrap_of_string "S-1-0-0-" in
  assert_equal (Sid.to_string s) "S-1-0-0"

let sf_parse_maxint_ok () =
  let s = unwrap_of_string
      (Printf.sprintf "S-1-281474976710655-%s-%s"
         (U32.to_string U32.max_int)
         (U32.to_string U32.max_int))
  in
  assert_equal (Sid.to_string s) "S-1-281474976710655-4294967295-4294967295"

let sf_parse_oobia_fail () =
  match Sid.of_string
          (Printf.sprintf "S-1-%s-42" (U64.to_string U64.max_int))
  with
    | Ok _ -> assert_failure "unexpectedly parsed the out of bounds subauth"
    | Error e ->
      assert_equal e "Invalid SID: identifier authority cannot fit 6 B \
                      (281474976710655)"

let sf_parse_oobsa_fail () =
  match Sid.of_string
          (Printf.sprintf "S-1-42-%s" (U64.to_string U64.max_int))
  with
    | Ok _ -> assert_failure "unexpectedly parsed the out of bounds subauth"
    | Error e ->
      assert_equal e "Invalid SID: error parsing subauth at position 7, \
                      (err: Uint32.of_string)"

let sf_parse_long_ok () =
  let s = unwrap_of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14"
  and l = max_sid in
  assert_bool
    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string l))
    (Sid.equal s l)

let sf_parse_too_long_ok () =
  (* must ignore trailing subauths *)
  let s1 = unwrap_of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15"
  and s2 = unwrap_of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15-16-17"
  and l = max_sid in
  assert_bool
    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s1) (Sid.to_string l))
    (Sid.equal s1 l);
  assert_bool
    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s2) (Sid.to_string l))
    (Sid.equal s2 l)

let pr_encode_null_ok () =
  let x =
    Sid.WellKnown.null
    |> Sid.PacketRep.encode
    |> Xxd.xxd_of_bytes ~blocklen:2
  in
  let expect = "0101 0000 0000 0000 0000 0000" in
  (*            vvcc iiii iiii iiii ssss ssss *)
  assert_equal
    ~msg:(Printf.sprintf "[%s] ≠ [%s]" x expect)
    x expect

let pr_encode_be_ok () =
  let sid = "S-1-0-42" in
  let sle = unwrap_of_string sid
            |> Sid.PacketRep.encode
            |> Xxd.xxd_of_bytes ~blocklen:2
  and sbe = unwrap_of_string sid
            |> Sid.PacketRep.encode ~endian:Big
            |> Xxd.xxd_of_bytes ~blocklen:2
  in
  let expect_le = "0101 0000 0000 0000 2a00 0000"
  and expect_be = "0101 0000 0000 0000 0000 002a" in
  (*               vvcc iiii iiii iiii ssss ssss *)
  assert_equal
    ~msg:(Printf.sprintf "[%s] ≠ [%s]" sle expect_le)
    sle expect_le;
  assert_equal
    ~msg:(Printf.sprintf "[%s] ≠ [%s]" sbe expect_be)
    sbe expect_be

let pr_encode_all_ok () =
  let x =
    Sid.WellKnown.everyone
    |> Sid.PacketRep.encode
    |> Xxd.xxd_of_bytes ~blocklen:2
  in
  let expect = "0101 0000 0000 0001 0000 0000" in
  (*            vvcc iiii iiii iiii ssss ssss *)
  assert_equal
    ~msg:(Printf.sprintf "[%s] ≠ [%s]" x expect)
    x expect

let pr_decode_all_ok () =
  let s =
    match
      Xxd.bytes_of_xxd "0101 0000 0000 0001 0000 0000"
      (*                vvcc iiii iiii iiii ssss ssss *)
      |> Sid.PacketRep.decode
    with
      | Ok s -> s
      | Error e ->
        assert_failure
          (Printf.sprintf "error decoding SID: %s" e)
  in
  let w = Sid.WellKnown.world in
  assert_bool
    (Printf.sprintf "[%s] ≠ [%s]"
       (Sid.to_string s) (Sid.to_string w))
    (Sid.equal s w)

let pr_decode_be_ok () =
  let sid = unwrap_of_string "S-1-1-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15"
  and sle =
    match Xxd.bytes_of_xxd
            "010f 0000 0000 0001 \
             0100 0000 0200 0000 0300 0000 0400 0000 \
             0500 0000 0600 0000 0700 0000 0800 0000 \
             0900 0000 0a00 0000 0b00 0000 0c00 0000 \
             0d00 0000 0e00 0000 0f00 0000"
      |> Sid.PacketRep.decode
    with
      | Ok s -> s
      | Error e ->
        assert_failure
          (Printf.sprintf "error decoding SID: %s" e)
  and sbe =
    match Xxd.bytes_of_xxd
            "010f 0000 0000 0001 \
             0000 0001 0000 0002 0000 0003 0000 0004 \
             0000 0005 0000 0006 0000 0007 0000 0008 \
             0000 0009 0000 000a 0000 000b 0000 000c \
             0000 000d 0000 000e 0000 000f"
      |> Sid.PacketRep.decode ~endian:Big
    with
      | Ok s -> s
      | Error e ->
        assert_failure
          (Printf.sprintf "error decoding SID: %s" e)
  in
  assert_bool
    (Printf.sprintf "le: [%s] ≠ [%s]" (Sid.to_string sid) (Sid.to_string sle))
    (Sid.equal sid sle);
  assert_bool
    (Printf.sprintf "be: [%s] ≠ [%s]" (Sid.to_string sid) (Sid.to_string sbe))
    (Sid.equal sid sbe)

let pr_decode_version_fail () =
  let b = Xxd.bytes_of_xxd "0201 0000 0000 0001 0000 0000" in
  (*                        vvcc iiii iiii iiii ssss ssss *)
  match Sid.PacketRep.decode b with
    | Error e ->
      let expect = "input malformed: expected SID version=0x01, got 0x02" in
      assert_equal
        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
        e expect
    | Ok s ->
      assert_failure
        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
           (Sid.to_string s))

let pr_decode_sacount_fail () =
  let b = Xxd.bytes_of_xxd "0110 0000 0000 0001 0000 0000" in
  (*                        vvcc iiii iiii iiii ssss ssss *)
  match Sid.PacketRep.decode b with
    | Error e ->
      let expect = "input malformed: up to 15 subAuthority elements \
                    permitted, 16 specified" in
      assert_equal
        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
        e expect
    | Ok s ->
      assert_failure
        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
           (Sid.to_string s))

let pr_decode_short_fail () =
  let b = Xxd.bytes_of_xxd "0105 0000 0000 00" in
  (*                        vvcc iiii iiii ii…… *)
  match Sid.PacketRep.decode b with
    | Error e ->
      let expect = "bad input size: expected 8–68 B, got 7 B" in
      assert_equal
        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
        e expect
    | Ok s ->
      assert_failure
        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
           (Sid.to_string s))

let pr_decode_long_fail () =
  let r =
    "010e 0000 0000 0000 0100 0000 0200 0000 \
     0300 0000 0400 0000 0500 0000 0600 0000 \
     0700 0000 0800 0000 0900 0000 0a00 0000 \
     0b00 0000 0c00 0000 0d00 0000 0e00 0000 \
     0f00 0000 1000 0000"
  in
  let b = Xxd.bytes_of_xxd r in
  match Sid.PacketRep.decode b with
    | Error e ->
      let expect = "bad input size: expected 8–68 B, got 72 B" in
      assert_equal
        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
        e expect
    | Ok s ->
      assert_failure
        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
           (Sid.to_string s))

let pr_decode_odd_fail () =
  match
    Xxd.bytes_of_xxd "0101 0000 0000 0000 0100 0000 0200"
    (*                vvcc iiii iiii iiii ssss ssss ssss …
                      upper half word missing *)
    |> Sid.PacketRep.decode
  with
    | Error e ->
      let expect = "bad input size: not divisible by word length (4)" in
      assert_equal
        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
        e expect
    | Ok s ->
      assert_failure
        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
           (Sid.to_string s))


let string_format_test = "string-format-syntax" >:::
  [ "parse-ok"              >:: sf_parse_ok
  ; "parse-empty-fail"      >:: sf_parse_empty_fail
  ; "parse-junk-fail"       >:: sf_parse_junk_fail
  ; "parse-ver-junk-fail"   >:: sf_parse_ver_junk_fail
  ; "parse-ver-inval-fail"  >:: sf_parse_ver_inval_fail
  ; "parse-ver-inval2-fail" >:: sf_parse_ver_inval2_fail
  ; "parse-trailing-ok"     >:: sf_parse_trailing_ok
  ; "parse-maxint-ok"       >:: sf_parse_maxint_ok
  ; "parse-oobia-fail"      >:: sf_parse_oobia_fail
  ; "parse-oobsa-fail"      >:: sf_parse_oobsa_fail
  ; "parse-long-ok"         >:: sf_parse_long_ok
  ; "parse-too-long-ok"     >:: sf_parse_too_long_ok
  ]

let packet_rep_test = "packet-rep" >:::
  [ "encode-null-ok"        >:: pr_encode_null_ok
  ; "encode-all-ok"         >:: pr_encode_all_ok
  ; "encode-be-ok"          >:: pr_encode_be_ok
  ; "decode-all-ok"         >:: pr_decode_all_ok
  ; "decode-be-ok"          >:: pr_decode_be_ok
  ; "decode-version-fail"   >:: pr_decode_version_fail
  ; "decode-sacount-fail"   >:: pr_decode_sacount_fail
  ; "decode-short-fail"     >:: pr_decode_short_fail
  ; "decode-long-fail"      >:: pr_decode_long_fail
  ; "decode-odd-fail"       >:: pr_decode_odd_fail
  ]

let () =
  ignore (run_test_tt_main string_format_test);
  ignore (run_test_tt_main packet_rep_test   )