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

open OUnit

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

let max_ident_auth = U64.of_string "0x0000_ffff_ffff_ffff"

(*
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
         U64.one
         [| 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
         |]

let create_ok () =
  let w = Sid.WellKnown.everyone
  and s =
    match Sid.create U64.one [| U32.zero |] 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_nosa_fail () =
  match Sid.create U64.zero [| |] with
    | None -> ()
    | Some s -> assert_failure ("Sid.create succeeded despite lack of sas")

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

let create_iatoobig_fail () =
  let sas = Array.make 2 U32.one in
  let ia = U64.add max_ident_auth U64.one in
  match Sid.create ia sas with
    | None -> ()
    | Some s -> assert_failure ("Sid.create succeeded on invalid ident auth")

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 U64.one [| U32.zero |] 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_nosa_fail () =
  match Sid.of_string "S-1-1" with
    | Ok s ->
      assert_failure
        (Printf.sprintf "unexpectedly parsed garbage as SID [%s]"
           (Sid.to_string s))
    | Error e ->
      assert_equal e "input malformed: subauthority list failed “strict” \
                      validation (count=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 s1 = unwrap_of_string
      (Printf.sprintf "S-1-%s-%s-%s"
         (U32.to_string U32.max_int)
         (U32.to_string U32.max_int)
         (U32.to_string U32.max_int))
  and s2 = unwrap_of_string
      (Printf.sprintf "S-1-%s-%s-%s"
         (U64.to_string_hex max_ident_auth)
         (U32.to_string U32.max_int)
         (U32.to_string U32.max_int))
  in
  assert_equal (Sid.to_string s1) "S-1-4294967295-4294967295-4294967295";
  assert_equal (Sid.to_string s2) "S-1-0xffffffffffff-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 "input malformed: decimal identifier authority failed \
                      “strict” validation (value=18446744073709551615)"

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 sf_parse_iaxx_ok () =
  (* ias > UINT32_MAX → hexdigits; proof that MS are a bunch of weirdos *)
  let result = unwrap_of_string "S-1-0x0070c51cf00d-13-37"
  and expect =
    match Xxd.bytes_of "0102 0070 c51c f00d 0d00 0000 2500 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
  assert_bool
    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string result) (Sid.to_string expect))
    (Sid.equal result expect)

let sf_parse_iaxxoob_fail () =
  (* ias <= UINT32_MAX → decimal; hex not allowed *)
  match Sid.of_string "S-1-0x0000deadbeef-17-01" with
    | Error e ->
      let expect = "input malformed: hex-encoded identifier authority failed \
                    “strict” validation (value=3735928559)"
      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 sf_parse_iaxxinval_fail () =
  (* ias <= UINT32_MAX → decimal; hex not allowed *)
  match Sid.of_string "S-1-0xEA75BADB10OD-17-01" with
    | Error e ->
      let expect = "Invalid SID [S-1-0xEA75BADB10OD-17-01]: expected \
                    hexadecimal digit at position 16 while parsing ident \
                    auth, got ‘O’"
      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 sf_parse_iaxxshort_fail () =
  (* too few digits, need exactly 12 *)
  match Sid.of_string "S-1-0xdeadbeef-17-01" with
    | Error e ->
      let expect = "Invalid SID [S-1-0xdeadbeef-17-01]: expected \
                    hexadecimal digit at position 14 while parsing ident \
                    auth, got ‘-’"
      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 sf_parse_iaxxlong_fail () =
  (* too many digits, need exactly 12 *)
  match Sid.of_string "S-1-0xC01DC01DB100D-17-01" with
    | Error e ->
      let expect = "input malformed: subauthority list failed “strict” \
                    validation (count=0)"
      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 sf_print_iaxx_ok () =
  (* hex ia must be padded to 12 digits *)
  let str = "S-1-0x0070c51cf00d-13-37" in
  let sid = unwrap_of_string str in
  assert_equal
    ~msg:(Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string sid) str)
    (Sid.to_string sid) str

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

