Merge loops/fed-prims into architecture: fed-sx host primitives (Phases A-I)
Pure-OCaml WASM-safe crypto/CID surface + native HTTP server: - crypto-sha256/sha512 (FIPS 180-4), crypto-sha3-256 (FIPS 202) - cbor-encode/decode (deterministic dag-cbor), cid-from-bytes/from-sx (CIDv1) - ed25519-verify (RFC 8032), rsa-sha256-verify (PKCS#1 v1.5, RFC 8017) - file-list-dir (native-safe), http-listen (native-only, bin/sx_server.ml) Unblocks Erlang Phase 8 BIFs (erlang-on-sx.md blocker -> RESOLVED). Merged: build green, 63 crypto tests pass, WASM boot OK, http test 6/6, Erlang conformance 715/715, no regression. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
142
hosts/ocaml/lib/sx_cbor.ml
Normal file
142
hosts/ocaml/lib/sx_cbor.ml
Normal file
@@ -0,0 +1,142 @@
|
||||
(** dag-cbor encode / decode — pure OCaml, WASM-safe.
|
||||
|
||||
RFC 8949 deterministic subset as constrained by IPLD dag-cbor
|
||||
(RFC 8742): unsigned/negative ints, text strings, arrays, maps
|
||||
with keys sorted by **length-then-bytewise**, bool, null, and
|
||||
tag 42 (CID link, decode-side passthrough). Floats are not
|
||||
supported (no fed-sx shape needs them yet) — encoding a [Number]
|
||||
or decoding a float head raises. Reference: RFC 8949 §3, §4.2. *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
exception Cbor_error of string
|
||||
|
||||
(* ---- Encoder ---- *)
|
||||
|
||||
let write_head buf major v =
|
||||
let m = major lsl 5 in
|
||||
if v < 24 then
|
||||
Buffer.add_char buf (Char.chr (m lor v))
|
||||
else if v < 0x100 then begin
|
||||
Buffer.add_char buf (Char.chr (m lor 24));
|
||||
Buffer.add_char buf (Char.chr v)
|
||||
end else if v < 0x10000 then begin
|
||||
Buffer.add_char buf (Char.chr (m lor 25));
|
||||
Buffer.add_char buf (Char.chr ((v lsr 8) land 0xFF));
|
||||
Buffer.add_char buf (Char.chr (v land 0xFF))
|
||||
end else if v < 0x100000000 then begin
|
||||
Buffer.add_char buf (Char.chr (m lor 26));
|
||||
for i = 3 downto 0 do
|
||||
Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
|
||||
done
|
||||
end else begin
|
||||
Buffer.add_char buf (Char.chr (m lor 27));
|
||||
for i = 7 downto 0 do
|
||||
Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
|
||||
done
|
||||
end
|
||||
|
||||
(* dag-cbor map key order: shorter key first, then bytewise. *)
|
||||
let key_order a b =
|
||||
let la = String.length a and lb = String.length b in
|
||||
if la <> lb then compare la lb else compare a b
|
||||
|
||||
let rec encode_into buf (v : value) : unit =
|
||||
match v with
|
||||
| Integer n ->
|
||||
if n >= 0 then write_head buf 0 n
|
||||
else write_head buf 1 (-1 - n)
|
||||
| String s ->
|
||||
write_head buf 3 (String.length s);
|
||||
Buffer.add_string buf s
|
||||
| Symbol s | Keyword s ->
|
||||
write_head buf 3 (String.length s);
|
||||
Buffer.add_string buf s
|
||||
| Bool false -> Buffer.add_char buf '\xf4'
|
||||
| Bool true -> Buffer.add_char buf '\xf5'
|
||||
| Nil -> Buffer.add_char buf '\xf6'
|
||||
| List items ->
|
||||
write_head buf 4 (List.length items);
|
||||
List.iter (encode_into buf) items
|
||||
| Dict d ->
|
||||
let keys = Hashtbl.fold (fun k _ acc -> k :: acc) d [] in
|
||||
let keys = List.sort_uniq key_order keys in
|
||||
write_head buf 5 (List.length keys);
|
||||
List.iter (fun k ->
|
||||
write_head buf 3 (String.length k);
|
||||
Buffer.add_string buf k;
|
||||
encode_into buf (Hashtbl.find d k)) keys
|
||||
| Number _ ->
|
||||
raise (Cbor_error "cbor-encode: floats unsupported (dag-cbor subset)")
|
||||
| _ ->
|
||||
raise (Cbor_error
|
||||
("cbor-encode: unencodable value " ^ type_of v))
|
||||
|
||||
let encode (v : value) : string =
|
||||
let buf = Buffer.create 64 in
|
||||
encode_into buf v;
|
||||
Buffer.contents buf
|
||||
|
||||
(* ---- Decoder ---- *)
|
||||
|
||||
let decode (s : string) : value =
|
||||
let pos = ref 0 in
|
||||
let len = String.length s in
|
||||
let byte () =
|
||||
if !pos >= len then raise (Cbor_error "cbor-decode: truncated");
|
||||
let c = Char.code s.[!pos] in incr pos; c
|
||||
in
|
||||
let read_uint ai =
|
||||
if ai < 24 then ai
|
||||
else if ai = 24 then byte ()
|
||||
else if ai = 25 then let a = byte () in let b = byte () in (a lsl 8) lor b
|
||||
else if ai = 26 then begin
|
||||
let v = ref 0 in
|
||||
for _ = 0 to 3 do v := (!v lsl 8) lor byte () done; !v
|
||||
end else if ai = 27 then begin
|
||||
let v = ref 0 in
|
||||
for _ = 0 to 7 do v := (!v lsl 8) lor byte () done; !v
|
||||
end else raise (Cbor_error "cbor-decode: bad additional info")
|
||||
in
|
||||
let read_bytes n =
|
||||
if !pos + n > len then raise (Cbor_error "cbor-decode: truncated");
|
||||
let r = String.sub s !pos n in pos := !pos + n; r
|
||||
in
|
||||
let rec item () =
|
||||
let b = byte () in
|
||||
let major = b lsr 5 and ai = b land 0x1f in
|
||||
match major with
|
||||
| 0 -> Integer (read_uint ai)
|
||||
| 1 -> Integer (-1 - read_uint ai)
|
||||
| 2 -> String (read_bytes (read_uint ai))
|
||||
| 3 -> String (read_bytes (read_uint ai))
|
||||
| 4 ->
|
||||
let n = read_uint ai in
|
||||
List (List.init n (fun _ -> item ()))
|
||||
| 5 ->
|
||||
let n = read_uint ai in
|
||||
let d = make_dict () in
|
||||
for _ = 1 to n do
|
||||
let k = match item () with
|
||||
| String k -> k
|
||||
| _ -> raise (Cbor_error "cbor-decode: non-string map key")
|
||||
in
|
||||
Hashtbl.replace d k (item ())
|
||||
done;
|
||||
Dict d
|
||||
| 6 ->
|
||||
(* Tag: tag-42 CID link → pass the inner item through. *)
|
||||
ignore (read_uint ai); item ()
|
||||
| 7 ->
|
||||
(match ai with
|
||||
| 20 -> Bool false
|
||||
| 21 -> Bool true
|
||||
| 22 -> Nil
|
||||
| 23 -> Nil
|
||||
| _ ->
|
||||
raise (Cbor_error
|
||||
"cbor-decode: floats/simple unsupported (dag-cbor subset)"))
|
||||
| _ -> raise (Cbor_error "cbor-decode: bad major type")
|
||||
in
|
||||
let v = item () in
|
||||
v
|
||||
66
hosts/ocaml/lib/sx_cid.ml
Normal file
66
hosts/ocaml/lib/sx_cid.ml
Normal file
@@ -0,0 +1,66 @@
|
||||
(** CIDv1 computation — pure OCaml, WASM-safe.
|
||||
|
||||
Multihash + CIDv1 + multibase base32-lower (RFC 4648, no pad,
|
||||
multibase prefix 'b'). Codecs: dag-cbor 0x71, raw 0x55. Hash
|
||||
codes: sha2-256 0x12, sha3-256 0x16. Reference: the multiformats
|
||||
specs (unsigned-varint, multihash, cid, multibase). No deps. *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
(* Unsigned LEB128 (multiformats unsigned-varint). *)
|
||||
let varint (n : int) : string =
|
||||
let buf = Buffer.create 4 in
|
||||
let n = ref n in
|
||||
let cont = ref true in
|
||||
while !cont do
|
||||
let b = !n land 0x7f in
|
||||
n := !n lsr 7;
|
||||
if !n = 0 then (Buffer.add_char buf (Char.chr b); cont := false)
|
||||
else Buffer.add_char buf (Char.chr (b lor 0x80))
|
||||
done;
|
||||
Buffer.contents buf
|
||||
|
||||
(* RFC 4648 base32 lowercase, no padding. *)
|
||||
let b32_alpha = "abcdefghijklmnopqrstuvwxyz234567"
|
||||
|
||||
let base32_lower (s : string) : string =
|
||||
let buf = Buffer.create ((String.length s * 8 + 4) / 5) in
|
||||
let acc = ref 0 and bits = ref 0 in
|
||||
String.iter (fun c ->
|
||||
acc := (!acc lsl 8) lor (Char.code c);
|
||||
bits := !bits + 8;
|
||||
while !bits >= 5 do
|
||||
bits := !bits - 5;
|
||||
Buffer.add_char buf b32_alpha.[(!acc lsr !bits) land 0x1f]
|
||||
done) s;
|
||||
if !bits > 0 then
|
||||
Buffer.add_char buf b32_alpha.[(!acc lsl (5 - !bits)) land 0x1f];
|
||||
Buffer.contents buf
|
||||
|
||||
(* "abef" -> the 2 raw bytes. *)
|
||||
let unhex (h : string) : string =
|
||||
let n = String.length h / 2 in
|
||||
let b = Bytes.create n in
|
||||
for i = 0 to n - 1 do
|
||||
Bytes.set b i
|
||||
(Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
|
||||
done;
|
||||
Bytes.unsafe_to_string b
|
||||
|
||||
(* multihash = varint(code) || varint(len) || digest *)
|
||||
let multihash (code : int) (digest : string) : string =
|
||||
varint code ^ varint (String.length digest) ^ digest
|
||||
|
||||
(* CIDv1 = 0x01 || varint(codec) || multihash ; multibase 'b' base32. *)
|
||||
let cidv1 (codec : int) (mh : string) : string =
|
||||
"b" ^ base32_lower ("\x01" ^ varint codec ^ mh)
|
||||
|
||||
let codec_dag_cbor = 0x71
|
||||
let mh_sha2_256 = 0x12
|
||||
|
||||
(* Canonicalize an SX value: dag-cbor encode -> sha2-256 ->
|
||||
multihash -> CIDv1 (dag-cbor codec). *)
|
||||
let cid_from_sx (v : value) : string =
|
||||
let cbor = Sx_cbor.encode v in
|
||||
let digest = unhex (Sx_sha2.sha256_hex cbor) in
|
||||
cidv1 codec_dag_cbor (multihash mh_sha2_256 digest)
|
||||
289
hosts/ocaml/lib/sx_ed25519.ml
Normal file
289
hosts/ocaml/lib/sx_ed25519.ml
Normal file
@@ -0,0 +1,289 @@
|
||||
(** Ed25519 signature verification — pure OCaml, WASM-safe.
|
||||
|
||||
RFC 8032 §5.1.7 cofactorless verify over edwards25519. Includes a
|
||||
minimal arbitrary-precision unsigned bignum (no Zarith / no deps)
|
||||
and twisted-Edwards extended-coordinate point arithmetic. Verify
|
||||
is total: malformed inputs return [false], never raise. SHA-512
|
||||
is reused from {!Sx_sha2}. Reference: RFC 8032, RFC 7748. *)
|
||||
|
||||
(* ---- Minimal bignum: int array, little-endian, base 2^26. ---- *)
|
||||
|
||||
let bits = 26
|
||||
let base = 1 lsl bits
|
||||
let mask = base - 1
|
||||
|
||||
type bn = int array (* normalized: no high zero limbs, length >= 1 *)
|
||||
|
||||
let norm (a : bn) : bn =
|
||||
let n = ref (Array.length a) in
|
||||
while !n > 1 && a.(!n - 1) = 0 do decr n done;
|
||||
if !n = Array.length a then a else Array.sub a 0 !n
|
||||
|
||||
let bzero : bn = [| 0 |]
|
||||
let of_int n : bn =
|
||||
if n = 0 then bzero
|
||||
else begin
|
||||
let r = ref [] and n = ref n in
|
||||
while !n > 0 do r := (!n land mask) :: !r; n := !n lsr bits done;
|
||||
norm (Array.of_list (List.rev !r))
|
||||
end
|
||||
|
||||
let is_zero (a : bn) = Array.length a = 1 && a.(0) = 0
|
||||
|
||||
let cmp (a : bn) (b : bn) : int =
|
||||
let a = norm a and b = norm b in
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
if la <> lb then compare la lb
|
||||
else begin
|
||||
let r = ref 0 and i = ref (la - 1) in
|
||||
while !r = 0 && !i >= 0 do
|
||||
if a.(!i) <> b.(!i) then r := compare a.(!i) b.(!i);
|
||||
decr i
|
||||
done; !r
|
||||
end
|
||||
|
||||
let add (a : bn) (b : bn) : bn =
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
let n = (max la lb) + 1 in
|
||||
let r = Array.make n 0 in
|
||||
let carry = ref 0 in
|
||||
for i = 0 to n - 1 do
|
||||
let s = !carry
|
||||
+ (if i < la then a.(i) else 0)
|
||||
+ (if i < lb then b.(i) else 0) in
|
||||
r.(i) <- s land mask; carry := s lsr bits
|
||||
done;
|
||||
norm r
|
||||
|
||||
(* a - b, requires a >= b *)
|
||||
let sub (a : bn) (b : bn) : bn =
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
let r = Array.make la 0 in
|
||||
let borrow = ref 0 in
|
||||
for i = 0 to la - 1 do
|
||||
let s = a.(i) - !borrow - (if i < lb then b.(i) else 0) in
|
||||
if s < 0 then (r.(i) <- s + base; borrow := 1)
|
||||
else (r.(i) <- s; borrow := 0)
|
||||
done;
|
||||
norm r
|
||||
|
||||
let mul (a : bn) (b : bn) : bn =
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
let r = Array.make (la + lb) 0 in
|
||||
for i = 0 to la - 1 do
|
||||
let carry = ref 0 in
|
||||
for j = 0 to lb - 1 do
|
||||
let s = r.(i + j) + a.(i) * b.(j) + !carry in
|
||||
r.(i + j) <- s land mask; carry := s lsr bits
|
||||
done;
|
||||
r.(i + lb) <- r.(i + lb) + !carry
|
||||
done;
|
||||
norm r
|
||||
|
||||
let numbits (a : bn) : int =
|
||||
let a = norm a in
|
||||
let hi = Array.length a - 1 in
|
||||
if hi = 0 && a.(0) = 0 then 0
|
||||
else begin
|
||||
let b = ref 0 and v = ref a.(hi) in
|
||||
while !v > 0 do incr b; v := !v lsr 1 done;
|
||||
hi * bits + !b
|
||||
end
|
||||
|
||||
let bit (a : bn) (i : int) : int =
|
||||
let limb = i / bits and off = i mod bits in
|
||||
if limb >= Array.length a then 0 else (a.(limb) lsr off) land 1
|
||||
|
||||
(* r = a mod m (m > 0), binary long division. *)
|
||||
let bn_mod (a : bn) (m : bn) : bn =
|
||||
if cmp a m < 0 then norm a
|
||||
else begin
|
||||
let r = ref bzero in
|
||||
for i = numbits a - 1 downto 0 do
|
||||
(* r = r*2 + bit *)
|
||||
r := add !r !r;
|
||||
if bit a i = 1 then r := add !r [| 1 |];
|
||||
if cmp !r m >= 0 then r := sub !r m
|
||||
done;
|
||||
!r
|
||||
end
|
||||
|
||||
let div_small (a : bn) (d : int) : bn =
|
||||
let la = Array.length a in
|
||||
let q = Array.make la 0 in
|
||||
let rem = ref 0 in
|
||||
for i = la - 1 downto 0 do
|
||||
let cur = (!rem lsl bits) lor a.(i) in
|
||||
q.(i) <- cur / d; rem := cur mod d
|
||||
done;
|
||||
norm q
|
||||
|
||||
let powmod (b0 : bn) (e : bn) (m : bn) : bn =
|
||||
let result = ref [| 1 |] and b = ref (bn_mod b0 m) in
|
||||
let nb = numbits e in
|
||||
for i = 0 to nb - 1 do
|
||||
if bit e i = 1 then result := bn_mod (mul !result !b) m;
|
||||
b := bn_mod (mul !b !b) m
|
||||
done;
|
||||
!result
|
||||
|
||||
let of_bytes_le (s : string) : bn =
|
||||
let acc = ref bzero in
|
||||
for i = String.length s - 1 downto 0 do
|
||||
acc := add (mul !acc (of_int 256)) (of_int (Char.code s.[i]))
|
||||
done;
|
||||
!acc
|
||||
|
||||
let to_bytes_le (a : bn) (n : int) : string =
|
||||
let b = Bytes.make n '\000' in
|
||||
let cur = ref (norm a) in
|
||||
for i = 0 to n - 1 do
|
||||
let q = div_small !cur 256 in
|
||||
let r =
|
||||
let qm = mul q (of_int 256) in
|
||||
let d = sub !cur qm in
|
||||
if is_zero d then 0 else d.(0)
|
||||
in
|
||||
Bytes.set b i (Char.chr r);
|
||||
cur := q
|
||||
done;
|
||||
Bytes.unsafe_to_string b
|
||||
|
||||
(* ---- Field GF(p), p = 2^255 - 19 ---- *)
|
||||
|
||||
let p =
|
||||
let twop255 = Array.make 11 0 in (* 11*26 = 286 > 255 *)
|
||||
let limb = 255 / bits and off = 255 mod bits in
|
||||
twop255.(limb) <- 1 lsl off;
|
||||
sub (norm twop255) (of_int 19)
|
||||
|
||||
let fmod a = bn_mod a p
|
||||
let fadd a b = fmod (add a b)
|
||||
let fsub a b = fmod (add a (sub p (fmod b)))
|
||||
let fmul a b = fmod (mul a b)
|
||||
let fpow a e = powmod a e p
|
||||
let finv a = fpow a (sub p (of_int 2)) (* Fermat: a^(p-2) *)
|
||||
|
||||
(* group order L = 2^252 + 27742317777372353535851937790883648493 *)
|
||||
let ell =
|
||||
of_bytes_le
|
||||
"\xed\xd3\xf5\x5c\x1a\x63\x12\x58\xd6\x9c\xf7\xa2\xde\xf9\xde\x14\
|
||||
\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10"
|
||||
|
||||
(* d = -121665 / 121666 mod p *)
|
||||
let dconst =
|
||||
let inv666 = finv (of_int 121666) in
|
||||
fmod (mul (fsub (of_int 0) (of_int 121665)) inv666)
|
||||
|
||||
(* sqrt(-1) = 2^((p-1)/4) mod p *)
|
||||
let sqrtm1 = fpow (of_int 2) (div_small (sub p (of_int 1)) 4)
|
||||
|
||||
(* ---- edwards25519 points in extended coords (X,Y,Z,T) ---- *)
|
||||
|
||||
type pt = { x : bn; y : bn; z : bn; t : bn }
|
||||
|
||||
let identity = { x = bzero; y = of_int 1; z = of_int 1; t = bzero }
|
||||
|
||||
(* add-2008-hwcd-3, complete for a = -1 on ed25519 *)
|
||||
let padd (p1 : pt) (p2 : pt) : pt =
|
||||
let a = fmul (fsub p1.y p1.x) (fsub p2.y p2.x) in
|
||||
let b = fmul (fadd p1.y p1.x) (fadd p2.y p2.x) in
|
||||
let c = fmul (fmul p1.t (fmul (of_int 2) dconst)) p2.t in
|
||||
let dd = fmul (fmul p1.z (of_int 2)) p2.z in
|
||||
let e = fsub b a in
|
||||
let f = fsub dd c in
|
||||
let g = fadd dd c in
|
||||
let h = fadd b a in
|
||||
{ x = fmul e f; y = fmul g h; t = fmul e h; z = fmul f g }
|
||||
|
||||
let scalar_mul (n : bn) (q : pt) : pt =
|
||||
let r = ref identity in
|
||||
for i = numbits n - 1 downto 0 do
|
||||
r := padd !r !r;
|
||||
if bit n i = 1 then r := padd !r q
|
||||
done;
|
||||
!r
|
||||
|
||||
let pnegate (q : pt) : pt =
|
||||
{ q with x = fsub (of_int 0) q.x; t = fsub (of_int 0) q.t }
|
||||
|
||||
(* Decompress a 32-byte little-endian point encoding. *)
|
||||
let decompress (s : string) : pt option =
|
||||
if String.length s <> 32 then None
|
||||
else begin
|
||||
let sign = (Char.code s.[31] lsr 7) land 1 in
|
||||
let s' = Bytes.of_string s in
|
||||
Bytes.set s' 31 (Char.chr (Char.code s.[31] land 0x7f));
|
||||
let y = of_bytes_le (Bytes.unsafe_to_string s') in
|
||||
if cmp y p >= 0 then None
|
||||
else begin
|
||||
let y2 = fmul y y in
|
||||
let u = fsub y2 (of_int 1) in
|
||||
let v = fadd (fmul dconst y2) (of_int 1) in
|
||||
(* x = u v^3 (u v^7)^((p-5)/8) *)
|
||||
let v3 = fmul (fmul v v) v in
|
||||
let v7 = fmul (fmul v3 v3) v in
|
||||
let exp = div_small (sub p (of_int 5)) 8 in
|
||||
let x0 = fmul (fmul u v3) (fpow (fmul u v7) exp) in
|
||||
let vx2 = fmul v (fmul x0 x0) in
|
||||
let x =
|
||||
if cmp vx2 u = 0 then Some x0
|
||||
else if cmp vx2 (fsub (of_int 0) u) = 0 then Some (fmul x0 sqrtm1)
|
||||
else None
|
||||
in
|
||||
match x with
|
||||
| None -> None
|
||||
| Some x ->
|
||||
if is_zero x && sign = 1 then None
|
||||
else begin
|
||||
let x = if (bit x 0) <> sign then fsub (of_int 0) x else x in
|
||||
Some { x; y; z = of_int 1; t = fmul x y }
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
(* Encode a point to 32-byte little-endian (y with x-parity bit). *)
|
||||
let encode (q : pt) : string =
|
||||
let zi = finv q.z in
|
||||
let x = fmul q.x zi and y = fmul q.y zi in
|
||||
let b = Bytes.of_string (to_bytes_le y 32) in
|
||||
let last = Char.code (Bytes.get b 31) lor ((bit x 0) lsl 7) in
|
||||
Bytes.set b 31 (Char.chr last);
|
||||
Bytes.unsafe_to_string b
|
||||
|
||||
(* base point: y = 4/5 mod p, x even (sign 0). *)
|
||||
let base_point =
|
||||
let by = fmul (of_int 4) (finv (of_int 5)) in
|
||||
match decompress (to_bytes_le by 32) with
|
||||
| Some pt -> pt
|
||||
| None -> failwith "ed25519: base point decompress failed"
|
||||
|
||||
let unhex (h : string) : string =
|
||||
let n = String.length h / 2 in
|
||||
let b = Bytes.create n in
|
||||
for i = 0 to n - 1 do
|
||||
Bytes.set b i
|
||||
(Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
|
||||
done;
|
||||
Bytes.unsafe_to_string b
|
||||
|
||||
let sha512_bytes s = unhex (Sx_sha2.sha512_hex s)
|
||||
|
||||
(* RFC 8032 §5.1.7 cofactorless: encode([S]B - [k]A) == R. *)
|
||||
let verify ~pubkey ~msg ~sig_ : bool =
|
||||
if String.length pubkey <> 32 || String.length sig_ <> 64 then false
|
||||
else
|
||||
let rb = String.sub sig_ 0 32 in
|
||||
let sb = String.sub sig_ 32 32 in
|
||||
let s = of_bytes_le sb in
|
||||
if cmp s ell >= 0 then false
|
||||
else
|
||||
match decompress pubkey with
|
||||
| None -> false
|
||||
| Some a ->
|
||||
let h = sha512_bytes (rb ^ pubkey ^ msg) in
|
||||
let k = bn_mod (of_bytes_le h) ell in
|
||||
let sb_pt = scalar_mul s base_point in
|
||||
let ka = scalar_mul k a in
|
||||
let chk = padd sb_pt (pnegate ka) in
|
||||
(try encode chk = rb with _ -> false)
|
||||
@@ -3237,6 +3237,21 @@ let () =
|
||||
with Sys_error msg -> raise (Eval_error ("file-read: " ^ msg)))
|
||||
| _ -> raise (Eval_error "file-read: (path)"));
|
||||
|
||||
(* fed-sx Step 3 segment replay. Sorted names, no "."/".." ;
|
||||
errors prefixed like file-read (msg carries enoent/enotdir). *)
|
||||
register "file-list-dir" (fun args ->
|
||||
match args with
|
||||
| [String path] ->
|
||||
(try
|
||||
let names = Sys.readdir path in
|
||||
let names =
|
||||
Array.to_list names
|
||||
|> List.filter (fun n -> n <> "." && n <> "..") in
|
||||
let names = List.sort compare names in
|
||||
List (List.map (fun n -> String n) names)
|
||||
with Sys_error msg -> raise (Eval_error ("file-list-dir: " ^ msg)))
|
||||
| _ -> raise (Eval_error "file-list-dir: (path)"));
|
||||
|
||||
register "file-write" (fun args ->
|
||||
match args with
|
||||
| [String path; String content] ->
|
||||
@@ -4158,4 +4173,61 @@ let () =
|
||||
Sx_types.jit_skipped_count := 0;
|
||||
Sx_types.jit_threshold_skipped_count := 0;
|
||||
Sx_types.jit_evicted_count := 0;
|
||||
Nil)
|
||||
Nil);
|
||||
|
||||
(* fed-sx host primitives — pure-OCaml crypto (WASM-safe). *)
|
||||
register "crypto-sha256" (fun args ->
|
||||
match args with
|
||||
| [String s] -> String (Sx_sha2.sha256_hex s)
|
||||
| _ -> raise (Eval_error "crypto-sha256: (bytes)"));
|
||||
|
||||
register "crypto-sha512" (fun args ->
|
||||
match args with
|
||||
| [String s] -> String (Sx_sha2.sha512_hex s)
|
||||
| _ -> raise (Eval_error "crypto-sha512: (bytes)"));
|
||||
|
||||
register "crypto-sha3-256" (fun args ->
|
||||
match args with
|
||||
| [String s] -> String (Sx_sha3.sha3_256_hex s)
|
||||
| _ -> raise (Eval_error "crypto-sha3-256: (bytes)"));
|
||||
|
||||
register "cbor-encode" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
(try String (Sx_cbor.encode v)
|
||||
with Sx_cbor.Cbor_error m -> raise (Eval_error m))
|
||||
| _ -> raise (Eval_error "cbor-encode: (value)"));
|
||||
|
||||
register "cbor-decode" (fun args ->
|
||||
match args with
|
||||
| [String s] ->
|
||||
(try Sx_cbor.decode s
|
||||
with Sx_cbor.Cbor_error m -> raise (Eval_error m))
|
||||
| _ -> raise (Eval_error "cbor-decode: (bytes)"));
|
||||
|
||||
register "cid-from-bytes" (fun args ->
|
||||
match args with
|
||||
| [Integer codec; String mh] ->
|
||||
String (Sx_cid.cidv1 codec mh)
|
||||
| _ -> raise (Eval_error "cid-from-bytes: (codec multihash-bytes)"));
|
||||
|
||||
register "cid-from-sx" (fun args ->
|
||||
match args with
|
||||
| [v] ->
|
||||
(try String (Sx_cid.cid_from_sx v)
|
||||
with Sx_cbor.Cbor_error m -> raise (Eval_error m))
|
||||
| _ -> raise (Eval_error "cid-from-sx: (value)"));
|
||||
|
||||
(* Verify is total: any malformed input -> false, never raises. *)
|
||||
register "ed25519-verify" (fun args ->
|
||||
match args with
|
||||
| [String pk; String msg; String sg] ->
|
||||
Bool (try Sx_ed25519.verify ~pubkey:pk ~msg ~sig_:sg
|
||||
with _ -> false)
|
||||
| _ -> Bool false);
|
||||
|
||||
register "rsa-sha256-verify" (fun args ->
|
||||
match args with
|
||||
| [String spki; String msg; String sg] ->
|
||||
Bool (try Sx_rsa.verify ~spki ~msg ~sig_:sg with _ -> false)
|
||||
| _ -> Bool false)
|
||||
|
||||
220
hosts/ocaml/lib/sx_rsa.ml
Normal file
220
hosts/ocaml/lib/sx_rsa.ml
Normal file
@@ -0,0 +1,220 @@
|
||||
(** RSASSA-PKCS1-v1_5 verification with SHA-256 — pure OCaml,
|
||||
WASM-safe. Self-contained minimal bignum (modexp only), a tiny
|
||||
DER reader for SubjectPublicKeyInfo, and the fixed SHA-256
|
||||
DigestInfo prefix. Verify only on public data — constant time
|
||||
not required. Reference: RFC 8017 §8.2.2, §9.2. No deps. *)
|
||||
|
||||
(* ---- Minimal unsigned bignum: int array, little-endian, base 2^26 ---- *)
|
||||
|
||||
let bits = 26
|
||||
let base = 1 lsl bits
|
||||
let mask = base - 1
|
||||
|
||||
type bn = int array
|
||||
|
||||
let norm a =
|
||||
let n = ref (Array.length a) in
|
||||
while !n > 1 && a.(!n - 1) = 0 do decr n done;
|
||||
if !n = Array.length a then a else Array.sub a 0 !n
|
||||
|
||||
let bzero : bn = [| 0 |]
|
||||
let is_zero a = Array.length a = 1 && a.(0) = 0
|
||||
|
||||
let cmp a b =
|
||||
let a = norm a and b = norm b in
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
if la <> lb then compare la lb
|
||||
else begin
|
||||
let r = ref 0 and i = ref (la - 1) in
|
||||
while !r = 0 && !i >= 0 do
|
||||
if a.(!i) <> b.(!i) then r := compare a.(!i) b.(!i);
|
||||
decr i
|
||||
done; !r
|
||||
end
|
||||
|
||||
let add a b =
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
let n = (max la lb) + 1 in
|
||||
let r = Array.make n 0 and carry = ref 0 in
|
||||
for i = 0 to n - 1 do
|
||||
let s = !carry + (if i < la then a.(i) else 0)
|
||||
+ (if i < lb then b.(i) else 0) in
|
||||
r.(i) <- s land mask; carry := s lsr bits
|
||||
done;
|
||||
norm r
|
||||
|
||||
let sub a b = (* requires a >= b *)
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
let r = Array.make la 0 and borrow = ref 0 in
|
||||
for i = 0 to la - 1 do
|
||||
let s = a.(i) - !borrow - (if i < lb then b.(i) else 0) in
|
||||
if s < 0 then (r.(i) <- s + base; borrow := 1)
|
||||
else (r.(i) <- s; borrow := 0)
|
||||
done;
|
||||
norm r
|
||||
|
||||
let mul a b =
|
||||
let la = Array.length a and lb = Array.length b in
|
||||
let r = Array.make (la + lb) 0 in
|
||||
for i = 0 to la - 1 do
|
||||
let carry = ref 0 in
|
||||
for j = 0 to lb - 1 do
|
||||
let s = r.(i + j) + a.(i) * b.(j) + !carry in
|
||||
r.(i + j) <- s land mask; carry := s lsr bits
|
||||
done;
|
||||
r.(i + lb) <- r.(i + lb) + !carry
|
||||
done;
|
||||
norm r
|
||||
|
||||
let numbits a =
|
||||
let a = norm a in
|
||||
let hi = Array.length a - 1 in
|
||||
if hi = 0 && a.(0) = 0 then 0
|
||||
else begin
|
||||
let b = ref 0 and v = ref a.(hi) in
|
||||
while !v > 0 do incr b; v := !v lsr 1 done;
|
||||
hi * bits + !b
|
||||
end
|
||||
|
||||
let bit a i =
|
||||
let limb = i / bits and off = i mod bits in
|
||||
if limb >= Array.length a then 0 else (a.(limb) lsr off) land 1
|
||||
|
||||
let bn_mod a m = (* binary long division, m > 0 *)
|
||||
if cmp a m < 0 then norm a
|
||||
else begin
|
||||
let r = ref bzero in
|
||||
for i = numbits a - 1 downto 0 do
|
||||
r := add !r !r;
|
||||
if bit a i = 1 then r := add !r [| 1 |];
|
||||
if cmp !r m >= 0 then r := sub !r m
|
||||
done;
|
||||
!r
|
||||
end
|
||||
|
||||
let powmod b0 e m =
|
||||
let result = ref [| 1 |] and b = ref (bn_mod b0 m) in
|
||||
for i = 0 to numbits e - 1 do
|
||||
if bit e i = 1 then result := bn_mod (mul !result !b) m;
|
||||
b := bn_mod (mul !b !b) m
|
||||
done;
|
||||
!result
|
||||
|
||||
let of_bytes_be (s : string) : bn =
|
||||
let acc = ref bzero in
|
||||
for i = 0 to String.length s - 1 do
|
||||
acc := add (mul !acc [| 256 |]) [| Char.code s.[i] |]
|
||||
done;
|
||||
!acc
|
||||
|
||||
let div_small a d =
|
||||
let la = Array.length a in
|
||||
let q = Array.make la 0 and rem = ref 0 in
|
||||
for i = la - 1 downto 0 do
|
||||
let cur = (!rem lsl bits) lor a.(i) in
|
||||
q.(i) <- cur / d; rem := cur mod d
|
||||
done;
|
||||
norm q
|
||||
|
||||
let to_bytes_be (a : bn) (n : int) : string =
|
||||
let b = Bytes.make n '\000' in
|
||||
let cur = ref (norm a) in
|
||||
for i = n - 1 downto 0 do
|
||||
let q = div_small !cur 256 in
|
||||
let r =
|
||||
let d = sub !cur (mul q [| 256 |]) in
|
||||
if is_zero d then 0 else d.(0)
|
||||
in
|
||||
Bytes.set b i (Char.chr r);
|
||||
cur := q
|
||||
done;
|
||||
Bytes.unsafe_to_string b
|
||||
|
||||
(* ---- Minimal DER reader (for SubjectPublicKeyInfo) ---- *)
|
||||
|
||||
exception Der of string
|
||||
|
||||
(* Returns (tag, content_start, content_len, next). *)
|
||||
let der_tlv s pos =
|
||||
if pos + 2 > String.length s then raise (Der "short");
|
||||
let tag = Char.code s.[pos] in
|
||||
let l0 = Char.code s.[pos + 1] in
|
||||
let len, hdr =
|
||||
if l0 < 0x80 then l0, 2
|
||||
else begin
|
||||
let nb = l0 land 0x7f in
|
||||
if pos + 2 + nb > String.length s then raise (Der "short len");
|
||||
let v = ref 0 in
|
||||
for i = 0 to nb - 1 do
|
||||
v := (!v lsl 8) lor Char.code s.[pos + 2 + i]
|
||||
done;
|
||||
!v, 2 + nb
|
||||
end
|
||||
in
|
||||
(tag, pos + hdr, len, pos + hdr + len)
|
||||
|
||||
(* SPKI DER -> (n, e) as bignums. *)
|
||||
let parse_spki (der : string) : bn * bn =
|
||||
let tag, c, _l, _ = der_tlv der 0 in
|
||||
if tag <> 0x30 then raise (Der "spki: outer not SEQUENCE");
|
||||
(* AlgorithmIdentifier SEQUENCE — skip. *)
|
||||
let _, _, _, after_alg = der_tlv der c in
|
||||
(* BIT STRING. *)
|
||||
let bt, bc, bl, _ = der_tlv der after_alg in
|
||||
if bt <> 0x03 then raise (Der "spki: expected BIT STRING");
|
||||
(* First content byte = unused bits (must be 0). *)
|
||||
let rpk_start = bc + 1 in
|
||||
ignore bl;
|
||||
let st, sc, _, _ = der_tlv der rpk_start in
|
||||
if st <> 0x30 then raise (Der "spki: RSAPublicKey not SEQUENCE");
|
||||
let nt, nc, nl, after_n = der_tlv der sc in
|
||||
if nt <> 0x02 then raise (Der "spki: modulus not INTEGER");
|
||||
let et, ec, el, _ = der_tlv der after_n in
|
||||
if et <> 0x02 then raise (Der "spki: exponent not INTEGER");
|
||||
let n = of_bytes_be (String.sub der nc nl) in
|
||||
let e = of_bytes_be (String.sub der ec el) in
|
||||
(n, e)
|
||||
|
||||
(* SHA-256 DigestInfo DER prefix (RFC 8017 §9.2 note 1). *)
|
||||
let sha256_digestinfo_prefix =
|
||||
"\x30\x31\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x01\x05\x00\x04\x20"
|
||||
|
||||
let unhex h =
|
||||
let n = String.length h / 2 in
|
||||
let b = Bytes.create n in
|
||||
for i = 0 to n - 1 do
|
||||
Bytes.set b i (Char.chr (int_of_string ("0x" ^ String.sub h (2 * i) 2)))
|
||||
done;
|
||||
Bytes.unsafe_to_string b
|
||||
|
||||
(* RSASSA-PKCS1-v1_5 verify with SHA-256. Total: any malformed
|
||||
input yields false (caller wraps, but be defensive here too). *)
|
||||
let verify ~spki ~msg ~sig_ : bool =
|
||||
try
|
||||
let n, e = parse_spki spki in
|
||||
let k = (numbits n + 7) / 8 in
|
||||
if String.length sig_ <> k then false
|
||||
else begin
|
||||
let s = of_bytes_be sig_ in
|
||||
if cmp s n >= 0 then false
|
||||
else begin
|
||||
let m = powmod s e n in
|
||||
let em = to_bytes_be m k in
|
||||
(* EM = 0x00 01 FF..FF 00 || DigestInfo || H *)
|
||||
let h = unhex (Sx_sha2.sha256_hex msg) in
|
||||
let t = sha256_digestinfo_prefix ^ h in
|
||||
let tlen = String.length t in
|
||||
if k < tlen + 11 then false
|
||||
else begin
|
||||
let ok = ref (em.[0] = '\x00' && em.[1] = '\x01') in
|
||||
let ps_end = k - tlen - 1 in
|
||||
for i = 2 to ps_end - 1 do
|
||||
if em.[i] <> '\xff' then ok := false
|
||||
done;
|
||||
if em.[ps_end] <> '\x00' then ok := false;
|
||||
if String.sub em (ps_end + 1) tlen <> t then ok := false;
|
||||
!ok
|
||||
end
|
||||
end
|
||||
end
|
||||
with _ -> false
|
||||
212
hosts/ocaml/lib/sx_sha2.ml
Normal file
212
hosts/ocaml/lib/sx_sha2.ml
Normal file
@@ -0,0 +1,212 @@
|
||||
(** SHA-2 (SHA-256, SHA-512) — pure OCaml, WASM-safe.
|
||||
|
||||
No C stubs, no external deps. Used by the fed-sx host primitives
|
||||
[crypto-sha256] / [crypto-sha512]. Reference: FIPS 180-4. *)
|
||||
|
||||
(* ---- SHA-256 (FIPS 180-4 §6.2). 32-bit words held in native int,
|
||||
masked to 32 bits after every arithmetic op. ---- *)
|
||||
|
||||
let mask32 = 0xFFFFFFFF
|
||||
|
||||
let k256 = [|
|
||||
0x428a2f98; 0x71374491; 0xb5c0fbcf; 0xe9b5dba5;
|
||||
0x3956c25b; 0x59f111f1; 0x923f82a4; 0xab1c5ed5;
|
||||
0xd807aa98; 0x12835b01; 0x243185be; 0x550c7dc3;
|
||||
0x72be5d74; 0x80deb1fe; 0x9bdc06a7; 0xc19bf174;
|
||||
0xe49b69c1; 0xefbe4786; 0x0fc19dc6; 0x240ca1cc;
|
||||
0x2de92c6f; 0x4a7484aa; 0x5cb0a9dc; 0x76f988da;
|
||||
0x983e5152; 0xa831c66d; 0xb00327c8; 0xbf597fc7;
|
||||
0xc6e00bf3; 0xd5a79147; 0x06ca6351; 0x14292967;
|
||||
0x27b70a85; 0x2e1b2138; 0x4d2c6dfc; 0x53380d13;
|
||||
0x650a7354; 0x766a0abb; 0x81c2c92e; 0x92722c85;
|
||||
0xa2bfe8a1; 0xa81a664b; 0xc24b8b70; 0xc76c51a3;
|
||||
0xd192e819; 0xd6990624; 0xf40e3585; 0x106aa070;
|
||||
0x19a4c116; 0x1e376c08; 0x2748774c; 0x34b0bcb5;
|
||||
0x391c0cb3; 0x4ed8aa4a; 0x5b9cca4f; 0x682e6ff3;
|
||||
0x748f82ee; 0x78a5636f; 0x84c87814; 0x8cc70208;
|
||||
0x90befffa; 0xa4506ceb; 0xbef9a3f7; 0xc67178f2 |]
|
||||
|
||||
let rotr32 x n = ((x lsr n) lor (x lsl (32 - n))) land mask32
|
||||
|
||||
let sha256_hex (msg : string) : string =
|
||||
let h = [| 0x6a09e667; 0xbb67ae85; 0x3c6ef372; 0xa54ff53a;
|
||||
0x510e527f; 0x9b05688c; 0x1f83d9ab; 0x5be0cd19 |] in
|
||||
let len = String.length msg in
|
||||
(* Padded length: multiple of 64 bytes. *)
|
||||
let bitlen = len * 8 in
|
||||
let padlen =
|
||||
let r = (len + 1) mod 64 in
|
||||
if r <= 56 then 56 - r else 120 - r
|
||||
in
|
||||
let total = len + 1 + padlen + 8 in
|
||||
let buf = Bytes.make total '\000' in
|
||||
Bytes.blit_string msg 0 buf 0 len;
|
||||
Bytes.set buf len '\x80';
|
||||
(* 64-bit big-endian bit length (we cap at OCaml int range). *)
|
||||
for i = 0 to 7 do
|
||||
Bytes.set buf (total - 1 - i)
|
||||
(Char.chr ((bitlen lsr (8 * i)) land 0xFF))
|
||||
done;
|
||||
let w = Array.make 64 0 in
|
||||
let nblocks = total / 64 in
|
||||
for b = 0 to nblocks - 1 do
|
||||
let base = b * 64 in
|
||||
for t = 0 to 15 do
|
||||
let o = base + t * 4 in
|
||||
w.(t) <-
|
||||
(Char.code (Bytes.get buf o) lsl 24)
|
||||
lor (Char.code (Bytes.get buf (o + 1)) lsl 16)
|
||||
lor (Char.code (Bytes.get buf (o + 2)) lsl 8)
|
||||
lor (Char.code (Bytes.get buf (o + 3)))
|
||||
done;
|
||||
for t = 16 to 63 do
|
||||
let s0 =
|
||||
(rotr32 w.(t - 15) 7) lxor (rotr32 w.(t - 15) 18)
|
||||
lxor (w.(t - 15) lsr 3) in
|
||||
let s1 =
|
||||
(rotr32 w.(t - 2) 17) lxor (rotr32 w.(t - 2) 19)
|
||||
lxor (w.(t - 2) lsr 10) in
|
||||
w.(t) <- (w.(t - 16) + s0 + w.(t - 7) + s1) land mask32
|
||||
done;
|
||||
let a = ref h.(0) and bb = ref h.(1) and c = ref h.(2)
|
||||
and d = ref h.(3) and e = ref h.(4) and f = ref h.(5)
|
||||
and g = ref h.(6) and hh = ref h.(7) in
|
||||
for t = 0 to 63 do
|
||||
let s1 =
|
||||
(rotr32 !e 6) lxor (rotr32 !e 11) lxor (rotr32 !e 25) in
|
||||
let ch = (!e land !f) lxor ((lnot !e land mask32) land !g) in
|
||||
let t1 = (!hh + s1 + ch + k256.(t) + w.(t)) land mask32 in
|
||||
let s0 =
|
||||
(rotr32 !a 2) lxor (rotr32 !a 13) lxor (rotr32 !a 22) in
|
||||
let maj = (!a land !bb) lxor (!a land !c) lxor (!bb land !c) in
|
||||
let t2 = (s0 + maj) land mask32 in
|
||||
hh := !g; g := !f; f := !e;
|
||||
e := (!d + t1) land mask32;
|
||||
d := !c; c := !bb; bb := !a;
|
||||
a := (t1 + t2) land mask32
|
||||
done;
|
||||
h.(0) <- (h.(0) + !a) land mask32;
|
||||
h.(1) <- (h.(1) + !bb) land mask32;
|
||||
h.(2) <- (h.(2) + !c) land mask32;
|
||||
h.(3) <- (h.(3) + !d) land mask32;
|
||||
h.(4) <- (h.(4) + !e) land mask32;
|
||||
h.(5) <- (h.(5) + !f) land mask32;
|
||||
h.(6) <- (h.(6) + !g) land mask32;
|
||||
h.(7) <- (h.(7) + !hh) land mask32
|
||||
done;
|
||||
let out = Buffer.create 64 in
|
||||
Array.iter (fun x -> Buffer.add_string out (Printf.sprintf "%08x" x)) h;
|
||||
Buffer.contents out
|
||||
|
||||
(* ---- SHA-512 (FIPS 180-4 §6.4). 64-bit words via Int64.
|
||||
128-bit length append; we only support messages whose bit length
|
||||
fits in 64 bits (high word is always zero). ---- *)
|
||||
|
||||
let k512 = [|
|
||||
0x428a2f98d728ae22L; 0x7137449123ef65cdL; 0xb5c0fbcfec4d3b2fL;
|
||||
0xe9b5dba58189dbbcL; 0x3956c25bf348b538L; 0x59f111f1b605d019L;
|
||||
0x923f82a4af194f9bL; 0xab1c5ed5da6d8118L; 0xd807aa98a3030242L;
|
||||
0x12835b0145706fbeL; 0x243185be4ee4b28cL; 0x550c7dc3d5ffb4e2L;
|
||||
0x72be5d74f27b896fL; 0x80deb1fe3b1696b1L; 0x9bdc06a725c71235L;
|
||||
0xc19bf174cf692694L; 0xe49b69c19ef14ad2L; 0xefbe4786384f25e3L;
|
||||
0x0fc19dc68b8cd5b5L; 0x240ca1cc77ac9c65L; 0x2de92c6f592b0275L;
|
||||
0x4a7484aa6ea6e483L; 0x5cb0a9dcbd41fbd4L; 0x76f988da831153b5L;
|
||||
0x983e5152ee66dfabL; 0xa831c66d2db43210L; 0xb00327c898fb213fL;
|
||||
0xbf597fc7beef0ee4L; 0xc6e00bf33da88fc2L; 0xd5a79147930aa725L;
|
||||
0x06ca6351e003826fL; 0x142929670a0e6e70L; 0x27b70a8546d22ffcL;
|
||||
0x2e1b21385c26c926L; 0x4d2c6dfc5ac42aedL; 0x53380d139d95b3dfL;
|
||||
0x650a73548baf63deL; 0x766a0abb3c77b2a8L; 0x81c2c92e47edaee6L;
|
||||
0x92722c851482353bL; 0xa2bfe8a14cf10364L; 0xa81a664bbc423001L;
|
||||
0xc24b8b70d0f89791L; 0xc76c51a30654be30L; 0xd192e819d6ef5218L;
|
||||
0xd69906245565a910L; 0xf40e35855771202aL; 0x106aa07032bbd1b8L;
|
||||
0x19a4c116b8d2d0c8L; 0x1e376c085141ab53L; 0x2748774cdf8eeb99L;
|
||||
0x34b0bcb5e19b48a8L; 0x391c0cb3c5c95a63L; 0x4ed8aa4ae3418acbL;
|
||||
0x5b9cca4f7763e373L; 0x682e6ff3d6b2b8a3L; 0x748f82ee5defb2fcL;
|
||||
0x78a5636f43172f60L; 0x84c87814a1f0ab72L; 0x8cc702081a6439ecL;
|
||||
0x90befffa23631e28L; 0xa4506cebde82bde9L; 0xbef9a3f7b2c67915L;
|
||||
0xc67178f2e372532bL; 0xca273eceea26619cL; 0xd186b8c721c0c207L;
|
||||
0xeada7dd6cde0eb1eL; 0xf57d4f7fee6ed178L; 0x06f067aa72176fbaL;
|
||||
0x0a637dc5a2c898a6L; 0x113f9804bef90daeL; 0x1b710b35131c471bL;
|
||||
0x28db77f523047d84L; 0x32caab7b40c72493L; 0x3c9ebe0a15c9bebcL;
|
||||
0x431d67c49c100d4cL; 0x4cc5d4becb3e42b6L; 0x597f299cfc657e2aL;
|
||||
0x5fcb6fab3ad6faecL; 0x6c44198c4a475817L |]
|
||||
|
||||
let ( &: ) = Int64.logand
|
||||
let ( |: ) = Int64.logor
|
||||
let ( ^: ) = Int64.logxor
|
||||
let ( +: ) = Int64.add
|
||||
let lnot64 = Int64.lognot
|
||||
|
||||
let rotr64 x n =
|
||||
(Int64.shift_right_logical x n) |: (Int64.shift_left x (64 - n))
|
||||
|
||||
let sha512_hex (msg : string) : string =
|
||||
let h = [| 0x6a09e667f3bcc908L; 0xbb67ae8584caa73bL;
|
||||
0x3c6ef372fe94f82bL; 0xa54ff53a5f1d36f1L;
|
||||
0x510e527fade682d1L; 0x9b05688c2b3e6c1fL;
|
||||
0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L |] in
|
||||
let len = String.length msg in
|
||||
let bitlen = len * 8 in
|
||||
(* Pad to a multiple of 128 bytes; 16-byte big-endian length. *)
|
||||
let padlen =
|
||||
let r = (len + 1) mod 128 in
|
||||
if r <= 112 then 112 - r else 240 - r
|
||||
in
|
||||
let total = len + 1 + padlen + 16 in
|
||||
let buf = Bytes.make total '\000' in
|
||||
Bytes.blit_string msg 0 buf 0 len;
|
||||
Bytes.set buf len '\x80';
|
||||
for i = 0 to 7 do
|
||||
Bytes.set buf (total - 1 - i)
|
||||
(Char.chr ((bitlen lsr (8 * i)) land 0xFF))
|
||||
done;
|
||||
let w = Array.make 80 0L in
|
||||
let nblocks = total / 128 in
|
||||
for b = 0 to nblocks - 1 do
|
||||
let base = b * 128 in
|
||||
for t = 0 to 15 do
|
||||
let o = base + t * 8 in
|
||||
let v = ref 0L in
|
||||
for j = 0 to 7 do
|
||||
v := Int64.logor (Int64.shift_left !v 8)
|
||||
(Int64.of_int (Char.code (Bytes.get buf (o + j))))
|
||||
done;
|
||||
w.(t) <- !v
|
||||
done;
|
||||
for t = 16 to 79 do
|
||||
let s0 =
|
||||
(rotr64 w.(t - 15) 1) ^: (rotr64 w.(t - 15) 8)
|
||||
^: (Int64.shift_right_logical w.(t - 15) 7) in
|
||||
let s1 =
|
||||
(rotr64 w.(t - 2) 19) ^: (rotr64 w.(t - 2) 61)
|
||||
^: (Int64.shift_right_logical w.(t - 2) 6) in
|
||||
w.(t) <- w.(t - 16) +: s0 +: w.(t - 7) +: s1
|
||||
done;
|
||||
let a = ref h.(0) and bb = ref h.(1) and c = ref h.(2)
|
||||
and d = ref h.(3) and e = ref h.(4) and f = ref h.(5)
|
||||
and g = ref h.(6) and hh = ref h.(7) in
|
||||
for t = 0 to 79 do
|
||||
let s1 = (rotr64 !e 14) ^: (rotr64 !e 18) ^: (rotr64 !e 41) in
|
||||
let ch = (!e &: !f) ^: ((lnot64 !e) &: !g) in
|
||||
let t1 = !hh +: s1 +: ch +: k512.(t) +: w.(t) in
|
||||
let s0 = (rotr64 !a 28) ^: (rotr64 !a 34) ^: (rotr64 !a 39) in
|
||||
let maj = (!a &: !bb) ^: (!a &: !c) ^: (!bb &: !c) in
|
||||
let t2 = s0 +: maj in
|
||||
hh := !g; g := !f; f := !e;
|
||||
e := !d +: t1;
|
||||
d := !c; c := !bb; bb := !a;
|
||||
a := t1 +: t2
|
||||
done;
|
||||
h.(0) <- h.(0) +: !a;
|
||||
h.(1) <- h.(1) +: !bb;
|
||||
h.(2) <- h.(2) +: !c;
|
||||
h.(3) <- h.(3) +: !d;
|
||||
h.(4) <- h.(4) +: !e;
|
||||
h.(5) <- h.(5) +: !f;
|
||||
h.(6) <- h.(6) +: !g;
|
||||
h.(7) <- h.(7) +: !hh
|
||||
done;
|
||||
let out = Buffer.create 128 in
|
||||
Array.iter
|
||||
(fun x -> Buffer.add_string out (Printf.sprintf "%016Lx" x)) h;
|
||||
Buffer.contents out
|
||||
107
hosts/ocaml/lib/sx_sha3.ml
Normal file
107
hosts/ocaml/lib/sx_sha3.ml
Normal file
@@ -0,0 +1,107 @@
|
||||
(** SHA-3 (SHA3-256) — pure OCaml, WASM-safe.
|
||||
|
||||
Keccak-f[1600] permutation + SHA-3 multi-rate padding (domain byte
|
||||
0x06, NOT the legacy Keccak 0x01). Reference: FIPS 202. No deps. *)
|
||||
|
||||
let ( ^: ) = Int64.logxor
|
||||
let ( &: ) = Int64.logand
|
||||
let lnot64 = Int64.lognot
|
||||
|
||||
let rotl64 x n =
|
||||
if n = 0 then x
|
||||
else
|
||||
Int64.logor (Int64.shift_left x n) (Int64.shift_right_logical x (64 - n))
|
||||
|
||||
(* FIPS 202 Table 2 — ρ rotation offsets, indexed lane = x + 5*y. *)
|
||||
let rho = [|
|
||||
0; 1; 62; 28; 27;
|
||||
36; 44; 6; 55; 20;
|
||||
3; 10; 43; 25; 39;
|
||||
41; 45; 15; 21; 8;
|
||||
18; 2; 61; 56; 14 |]
|
||||
|
||||
(* FIPS 202 §3.2.5 — round constants RC[0..23] for ι. *)
|
||||
let rc = [|
|
||||
0x0000000000000001L; 0x0000000000008082L; 0x800000000000808aL;
|
||||
0x8000000080008000L; 0x000000000000808bL; 0x0000000080000001L;
|
||||
0x8000000080008081L; 0x8000000000008009L; 0x000000000000008aL;
|
||||
0x0000000000000088L; 0x0000000080008009L; 0x000000008000000aL;
|
||||
0x000000008000808bL; 0x800000000000008bL; 0x8000000000008089L;
|
||||
0x8000000000008003L; 0x8000000000008002L; 0x8000000000000080L;
|
||||
0x000000000000800aL; 0x800000008000000aL; 0x8000000080008081L;
|
||||
0x8000000000008080L; 0x0000000080000001L; 0x8000000080008008L |]
|
||||
|
||||
let keccak_f (a : int64 array) : unit =
|
||||
let c = Array.make 5 0L and d = Array.make 5 0L in
|
||||
let b = Array.make 25 0L in
|
||||
for round = 0 to 23 do
|
||||
(* θ *)
|
||||
for x = 0 to 4 do
|
||||
c.(x) <- a.(x) ^: a.(x + 5) ^: a.(x + 10)
|
||||
^: a.(x + 15) ^: a.(x + 20)
|
||||
done;
|
||||
for x = 0 to 4 do
|
||||
d.(x) <- c.((x + 4) mod 5) ^: (rotl64 c.((x + 1) mod 5) 1)
|
||||
done;
|
||||
for x = 0 to 4 do
|
||||
for y = 0 to 4 do
|
||||
a.(x + 5 * y) <- a.(x + 5 * y) ^: d.(x)
|
||||
done
|
||||
done;
|
||||
(* ρ and π: B[y, 2x+3y] = rotl(A[x,y], rho[x,y]) *)
|
||||
for x = 0 to 4 do
|
||||
for y = 0 to 4 do
|
||||
let nx = y and ny = (2 * x + 3 * y) mod 5 in
|
||||
b.(nx + 5 * ny) <- rotl64 a.(x + 5 * y) rho.(x + 5 * y)
|
||||
done
|
||||
done;
|
||||
(* χ *)
|
||||
for y = 0 to 4 do
|
||||
for x = 0 to 4 do
|
||||
a.(x + 5 * y) <-
|
||||
b.(x + 5 * y)
|
||||
^: ((lnot64 b.((x + 1) mod 5 + 5 * y))
|
||||
&: b.((x + 2) mod 5 + 5 * y))
|
||||
done
|
||||
done;
|
||||
(* ι *)
|
||||
a.(0) <- a.(0) ^: rc.(round)
|
||||
done
|
||||
|
||||
let sha3_256_hex (msg : string) : string =
|
||||
let rate = 136 (* bytes: (1600 - 2*256) / 8 *) in
|
||||
let len = String.length msg in
|
||||
(* pad10*1 with SHA-3 domain byte 0x06; last byte ORed with 0x80. *)
|
||||
let q = rate - (len mod rate) in
|
||||
let padded = Bytes.make (len + q) '\000' in
|
||||
Bytes.blit_string msg 0 padded 0 len;
|
||||
if q = 1 then
|
||||
Bytes.set padded len '\x86'
|
||||
else begin
|
||||
Bytes.set padded len '\x06';
|
||||
Bytes.set padded (len + q - 1) '\x80'
|
||||
end;
|
||||
let total = Bytes.length padded in
|
||||
let a = Array.make 25 0L in
|
||||
let nblocks = total / rate in
|
||||
for blk = 0 to nblocks - 1 do
|
||||
let base = blk * rate in
|
||||
(* Absorb: XOR rate bytes into the state, little-endian lanes. *)
|
||||
for j = 0 to rate - 1 do
|
||||
let lane = j / 8 and sh = (j mod 8) * 8 in
|
||||
let byte = Int64.of_int (Char.code (Bytes.get padded (base + j))) in
|
||||
a.(lane) <- a.(lane) ^: (Int64.shift_left byte sh)
|
||||
done;
|
||||
keccak_f a
|
||||
done;
|
||||
(* Squeeze 32 bytes (fits in the first 4 lanes; rate > 32). *)
|
||||
let out = Buffer.create 64 in
|
||||
for j = 0 to 31 do
|
||||
let lane = j / 8 and sh = (j mod 8) * 8 in
|
||||
let byte =
|
||||
Int64.to_int
|
||||
(Int64.logand (Int64.shift_right_logical a.(lane) sh) 0xFFL)
|
||||
in
|
||||
Buffer.add_string out (Printf.sprintf "%02x" byte)
|
||||
done;
|
||||
Buffer.contents out
|
||||
Reference in New Issue
Block a user