From 24c67a318927448353c53de31205a96bf9a2733f Mon Sep 17 00:00:00 2001 From: Swrup Date: Wed, 12 Feb 2025 11:19:19 +0100 Subject: [PATCH] init --- .gitignore | 1 + .ocamlformat | 43 +++++++ LICENSE.md | 21 ++++ README.md | 11 ++ dune-project | 24 ++++ purr_chacha.opam | 28 +++++ src/dune | 3 + src/poly1305.ml | 284 ++++++++++++++++++++++++++++++++++++++++++++ src/purr_chacha.ml | 135 +++++++++++++++++++++ src/purr_chacha.mli | 21 ++++ test/dune | 3 + test/test.ml | 101 ++++++++++++++++ 12 files changed, 675 insertions(+) create mode 100644 .gitignore create mode 100644 .ocamlformat create mode 100644 LICENSE.md create mode 100644 README.md create mode 100644 dune-project create mode 100644 purr_chacha.opam create mode 100644 src/dune create mode 100644 src/poly1305.ml create mode 100644 src/purr_chacha.ml create mode 100644 src/purr_chacha.mli create mode 100644 test/dune create mode 100644 test/test.ml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e35d885 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +_build diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..c365faf --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,43 @@ +version=0.27.0 +assignment-operator=end-line +break-cases=fit +break-fun-decl=wrap +break-fun-sig=wrap +break-infix=wrap +break-infix-before-func=false +break-separators=before +break-sequences=true +cases-exp-indent=2 +cases-matching-exp-indent=normal +doc-comments=before +doc-comments-padding=2 +doc-comments-tag-only=default +dock-collection-brackets=false +exp-grouping=preserve +field-space=loose +if-then-else=compact +indicate-multiline-delimiters=space +indicate-nested-or-patterns=unsafe-no +infix-precedence=indent +leading-nested-match-parens=false +let-and=sparse +let-binding-spacing=compact +let-module=compact +margin=80 +max-indent=2 +module-item-spacing=sparse +ocaml-version=4.14.0 +ocp-indent-compat=false +parens-ite=false +parens-tuple=always +parse-docstrings=true +sequence-blank-line=preserve-one +sequence-style=terminator +single-case=compact +space-around-arrays=true +space-around-lists=true +space-around-records=true +space-around-variants=true +type-decl=sparse +wrap-comments=false +wrap-fun-args=true diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..2429c49 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2025 swrup + +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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..808d180 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +# Purr_chacha + +A pure OCaml implementation of [ChaCha20](https://datatracker.ietf.org/doc/html/rfc7539). + +This is implemented for fun. +Do not expect anything from it. +It will likely be slow due to OCaml memory representation of values. + +# License + +MIT or public domain diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..fd9fa49 --- /dev/null +++ b/dune-project @@ -0,0 +1,24 @@ +(lang dune 3.12) + +(name purr_chacha) + +(generate_opam_files true) + +(source + (uri https://git.zapashcanon.fr/swrup/purr_chacha.git)) + +;(documentation https://url/to/documentation) + +(authors "swrup ") + +(maintainers "swrup ") + +(license MIT) + +(package + (name purr_chacha) + (synopsis "Implement ChaCha20 stream cipher") + (description "A pure OCaml implementation of ChaCha20 stream cipher") + (depends ocaml dune) + (tags + (cryptography chacha20))) diff --git a/purr_chacha.opam b/purr_chacha.opam new file mode 100644 index 0000000..eee510e --- /dev/null +++ b/purr_chacha.opam @@ -0,0 +1,28 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "Implement ChaCha20 stream cipher" +description: "A pure OCaml implementation of ChaCha20 stream cipher" +maintainer: ["swrup "] +authors: ["swrup "] +license: "MIT" +tags: ["cryptography" "chacha20"] +depends: [ + "ocaml" + "dune" {>= "3.12"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "https://git.zapashcanon.fr/swrup/purr_chacha.git" diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..e95fa08 --- /dev/null +++ b/src/dune @@ -0,0 +1,3 @@ +(library + (public_name purr_chacha) + (name purr_chacha)) diff --git a/src/poly1305.ml b/src/poly1305.ml new file mode 100644 index 0000000..1221815 --- /dev/null +++ b/src/poly1305.ml @@ -0,0 +1,284 @@ +(* adapted from the 64 bit version of: + https://github.com/floodyberry/poly1305-donna *) + +open Int64 + +type int128 = + { hi : Int64.t + ; lo : Int64.t + } + +let mul128 a b = + let a_lo = logand a 0xffffffff_L in + let a_hi = shift_right_logical a 32 in + let b_lo = logand b 0xffffffff_L in + let b_hi = shift_right_logical b 32 in + let lolo = mul a_lo b_lo in + let lohi = mul a_lo b_hi in + let hilo = mul a_hi b_lo in + let hihi = mul a_hi b_hi in + let c = + add + (add (shift_right_logical lolo 32) (logand lohi 0xffffffff_L)) + (logand hilo 0xffffffff_L) + in + let lo = logor (logand lolo 0xffffffff_L) (shift_left c 32) in + let hi = + add + (add + (add hihi (shift_right_logical lohi 32)) + (shift_right_logical hilo 32) ) + (shift_right_logical c 32) + in + { hi; lo } + +let lt a b = if unsigned_compare a b < 0 then 1_L else 0_L + +let add128 a b = + let t = a.lo in + let lo = add a.lo b.lo in + let hi = add (add b.hi (lt lo t)) a.hi in + { hi; lo } + +let addlo a b = + let t = a.lo in + let lo = add a.lo b in + let hi = add a.hi (lt lo t) in + { hi; lo } + +let shr a n = add (shift_right_logical a.lo n) (shift_left a.hi (64 - n)) + +type state = + { r : Int64.t array + ; h : Int64.t array + ; pad : Int64.t array + ; mutable leftover : int + ; buffer : bytes + ; mutable final : bool + ; mac : bytes + } + +let u8to64 s pos = String.get_int64_le s pos + +let init key = + let t0 = u8to64 key 0 in + let t1 = u8to64 key 8 in + let r = Array.make 3 0x0_L in + r.(0) <- logand t0 0xffc0fffffff_L; + r.(1) <- + logand + (logor (shift_right_logical t0 44) (shift_left t1 20)) + 0xfffffc0ffff_L; + r.(2) <- logand (shift_right_logical t1 24) 0x00ffffffc0f_L; + let h = Array.make 3 0x0_L in + let pad = Array.make 2 0x0_L in + pad.(0) <- u8to64 key 16; + pad.(1) <- u8to64 key 24; + let leftover = 0 in + let buffer = Bytes.make 16 '\000' in + let final = true in + let mac = Bytes.make 16 '\000' in + { r; h; pad; leftover; buffer; final; mac } + +let blocks state s pos len = + let hibit : Int64.t = if state.final then shift_left 1_L 40 else 0_L in + let r = Array.copy state.r in + let h = Array.copy state.h in + let s1 = mul r.(1) (shift_left 5_L 2) in + let s2 = mul r.(2) (shift_left 5_L 2) in + let rec loop pos len = + if len < 16 then () + else + (* h += m[i] *) + let t0 = u8to64 s (pos + 0) in + let t1 = u8to64 s (pos + 8) in + h.(0) <- add h.(0) (logand t0 0xfffffffffff_L); + h.(1) <- + add h.(1) + (logand + (logor (shift_right_logical t0 44) (shift_left t1 20)) + 0xfffffffffff_L ); + h.(2) <- + add h.(2) + (logor (logand (shift_right_logical t1 24) 0x3ffffffffff_L) hibit); + + (* h *= r *) + let d0 : int128 = + add128 (add128 (mul128 h.(0) r.(0)) (mul128 h.(1) s2)) (mul128 h.(2) s1) + in + let d1 = + add128 + (add128 (mul128 h.(0) r.(1)) (mul128 h.(1) r.(0))) + (mul128 h.(2) s2) + in + let d2 = + add128 + (add128 (mul128 h.(0) r.(2)) (mul128 h.(1) r.(1))) + (mul128 h.(2) r.(0)) + in + + (* (partial) h %= p *) + let c = shr d0 44 in + h.(0) <- logand d0.lo 0xfffffffffff_L; + let d1 = addlo d1 c in + let c = shr d1 44 in + h.(1) <- logand d1.lo 0xfffffffffff_L; + let d2 = addlo d2 c in + let c = shr d2 42 in + h.(2) <- logand d2.lo 0x3ffffffffff_L; + h.(0) <- add h.(0) (mul c 5_L); + let c = shift_right_logical h.(0) 44 in + h.(0) <- logand h.(0) 0xfffffffffff_L; + h.(1) <- add h.(1) c; + + loop (pos + 16) (len - 16) + in + loop pos len; + + state.h.(0) <- h.(0); + state.h.(1) <- h.(1); + state.h.(2) <- h.(2); + () + +let finish state = + (* process the remaining block *) + if state.leftover <> 0 then ( + let i = state.leftover in + Bytes.set state.buffer i '\001'; + for i = i + 1 to 16 - 1 do + Bytes.set state.buffer i '\000' + done; + state.final <- false; + blocks state (Bytes.unsafe_to_string state.buffer) 0 16 ); + + (* fully carry h *) + let h = Array.copy state.h in + let c = shift_right_logical h.(1) 44 in + h.(1) <- logand h.(1) 0xfffffffffff_L; + + h.(2) <- add h.(2) c; + let c = shift_right_logical h.(2) 42 in + h.(2) <- logand h.(2) 0x3ffffffffff_L; + + h.(0) <- add h.(0) (mul c 5_L); + let c = shift_right_logical h.(0) 44 in + h.(0) <- logand h.(0) 0xfffffffffff_L; + + h.(1) <- add h.(1) c; + let c = shift_right_logical h.(1) 44 in + h.(1) <- logand h.(1) 0xfffffffffff_L; + + h.(2) <- add h.(2) c; + let c = shift_right_logical h.(2) 42 in + h.(2) <- logand h.(2) 0x3ffffffffff_L; + + h.(0) <- add h.(0) (mul c 5_L); + let c = shift_right_logical h.(0) 44 in + h.(0) <- logand h.(0) 0xfffffffffff_L; + + h.(1) <- add h.(1) c; + + (* compute h + -p *) + let g = Array.make 3 0_L in + g.(0) <- add h.(0) 5_L; + let c = shift_right_logical g.(0) 44 in + g.(0) <- logand g.(0) 0xfffffffffff_L; + + g.(1) <- add h.(1) c; + let c = shift_right_logical g.(1) 44 in + g.(1) <- logand g.(1) 0xfffffffffff_L; + + g.(2) <- sub (add h.(2) c) (shift_left 1_L 42); + + (* select h if h < p, or h + -p if h >= p *) + let c = sub (shift_right_logical g.(2) (64 - 1)) 1_L in + g.(0) <- logand g.(0) c; + g.(1) <- logand g.(1) c; + g.(2) <- logand g.(2) c; + let c = lognot c in + h.(0) <- logor (logand h.(0) c) g.(0); + h.(1) <- logor (logand h.(1) c) g.(1); + h.(2) <- logor (logand h.(2) c) g.(2); + + (* h = (h + pad) *) + let t0 = state.pad.(0) in + let t1 = state.pad.(1) in + + h.(0) <- add h.(0) (logand t0 0xfffffffffff_L); + let c = shift_right_logical h.(0) 44 in + h.(0) <- logand h.(0) 0xfffffffffff_L; + + h.(1) <- + add h.(1) + (add + (logand + (logor (shift_right_logical t0 44) (shift_left t1 20)) + 0xfffffffffff_L ) + c ); + let c = shift_right_logical h.(1) 44 in + h.(1) <- logand h.(1) 0xfffffffffff_L; + + h.(2) <- + add h.(2) (add (logand (shift_right_logical t1 24) 0xfffffffffff_L) c); + h.(2) <- logand h.(2) 0x3ffffffffff_L; + + (* mac = h % (2^128) *) + h.(0) <- logor h.(0) (shift_left h.(1) 44); + h.(1) <- logor (shift_right_logical h.(1) 20) (shift_left h.(2) 24); + + Bytes.set_int64_le state.mac 0 h.(0); + Bytes.set_int64_le state.mac 8 h.(1); + + (* zero out the state *) + state.h.(0) <- 0_L; + state.h.(1) <- 0_L; + state.h.(2) <- 0_L; + state.r.(0) <- 0_L; + state.r.(1) <- 0_L; + state.r.(2) <- 0_L; + state.pad.(0) <- 0_L; + state.pad.(1) <- 0_L; + + () + +let update state s = + let pos = ref 0 in + let len = ref (String.length s) in + (* handle leftover *) + let return = + if state.leftover <> 0 then ( + let want = 16 - state.leftover in + let want = if want > !len then !len else want in + String.blit s !pos state.buffer state.leftover want; + len := !len - want; + pos := !pos + want; + state.leftover <- state.leftover + want; + if state.leftover < 16 then true + else ( + blocks state (Bytes.unsafe_to_string state.buffer) 0 16; + state.leftover <- 0; + false ) ) + else false + in + if return then () + else ( + (* process full blocks *) + if !len >= 16 then ( + let want = Int.logand !len (Int.lognot (16 - 1)) in + blocks state s !pos want; + pos := !pos + want; + len := !len - want ); + + (* store leftover *) + if !len <> 0 then ( + String.blit s !pos state.buffer state.leftover !len; + state.leftover <- state.leftover + !len; + () ); + () ) + +let mac ~key s = + if String.length key <> 32 then invalid_arg "key length must be 32 bytes"; + let state = init key in + update state s; + finish state; + Bytes.unsafe_to_string state.mac diff --git a/src/purr_chacha.ml b/src/purr_chacha.ml new file mode 100644 index 0000000..e0a3fa0 --- /dev/null +++ b/src/purr_chacha.ml @@ -0,0 +1,135 @@ +(* n-bit left rotation (<<<) + result is unspecified if n < 0 or n >= 32 *) +let rot_l_32 v n = + let open Int32 in + logor (shift_left v n) (shift_right_logical v (32 - n)) + +(* mutates chacha state [s] *) +let quarter_round s a b c d = + let open Int32 in + (* a += b; d ^= a; d <<<= 16; *) + s.(a) <- add s.(a) s.(b); + s.(d) <- logxor s.(d) s.(a); + s.(d) <- rot_l_32 s.(d) 16; + (* c += d; b ^= c; b <<<= 12; *) + s.(c) <- add s.(c) s.(d); + s.(b) <- logxor s.(b) s.(c); + s.(b) <- rot_l_32 s.(b) 12; + (* a += b; d ^= a; d <<<= 8; *) + s.(a) <- add s.(a) s.(b); + s.(d) <- logxor s.(d) s.(a); + s.(d) <- rot_l_32 s.(d) 8; + (* c += d; b ^= c; b <<<= 7; *) + s.(c) <- add s.(c) s.(d); + s.(b) <- logxor s.(b) s.(c); + s.(b) <- rot_l_32 s.(b) 7; + () + +let init_state key block_counter nonce = + Array.concat + [ [| 0x61707865_l; 0x3320646e_l; 0x79622d32_l; 0x6b206574_l |] + ; key + ; [| block_counter |] + ; nonce + ] + +let chacha20_block key block_counter nonce = + let s = init_state key block_counter nonce in + let w_s = Array.copy s in + for _i = 0 to 10 - 1 do + (* round 1. *) + quarter_round w_s 0 4 8 12; + quarter_round w_s 1 5 9 13; + quarter_round w_s 2 6 10 14; + quarter_round w_s 3 7 11 15; + (* round 2. *) + quarter_round w_s 0 5 10 15; + quarter_round w_s 1 6 11 12; + quarter_round w_s 2 7 8 13; + quarter_round w_s 3 4 9 14 + done; + for i = 0 to 15 do + s.(i) <- Int32.add s.(i) w_s.(i) + done; + s + +let serialize state = + let len = Array.length state in + let s = Bytes.create (4 * len) in + for i = 0 to len - 1 do + Bytes.set_int32_le s (i * 4) state.(i) + done; + Bytes.unsafe_to_string s + +(* TODO check Sys.big_endian ? this is probably bugged *) +(* ! raw length must be divisible by 4 here + use padding with \x00 if needed + convert string to int32 array; in correct order + we receive key and nonce as a sequence of octets with + no particular structure; to read in little endian *) +let read raw = + let nb = String.length raw / 4 in + let arr = Array.init nb (fun i -> String.get_int32_le raw (i * 4)) in + arr + +(* [xor a b] apply xor to two int32 array; up to len = len(a) + put result in a *) +let xor a b = + for i = 0 to Array.length a - 1 do + a.(i) <- Int32.logxor a.(i) b.(i) + done + +let chacha20_encrypt ~key ~nonce ?initial_counter plaintext = + if String.length key <> 32 then invalid_arg "key length must be 32 bytes"; + if String.length nonce <> 12 then invalid_arg "nonce length must be 12 bytes"; + let key = read key in + let nonce = read nonce in + let initial_counter = Option.value ~default:0_l initial_counter in + + let len = String.length plaintext in + let remaining_len = len mod 64 in + let encrypted_message = Bytes.create ((len / 64 * 64) + remaining_len) in + for j = 0 to (len / 64) - 1 do + let block_counter = Int32.add initial_counter (Int32.of_int j) in + let key_stream = chacha20_block key block_counter nonce in + let block = read (String.sub plaintext (j * 64) 64) in + xor block key_stream; + let s = serialize block in + Bytes.blit_string s 0 encrypted_message (j * 64) 64; + () + done; + if remaining_len <> 0 then ( + let j = String.length plaintext / 64 in + let block_counter = Int32.add initial_counter (Int32.of_int j) in + let key_stream = chacha20_block key block_counter nonce in + let remaining_padded_plaintext = + let padded = + Bytes.make (remaining_len - ((remaining_len mod 4) - 4)) '\x00' + in + let s = String.sub plaintext (j * 64) remaining_len in + Bytes.blit_string s 0 padded 0 remaining_len; + Bytes.unsafe_to_string padded + in + let block = read remaining_padded_plaintext in + xor block key_stream; + let s = serialize block in + (* rm padding *) + let s = String.sub s 0 remaining_len in + Bytes.blit_string s 0 encrypted_message (j * 64) remaining_len; + () ); + Bytes.unsafe_to_string encrypted_message + +let poly1305_mac = Poly1305.mac + +let poly1305_key_gen ~key ~nonce = + if String.length key <> 32 then invalid_arg "key length must be 32 bytes"; + if String.length nonce <> 12 then invalid_arg "nonce length must be 12 bytes"; + let key = read key in + let nonce = read nonce in + let counter = 0_l in + let block = chacha20_block key counter nonce in + let s = Bytes.create 32 in + for i = 0 to 8 - 1 do + Bytes.set_int32_le s (i * 4) block.(i) + done; + Bytes.unsafe_to_string s diff --git a/src/purr_chacha.mli b/src/purr_chacha.mli new file mode 100644 index 0000000..4515e56 --- /dev/null +++ b/src/purr_chacha.mli @@ -0,0 +1,21 @@ +(* Purr_chacha, a pure OCaml implementation of ChaCha20 stream cipher + https://datatracker.ietf.org/doc/html/rfc7539 *) + +(* [chacha20_encrypt ~key ~nonce ~initial_counter s] + Is ChaCha20 ciphertext of [s] + [key] must be 32 bytes + [nonce] must be 12 bytes + [initial_counter] default to Int32.zero *) +val chacha20_encrypt : + key:string -> nonce:string -> ?initial_counter:int32 -> string -> string + +(* [poly1305_mac ~key s ] + Is the poly1305 message authentication code of [s] with [key] + [key] must be 32 bytes *) +val poly1305_mac : key:string -> string -> string + +(* [poly1305_key_gen ~key ~nonce ] + Is a one-time poly1305 key generated pseudorandomly with chacha20 + [key] must be 32 bytes + [nonce] must be 12 bytes *) +val poly1305_key_gen : key:string -> nonce:string -> string diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..d7886c3 --- /dev/null +++ b/test/dune @@ -0,0 +1,3 @@ +(test + (name test) + (libraries purr_chacha)) diff --git a/test/test.ml b/test/test.ml new file mode 100644 index 0000000..52aae89 --- /dev/null +++ b/test/test.ml @@ -0,0 +1,101 @@ +open Purr_chacha + +let k_0 = + "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f" + +let n_0 = "\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x00" + +let c_0 = 1_l + +let p_0 = + "Ladies and Gentlemen of the class of '99: If I could offer you only one tip \ + for the future, sunscreen would be it." + +let expected_0 = + "\x6e\x2e\x35\x9a\x25\x68\xf9\x80\x41\xba\x07\x28\xdd\x0d\x69\x81\xe9\x7e\x7a\xec\x1d\x43\x60\xc2\x0a\x27\xaf\xcc\xfd\x9f\xae\x0b\xf9\x1b\x65\xc5\x52\x47\x33\xab\x8f\x59\x3d\xab\xcd\x62\xb3\x57\x16\x39\xd6\x24\xe6\x51\x52\xab\x8f\x53\x0c\x35\x9f\x08\x61\xd8\x07\xca\x0d\xbf\x50\x0d\x6a\x61\x56\xa3\x8e\x08\x8a\x22\xb6\x5e\x52\xbc\x51\x4d\x16\xcc\xf8\x06\x81\x8c\xe9\x1a\xb7\x79\x37\x36\x5a\xf9\x0b\xbf\x74\xa3\x5b\xe6\xb4\x0b\x8e\xed\xf2\x78\x5e\x42\x87\x4d" + +let k_1 = + "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + +let n_1 = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + +let c_1 = 0_l + +let p_1 = + "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" + +let expected_1 = + "\x76\xb8\xe0\xad\xa0\xf1\x3d\x90\x40\x5d\x6a\xe5\x53\x86\xbd\x28\xbd\xd2\x19\xb8\xa0\x8d\xed\x1a\xa8\x36\xef\xcc\x8b\x77\x0d\xc7\xda\x41\x59\x7c\x51\x57\x48\x8d\x77\x24\xe0\x3f\xb8\xd8\x4a\x37\x6a\x43\xb8\xf4\x15\x18\xa1\x1c\xc3\x87\xb6\x69\xb2\xee\x65\x86" + +let k_2 = + "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01" + +let n_2 = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02" + +let c_2 = 1_l + +let p_2 = + "\x41\x6e\x79\x20\x73\x75\x62\x6d\x69\x73\x73\x69\x6f\x6e\x20\x74\x6f\x20\x74\x68\x65\x20\x49\x45\x54\x46\x20\x69\x6e\x74\x65\x6e\x64\x65\x64\x20\x62\x79\x20\x74\x68\x65\x20\x43\x6f\x6e\x74\x72\x69\x62\x75\x74\x6f\x72\x20\x66\x6f\x72\x20\x70\x75\x62\x6c\x69\x63\x61\x74\x69\x6f\x6e\x20\x61\x73\x20\x61\x6c\x6c\x20\x6f\x72\x20\x70\x61\x72\x74\x20\x6f\x66\x20\x61\x6e\x20\x49\x45\x54\x46\x20\x49\x6e\x74\x65\x72\x6e\x65\x74\x2d\x44\x72\x61\x66\x74\x20\x6f\x72\x20\x52\x46\x43\x20\x61\x6e\x64\x20\x61\x6e\x79\x20\x73\x74\x61\x74\x65\x6d\x65\x6e\x74\x20\x6d\x61\x64\x65\x20\x77\x69\x74\x68\x69\x6e\x20\x74\x68\x65\x20\x63\x6f\x6e\x74\x65\x78\x74\x20\x6f\x66\x20\x61\x6e\x20\x49\x45\x54\x46\x20\x61\x63\x74\x69\x76\x69\x74\x79\x20\x69\x73\x20\x63\x6f\x6e\x73\x69\x64\x65\x72\x65\x64\x20\x61\x6e\x20\x22\x49\x45\x54\x46\x20\x43\x6f\x6e\x74\x72\x69\x62\x75\x74\x69\x6f\x6e\x22\x2e\x20\x53\x75\x63\x68\x20\x73\x74\x61\x74\x65\x6d\x65\x6e\x74\x73\x20\x69\x6e\x63\x6c\x75\x64\x65\x20\x6f\x72\x61\x6c\x20\x73\x74\x61\x74\x65\x6d\x65\x6e\x74\x73\x20\x69\x6e\x20\x49\x45\x54\x46\x20\x73\x65\x73\x73\x69\x6f\x6e\x73\x2c\x20\x61\x73\x20\x77\x65\x6c\x6c\x20\x61\x73\x20\x77\x72\x69\x74\x74\x65\x6e\x20\x61\x6e\x64\x20\x65\x6c\x65\x63\x74\x72\x6f\x6e\x69\x63\x20\x63\x6f\x6d\x6d\x75\x6e\x69\x63\x61\x74\x69\x6f\x6e\x73\x20\x6d\x61\x64\x65\x20\x61\x74\x20\x61\x6e\x79\x20\x74\x69\x6d\x65\x20\x6f\x72\x20\x70\x6c\x61\x63\x65\x2c\x20\x77\x68\x69\x63\x68\x20\x61\x72\x65\x20\x61\x64\x64\x72\x65\x73\x73\x65\x64\x20\x74\x6f" + +let expected_2 = + "\xa3\xfb\xf0\x7d\xf3\xfa\x2f\xde\x4f\x37\x6c\xa2\x3e\x82\x73\x70\x41\x60\x5d\x9f\x4f\x4f\x57\xbd\x8c\xff\x2c\x1d\x4b\x79\x55\xec\x2a\x97\x94\x8b\xd3\x72\x29\x15\xc8\xf3\xd3\x37\xf7\xd3\x70\x05\x0e\x9e\x96\xd6\x47\xb7\xc3\x9f\x56\xe0\x31\xca\x5e\xb6\x25\x0d\x40\x42\xe0\x27\x85\xec\xec\xfa\x4b\x4b\xb5\xe8\xea\xd0\x44\x0e\x20\xb6\xe8\xdb\x09\xd8\x81\xa7\xc6\x13\x2f\x42\x0e\x52\x79\x50\x42\xbd\xfa\x77\x73\xd8\xa9\x05\x14\x47\xb3\x29\x1c\xe1\x41\x1c\x68\x04\x65\x55\x2a\xa6\xc4\x05\xb7\x76\x4d\x5e\x87\xbe\xa8\x5a\xd0\x0f\x84\x49\xed\x8f\x72\xd0\xd6\x62\xab\x05\x26\x91\xca\x66\x42\x4b\xc8\x6d\x2d\xf8\x0e\xa4\x1f\x43\xab\xf9\x37\xd3\x25\x9d\xc4\xb2\xd0\xdf\xb4\x8a\x6c\x91\x39\xdd\xd7\xf7\x69\x66\xe9\x28\xe6\x35\x55\x3b\xa7\x6c\x5c\x87\x9d\x7b\x35\xd4\x9e\xb2\xe6\x2b\x08\x71\xcd\xac\x63\x89\x39\xe2\x5e\x8a\x1e\x0e\xf9\xd5\x28\x0f\xa8\xca\x32\x8b\x35\x1c\x3c\x76\x59\x89\xcb\xcf\x3d\xaa\x8b\x6c\xcc\x3a\xaf\x9f\x39\x79\xc9\x2b\x37\x20\xfc\x88\xdc\x95\xed\x84\xa1\xbe\x05\x9c\x64\x99\xb9\xfd\xa2\x36\xe7\xe8\x18\xb0\x4b\x0b\xc3\x9c\x1e\x87\x6b\x19\x3b\xfe\x55\x69\x75\x3f\x88\x12\x8c\xc0\x8a\xaa\x9b\x63\xd1\xa1\x6f\x80\xef\x25\x54\xd7\x18\x9c\x41\x1f\x58\x69\xca\x52\xc5\xb8\x3f\xa3\x6f\xf2\x16\xb9\xc1\xd3\x00\x62\xbe\xbc\xfd\x2d\xc5\xbc\xe0\x91\x19\x34\xfd\xa7\x9a\x86\xf6\xe6\x98\xce\xd7\x59\xc3\xff\x9b\x64\x77\x33\x8f\x3d\xa4\xf9\xcd\x85\x14\xea\x99\x82\xcc\xaf\xb3\x41\xb2\x38\x4d\xd9\x02\xf3\xd1\xab\x7a\xc6\x1d\xd2\x9c\x6f\x21\xba\x5b\x86\x2f\x37\x30\xe3\x7c\xfd\xc4\xfd\x80\x6c\x22\xf2\x21" + +let k_3 = + "\x1c\x92\x40\xa5\xeb\x55\xd3\x8a\xf3\x33\x88\x86\x04\xf6\xb5\xf0\x47\x39\x17\xc1\x40\x2b\x80\x09\x9d\xca\x5c\xbc\x20\x70\x75\xc0" + +let c_3 = 42_l + +let n_3 = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02" + +let p_3 = + "\x27\x54\x77\x61\x73\x20\x62\x72\x69\x6c\x6c\x69\x67\x2c\x20\x61\x6e\x64\x20\x74\x68\x65\x20\x73\x6c\x69\x74\x68\x79\x20\x74\x6f\x76\x65\x73\x0a\x44\x69\x64\x20\x67\x79\x72\x65\x20\x61\x6e\x64\x20\x67\x69\x6d\x62\x6c\x65\x20\x69\x6e\x20\x74\x68\x65\x20\x77\x61\x62\x65\x3a\x0a\x41\x6c\x6c\x20\x6d\x69\x6d\x73\x79\x20\x77\x65\x72\x65\x20\x74\x68\x65\x20\x62\x6f\x72\x6f\x67\x6f\x76\x65\x73\x2c\x0a\x41\x6e\x64\x20\x74\x68\x65\x20\x6d\x6f\x6d\x65\x20\x72\x61\x74\x68\x73\x20\x6f\x75\x74\x67\x72\x61\x62\x65\x2e" + +let expected_3 = + "\x62\xe6\x34\x7f\x95\xed\x87\xa4\x5f\xfa\xe7\x42\x6f\x27\xa1\xdf\x5f\xb6\x91\x10\x04\x4c\x0d\x73\x11\x8e\xff\xa9\x5b\x01\xe5\xcf\x16\x6d\x3d\xf2\xd7\x21\xca\xf9\xb2\x1e\x5f\xb1\x4c\x61\x68\x71\xfd\x84\xc5\x4f\x9d\x65\xb2\x83\x19\x6c\x7f\xe4\xf6\x05\x53\xeb\xf3\x9c\x64\x02\xc4\x22\x34\xe3\x2a\x35\x6b\x3e\x76\x43\x12\xa6\x1a\x55\x32\x05\x57\x16\xea\xd6\x96\x25\x68\xf8\x7d\x3f\x3f\x77\x04\xc6\xa8\xd1\xbc\xd1\xbf\x4d\x50\xd6\x15\x4b\x6d\xa7\x31\xb1\x87\xb5\x8d\xfd\x72\x8a\xfa\x36\x75\x7a\x79\x7a\xc1\x88\xd1" + +let ciphertext_0 = chacha20_encrypt ~key:k_0 ~nonce:n_0 ~initial_counter:c_0 p_0 + +let ciphertext_1 = chacha20_encrypt ~key:k_1 ~nonce:n_1 ~initial_counter:c_1 p_1 + +let ciphertext_2 = chacha20_encrypt ~key:k_2 ~nonce:n_2 ~initial_counter:c_2 p_2 + +let ciphertext_3 = chacha20_encrypt ~key:k_3 ~nonce:n_3 ~initial_counter:c_3 p_3 + +let () = + assert (ciphertext_0 = expected_0); + assert (ciphertext_1 = expected_1); + assert (ciphertext_2 = expected_2); + assert (ciphertext_3 = expected_3); + assert ( + p_0 = chacha20_encrypt ~key:k_0 ~nonce:n_0 ~initial_counter:c_0 expected_0 ); + assert ( + p_1 = chacha20_encrypt ~key:k_1 ~nonce:n_1 ~initial_counter:c_1 expected_1 ); + assert ( + p_2 = chacha20_encrypt ~key:k_2 ~nonce:n_2 ~initial_counter:c_2 expected_2 ); + assert ( + p_3 = chacha20_encrypt ~key:k_3 ~nonce:n_3 ~initial_counter:c_3 expected_3 ); + () + +let () = + let key = + "\x85\xd6\xbe\x78\x57\x55\x6d\x33\x7f\x44\x52\xfe\x42\xd5\x06\xa8\x01\x03\x80\x8a\xfb\x0d\xb2\xfd\x4a\xbf\xf6\xaf\x41\x49\xf5\x1b" + in + let s = "Cryptographic Forum Research Group" in + let expected = + "\xa8\x06\x1d\xc1\x30\x51\x36\xc6\xc2\x2b\x8b\xaf\x0c\x01\x27\xa9" + in + let mac = poly1305_mac ~key s in + assert (String.equal mac expected); + () + +let () = + let key = + "\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f" + in + let nonce = "\x00\x00\x00\x00\x00\x01\x02\x03\x04\x05\x06\x07" in + let expected = + "\x8a\xd5\xa0\x8b\x90\x5f\x81\xcc\x81\x50\x40\x27\x4a\xb2\x94\x71\xa8\x33\xb6\x37\xe3\xfd\x0d\xa5\x08\xdb\xb8\xe2\xfd\xd1\xa6\x46" + in + let res = poly1305_key_gen ~key ~nonce in + assert (String.equal res expected); + ()