let mssf_parse_ok () =
  (* accept well-formed input *)
  let s = ms_unwrap_of_string "S-1-1-0"
  and z = Sid.create_unsafe U64.one [| U32.zero |] 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 mssf_parse_hex_junk_ok () =
  (* accept certain kinds of malformed input; note: we expect hex digit
     to be lowercase *)
  let samples =
    [ "S-1-0x000000000000-1"  , false, Some ("S-1-0-1"             , true )
    ; "S-1-0x0000000000ff-1"  , false, Some ("S-1-255-1"           , true )
    ; "S-1-0x0001000000ff-1"  , true , Some ("S-1-0x1000000ff-1"   , false)
    ; "S-1-0xffffffffffff-1"  , true , Some ("S-1-0xffffffffffff-1", true )
    ; "S-1-0xff00ff00ff-1"    , false, Some ("S-1-0xff00ff00ff-1"  , false)
    ; "S-1-0xff00ff00ff00ff-1", false, None
    ; "S-1-0x4200000000-1"    , false, Some ("S-1-0x4200000000-1"  , false)
    ; "S-1-0x1701d000-1"      , false, Some ("S-1-385994752-1"     , true )
    ; "S-1-0x1337000-1"       , false, Some ("S-1-20148224-1"      , true )
    ; "S-1-0xff-1"            , false, Some ("S-1-255-1"           , true )
    ; "S-1-4294967296-1"      , false, Some ("S-1-0x100000000-1"   , false)
    ; "S-1-01-1"              , false, Some ("S-1-1-1"             , true )
    ; "S-1-08-1"              , false, Some ("S-1-8-1"             , true )
    ; "S-1-001-1"             , false, Some ("S-1-1-1"             , true )
    ; "S-1-1"                 , false, None
    ; "S-1-5"                 , false, None
    ]
  in
  let is_wellformed s =
    match Sid.StringFmt.decode s with  Ok _ -> true | Error _ -> false in
  let check (input, inwell, output) =
    let () =
      if is_wellformed input then
        assert_bool
          (Printf.sprintf "Sid [%s] parsed a-ok despite strict mode" input)
          inwell
      else
        assert_bool
          (Printf.sprintf "Sid [%s] failed to parse with strict mode" input)
          (not inwell)
    in
    let () =
      match Sid.MSStringFmt.decode input, output with
        | Ok s, None ->
          assert_bool
            (Printf.sprintf "Sid [%s] unexpectedly parsed a-ok with MS mode"
               input)
            false
        | Ok s, Some (output, outwell) -> (* test round-trip results *)
          let reenc = Sid.MSStringFmt.encode s in
          let () =
            assert_bool
              (Printf.sprintf "Sid [%s] re-encoded as [%s] failed to match \
                               expected value of [%s]"
                 input reenc output)
              (output = reenc)
          in (* finally: validate behavior of strict parse against output *)
          assert_bool
            (Printf.sprintf "Sid [%s] re-encoded as [%s] unexpectedly \
                             %s in strict mode"
               input reenc
               (if outwell then "failed to parse" else "parsed ok"))
            (is_wellformed reenc = outwell)
        | Error _, None -> () (* bad even by MS standards *)
        | Error e, Some (output, _) ->
          assert_bool
            (Printf.sprintf "Sid [%s] failed to parse in MS mode (%s), \
                             expected [%s] after reconversion"
               input e output)
            false
    in ()
  in
  List.iter check samples


let pr_encode_null_ok () =
  let x =
    Sid.WellKnown.null
    |> Sid.PacketRep.encode
    |> 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.of_bytes ~blocklen:2
  and sbe = unwrap_of_string sid
            |> Sid.PacketRep.encode ~endian:Sid.PacketRep.Big
            |> 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.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 "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
            "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
            "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:Sid.PacketRep.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 "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 "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 "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 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 "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-nosa-fail"       >:: sf_parse_nosa_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
  ; "parse-iaxx-ok"         >:: sf_parse_iaxx_ok
  ; "parse-iaxxoob-fail"    >:: sf_parse_iaxxoob_fail
  ; "parse-iaxxinval-fail"  >:: sf_parse_iaxxinval_fail
  ; "parse-iaxxshort-fail"  >:: sf_parse_iaxxshort_fail
  ; "parse-iaxxlong-fail"   >:: sf_parse_iaxxlong_fail
  ; "print-iaxx-ok"         >:: sf_print_iaxx_ok
  ]

let ms_string_format_test = "ms-string-format-syntax" >:::
  [ "parse-ok"              >:: mssf_parse_ok
  ; "parse-hex-junk-ok"     >:: mssf_parse_hex_junk_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 toplevel_test = "toplevel" >:::
  [ "create-ok"             >:: create_ok
  ; "create-etoomany-fail"  >:: create_etoomany_fail
  ; "create-iatoobig-fail"  >:: create_iatoobig_fail
  ]

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