├── .gitignore ├── .ocamlformat ├── .travis.yml ├── CHANGES.md ├── CODE_OF_CONDUCT.md ├── LICENSE.md ├── README.md ├── chacha20 ├── lib │ ├── chacha20.ml │ ├── chacha20.mli │ └── dune └── test │ ├── .ocamlformat │ ├── dune │ ├── test_all.ml │ └── test_all.mli ├── dune-project ├── lib ├── cipher.ml ├── cipher.mli ├── cipher_aes_gcm.ml ├── cipher_aes_gcm.mli ├── cipher_chacha_poly.ml ├── cipher_chacha_poly.mli ├── cipher_state.ml ├── cipher_state.mli ├── dh.ml ├── dh.mli ├── dh_25519.ml ├── dh_25519.mli ├── dh_448.ml ├── dh_448.mli ├── dune ├── hash.ml ├── hash.mli ├── hkdf.ml ├── hkdf.mli ├── pattern.ml ├── pattern.mli ├── private_key.ml ├── private_key.mli ├── protocol.ml ├── protocol.mli ├── public_key.ml ├── public_key.mli ├── state.ml ├── state.mli ├── symmetric_state.ml ├── symmetric_state.mli ├── util.ml └── util.mli ├── noise.opam ├── test ├── .ocamlformat ├── bench │ ├── bench.ml │ └── dune ├── examples │ ├── dune │ ├── noise_demo_one_way.expected │ ├── noise_demo_one_way.ml │ ├── noise_demo_one_way.mli │ ├── noise_demo_two_way.expected │ ├── noise_demo_two_way.ml │ └── noise_demo_two_way.mli ├── helpers │ ├── dune │ ├── hex_string.ml │ ├── hex_string.mli │ ├── infix.ml │ └── infix.mli ├── unit │ ├── dune │ ├── test_all.ml │ ├── test_cipher.ml │ ├── test_cipher.mli │ ├── test_cipher_aes_gcm.ml │ ├── test_cipher_aes_gcm.mli │ ├── test_cipher_chacha_poly.ml │ ├── test_cipher_chacha_poly.mli │ ├── test_cipher_state.ml │ ├── test_cipher_state.mli │ ├── test_dh.ml │ ├── test_dh.mli │ ├── test_dh_25519.ml │ ├── test_dh_25519.mli │ ├── test_hash.ml │ ├── test_hash.mli │ ├── test_hkdf.ml │ ├── test_hkdf.mli │ ├── test_pattern.ml │ └── test_pattern.mli └── vectors │ ├── README.md │ ├── cacophony.txt │ ├── dune │ ├── noise-c-basic.txt │ ├── test_vectors.ml │ └── test_vectors.mli └── tweetnacl ├── lib ├── dune ├── tweetnacl.c ├── tweetnacl.h ├── tweetnacl.ml ├── tweetnacl.mli └── tweetnacl_stubs.c └── test ├── .ocamlformat ├── dune ├── test_all.ml └── test_all.mli /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .merlin 3 | *.install 4 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.8 2 | break-cases=all 3 | break-infix=fit-or-vertical 4 | field-space=loose 5 | margin=79 6 | parens-tuple=always 7 | sequence-style=terminator 8 | type-decl=sparse 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | services: 4 | - docker 5 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh 6 | script: bash ./.travis-docker.sh 7 | env: 8 | global: 9 | - PACKAGE=noise 10 | - DISTRO=alpine-3.7 11 | matrix: 12 | - OCAML_VERSION=4.04 13 | - OCAML_VERSION=4.05 14 | - OCAML_VERSION=4.06 15 | - OCAML_VERSION=4.07 16 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v0.2.0 2018-10-19 2 | ================= 3 | 4 | Use digestif 0.7 and remove custom HMAC implementation (#2). 5 | 6 | v0.1.0 2018-09-07 7 | ================= 8 | 9 | Initial release. 10 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, sex characteristics, gender identity and expression, 9 | level of experience, education, socio-economic status, nationality, personal 10 | appearance, race, religion, or sexual identity and orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at `me AT emillon DOT org`. All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 71 | available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html 72 | 73 | [homepage]: https://www.contributor-covenant.org 74 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright 2018 Etienne Millon 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 17 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 18 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 19 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 20 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 22 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ocaml-noise 2 | =========== 3 | 4 | OCaml implementation of the [Noise Protocol 5 | Framework](https://noiseprotocol.org/). 6 | 7 | Not ready for primetime. 8 | 9 | More precisely, some primitives are implemented in an ad hoc manner. This passes 10 | a good amount of test vectors, but this has not been properly fuzzed and there 11 | are no countermeasures with respect to side channel attacks. 12 | 13 | What is this NOT? 14 | ----------------- 15 | 16 | This is **not** an implementation of a full cryptographic protocol that you can 17 | drop into your application and have secure channels. 18 | 19 | What is this? 20 | ------------- 21 | 22 | This is an implementation of the Noise Protocol Framework. It consists of 23 | building bricks that can be used to create a secure cryptographic protocol. 24 | 25 | Because of the way Noise works, it is possible to process messages in full 26 | without dealing with I/O or buffering. So, this library only deals with the 27 | handshake and encrypting/decrypting payloads. 28 | 29 | How to use this? 30 | ---------------- 31 | 32 | Refer to the examples in `test/examples/` for an example, but basically: 33 | 34 | - pick a protocol 35 | - import or generate the relevant keys on each side 36 | - create initial states using `Noise.State.make` and 37 | `Noise.Protocol.initialize` 38 | - drive the handshake using `Noise.Protocol.read_message` and 39 | `Noise.Protocol.write_message` 40 | - check that the handshake is completed (see `Noise.State.handshake_hash`) 41 | - send transport messages using `Noise.Protocol.read_message` and 42 | `Noise.Protocol.write_message` 43 | 44 | Resources 45 | --------- 46 | 47 | - [Trevor Perrin, RWC 2018](https://www.youtube.com/watch?v=3gipxdJ22iM) 48 | - [an explanation by David Wong](https://www.youtube.com/watch?v=ceGTgqypwnQ) 49 | - [the spec itself](https://noiseprotocol.org/noise.html) 50 | -------------------------------------------------------------------------------- /chacha20/lib/chacha20.ml: -------------------------------------------------------------------------------- 1 | let rotate_left n b = 2 | let open Int32 in 3 | let hi = shift_left n b in 4 | let lo = shift_right_logical n (32 - b) in 5 | logor hi lo 6 | 7 | let quarter_round (a, b, c, d) = 8 | let open Int32 in 9 | (*1. a += b; d ^= a; d <<<= 16;*) 10 | let a = add a b in 11 | let d = logxor d a in 12 | let d = rotate_left d 16 in 13 | (*2. c += d; b ^= c; b <<<= 12;*) 14 | let c = add c d in 15 | let b = logxor b c in 16 | let b = rotate_left b 12 in 17 | (*3. a += b; d ^= a; d <<<= 8;*) 18 | let a = add a b in 19 | let d = logxor d a in 20 | let d = rotate_left d 8 in 21 | (*4. c += d; b ^= c; b <<<= 7;*) 22 | let c = add c d in 23 | let b = logxor b c in 24 | let b = rotate_left b 7 in 25 | (a, b, c, d) 26 | 27 | type state = int32 array [@@deriving eq, show] 28 | 29 | let make_state l = 30 | if List.length l = 16 then Array.of_list l else invalid_arg "make_state" 31 | 32 | let get s i = s.(i) 33 | 34 | let set i v s = 35 | let f j = if i = j then v else get s j in 36 | Array.init 16 f 37 | 38 | let quarter_round_state s (ia, ib, ic, id) = 39 | let a = get s ia in 40 | let b = get s ib in 41 | let c = get s ic in 42 | let d = get s id in 43 | let na, nb, nc, nd = quarter_round (a, b, c, d) in 44 | s |> set ia na |> set ib nb |> set ic nc |> set id nd 45 | 46 | type key = Key of Cstruct.t 47 | 48 | let make_key key = 49 | if Cstruct.len key = 32 then Ok (Key key) else Error "wrong key length" 50 | 51 | let key_words (Key key) = 52 | [ Cstruct.LE.get_uint32 key 0 53 | ; Cstruct.LE.get_uint32 key 4 54 | ; Cstruct.LE.get_uint32 key 8 55 | ; Cstruct.LE.get_uint32 key 12 56 | ; Cstruct.LE.get_uint32 key 16 57 | ; Cstruct.LE.get_uint32 key 20 58 | ; Cstruct.LE.get_uint32 key 24 59 | ; Cstruct.LE.get_uint32 key 28 ] 60 | 61 | type nonce = Nonce of Cstruct.t 62 | 63 | let make_nonce nonce = 64 | if Cstruct.len nonce = 12 then Ok (Nonce nonce) 65 | else Error "wrong nonce length" 66 | 67 | let nonce_words (Nonce nonce) = 68 | [ Cstruct.LE.get_uint32 nonce 0 69 | ; Cstruct.LE.get_uint32 nonce 4 70 | ; Cstruct.LE.get_uint32 nonce 8 ] 71 | 72 | let ( >>= ) x f = 73 | match x with 74 | | Ok y -> 75 | f y 76 | | Error _ as e -> 77 | e 78 | 79 | let make_state_for_encryption_checked ~key ~nonce count = 80 | let constant_words = [0x61707865l; 0x3320646el; 0x79622d32l; 0x6b206574l] in 81 | let count_words = [count] in 82 | make_state 83 | @@ List.concat 84 | [constant_words; key_words key; count_words; nonce_words nonce] 85 | 86 | let make_state_for_encryption ~key ~nonce ~count = 87 | make_key key 88 | >>= fun key -> 89 | make_nonce nonce 90 | >>= fun nonce -> Ok (make_state_for_encryption_checked ~key ~nonce count) 91 | 92 | let rec iterate n f x = if n = 0 then x else iterate (n - 1) f (f x) 93 | 94 | let add_state a b = Array.init 16 (fun i -> Int32.add (get a i) (get b i)) 95 | 96 | let process s0 = 97 | let qr i s = quarter_round_state s i in 98 | let inner_block s = 99 | s 100 | |> qr (0, 4, 8, 12) 101 | |> qr (1, 5, 9, 13) 102 | |> qr (2, 6, 10, 14) 103 | |> qr (3, 7, 11, 15) 104 | |> qr (0, 5, 10, 15) 105 | |> qr (1, 6, 11, 12) 106 | |> qr (2, 7, 8, 13) 107 | |> qr (3, 4, 9, 14) 108 | in 109 | add_state s0 (iterate 10 inner_block s0) 110 | 111 | let serialize s = 112 | let cs = Cstruct.create 64 in 113 | for i = 0 to 15 do 114 | Cstruct.LE.set_uint32 cs (4 * i) (get s i) 115 | done; 116 | cs 117 | 118 | let rec split_into_blocks cs = 119 | let len = Cstruct.len cs in 120 | let block_len = 64 in 121 | if len = 0 then [] 122 | else if len < block_len then [cs] 123 | else 124 | let block, rest = Cstruct.split cs block_len in 125 | block :: split_into_blocks rest 126 | 127 | let xor_block a b = 128 | let n = Cstruct.len a in 129 | let r = Cstruct.create n in 130 | for i = 0 to n - 1 do 131 | let v_a = Cstruct.get_uint8 a i in 132 | let v_b = Cstruct.get_uint8 b i in 133 | let v = v_a lxor v_b in 134 | Cstruct.set_uint8 r i v 135 | done; 136 | r 137 | 138 | let encrypt ~key ~counter ~nonce plaintext = 139 | make_key key 140 | >>= fun key -> 141 | make_nonce nonce 142 | >>= fun nonce -> 143 | let blocks = split_into_blocks plaintext in 144 | let rj = ref 0 in 145 | let encrypted_blocks = 146 | List.rev_map 147 | (fun block -> 148 | let j = !rj in 149 | incr rj; 150 | Int32.of_int j 151 | |> Int32.add counter 152 | |> make_state_for_encryption_checked ~key ~nonce 153 | |> process 154 | |> serialize 155 | |> xor_block block ) 156 | blocks 157 | |> List.rev 158 | in 159 | Ok (Cstruct.concat encrypted_blocks) 160 | -------------------------------------------------------------------------------- /chacha20/lib/chacha20.mli: -------------------------------------------------------------------------------- 1 | val quarter_round : 2 | int32 * int32 * int32 * int32 -> int32 * int32 * int32 * int32 3 | 4 | type state [@@deriving eq, show] 5 | 6 | val make_state : int32 list -> state 7 | 8 | val quarter_round_state : state -> int * int * int * int -> state 9 | 10 | val make_state_for_encryption : 11 | key:Cstruct.t -> nonce:Cstruct.t -> count:int32 -> (state, string) result 12 | 13 | val process : state -> state 14 | 15 | val serialize : state -> Cstruct.t 16 | 17 | val encrypt : 18 | key:Cstruct.t 19 | -> counter:int32 20 | -> nonce:Cstruct.t 21 | -> Cstruct.t 22 | -> (Cstruct.t, string) result 23 | -------------------------------------------------------------------------------- /chacha20/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name chacha20) 3 | (public_name noise._chacha20) 4 | (libraries 5 | cstruct 6 | ) 7 | (preprocess 8 | (pps ppx_deriving.std) 9 | ) 10 | ) 11 | -------------------------------------------------------------------------------- /chacha20/test/.ocamlformat: -------------------------------------------------------------------------------- 1 | disable=true 2 | -------------------------------------------------------------------------------- /chacha20/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_all) 3 | (libraries 4 | oUnit 5 | hex 6 | chacha20 7 | ) 8 | (preprocess 9 | (pps ppx_deriving.std) 10 | ) 11 | ) 12 | -------------------------------------------------------------------------------- /chacha20/test/test_all.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let equal_cstruct = Cstruct.equal 4 | let pp_cstruct = Cstruct.hexdump_pp 5 | 6 | let test_quarter_round = 7 | let test x expected ctxt = 8 | let got = Chacha20.quarter_round x in 9 | assert_equal 10 | ~ctxt 11 | ~cmp:[%eq: int32 * int32 * int32 * int32] 12 | ~printer:[%show: int32 * int32 * int32 * int32] 13 | expected 14 | got 15 | in 16 | "quarter_round" >::: 17 | [ "RFC 7539 2.1.1" >:: test 18 | ( 0x11111111l 19 | , 0x01020304l 20 | , 0x9b8d6f43l 21 | , 0x01234567l 22 | ) 23 | ( 0xea2a92f4l 24 | , 0xcb1cf8cel 25 | , 0x4581472el 26 | , 0x5881c4bbl 27 | ) 28 | ] 29 | 30 | let test_quarter_round_state = 31 | let test s i expected ctxt = 32 | let got = Chacha20.quarter_round_state s i in 33 | assert_equal 34 | ~ctxt 35 | ~cmp:[%eq: Chacha20.state] 36 | ~printer:[%show: Chacha20.state] 37 | expected 38 | got 39 | in 40 | "quarter_round_state" >::: 41 | [ "RFC 7539 2.2.1" >:: test 42 | ( Chacha20.make_state 43 | [ 0x879531e0l; 0xc5ecf37dl; 0x516461b1l; 0xc9a62f8al 44 | ; 0x44c20ef3l; 0x3390af7fl; 0xd9fc690bl; 0x2a5f714cl 45 | ; 0x53372767l; 0xb00a5631l; 0x974c541al; 0x359e9963l 46 | ; 0x5c971061l; 0x3d631689l; 0x2098d9d6l; 0x91dbd320l 47 | ] 48 | ) 49 | (2, 7, 8, 13) 50 | ( Chacha20.make_state 51 | [ 0x879531e0l; 0xc5ecf37dl; 0xbdb886dcl; 0xc9a62f8al 52 | ; 0x44c20ef3l; 0x3390af7fl; 0xd9fc690bl; 0xcfacafd2l 53 | ; 0xe46bea80l; 0xb00a5631l; 0x974c541al; 0x359e9963l 54 | ; 0x5c971061l; 0xccc07c79l; 0x2098d9d6l; 0x91dbd320l 55 | ] 56 | ) 57 | ] 58 | 59 | module Data = struct 60 | (* data from RFC 7539 2.3.2 *) 61 | let key = 62 | Hex.to_cstruct 63 | ( `Hex 64 | ( "000102030405060708090a0b0c0d0e0f" 65 | ^ "101112131415161718191a1b1c1d1e1f" 66 | ) 67 | ) 68 | 69 | let nonce = 70 | Hex.to_cstruct 71 | (`Hex "000000090000004a00000000") 72 | 73 | let count = 1l 74 | 75 | let after_process = 76 | Chacha20.make_state 77 | [ 0xe4e7f110l; 0x15593bd1l; 0x1fdd0f50l; 0xc47120a3l 78 | ; 0xc7f4d1c7l; 0x0368c033l; 0x9aaa2204l; 0x4e6cd4c3l 79 | ; 0x466482d2l; 0x09aa9f07l; 0x05d7c214l; 0xa2028bd9l 80 | ; 0xd19c12b5l; 0xb94e16del; 0xe883d0cbl; 0x4e3c50a2l 81 | ] 82 | end 83 | 84 | let test_make_state_for_encryption = 85 | let test ~key ~nonce ~count expected ctxt = 86 | let got = Chacha20.make_state_for_encryption ~key ~nonce ~count in 87 | assert_equal 88 | ~ctxt 89 | ~cmp:[%eq: (Chacha20.state, string) result] 90 | ~printer:[%show: (Chacha20.state, string) result] 91 | expected 92 | got 93 | in 94 | let open Data in 95 | "make_state_for_encryption" >::: 96 | [ "key with wrong length" >:: test 97 | ~key:(Cstruct.create 3) 98 | ~nonce 99 | ~count 100 | (Error "wrong key length") 101 | ; "Nonce with wrong length" >:: test 102 | ~key 103 | ~nonce:(Cstruct.create 3) 104 | ~count 105 | (Error "wrong nonce length") 106 | ; "OK" >:: test 107 | ~key 108 | ~nonce 109 | ~count 110 | ( Ok 111 | ( Chacha20.make_state 112 | [ 0x61707865l; 0x3320646el; 0x79622d32l; 0x6b206574l 113 | ; 0x03020100l; 0x07060504l; 0x0b0a0908l; 0x0f0e0d0cl 114 | ; 0x13121110l; 0x17161514l; 0x1b1a1918l; 0x1f1e1d1cl 115 | ; 0x00000001l; 0x09000000l; 0x4a000000l; 0x00000000l 116 | ] 117 | ) 118 | ) 119 | ] 120 | 121 | let test_process = 122 | let test state expected ctxt = 123 | let got = Chacha20.process state in 124 | assert_equal 125 | ~ctxt 126 | ~cmp:[%eq: Chacha20.state] 127 | ~printer:[%show: Chacha20.state] 128 | expected 129 | got 130 | in 131 | let get_exn = function 132 | | Ok x -> x 133 | | Error _ -> assert false 134 | in 135 | let open Data in 136 | "process" >::: 137 | [ "RFC 7539 2.3.2" >:: test 138 | (Chacha20.make_state_for_encryption ~key ~nonce ~count |> get_exn) 139 | after_process 140 | ] 141 | 142 | let test_serialize = 143 | let test state expected ctxt = 144 | let got = Chacha20.serialize state in 145 | assert_equal 146 | ~ctxt 147 | ~cmp:[%eq: cstruct] 148 | ~printer:[%show: cstruct] 149 | expected 150 | got 151 | in 152 | "serialize" >::: 153 | [ "RFC 7539 2.3.2" >:: test 154 | Data.after_process 155 | (Hex.to_cstruct 156 | ( `Hex 157 | ( "10f1e7e4d13b5915500fdd1fa32071c4" 158 | ^ "c7d1f4c733c068030422aa9ac3d46c4e" 159 | ^ "d2826446079faa0914c2d705d98b02a2" 160 | ^ "b5129cd1de164eb9cbd083e8a2503c4e" 161 | ) 162 | ) 163 | ) 164 | ] 165 | 166 | let test_encrypt = 167 | let test ~key ~nonce ~counter ~plaintext expected_ciphertext ctxt = 168 | let got = Chacha20.encrypt ~key ~nonce ~counter plaintext in 169 | let expected = Ok expected_ciphertext in 170 | assert_equal 171 | ~ctxt 172 | ~cmp:[%eq: (cstruct, string) result] 173 | ~printer:[%show: (cstruct, string) result] 174 | expected 175 | got 176 | in 177 | let plaintext_sunscreen = 178 | Cstruct.of_string @@ 179 | String.concat "" 180 | [ "Ladies and Gentlemen of the class of '99: " 181 | ; "If I could offer you only one tip for the " 182 | ; "future, sunscreen would be it." 183 | ] 184 | in 185 | "encrypt" >::: 186 | [ "RFC 7539 2.4.2" >:: test 187 | ~key:Data.key 188 | ~nonce:(Hex.to_cstruct (`Hex "000000000000004a00000000")) 189 | ~counter:1l 190 | ~plaintext:plaintext_sunscreen 191 | (Hex.to_cstruct 192 | (`Hex 193 | ( String.concat "" 194 | [ "6e2e359a2568f98041ba0728dd0d6981" 195 | ; "e97e7aec1d4360c20a27afccfd9fae0b" 196 | ; "f91b65c5524733ab8f593dabcd62b357" 197 | ; "1639d624e65152ab8f530c359f0861d8" 198 | ; "07ca0dbf500d6a6156a38e088a22b65e" 199 | ; "52bc514d16ccf806818ce91ab7793736" 200 | ; "5af90bbf74a35be6b40b8eedf2785e42" 201 | ; "874d" 202 | ] 203 | ) 204 | ) 205 | ) 206 | ] 207 | 208 | let suite = 209 | "Chacha20" >::: 210 | [ test_quarter_round 211 | ; test_quarter_round_state 212 | ; test_make_state_for_encryption 213 | ; test_process 214 | ; test_serialize 215 | ; test_encrypt 216 | ] 217 | 218 | let () = run_test_tt_main suite 219 | -------------------------------------------------------------------------------- /chacha20/test/test_all.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emillon/ocaml-noise/d5a3e0f634fba1f8d948a91c70a1dad6470722b0/chacha20/test/test_all.mli -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.1) 2 | (using fmt 1.0) 3 | -------------------------------------------------------------------------------- /lib/cipher.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | AES_GCM 3 | | Chacha_poly 4 | [@@deriving eq, show] 5 | 6 | let of_string = function 7 | | "AESGCM" -> 8 | Ok AES_GCM 9 | | "ChaChaPoly" -> 10 | Ok Chacha_poly 11 | | s -> 12 | Printf.ksprintf (fun e -> Error e) "Cipher.of_string: %s" s 13 | 14 | let encrypt_with_ad = function 15 | | AES_GCM -> 16 | Cipher_aes_gcm.encrypt_with_ad 17 | | Chacha_poly -> 18 | Cipher_chacha_poly.encrypt_with_ad 19 | 20 | let decrypt_with_ad = function 21 | | AES_GCM -> 22 | Cipher_aes_gcm.decrypt_with_ad 23 | | Chacha_poly -> 24 | Cipher_chacha_poly.decrypt_with_ad 25 | -------------------------------------------------------------------------------- /lib/cipher.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | AES_GCM 3 | | Chacha_poly 4 | [@@deriving eq, show] 5 | 6 | val of_string : string -> (t, string) result 7 | 8 | val encrypt_with_ad : 9 | t 10 | -> key:Private_key.t 11 | -> nonce:int64 12 | -> ad:Cstruct.t 13 | -> Cstruct.t 14 | -> (Cstruct.t, string) result 15 | 16 | val decrypt_with_ad : 17 | t 18 | -> key:Private_key.t 19 | -> nonce:int64 20 | -> ad:Cstruct.t 21 | -> Cstruct.t 22 | -> (Cstruct.t, string) result 23 | -------------------------------------------------------------------------------- /lib/cipher_aes_gcm.ml: -------------------------------------------------------------------------------- 1 | let iv ~nonce = 2 | let buf = Cstruct.create 12 in 3 | Cstruct.BE.set_uint64 buf 4 nonce; 4 | buf 5 | 6 | let make_key key = 7 | let open Nocrypto.Cipher_block.AES.GCM in 8 | let private_bytes = Private_key.bytes key in 9 | match of_secret private_bytes with 10 | | key -> 11 | Ok key 12 | | exception Invalid_argument _ -> 13 | Error "Wrong key size" 14 | 15 | let encrypt_with_ad ~key ~nonce ~ad plaintext = 16 | let open Nocrypto.Cipher_block.AES.GCM in 17 | match make_key key with 18 | | Error _ as e -> 19 | e 20 | | Ok key -> 21 | let iv = iv ~nonce in 22 | let result = encrypt ~key ~adata:ad ~iv plaintext in 23 | Ok (Cstruct.concat [result.message; result.tag]) 24 | 25 | let decrypt_with_ad ~key ~nonce ~ad ciphertext_and_tag = 26 | let open Nocrypto.Cipher_block.AES.GCM in 27 | match make_key key with 28 | | Error _ as e -> 29 | e 30 | | Ok key -> 31 | let iv = iv ~nonce in 32 | let tag_len = 128 / 8 in 33 | let ciphertext_len = Cstruct.len ciphertext_and_tag - tag_len in 34 | if ciphertext_len < 0 then Error "Ciphertext is too short" 35 | else 36 | let ciphertext, tag = 37 | Cstruct.split ciphertext_and_tag ciphertext_len 38 | in 39 | let result = decrypt ~key ~adata:ad ~iv ciphertext in 40 | if Util.equal_constant_time result.tag tag then Ok result.message 41 | else Error "Wrong tag" 42 | -------------------------------------------------------------------------------- /lib/cipher_aes_gcm.mli: -------------------------------------------------------------------------------- 1 | val iv : nonce:int64 -> Cstruct.t 2 | 3 | val encrypt_with_ad : 4 | key:Private_key.t 5 | -> nonce:int64 6 | -> ad:Cstruct.t 7 | -> Cstruct.t 8 | -> (Cstruct.t, string) result 9 | 10 | val decrypt_with_ad : 11 | key:Private_key.t 12 | -> nonce:int64 13 | -> ad:Cstruct.t 14 | -> Cstruct.t 15 | -> (Cstruct.t, string) result 16 | -------------------------------------------------------------------------------- /lib/cipher_chacha_poly.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | let pad16 x = 4 | let len = Cstruct.len x in 5 | let lenmod16 = len mod 16 in 6 | if lenmod16 = 0 then Cstruct.empty else Cstruct.create (16 - lenmod16) 7 | 8 | let num_to_8_le_bytes n = 9 | let cs = Cstruct.create 8 in 10 | Cstruct.LE.set_uint64 cs 0 (Int64.of_int n); 11 | cs 12 | 13 | let key_gen ~key ~nonce = 14 | let%map s0 = Chacha20.make_state_for_encryption ~key ~nonce ~count:0l in 15 | let s1 = Chacha20.process s0 in 16 | Cstruct.sub (Chacha20.serialize s1) 0 32 17 | 18 | let compute_tag ~otk ~ad ~ciphertext = 19 | let mac_data = 20 | Cstruct.concat 21 | [ ad 22 | ; pad16 ad 23 | ; ciphertext 24 | ; pad16 ciphertext 25 | ; num_to_8_le_bytes (Cstruct.len ad) 26 | ; num_to_8_le_bytes (Cstruct.len ciphertext) ] 27 | in 28 | Tweetnacl.poly1305 ~key:otk mac_data 29 | 30 | let encrypt_with_ad_low ~key ~fixed ~iv ~ad plaintext = 31 | let key = Private_key.bytes key in 32 | let nonce = Cstruct.concat [fixed; iv] in 33 | let%bind otk = key_gen ~key ~nonce in 34 | let%map ciphertext = Chacha20.encrypt ~key ~counter:1l ~nonce plaintext in 35 | let tag = compute_tag ~otk ~ad ~ciphertext in 36 | (ciphertext, tag) 37 | 38 | let encode_iv nonce = 39 | let iv = Cstruct.create 8 in 40 | Cstruct.LE.set_uint64 iv 0 nonce; 41 | iv 42 | 43 | let encrypt_with_ad ~key ~nonce ~ad plaintext = 44 | let%map ciphertext, tag = 45 | encrypt_with_ad_low ~key ~ad ~fixed:(Cstruct.create 4) 46 | ~iv:(encode_iv nonce) plaintext 47 | in 48 | Cstruct.concat [ciphertext; tag] 49 | 50 | let split ciphertext_and_tag = 51 | let tag_len = 128 / 8 in 52 | let ciphertext_len = Cstruct.len ciphertext_and_tag - tag_len in 53 | if ciphertext_len < 0 then Error "Ciphertext is too short" 54 | else Ok (Cstruct.split ciphertext_and_tag ciphertext_len) 55 | 56 | let encode_nonce n = 57 | let nonce = Cstruct.create 12 in 58 | Cstruct.LE.set_uint64 nonce 4 n; 59 | nonce 60 | 61 | let decrypt_with_ad ~key ~nonce ~ad ciphertext_and_tag = 62 | let key = Private_key.bytes key in 63 | let nonce = encode_nonce nonce in 64 | let%bind ciphertext, received_tag = split ciphertext_and_tag in 65 | let%bind otk = key_gen ~key ~nonce in 66 | let expected_tag = compute_tag ~otk ~ad ~ciphertext in 67 | if equal_constant_time expected_tag received_tag then 68 | Chacha20.encrypt ~key ~counter:1l ~nonce ciphertext 69 | else Error "Wrong tag" 70 | -------------------------------------------------------------------------------- /lib/cipher_chacha_poly.mli: -------------------------------------------------------------------------------- 1 | val encrypt_with_ad : 2 | key:Private_key.t 3 | -> nonce:int64 4 | -> ad:Cstruct.t 5 | -> Cstruct.t 6 | -> (Cstruct.t, string) result 7 | 8 | val encrypt_with_ad_low : 9 | key:Private_key.t 10 | -> fixed:Cstruct.t 11 | -> iv:Cstruct.t 12 | -> ad:Cstruct.t 13 | -> Cstruct.t 14 | -> (Cstruct.t * Cstruct.t, string) result 15 | 16 | val decrypt_with_ad : 17 | key:Private_key.t 18 | -> nonce:int64 19 | -> ad:Cstruct.t 20 | -> Cstruct.t 21 | -> (Cstruct.t, string) result 22 | -------------------------------------------------------------------------------- /lib/cipher_state.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | type t = 4 | | Empty 5 | | Ready of {key : Private_key.t; nonce : int64} 6 | | Depleted 7 | [@@deriving eq, show] 8 | 9 | let empty = Empty 10 | 11 | let create ?unsafe_nonce:(nonce = 0L) key = Ready {key; nonce} 12 | 13 | let depleted = Depleted 14 | 15 | let with_ t f x = 16 | match t with 17 | | Empty -> 18 | Ok (t, x) 19 | | Ready params -> 20 | let%map r = f ~key:params.key ~nonce:params.nonce x in 21 | let new_cs = 22 | let new_nonce = Int64.succ params.nonce in 23 | if new_nonce = 0xff_ff_ff_ff_ff_ff_ff_ffL then Depleted 24 | else Ready {params with nonce = new_nonce} 25 | in 26 | (new_cs, r) 27 | | Depleted -> 28 | Error "Nonce depleted" 29 | 30 | let has_key = function 31 | | Empty -> 32 | false 33 | | Ready _ -> 34 | true 35 | | Depleted -> 36 | true 37 | -------------------------------------------------------------------------------- /lib/cipher_state.mli: -------------------------------------------------------------------------------- 1 | (** The [CipherState] as defined in v34 5.1. 2 | It is represented a bit differently, since the [n] and [k] values only make 3 | sense for the case when a key is configured and not depleted. 4 | *) 5 | 6 | type t [@@deriving eq, show] 7 | 8 | val empty : t 9 | (** No key is set. *) 10 | 11 | val create : ?unsafe_nonce:int64 -> Private_key.t -> t 12 | (** Set a key. This sets a nonce to [0L]. [unsafe_nonce] is only used for 13 | testing. *) 14 | 15 | val depleted : t 16 | (** When a key has been used too many times, we arrive at this state, which 17 | signals an error when trying to encrypt or decrypt. *) 18 | 19 | val with_ : 20 | t 21 | -> (key:Private_key.t -> nonce:int64 -> 'a -> ('a, string) result) 22 | -> 'a 23 | -> (t * 'a, string) result 24 | (** Pass the unwrapped state to a continuation. 25 | - if the state is [empty], return the state and ['a] parameter, both 26 | unchanged. 27 | (if there is no key, encryption/decryption return the plaintext) 28 | - if a key is set, call the continuation with the key and nonce, and return 29 | the same state with the nonce incremented (or [depleted]), and the result 30 | of the continuation. 31 | - if the state is [depleted], return an error. 32 | *) 33 | 34 | val has_key : t -> bool 35 | (** Is it possible to use this to encrypt or decrypt? *) 36 | -------------------------------------------------------------------------------- /lib/dh.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | Curve_25519 3 | | Curve_448 4 | [@@deriving eq, show] 5 | 6 | let of_string = function 7 | | "25519" -> 8 | Ok Curve_25519 9 | | "448" -> 10 | Ok Curve_448 11 | | s -> 12 | Printf.ksprintf (fun e -> Error e) "Dh.of_string: %s" s 13 | 14 | let len = function 15 | | Curve_25519 -> 16 | 32 17 | | Curve_448 -> 18 | 56 19 | 20 | let key_exchange = function 21 | | Curve_25519 -> 22 | Dh_25519.key_exchange 23 | | Curve_448 -> 24 | Dh_448.key_exchange 25 | 26 | let public_key = function 27 | | Curve_25519 -> 28 | Dh_25519.public_key 29 | | Curve_448 -> 30 | Dh_448.public_key 31 | -------------------------------------------------------------------------------- /lib/dh.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | Curve_25519 3 | | Curve_448 4 | [@@deriving eq, show] 5 | 6 | val of_string : string -> (t, string) result 7 | 8 | val len : t -> int 9 | (** The DHLEN constant for this algorithm (in bytes). *) 10 | 11 | val key_exchange : t -> priv:Private_key.t -> pub:Public_key.t -> Cstruct.t 12 | 13 | val public_key : t -> Private_key.t -> Public_key.t 14 | -------------------------------------------------------------------------------- /lib/dh_25519.ml: -------------------------------------------------------------------------------- 1 | let key_size = 32 2 | 3 | let with_temp_array k = 4 | let a = Array.make key_size 0 in 5 | k a; 6 | let cs = Cstruct.create key_size in 7 | Array.iteri (Cstruct.set_uint8 cs) a; 8 | cs 9 | 10 | let convert_public pub = 11 | Callipyge.public_key_of_string @@ Cstruct.to_string @@ Public_key.bytes pub 12 | 13 | let convert_secret priv = 14 | Callipyge.secret_key_of_string 15 | @@ Cstruct.to_string 16 | @@ Private_key.bytes priv 17 | 18 | let key_exchange ~priv ~pub = 19 | let public = convert_public pub in 20 | let secret = convert_secret priv in 21 | with_temp_array @@ fun out -> Callipyge.ecdh_inplace ~out ~secret ~public 22 | 23 | let public_key_cs priv = 24 | let secret = convert_secret priv in 25 | with_temp_array @@ fun out -> Callipyge.ecdh_base_inplace ~out ~secret 26 | 27 | let public_key priv = Public_key.of_bytes (public_key_cs priv) 28 | 29 | let corresponds ~priv ~pub = 30 | let computed_pub = public_key_cs priv in 31 | Cstruct.equal (Public_key.bytes pub) computed_pub 32 | -------------------------------------------------------------------------------- /lib/dh_25519.mli: -------------------------------------------------------------------------------- 1 | val key_exchange : priv:Private_key.t -> pub:Public_key.t -> Cstruct.t 2 | 3 | val corresponds : priv:Private_key.t -> pub:Public_key.t -> bool 4 | 5 | val public_key : Private_key.t -> Public_key.t 6 | -------------------------------------------------------------------------------- /lib/dh_448.ml: -------------------------------------------------------------------------------- 1 | let hex_encode cs = 2 | let (`Hex h) = Hex.of_cstruct cs in 3 | h 4 | 5 | let private_key_noise_to_lib key = 6 | key |> Private_key.bytes |> hex_encode |> Rfc7748.X448.private_key_of_string 7 | 8 | let public_key_lib_to_cstruct key = 9 | key |> Rfc7748.X448.string_of_public_key |> Cstruct.of_hex 10 | 11 | let public_key_lib_to_noise key = 12 | key |> public_key_lib_to_cstruct |> Public_key.of_bytes 13 | 14 | let public_key_noise_to_lib key = 15 | key |> Public_key.bytes |> hex_encode |> Rfc7748.X448.public_key_of_string 16 | 17 | let public_key priv = 18 | priv 19 | |> private_key_noise_to_lib 20 | |> Rfc7748.X448.public_key_of_private_key 21 | |> public_key_lib_to_noise 22 | 23 | let corresponds ~priv ~pub = 24 | let computed_key = public_key priv in 25 | Public_key.equal computed_key pub 26 | 27 | let key_exchange ~priv ~pub = 28 | Rfc7748.X448.scale 29 | (private_key_noise_to_lib priv) 30 | (public_key_noise_to_lib pub) 31 | |> public_key_lib_to_cstruct 32 | -------------------------------------------------------------------------------- /lib/dh_448.mli: -------------------------------------------------------------------------------- 1 | val key_exchange : priv:Private_key.t -> pub:Public_key.t -> Cstruct.t 2 | 3 | val corresponds : priv:Private_key.t -> pub:Public_key.t -> bool 4 | 5 | val public_key : Private_key.t -> Public_key.t 6 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name noise) 3 | (libraries 4 | callipyge 5 | chacha20 6 | cstruct 7 | digestif.ocaml 8 | eqaf 9 | hex 10 | nocrypto 11 | rfc7748 12 | tweetnacl 13 | ) 14 | (preprocess 15 | (pps ppx_deriving.std ppx_let) 16 | ) 17 | ) 18 | -------------------------------------------------------------------------------- /lib/hash.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | SHA256 3 | | SHA512 4 | | BLAKE2s 5 | | BLAKE2b 6 | [@@deriving eq, show] 7 | 8 | let of_string = function 9 | | "SHA256" -> 10 | Ok SHA256 11 | | "SHA512" -> 12 | Ok SHA512 13 | | "BLAKE2s" -> 14 | Ok BLAKE2s 15 | | "BLAKE2b" -> 16 | Ok BLAKE2b 17 | | s -> 18 | Printf.ksprintf (fun e -> Error e) "Hash.of_string: %s" s 19 | 20 | let len = function 21 | | SHA256 -> 22 | 32 23 | | SHA512 -> 24 | 64 25 | | BLAKE2s -> 26 | 32 27 | | BLAKE2b -> 28 | 64 29 | 30 | module type DIGESTIF = sig 31 | type t 32 | 33 | val to_raw_string : t -> string 34 | 35 | val digest_string : ?off:int -> ?len:int -> string -> t 36 | 37 | val hmac_string : key:string -> ?off:int -> ?len:int -> string -> t 38 | end 39 | 40 | let digestif : t -> (module DIGESTIF) = function 41 | | SHA256 -> 42 | (module Digestif.SHA256) 43 | | SHA512 -> 44 | (module Digestif.SHA512) 45 | | BLAKE2s -> 46 | (module Digestif.BLAKE2S) 47 | | BLAKE2b -> 48 | (module Digestif.BLAKE2B) 49 | 50 | let hash t data = 51 | let (module D) = digestif t in 52 | Cstruct.to_string data 53 | |> D.digest_string 54 | |> D.to_raw_string 55 | |> Cstruct.of_string 56 | 57 | let hmac t ~key data = 58 | let (module D) = digestif t in 59 | let string_key = Cstruct.to_string key in 60 | Cstruct.to_string data 61 | |> D.hmac_string ~key:string_key 62 | |> D.to_raw_string 63 | |> Cstruct.of_string 64 | -------------------------------------------------------------------------------- /lib/hash.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | SHA256 3 | | SHA512 4 | | BLAKE2s 5 | | BLAKE2b 6 | [@@deriving eq, show] 7 | 8 | val of_string : string -> (t, string) result 9 | 10 | val len : t -> int 11 | (** [HASHLEN] *) 12 | 13 | val hash : t -> Cstruct.t -> Cstruct.t 14 | 15 | val hmac : t -> key:Cstruct.t -> Cstruct.t -> Cstruct.t 16 | -------------------------------------------------------------------------------- /lib/hkdf.ml: -------------------------------------------------------------------------------- 1 | let extract ~hmac ~salt ~ikm = hmac ~key:salt ikm 2 | 3 | let b01 = Cstruct.of_hex "01" 4 | 5 | let b02 = Cstruct.of_hex "02" 6 | 7 | let b03 = Cstruct.of_hex "03" 8 | 9 | let hkdf2_k ~hmac ~temp_key = 10 | let output1 = hmac ~key:temp_key b01 in 11 | let output2 = hmac ~key:temp_key (Cstruct.concat [output1; b02]) in 12 | (output1, output2) 13 | 14 | let hkdf2 ~hmac ~salt ~ikm = 15 | let temp_key = extract ~hmac ~salt ~ikm in 16 | hkdf2_k ~hmac ~temp_key 17 | 18 | let hkdf3_k ~hmac ~temp_key = 19 | let output1, output2 = hkdf2_k ~hmac ~temp_key in 20 | let output3 = hmac ~key:temp_key (Cstruct.concat [output2; b03]) in 21 | (output1, output2, output3) 22 | 23 | let hkdf3 ~hmac ~salt ~ikm = 24 | let temp_key = extract ~hmac ~salt ~ikm in 25 | hkdf3_k ~hmac ~temp_key 26 | -------------------------------------------------------------------------------- /lib/hkdf.mli: -------------------------------------------------------------------------------- 1 | val hkdf2 : 2 | hmac:(key:Cstruct.t -> Cstruct.t -> Cstruct.t) 3 | -> salt:Cstruct.t 4 | -> ikm:Cstruct.t 5 | -> Cstruct.t * Cstruct.t 6 | 7 | val hkdf3 : 8 | hmac:(key:Cstruct.t -> Cstruct.t -> Cstruct.t) 9 | -> salt:Cstruct.t 10 | -> ikm:Cstruct.t 11 | -> Cstruct.t * Cstruct.t * Cstruct.t 12 | 13 | val extract : 14 | hmac:(key:Cstruct.t -> Cstruct.t -> Cstruct.t) 15 | -> salt:Cstruct.t 16 | -> ikm:Cstruct.t 17 | -> Cstruct.t 18 | -------------------------------------------------------------------------------- /lib/pattern.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | N 3 | | K 4 | | X 5 | | NN 6 | | NX 7 | | IN 8 | | XN 9 | | XX 10 | | IX 11 | | NK 12 | | IK 13 | | KN 14 | | KK 15 | | KX 16 | | XK 17 | | IKpsk1 18 | | IKpsk2 19 | | INpsk1 20 | | INpsk2 21 | | IXpsk2 22 | | KKpsk0 23 | | KKpsk2 24 | | KNpsk0 25 | | KNpsk2 26 | | KXpsk2 27 | | NKpsk0 28 | | NKpsk2 29 | | NNpsk0 30 | | NNpsk2 31 | | NXpsk2 32 | | XKpsk3 33 | | XNpsk3 34 | | XXpsk3 35 | | Npsk0 36 | | Xpsk1 37 | | Kpsk0 38 | [@@deriving eq, show] 39 | 40 | let of_string = function 41 | | "N" -> 42 | Ok N 43 | | "K" -> 44 | Ok K 45 | | "X" -> 46 | Ok X 47 | | "NN" -> 48 | Ok NN 49 | | "NX" -> 50 | Ok NX 51 | | "IN" -> 52 | Ok IN 53 | | "XN" -> 54 | Ok XN 55 | | "XX" -> 56 | Ok XX 57 | | "IX" -> 58 | Ok IX 59 | | "NK" -> 60 | Ok NK 61 | | "IK" -> 62 | Ok IK 63 | | "KN" -> 64 | Ok KN 65 | | "KK" -> 66 | Ok KK 67 | | "KX" -> 68 | Ok KX 69 | | "XK" -> 70 | Ok XK 71 | | "IKpsk1" -> 72 | Ok IKpsk1 73 | | "IKpsk2" -> 74 | Ok IKpsk2 75 | | "NNpsk0" -> 76 | Ok NNpsk0 77 | | "NNpsk2" -> 78 | Ok NNpsk2 79 | | "NKpsk0" -> 80 | Ok NKpsk0 81 | | "NKpsk2" -> 82 | Ok NKpsk2 83 | | "NXpsk2" -> 84 | Ok NXpsk2 85 | | "KNpsk0" -> 86 | Ok KNpsk0 87 | | "KNpsk2" -> 88 | Ok KNpsk2 89 | | "KKpsk0" -> 90 | Ok KKpsk0 91 | | "KKpsk2" -> 92 | Ok KKpsk2 93 | | "KXpsk2" -> 94 | Ok KXpsk2 95 | | "INpsk1" -> 96 | Ok INpsk1 97 | | "INpsk2" -> 98 | Ok INpsk2 99 | | "IXpsk2" -> 100 | Ok IXpsk2 101 | | "XNpsk3" -> 102 | Ok XNpsk3 103 | | "XKpsk3" -> 104 | Ok XKpsk3 105 | | "XXpsk3" -> 106 | Ok XXpsk3 107 | | "Npsk0" -> 108 | Ok Npsk0 109 | | "Kpsk0" -> 110 | Ok Kpsk0 111 | | "Xpsk1" -> 112 | Ok Xpsk1 113 | | s -> 114 | Printf.ksprintf (fun e -> Error e) "Pattern.of_string: %s" s 115 | 116 | type step = 117 | | E 118 | | ES 119 | | S 120 | | SS 121 | | EE 122 | | SE 123 | | PSK 124 | 125 | let all_steps = function 126 | | N -> 127 | [[E; ES]] 128 | | K -> 129 | [[E; ES; SS]] 130 | | X -> 131 | [[E; ES; S; SS]] 132 | | NN -> 133 | [[E]; [E; EE]] 134 | | NX -> 135 | [[E]; [E; EE; S; ES]] 136 | | IN -> 137 | [[E; S]; [E; EE; SE]] 138 | | XN -> 139 | [[E]; [E; EE]; [S; SE]] 140 | | XX -> 141 | [[E]; [E; EE; S; ES]; [S; SE]] 142 | | IX -> 143 | [[E; S]; [E; EE; SE; S; ES]] 144 | | NK -> 145 | [[E; ES]; [E; EE]] 146 | | IK -> 147 | [[E; ES; S; SS]; [E; EE; SE]] 148 | | KN -> 149 | [[E]; [E; EE; SE]] 150 | | KK -> 151 | [[E; ES; SS]; [E; EE; SE]] 152 | | KX -> 153 | [[E]; [E; EE; SE; S; ES]] 154 | | XK -> 155 | [[E; ES]; [E; EE]; [S; SE]] 156 | | IKpsk1 -> 157 | [[E; ES; S; SS; PSK]; [E; EE; SE]] 158 | | IKpsk2 -> 159 | [[E; ES; S; SS]; [E; EE; SE; PSK]] 160 | | NNpsk0 -> 161 | [[PSK; E]; [E; EE]] 162 | | NNpsk2 -> 163 | [[E]; [E; EE; PSK]] 164 | | NKpsk0 -> 165 | [[PSK; E; ES]; [E; EE]] 166 | | NKpsk2 -> 167 | [[E; ES]; [E; EE; PSK]] 168 | | NXpsk2 -> 169 | [[E]; [E; EE; S; ES; PSK]] 170 | | KNpsk0 -> 171 | [[PSK; E]; [E; EE; SE]] 172 | | KNpsk2 -> 173 | [[E]; [E; EE; SE; PSK]] 174 | | KKpsk0 -> 175 | [[PSK; E; ES; SS]; [E; EE; SE]] 176 | | KKpsk2 -> 177 | [[E; ES; SS]; [E; EE; SE; PSK]] 178 | | KXpsk2 -> 179 | [[E]; [E; EE; SE; S; ES; PSK]] 180 | | INpsk1 -> 181 | [[E; S; PSK]; [E; EE; SE]] 182 | | INpsk2 -> 183 | [[E; S]; [E; EE; SE; PSK]] 184 | | IXpsk2 -> 185 | [[E; S]; [E; EE; SE; S; ES; PSK]] 186 | | XNpsk3 -> 187 | [[E]; [E; EE]; [S; SE; PSK]] 188 | | XKpsk3 -> 189 | [[E; ES]; [E; EE]; [S; SE; PSK]] 190 | | XXpsk3 -> 191 | [[E]; [E; EE; S; ES]; [S; SE; PSK]] 192 | | Npsk0 -> 193 | [[PSK; E; ES]] 194 | | Kpsk0 -> 195 | [[PSK; E; ES; SS]] 196 | | Xpsk1 -> 197 | [[E; ES; S; SS; PSK]] 198 | 199 | type transport = 200 | | One_way 201 | | Two_way 202 | 203 | let transport = function 204 | | N 205 | | K 206 | | X 207 | | Npsk0 208 | | Xpsk1 209 | | Kpsk0 -> 210 | One_way 211 | | NN 212 | | NX 213 | | IN 214 | | XN 215 | | XX 216 | | IX 217 | | NK 218 | | IK 219 | | KN 220 | | KK 221 | | KX 222 | | XK 223 | | IKpsk1 224 | | IKpsk2 225 | | NNpsk0 226 | | NNpsk2 227 | | NKpsk0 228 | | NKpsk2 229 | | NXpsk2 230 | | KNpsk0 231 | | KNpsk2 232 | | KKpsk0 233 | | KKpsk2 234 | | KXpsk2 235 | | INpsk1 236 | | INpsk2 237 | | IXpsk2 238 | | XNpsk3 239 | | XKpsk3 240 | | XXpsk3 -> 241 | Two_way 242 | -------------------------------------------------------------------------------- /lib/pattern.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | N 3 | | K 4 | | X 5 | | NN 6 | | NX 7 | | IN 8 | | XN 9 | | XX 10 | | IX 11 | | NK 12 | | IK 13 | | KN 14 | | KK 15 | | KX 16 | | XK 17 | | IKpsk1 18 | | IKpsk2 19 | | INpsk1 20 | | INpsk2 21 | | IXpsk2 22 | | KKpsk0 23 | | KKpsk2 24 | | KNpsk0 25 | | KNpsk2 26 | | KXpsk2 27 | | NKpsk0 28 | | NKpsk2 29 | | NNpsk0 30 | | NNpsk2 31 | | NXpsk2 32 | | XKpsk3 33 | | XNpsk3 34 | | XXpsk3 35 | | Npsk0 36 | | Xpsk1 37 | | Kpsk0 38 | [@@deriving eq, show] 39 | 40 | val of_string : string -> (t, string) result 41 | 42 | type step = 43 | | E 44 | | ES 45 | | S 46 | | SS 47 | | EE 48 | | SE 49 | | PSK 50 | 51 | val all_steps : t -> step list list 52 | 53 | type transport = 54 | | One_way 55 | | Two_way 56 | 57 | val transport : t -> transport 58 | -------------------------------------------------------------------------------- /lib/private_key.ml: -------------------------------------------------------------------------------- 1 | type t = Private of Cstruct.t [@@deriving eq] 2 | 3 | let pp fmt _ = Format.pp_print_string fmt "" 4 | 5 | let bytes (Private cs) = cs 6 | 7 | let of_bytes cs = Private cs 8 | -------------------------------------------------------------------------------- /lib/private_key.mli: -------------------------------------------------------------------------------- 1 | type t [@@deriving eq] 2 | 3 | val pp : Format.formatter -> t -> unit 4 | 5 | val bytes : t -> Cstruct.t 6 | 7 | val of_bytes : Cstruct.t -> t 8 | -------------------------------------------------------------------------------- /lib/protocol.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | let handle_ss s = State.mix_dh_key s ~remote:Static ~local:Static 4 | 5 | let handle_ee s = State.mix_dh_key s ~remote:Ephemeral ~local:Ephemeral 6 | 7 | let write_handler_payload payload s0 = State.encrypt_and_hash s0 payload 8 | 9 | let write_handler step s0 = 10 | let open Pattern in 11 | let return r = 12 | let%map x = r in 13 | (x, Cstruct.empty) 14 | in 15 | match step with 16 | | E -> ( 17 | match State.e_pub s0 with 18 | | None -> 19 | Error "No ephemeral public key" 20 | | Some epub -> 21 | let s1 = State.mix_hash_and_psk s0 epub in 22 | Ok (s1, Public_key.bytes epub) ) 23 | | ES -> 24 | let local, remote = 25 | let open State in 26 | if is_initiator s0 then (Ephemeral, Static) else (Static, Ephemeral) 27 | in 28 | return @@ State.mix_dh_key s0 ~local ~remote 29 | | SE -> 30 | let local, remote = 31 | let open State in 32 | if is_initiator s0 then (Static, Ephemeral) else (Ephemeral, Static) 33 | in 34 | return @@ State.mix_dh_key s0 ~local ~remote 35 | | S -> ( 36 | match State.s_pub s0 with 37 | | None -> 38 | Error "No static public key" 39 | | Some s_pub -> 40 | let plaintext = Public_key.bytes s_pub in 41 | State.encrypt_and_hash s0 plaintext ) 42 | | SS -> 43 | return @@ handle_ss s0 44 | | EE -> 45 | return @@ handle_ee s0 46 | | PSK -> 47 | return @@ State.mix_key_and_hash_psk s0 48 | 49 | let compose_write_handlers payload state steps = 50 | let rec go msgs s = function 51 | | [] -> 52 | Ok (s, Cstruct.concat (List.rev msgs)) 53 | | hdl :: hdls -> 54 | let%bind new_s, new_msg = hdl s in 55 | go (new_msg :: msgs) new_s hdls 56 | in 57 | let handlers = List.map write_handler steps in 58 | let handlers = handlers @ [write_handler_payload payload] in 59 | go [] state handlers 60 | 61 | let apply_transport ~is_last s = 62 | if is_last then State.setup_transport s else s 63 | 64 | let write_message s0 payload = 65 | let s1, state = State.next s0 in 66 | match state with 67 | | Handshake_step (steps, is_last) -> 68 | let%map s2, ciphertext = compose_write_handlers payload s1 steps in 69 | let s3 = apply_transport ~is_last s2 in 70 | (s3, ciphertext) 71 | | Transport -> 72 | State.send_transport s1 payload 73 | 74 | let read_handler_payload s msg = State.decrypt_and_hash s msg 75 | 76 | let read_handler step s0 msg0 = 77 | let open Pattern in 78 | match step with 79 | | E -> 80 | let re, msg1 = State.split_dh ~clear:true s0 msg0 in 81 | let%map s1 = State.set_re s0 re in 82 | let s2 = State.mix_hash_and_psk s1 re in 83 | (s2, msg1) 84 | | ES -> 85 | let local, remote = 86 | let open State in 87 | if is_initiator s0 then (Ephemeral, Static) else (Static, Ephemeral) 88 | in 89 | let%map s1 = State.mix_dh_key s0 ~remote ~local in 90 | (s1, msg0) 91 | | SE -> 92 | let local, remote = 93 | let open State in 94 | if is_initiator s0 then (Static, Ephemeral) else (Ephemeral, Static) 95 | in 96 | let%map s1 = State.mix_dh_key s0 ~remote ~local in 97 | (s1, msg0) 98 | | S -> 99 | let temp, msg1 = State.split_dh s0 msg0 in 100 | let%bind s1, plaintext = 101 | State.decrypt_and_hash s0 (Public_key.bytes temp) 102 | in 103 | let%map s2 = State.set_rs s1 (Public_key.of_bytes plaintext) in 104 | (s2, msg1) 105 | | SS -> 106 | let%map s1 = handle_ss s0 in 107 | (s1, msg0) 108 | | EE -> 109 | let%map s1 = handle_ee s0 in 110 | (s1, msg0) 111 | | PSK -> 112 | let%map s1 = State.mix_key_and_hash_psk s0 in 113 | (s1, msg0) 114 | 115 | let rec compose_read_handlers s steps msg = 116 | match steps with 117 | | step :: steps -> 118 | let hdl = read_handler step in 119 | let%bind next_s, next_msg = hdl s msg in 120 | compose_read_handlers next_s steps next_msg 121 | | [] -> 122 | read_handler_payload s msg 123 | 124 | let read_message s0 msg = 125 | let s1, state = State.next s0 in 126 | match state with 127 | | Handshake_step (steps, is_last) -> 128 | let%map s2, plaintext = compose_read_handlers s1 steps msg in 129 | let s3 = apply_transport ~is_last s2 in 130 | (s3, plaintext) 131 | | Transport -> 132 | State.receive_transport s1 msg 133 | 134 | let initialize s ~prologue ~public_keys = 135 | List.fold_left State.mix_hash s 136 | (prologue :: List.map Public_key.bytes public_keys) 137 | -------------------------------------------------------------------------------- /lib/protocol.mli: -------------------------------------------------------------------------------- 1 | val initialize : 2 | State.t -> prologue:Cstruct.t -> public_keys:Public_key.t list -> State.t 3 | (** Hash the public data *) 4 | 5 | val read_message : 6 | State.t -> Cstruct.t -> (State.t * Cstruct.t, string) result 7 | 8 | val write_message : 9 | State.t -> Cstruct.t -> (State.t * Cstruct.t, string) result 10 | -------------------------------------------------------------------------------- /lib/public_key.ml: -------------------------------------------------------------------------------- 1 | type t = Public of Cstruct.t [@@deriving eq] 2 | 3 | let pp fmt (Public cs) = 4 | Format.fprintf fmt "" Cstruct.hexdump_pp cs 5 | 6 | let bytes (Public cs) = cs 7 | 8 | let of_bytes cs = Public cs 9 | -------------------------------------------------------------------------------- /lib/public_key.mli: -------------------------------------------------------------------------------- 1 | type t [@@deriving eq] 2 | 3 | val pp : Format.formatter -> t -> unit 4 | 5 | val bytes : t -> Cstruct.t 6 | 7 | val of_bytes : Cstruct.t -> t 8 | -------------------------------------------------------------------------------- /lib/state.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | type params = 4 | { dh : Dh.t 5 | ; cipher : Cipher.t 6 | ; hash : Hash.t } 7 | 8 | type t = 9 | { re : Public_key.t option 10 | ; e : Private_key.t option 11 | ; rs : Public_key.t option 12 | ; s : Private_key.t option 13 | ; symmetric_state : Symmetric_state.t 14 | ; params : params 15 | ; cipher_state : Cipher_state.t 16 | ; transport_init_to_resp : Cipher_state.t option 17 | ; transport_resp_to_init : Cipher_state.t option 18 | ; is_initiator : bool 19 | ; pattern : Pattern.t 20 | ; remaining_handshake_steps : Pattern.step list list 21 | ; psk : Cstruct.t option } 22 | 23 | let prep_h name hash = 24 | let buf_name = Cstruct.of_string name in 25 | let hashlen = Hash.len hash in 26 | let name_len = Cstruct.len buf_name in 27 | if name_len <= hashlen then ( 28 | let buf = Cstruct.create hashlen in 29 | Cstruct.blit buf_name 0 buf 0 name_len; 30 | buf ) 31 | else Hash.hash hash buf_name 32 | 33 | let make ~name ~pattern ~is_initiator ~hash ~dh ~cipher ~s ~rs ~e ~psk = 34 | let h = prep_h name hash in 35 | let params = {hash; dh; cipher} in 36 | let symmetric_state = Symmetric_state.create hash dh h in 37 | { re = None 38 | ; e 39 | ; s 40 | ; rs 41 | ; params 42 | ; symmetric_state 43 | ; cipher_state = Cipher_state.empty 44 | ; transport_init_to_resp = None 45 | ; transport_resp_to_init = None 46 | ; is_initiator 47 | ; pattern 48 | ; remaining_handshake_steps = Pattern.all_steps pattern 49 | ; psk } 50 | 51 | let public_key_opt dh = function 52 | | Some priv -> 53 | Some (Dh.public_key dh priv) 54 | | None -> 55 | None 56 | 57 | let e_pub state = public_key_opt state.params.dh state.e 58 | 59 | let s_pub state = public_key_opt state.params.dh state.s 60 | 61 | let is_initiator state = state.is_initiator 62 | 63 | let pattern state = state.pattern 64 | 65 | let split_dh ?(clear = false) s msg = 66 | let dh_len = Dh.len s.params.dh in 67 | let len = 68 | if clear then dh_len 69 | else if Cipher_state.has_key s.cipher_state then dh_len + 16 70 | else dh_len 71 | in 72 | let a, b = Cstruct.split msg len in 73 | (Public_key.of_bytes a, b) 74 | 75 | let mix_hash s data = 76 | {s with symmetric_state = Symmetric_state.mix_hash s.symmetric_state data} 77 | 78 | let set_symmetric_state_and_key s (symmetric_state, key) = 79 | {s with cipher_state = Cipher_state.create key; symmetric_state} 80 | 81 | let mix_key s input = 82 | Symmetric_state.mix_key s.symmetric_state input 83 | |> set_symmetric_state_and_key s 84 | 85 | let mix_hash_and_psk s0 key = 86 | let input = Public_key.bytes key in 87 | let s1 = mix_hash s0 input in 88 | match s1.psk with 89 | | Some _ -> 90 | mix_key s1 input 91 | | None -> 92 | s1 93 | 94 | let get_psk s = 95 | match s.psk with 96 | | Some psk -> 97 | Ok psk 98 | | None -> 99 | Error "no psk" 100 | 101 | let mix_key_and_hash_psk s = 102 | let%map psk = get_psk s in 103 | Symmetric_state.mix_key_and_hash s.symmetric_state psk 104 | |> set_symmetric_state_and_key s 105 | 106 | type key_type = 107 | | Static 108 | | Ephemeral 109 | 110 | let key_or_error key_opt name = 111 | match key_opt with 112 | | None -> 113 | Error (Printf.sprintf "%s is not set" name) 114 | | Some k -> 115 | Ok k 116 | 117 | let local_key s = function 118 | | Static -> 119 | key_or_error s.s "s" 120 | | Ephemeral -> 121 | key_or_error s.e "e" 122 | 123 | let remote_key s = function 124 | | Static -> 125 | key_or_error s.rs "rs" 126 | | Ephemeral -> 127 | key_or_error s.re "re" 128 | 129 | let mix_dh_key s ~local ~remote = 130 | let%bind priv = local_key s local in 131 | let%bind pub = remote_key s remote in 132 | Dh.key_exchange s.params.dh ~priv ~pub |> mix_key s |> fun x -> Ok x 133 | 134 | let has_dh_size s k = Cstruct.len (Public_key.bytes k) = Dh.len s.params.dh 135 | 136 | let set_re s k = 137 | assert (has_dh_size s k); 138 | match s.re with 139 | | None -> 140 | Ok {s with re = Some k} 141 | | Some _ -> 142 | Error "re is already set" 143 | 144 | let set_rs s k = 145 | assert (has_dh_size s k); 146 | match s.rs with 147 | | None -> 148 | Ok {s with rs = Some k} 149 | | Some _ -> 150 | Error "rs is already set" 151 | 152 | let decrypt_with_ad_cs cipher_state ~ad cipher = 153 | Cipher_state.with_ cipher_state (Cipher.decrypt_with_ad cipher ~ad) 154 | 155 | let decrypt_with_ad s ciphertext_and_tag = 156 | let%map new_cs, plaintext = 157 | decrypt_with_ad_cs s.cipher_state 158 | ~ad:(Symmetric_state.h s.symmetric_state) 159 | s.params.cipher ciphertext_and_tag 160 | in 161 | ({s with cipher_state = new_cs}, plaintext) 162 | 163 | let handshake_hash s = 164 | match s.transport_init_to_resp with 165 | | None -> 166 | None 167 | | Some _ -> 168 | Some (Symmetric_state.h s.symmetric_state) 169 | 170 | type state = 171 | | Handshake_step of Pattern.step list * bool 172 | | Transport 173 | 174 | let next s = 175 | match s.remaining_handshake_steps with 176 | | h :: t -> 177 | let is_last = t = [] in 178 | ({s with remaining_handshake_steps = t}, Handshake_step (h, is_last)) 179 | | [] -> 180 | (s, Transport) 181 | 182 | let decrypt_and_hash s0 ciphertext = 183 | let%map s1, plaintext = decrypt_with_ad s0 ciphertext in 184 | (mix_hash s1 ciphertext, plaintext) 185 | 186 | let encrypt_with_ad_cs cipher_state ~ad cipher = 187 | Cipher_state.with_ cipher_state (Cipher.encrypt_with_ad cipher ~ad) 188 | 189 | let encrypt_with_ad s plaintext = 190 | let%map new_cs, ciphertext = 191 | encrypt_with_ad_cs s.cipher_state 192 | ~ad:(Symmetric_state.h s.symmetric_state) 193 | s.params.cipher plaintext 194 | in 195 | ({s with cipher_state = new_cs}, ciphertext) 196 | 197 | let encrypt_and_hash s payload = 198 | let%map n1, ciphertext = encrypt_with_ad s payload in 199 | (mix_hash n1 ciphertext, ciphertext) 200 | 201 | let transport_encrypt s plaintext cipher_state = 202 | encrypt_with_ad_cs cipher_state ~ad:Cstruct.empty s.params.cipher plaintext 203 | 204 | let transport_decrypt s ciphertext cipher_state = 205 | decrypt_with_ad_cs cipher_state ~ad:Cstruct.empty s.params.cipher ciphertext 206 | 207 | let get_transport_init_to_resp s = s.transport_init_to_resp 208 | 209 | let set_transport_init_to_resp s v = {s with transport_init_to_resp = v} 210 | 211 | let get_transport_resp_to_init s = s.transport_resp_to_init 212 | 213 | let set_transport_resp_to_init s v = {s with transport_resp_to_init = v} 214 | 215 | let with_ s ~send = 216 | let get, set = 217 | if s.is_initiator = send then 218 | (get_transport_init_to_resp, set_transport_init_to_resp) 219 | else (get_transport_resp_to_init, set_transport_resp_to_init) 220 | in 221 | fun k -> 222 | match get s with 223 | | Some cipher_state -> 224 | let%map new_cs, result = k cipher_state in 225 | (set s (Some new_cs), result) 226 | | None -> 227 | Error "Transport is not setup" 228 | 229 | let setup_transport s = 230 | let init_to_resp, resp_to_init = Symmetric_state.split s.symmetric_state in 231 | match Pattern.transport s.pattern with 232 | | One_way -> 233 | {s with transport_init_to_resp = Some init_to_resp} 234 | | Two_way -> 235 | { s with 236 | transport_init_to_resp = Some init_to_resp 237 | ; transport_resp_to_init = Some resp_to_init } 238 | 239 | let send_transport s plaintext = 240 | with_ s ~send:true @@ transport_encrypt s plaintext 241 | 242 | let receive_transport s ciphertext = 243 | with_ s ~send:false @@ transport_decrypt s ciphertext 244 | -------------------------------------------------------------------------------- /lib/state.mli: -------------------------------------------------------------------------------- 1 | (** [HandshakeState] as defined in v34 5.3. *) 2 | 3 | type t 4 | 5 | val make : 6 | name:string 7 | -> pattern:Pattern.t 8 | -> is_initiator:bool 9 | -> hash:Hash.t 10 | -> dh:Dh.t 11 | -> cipher:Cipher.t 12 | -> s:Private_key.t option 13 | -> rs:Public_key.t option 14 | -> e:Private_key.t option 15 | -> psk:Cstruct.t option 16 | -> t 17 | 18 | val e_pub : t -> Public_key.t option 19 | (** The public key corresponding to [e]. *) 20 | 21 | val set_re : t -> Public_key.t -> (t, string) result 22 | (** Set [re], returning an error if was set before. *) 23 | 24 | val s_pub : t -> Public_key.t option 25 | (** The public key corresponding to [s]. *) 26 | 27 | val set_rs : t -> Public_key.t -> (t, string) result 28 | (** Set [rs], returning an error if was set before. *) 29 | 30 | val is_initiator : t -> bool 31 | 32 | val pattern : t -> Pattern.t 33 | 34 | type key_type = 35 | | Static 36 | | Ephemeral 37 | 38 | val mix_hash : t -> Cstruct.t -> t 39 | (** Delegate [mix_hash] on the underlying [Symmetric_state.t]. *) 40 | 41 | val mix_hash_and_psk : t -> Public_key.t -> t 42 | (** Call [mix_hash], and if a PSK is used, call [mix_key] as well. *) 43 | 44 | val mix_key : t -> Cstruct.t -> t 45 | (** Call [mix_key] on the underlying [Symmetric_state.t] and initialize the 46 | [Cipher_state.t] with the result. *) 47 | 48 | val mix_dh_key : t -> local:key_type -> remote:key_type -> (t, string) result 49 | (** Perform a key exchange using the [local] and [remote] key types, and call 50 | [mix_key] using the result. *) 51 | 52 | val mix_key_and_hash_psk : t -> (t, string) result 53 | (** Call [Symmetric_state.mix_key_and_hash] with the PSK. *) 54 | 55 | val decrypt_and_hash : t -> Cstruct.t -> (t * Cstruct.t, string) result 56 | 57 | val encrypt_and_hash : t -> Cstruct.t -> (t * Cstruct.t, string) result 58 | 59 | val handshake_hash : t -> Cstruct.t option 60 | (** Get the handshake hash, if the handshake is over. *) 61 | 62 | val split_dh : ?clear:bool -> t -> Cstruct.t -> Public_key.t * Cstruct.t 63 | (** Extract a DH key at the beginning of the specified buffer. 64 | The key size depends on whether it is expected to be encrypted or in clear. 65 | - if [clear] is [true] (it defaults to [false]), assume it is clear 66 | - otherwise, depends on [Cipher_state.has_key] 67 | *) 68 | 69 | val setup_transport : t -> t 70 | (** Call [Symmetric_state.split] and setup a one-way or two-way transport 71 | depending on the pattern. *) 72 | 73 | val receive_transport : t -> Cstruct.t -> (t * Cstruct.t, string) result 74 | (** Receive a message, based on the configured transport. *) 75 | 76 | val send_transport : t -> Cstruct.t -> (t * Cstruct.t, string) result 77 | (** Send a message, based on the configured transport. *) 78 | 79 | type state = 80 | | Handshake_step of Pattern.step list * bool 81 | (** Next steps, and is it the last message *) 82 | | Transport (** Handshake is over *) 83 | 84 | val next : t -> t * state 85 | (** Determine the next step, "popping" the next list of handshake steps. *) 86 | -------------------------------------------------------------------------------- /lib/symmetric_state.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { ck : Cstruct.t 3 | ; h : Cstruct.t 4 | ; hash : Hash.t 5 | ; dh : Dh.t } 6 | 7 | let h t = t.h 8 | 9 | let create hash dh h = {ck = h; h; hash; dh} 10 | 11 | let mix_hash s data = 12 | let new_h = Hash.hash s.hash (Cstruct.concat [s.h; data]) in 13 | {s with h = new_h} 14 | 15 | let truncate_if_hash_64 s input = 16 | if Hash.len s.hash = 64 then Cstruct.sub input 0 32 else input 17 | 18 | let hkdf_gen hkdf s input = 19 | let {ck; hash; dh; _} = s in 20 | let hashlen = Hash.len hash in 21 | let ikm_length = Cstruct.len input in 22 | let dh_len = Dh.len dh in 23 | assert (Cstruct.len ck = hashlen); 24 | assert (List.mem ikm_length [0; 32; dh_len]); 25 | hkdf ~hmac:(Hash.hmac hash) ~salt:ck ~ikm:input 26 | 27 | let hkdf2 = hkdf_gen Hkdf.hkdf2 28 | 29 | let hkdf3 = hkdf_gen Hkdf.hkdf3 30 | 31 | let mix_key s input = 32 | let new_ck, temp_k = hkdf2 s input in 33 | let new_s = {s with ck = new_ck} in 34 | let truncated_temp_k = truncate_if_hash_64 new_s temp_k in 35 | (new_s, Private_key.of_bytes truncated_temp_k) 36 | 37 | let split s = 38 | let make_cipher_state temp_k = 39 | temp_k 40 | |> truncate_if_hash_64 s 41 | |> Private_key.of_bytes 42 | |> Cipher_state.create 43 | in 44 | let temp_k1, temp_k2 = hkdf2 s Cstruct.empty in 45 | (make_cipher_state temp_k1, make_cipher_state temp_k2) 46 | 47 | let mix_key_and_hash s0 input = 48 | let new_ck, temp_h, temp_k = hkdf3 s0 input in 49 | let s1 = {s0 with ck = new_ck} in 50 | let s2 = mix_hash s1 temp_h in 51 | let truncated_temp_k = truncate_if_hash_64 s2 temp_k in 52 | (s2, Private_key.of_bytes truncated_temp_k) 53 | -------------------------------------------------------------------------------- /lib/symmetric_state.mli: -------------------------------------------------------------------------------- 1 | (** A wrapper around [ck] and [h]. 2 | See v34 5.2. *) 3 | 4 | type t 5 | 6 | val create : Hash.t -> Dh.t -> Cstruct.t -> t 7 | 8 | val mix_hash : t -> Cstruct.t -> t 9 | 10 | val mix_key : t -> Cstruct.t -> t * Private_key.t 11 | 12 | val mix_key_and_hash : t -> Cstruct.t -> t * Private_key.t 13 | 14 | val h : t -> Cstruct.t 15 | 16 | val split : t -> Cipher_state.t * Cipher_state.t 17 | -------------------------------------------------------------------------------- /lib/util.ml: -------------------------------------------------------------------------------- 1 | let equal_constant_time a b = 2 | Eqaf.equal (Cstruct.to_string a) (Cstruct.to_string b) 3 | 4 | module Let_syntax = struct 5 | let bind x ~f = 6 | match x with 7 | | Ok x -> 8 | f x 9 | | Error _ as e -> 10 | e 11 | 12 | let map x ~f = bind x ~f:(fun y -> Ok (f y)) 13 | end 14 | -------------------------------------------------------------------------------- /lib/util.mli: -------------------------------------------------------------------------------- 1 | val equal_constant_time : Cstruct.t -> Cstruct.t -> bool 2 | 3 | module Let_syntax : sig 4 | val map : ('a, 'e) result -> f:('a -> 'b) -> ('b, 'e) result 5 | 6 | val bind : ('a, 'e) result -> f:('a -> ('b, 'e) result) -> ('b, 'e) result 7 | end 8 | -------------------------------------------------------------------------------- /noise.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Etienne Millon " 3 | authors: "Etienne Millon " 4 | license: "BSD-2" 5 | homepage: "https://github.com/emillon/ocaml-noise" 6 | doc: "https://emillon.github.io/ocaml-noise/doc" 7 | bug-reports: "https://github.com/emillon/ocaml-noise/issues" 8 | depends: [ 9 | "ocaml" {>= "4.04.0"} 10 | "callipyge" {>= "0.2"} 11 | "cstruct" 12 | "digestif" {>= "0.7"} 13 | "dune" {build & >= "1.1.0"} 14 | "eqaf" 15 | "hex" 16 | "lwt_ppx" {with-test} 17 | "lwt" {with-test} 18 | "nocrypto" 19 | "ounit" {with-test} 20 | "ppx_deriving" 21 | "ppx_deriving_yojson" {with-test} 22 | "ppx_let" 23 | "ppxlib" {build} 24 | "rfc7748" 25 | ] 26 | build: [ 27 | ["dune" "subst"] {pinned} 28 | ["dune" "build" "-p" name "-j" jobs] 29 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 30 | ] 31 | dev-repo: "git+https://github.com/emillon/ocaml-noise.git" 32 | synopsis: "The Noise Protocol Framework" 33 | description: """ 34 | This library contains an implementation of the Noise Protocol Framework using 35 | different cryptographic libraries. 36 | """ 37 | -------------------------------------------------------------------------------- /test/.ocamlformat: -------------------------------------------------------------------------------- 1 | disable=true 2 | -------------------------------------------------------------------------------- /test/bench/bench.ml: -------------------------------------------------------------------------------- 1 | let crypto_random_bytes n = 2 | let ic = Pervasives.open_in_bin "/dev/urandom" in 3 | let s = Pervasives.really_input_string ic n in 4 | close_in ic; 5 | Cstruct.of_string s 6 | 7 | let random_private_key len = 8 | Noise.Private_key.of_bytes @@ crypto_random_bytes len 9 | 10 | let ensure_ok r = 11 | match r with 12 | | Ok _ -> () 13 | | Error e -> failwith e 14 | 15 | let bench_ciphers () = 16 | let plaintext = crypto_random_bytes 10_000 in 17 | 18 | let ad = crypto_random_bytes 10 in 19 | 20 | let bench_cipher algo key = 21 | Noise.Cipher.encrypt_with_ad 22 | algo 23 | ~key 24 | ~nonce:0L 25 | ~ad 26 | plaintext 27 | |> ensure_ok 28 | in 29 | 30 | let key_aes = random_private_key 16 in 31 | let key_chacha = random_private_key 32 in 32 | 33 | Benchmark.throughputN 1 34 | [ ("AES-GCM", bench_cipher Noise.Cipher.AES_GCM, key_aes) 35 | ; ("ChaChaPoly", bench_cipher Noise.Cipher.Chacha_poly, key_chacha) 36 | ] 37 | 38 | let bench_hashes () = 39 | let data = crypto_random_bytes 1_000 in 40 | 41 | let bench_hash hash () = 42 | Noise.Hash.hash hash data 43 | in 44 | 45 | Benchmark.throughputN 1 46 | [ ("SHA256", bench_hash Noise.Hash.SHA256, ()) 47 | ; ("SHA512", bench_hash Noise.Hash.SHA512, ()) 48 | ; ("BLAKE2s", bench_hash Noise.Hash.BLAKE2s, ()) 49 | ; ("BLAKE2b", bench_hash Noise.Hash.BLAKE2b, ()) 50 | ] 51 | 52 | let bench_dh () = 53 | let priv = random_private_key 32 in 54 | let pub = Noise.Dh_25519.public_key @@ random_private_key 32 in 55 | 56 | let bench_dh dh () : Cstruct.t = 57 | Noise.Dh.key_exchange dh ~priv ~pub 58 | in 59 | 60 | Benchmark.throughputN 1 61 | [ ("X25519", bench_dh Noise.Dh.Curve_25519, ()) 62 | ] 63 | 64 | let () = 65 | let open Benchmark.Tree in 66 | register @@ 67 | "Noise" @>>> 68 | [ "ciphers" @> lazy (bench_ciphers ()) 69 | ; "hashes" @> lazy (bench_hashes ()) 70 | ; "dh" @> lazy (bench_dh ()) 71 | ] 72 | 73 | let () = Benchmark.Tree.run_global () 74 | -------------------------------------------------------------------------------- /test/bench/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name bench) 3 | (libraries noise benchmark) 4 | ) 5 | 6 | (alias 7 | (name bench) 8 | (action (run ./bench.exe --all)) 9 | ) 10 | -------------------------------------------------------------------------------- /test/examples/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names 3 | noise_demo_one_way 4 | noise_demo_two_way 5 | ) 6 | (libraries 7 | noise 8 | lwt.unix 9 | ) 10 | (preprocess 11 | (pps 12 | lwt_ppx 13 | ) 14 | ) 15 | ) 16 | -------------------------------------------------------------------------------- /test/examples/noise_demo_one_way.expected: -------------------------------------------------------------------------------- 1 | resp: received Hello 2 | resp: received Noise 3 | resp: received Protocol 4 | -------------------------------------------------------------------------------- /test/examples/noise_demo_one_way.ml: -------------------------------------------------------------------------------- 1 | (** 2 | This is an example of a one-way transport protocol. 3 | 4 | Two processes are started, and after the handshake message is sent, the 5 | initiator can send messages to the responder. 6 | *) 7 | 8 | let dh = Noise.Dh.Curve_25519 9 | 10 | let crypto_random_bytes n = 11 | let ic = Pervasives.open_in_bin "/dev/urandom" in 12 | let s = Pervasives.really_input_string ic n in 13 | close_in ic; 14 | Cstruct.of_string s 15 | 16 | let generate_private_key () = 17 | Noise.Dh.len dh 18 | |> crypto_random_bytes 19 | |> Noise.Private_key.of_bytes 20 | 21 | let generate_key_pair () = 22 | let priv = generate_private_key () in 23 | (Noise.Dh_25519.public_key priv, priv) 24 | 25 | let make_state ~is_initiator = 26 | Noise.State.make 27 | ~name:"Noise_N_25519_AESGCM_SHA512" 28 | ~pattern:Noise.Pattern.N 29 | ~is_initiator 30 | ~hash:Noise.Hash.SHA512 31 | ~dh 32 | ~cipher:Noise.Cipher.AES_GCM 33 | ~psk:None 34 | 35 | exception Noise_protocol_error of string 36 | 37 | let to_lwt = function 38 | | Ok x -> Lwt.return x 39 | | Error e -> Lwt.fail (Noise_protocol_error e) 40 | 41 | let write_message oc state msg = 42 | let%lwt (new_state, ciphertext) = 43 | to_lwt (Noise.Protocol.write_message state msg) 44 | in 45 | let `Hex hex_line = Hex.of_cstruct ciphertext in 46 | let%lwt () = Lwt_io.write_line oc hex_line in 47 | Lwt.return new_state 48 | 49 | let read_message ic state = 50 | let%lwt hex_line = Lwt_io.read_line ic in 51 | let ciphertext = Hex.to_cstruct (`Hex hex_line) in 52 | to_lwt @@ Noise.Protocol.read_message state ciphertext 53 | 54 | let initiator ~prologue ~rs ~write_chan = 55 | let write = write_message write_chan in 56 | let e = generate_private_key () in 57 | let state0 = 58 | make_state 59 | ~rs:(Some rs) 60 | ~e:(Some e) 61 | ~s:None 62 | ~is_initiator:true 63 | |> Noise.Protocol.initialize 64 | ~prologue 65 | ~public_keys:[rs] 66 | in 67 | let%lwt state1 = write state0 Cstruct.empty in 68 | assert (Noise.State.handshake_hash state1 <> None); 69 | let go state msg = write state @@ Cstruct.of_string msg in 70 | let msgs = 71 | [ "Hello" 72 | ; "Noise" 73 | ; "Protocol" 74 | ; "stop" 75 | ] 76 | in 77 | let%lwt (_:Noise.State.t) = Lwt_list.fold_left_s go state1 msgs in 78 | Lwt.return_unit 79 | 80 | let responder ~prologue ~s ~read_chan = 81 | let read = read_message read_chan in 82 | let e = generate_private_key () in 83 | let state0 = 84 | make_state 85 | ~is_initiator:false 86 | ~rs:None 87 | ~e:(Some e) 88 | ~s:(Some s) 89 | |> Noise.Protocol.initialize 90 | ~prologue 91 | ~public_keys:[Noise.Dh_25519.public_key s] 92 | in 93 | let%lwt (state1, payload) = read state0 in 94 | assert (Cstruct.len payload = 0); 95 | assert (Noise.State.handshake_hash state1 <> None); 96 | let state = ref state1 in 97 | while%lwt true do 98 | let%lwt (new_state, cs) = read !state in 99 | let s = Cstruct.to_string cs in 100 | if s = "stop" then 101 | exit 0; 102 | let%lwt () = Lwt_io.printlf "resp: received %s%!" s in 103 | state := new_state; 104 | Lwt.return_unit 105 | done 106 | 107 | let main = 108 | let (rs, s) = generate_key_pair () in 109 | let (read_chan, write_chan) = Lwt_io.pipe () in 110 | let prologue = Cstruct.of_string "some-prologue-data" in 111 | let%lwt () = Lwt_io.flush_all () in 112 | match Lwt_unix.fork () with 113 | | n when n < 0 -> 114 | failwith "fork" 115 | | 0 -> initiator ~prologue ~rs ~write_chan 116 | | _ -> responder ~prologue ~s ~read_chan 117 | 118 | let () = Lwt_main.run main 119 | -------------------------------------------------------------------------------- /test/examples/noise_demo_one_way.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emillon/ocaml-noise/d5a3e0f634fba1f8d948a91c70a1dad6470722b0/test/examples/noise_demo_one_way.mli -------------------------------------------------------------------------------- /test/examples/noise_demo_two_way.expected: -------------------------------------------------------------------------------- 1 | init: got len(Hello) = 5 2 | init: got len(Noise) = 5 3 | init: got len(Protocol) = 8 4 | -------------------------------------------------------------------------------- /test/examples/noise_demo_two_way.ml: -------------------------------------------------------------------------------- 1 | (** 2 | This is an example of a two-way transport protocol. 3 | 4 | Two processes are started, and after the handshake messages are exchanged, 5 | the participants can talk to each other securely. 6 | *) 7 | 8 | let dh = Noise.Dh.Curve_25519 9 | 10 | let crypto_random_bytes n = 11 | let ic = Pervasives.open_in_bin "/dev/urandom" in 12 | let s = Pervasives.really_input_string ic n in 13 | close_in ic; 14 | Cstruct.of_string s 15 | 16 | let generate_private_key () = 17 | Noise.Dh.len dh 18 | |> crypto_random_bytes 19 | |> Noise.Private_key.of_bytes 20 | 21 | let make_state ~is_initiator = 22 | Noise.State.make 23 | ~name:"Noise_XX_25519_AESGCM_SHA512" 24 | ~pattern:Noise.Pattern.XX 25 | ~is_initiator 26 | ~hash:Noise.Hash.SHA512 27 | ~dh 28 | ~cipher:Noise.Cipher.AES_GCM 29 | ~rs:None 30 | ~psk:None 31 | 32 | exception Noise_protocol_error of string 33 | 34 | let to_lwt = function 35 | | Ok x -> Lwt.return x 36 | | Error e -> Lwt.fail (Noise_protocol_error e) 37 | 38 | let write_message oc state msg = 39 | let%lwt (new_state, ciphertext) = 40 | to_lwt (Noise.Protocol.write_message state msg) 41 | in 42 | let `Hex hex_line = Hex.of_cstruct ciphertext in 43 | let%lwt () = Lwt_io.write_line oc hex_line in 44 | Lwt.return new_state 45 | 46 | let read_message ic state = 47 | let%lwt hex_line = Lwt_io.read_line ic in 48 | let ciphertext = Hex.to_cstruct (`Hex hex_line) in 49 | to_lwt @@ Noise.Protocol.read_message state ciphertext 50 | 51 | let initiator ~prologue ~read_chan ~write_chan = 52 | let read = read_message read_chan in 53 | let write = write_message write_chan in 54 | let s = generate_private_key () in 55 | let e = generate_private_key () in 56 | let state0 = 57 | make_state 58 | ~e:(Some e) 59 | ~s:(Some s) 60 | ~is_initiator:true 61 | |> Noise.Protocol.initialize 62 | ~prologue 63 | ~public_keys:[] 64 | in 65 | let%lwt state1 = write state0 Cstruct.empty in 66 | let%lwt (state2, _) = read state1 in 67 | let%lwt state3 = write state2 Cstruct.empty in 68 | assert (Noise.State.handshake_hash state3 <> None); 69 | let go state msg = 70 | let%lwt state_inter = write state @@ Cstruct.of_string msg in 71 | let%lwt (new_state, response) = read state_inter in 72 | let%lwt () = Lwt_io.printlf "init: got %s" (Cstruct.to_string response) in 73 | Lwt.return new_state 74 | in 75 | let msgs = 76 | [ "Hello" 77 | ; "Noise" 78 | ; "Protocol" 79 | ; "stop" 80 | ] 81 | in 82 | let%lwt (_:Noise.State.t) = Lwt_list.fold_left_s go state3 msgs in 83 | Lwt.return_unit 84 | 85 | let responder ~prologue ~read_chan ~write_chan = 86 | let read = read_message read_chan in 87 | let write = write_message write_chan in 88 | let s = generate_private_key () in 89 | let e = generate_private_key () in 90 | let state0 = 91 | make_state 92 | ~is_initiator:false 93 | ~e:(Some e) 94 | ~s:(Some s) 95 | |> Noise.Protocol.initialize 96 | ~prologue 97 | ~public_keys:[] 98 | in 99 | let%lwt (state1, _) = read state0 in 100 | let%lwt state2 = write state1 Cstruct.empty in 101 | let%lwt (state3, payload) = read state2 in 102 | assert (Cstruct.len payload = 0); 103 | assert (Noise.State.handshake_hash state3 <> None); 104 | let handle s = 105 | if s = "stop" then 106 | exit 0; 107 | Printf.sprintf 108 | "len(%s) = %d" 109 | s 110 | (String.length s) 111 | in 112 | let state = ref state3 in 113 | while%lwt true do 114 | let%lwt (state_inter, cs) = read !state in 115 | let%lwt new_state = write state_inter @@ Cstruct.of_string @@ handle @@ Cstruct.to_string cs in 116 | state := new_state; 117 | Lwt.return_unit 118 | done 119 | 120 | let main = 121 | let (r2i_read, r2i_write) = Lwt_io.pipe () in 122 | let (i2r_read, i2r_write) = Lwt_io.pipe () in 123 | let prologue = Cstruct.of_string "some-prologue-data" in 124 | let%lwt () = Lwt_io.flush_all () in 125 | match Lwt_unix.fork () with 126 | | n when n < 0 -> 127 | failwith "fork" 128 | | 0 -> 129 | initiator 130 | ~prologue 131 | ~read_chan:i2r_read 132 | ~write_chan:r2i_write 133 | | _ -> 134 | responder 135 | ~prologue 136 | ~read_chan:r2i_read 137 | ~write_chan:i2r_write 138 | 139 | let () = Lwt_main.run main 140 | -------------------------------------------------------------------------------- /test/examples/noise_demo_two_way.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emillon/ocaml-noise/d5a3e0f634fba1f8d948a91c70a1dad6470722b0/test/examples/noise_demo_two_way.mli -------------------------------------------------------------------------------- /test/helpers/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name test_helpers) 3 | (libraries 4 | cstruct 5 | hex 6 | oUnit 7 | ppx_deriving_yojson.runtime 8 | ) 9 | (preprocess 10 | (pps 11 | ppx_deriving.std 12 | ppx_deriving_yojson 13 | )) 14 | ) 15 | -------------------------------------------------------------------------------- /test/helpers/hex_string.ml: -------------------------------------------------------------------------------- 1 | type t = Cstruct.t 2 | [@@deriving eq] 3 | 4 | let of_yojson json = 5 | let open Ppx_deriving_yojson_runtime in 6 | [%of_yojson: string] json >|= fun s -> 7 | Hex.to_cstruct (`Hex s) 8 | 9 | let pp fmt cstruct = 10 | let `Hex s = Hex.of_cstruct cstruct in 11 | Format.pp_print_string fmt s 12 | -------------------------------------------------------------------------------- /test/helpers/hex_string.mli: -------------------------------------------------------------------------------- 1 | type t = Cstruct.t 2 | [@@deriving eq,of_yojson] 3 | 4 | val pp : Format.formatter -> t -> unit 5 | -------------------------------------------------------------------------------- /test/helpers/infix.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let (>:=) s f = 4 | s >:: f s 5 | -------------------------------------------------------------------------------- /test/helpers/infix.mli: -------------------------------------------------------------------------------- 1 | val (>:=) : string -> (string -> OUnit2.test_fun) -> OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_all) 3 | (libraries 4 | hex 5 | noise 6 | oUnit 7 | test_helpers 8 | ) 9 | (preprocess 10 | (pps ppx_deriving.std) 11 | ) 12 | ) 13 | -------------------------------------------------------------------------------- /test/unit/test_all.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let suite = 4 | "Unit tests" >::: 5 | [ Test_cipher.suite 6 | ; Test_cipher_aes_gcm.suite 7 | ; Test_cipher_chacha_poly.suite 8 | ; Test_cipher_state.suite 9 | ; Test_dh.suite 10 | ; Test_dh_25519.suite 11 | ; Test_hash.suite 12 | ; Test_hkdf.suite 13 | ; Test_pattern.suite 14 | ] 15 | 16 | let () = 17 | run_test_tt_main suite 18 | -------------------------------------------------------------------------------- /test/unit/test_cipher.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers.Infix 3 | 4 | let test_of_string = 5 | let should_be expected s ctxt = 6 | let got = Noise.Cipher.of_string s in 7 | assert_equal 8 | ~ctxt 9 | ~cmp:[%eq: (Noise.Cipher.t, string) result] 10 | ~printer:[%show: (Noise.Cipher.t, string) result] 11 | expected 12 | got 13 | in 14 | "of_string" >::: 15 | [ "AESGCM" >:= should_be (Ok AES_GCM) 16 | ; "ChaChaPoly" >:= should_be (Ok Chacha_poly) 17 | ] 18 | 19 | let suite = 20 | "Cipher" >::: 21 | [ test_of_string 22 | ] 23 | -------------------------------------------------------------------------------- /test/unit/test_cipher.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_cipher_aes_gcm.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let test_iv = 4 | let test nonce expected ctxt = 5 | let got = Noise.Cipher_aes_gcm.iv ~nonce in 6 | let expected = Hex.to_cstruct expected in 7 | assert_equal 8 | ~ctxt 9 | ~cmp:[%eq: Test_helpers.Hex_string.t] 10 | ~printer:[%show: Test_helpers.Hex_string.t] 11 | expected 12 | got 13 | in 14 | "iv" >::: 15 | [ "zeroes" >:: test 0L (`Hex "000000000000000000000000") 16 | ; "ones" >:: test 0xff_ff_ff_ff_ff_ff_ff_ffL (`Hex "00000000ffffffffffffffff") 17 | ; "endianness" >:: test 0x01_02_03_04_05_06_07_08L (`Hex "000000000102030405060708") 18 | ] 19 | 20 | module Data = struct 21 | let plaintext = `Hex "deadbeef" 22 | let ciphertext = `Hex "a3f07724e1b3940449def6fce7608c8d01c79ec5" 23 | let key = `Hex "000102030405060708090a0b0c0d0e0f" 24 | let nonce = 54L 25 | let ad = `Hex "010203" 26 | end 27 | 28 | let test_encrypt_with_ad = 29 | let test ~key ~nonce ~ad ~plaintext ~expected ctxt = 30 | let key = Noise.Private_key.of_bytes @@ Hex.to_cstruct key in 31 | let ad = Hex.to_cstruct ad in 32 | let plaintext = Hex.to_cstruct plaintext in 33 | let expected = 34 | match expected with 35 | | Ok h -> Ok (Hex.to_cstruct h) 36 | | Error _ as e -> e 37 | in 38 | let got = Noise.Cipher_aes_gcm.encrypt_with_ad ~key ~nonce ~ad plaintext in 39 | assert_equal 40 | ~ctxt 41 | ~cmp:[%eq: (Test_helpers.Hex_string.t, string) result] 42 | ~printer:[%show: (Test_helpers.Hex_string.t, string) result] 43 | expected 44 | got 45 | in 46 | let open Data in 47 | "encrypt_with_ad" >::: 48 | [ "OK" >:: test 49 | ~key 50 | ~nonce 51 | ~ad 52 | ~plaintext 53 | ~expected:(Ok ciphertext) 54 | ; "Wrong key size" >:: 55 | test 56 | ~key:(`Hex "00") 57 | ~nonce 58 | ~ad 59 | ~plaintext 60 | ~expected:(Error "Wrong key size") 61 | ] 62 | 63 | let alter_tag h = 64 | let cs = Hex.to_cstruct h in 65 | let last_index = Cstruct.len cs - 1 in 66 | let modify = function 67 | | 0 -> 1 68 | | _ -> 0 69 | in 70 | Cstruct.get_uint8 cs last_index 71 | |> modify 72 | |> Cstruct.set_uint8 cs last_index; 73 | Hex.of_cstruct cs 74 | 75 | let test_decrypt_with_ad = 76 | let test ~key ~nonce ~ad ~ciphertext ~expected ctxt = 77 | let key = Noise.Private_key.of_bytes @@ Hex.to_cstruct key in 78 | let ad = Hex.to_cstruct ad in 79 | let ciphertext = Hex.to_cstruct ciphertext in 80 | let expected = 81 | match expected with 82 | | Ok h -> Ok (Hex.to_cstruct h) 83 | | Error _ as e -> e 84 | in 85 | let got = Noise.Cipher_aes_gcm.decrypt_with_ad ~key ~nonce ~ad ciphertext in 86 | assert_equal 87 | ~ctxt 88 | ~cmp:[%eq: (Test_helpers.Hex_string.t, string) result] 89 | ~printer:[%show: (Test_helpers.Hex_string.t, string) result] 90 | expected 91 | got 92 | in 93 | let open Data in 94 | "decrypt_with_ad" >::: 95 | [ "OK" >:: test 96 | ~key 97 | ~nonce 98 | ~ad 99 | ~ciphertext 100 | ~expected:(Ok plaintext) 101 | ; "Wrong key size" >:: test 102 | ~key:(`Hex "00") 103 | ~nonce 104 | ~ad 105 | ~ciphertext 106 | ~expected:(Error "Wrong key size") 107 | ; "Ciphertext too short" >:: test 108 | ~key 109 | ~nonce 110 | ~ad 111 | ~ciphertext:(`Hex "0102") 112 | ~expected:(Error "Ciphertext is too short") 113 | ; "Wrong tag" >:: test 114 | ~key 115 | ~nonce 116 | ~ad 117 | ~ciphertext:(alter_tag ciphertext) 118 | ~expected:(Error "Wrong tag") 119 | ] 120 | 121 | let suite = 122 | "Cipher_aes_gcm" >::: 123 | [ test_iv 124 | ; test_encrypt_with_ad 125 | ; test_decrypt_with_ad 126 | ] 127 | -------------------------------------------------------------------------------- /test/unit/test_cipher_aes_gcm.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_cipher_chacha_poly.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers 3 | 4 | let of_hexdump hex_lines = 5 | Hex.to_cstruct (`Hex (String.concat "" hex_lines)) 6 | 7 | let of_hex hex = 8 | Hex.to_cstruct (`Hex hex) 9 | 10 | let test_encrypt = 11 | let test ~plaintext ~ad ~key ~iv ~fixed ~expected_ciphertext ~expected_tag 12 | ctxt = 13 | let got = 14 | Noise.Cipher_chacha_poly.encrypt_with_ad_low 15 | ~ad 16 | ~key 17 | ~fixed 18 | ~iv 19 | plaintext 20 | in 21 | let expected = Ok (expected_ciphertext, expected_tag) in 22 | assert_equal 23 | ~ctxt 24 | ~cmp:[%eq: (Hex_string.t * Hex_string.t, string) result] 25 | ~printer:[%show: (Hex_string.t * Hex_string.t, string) result] 26 | expected 27 | got 28 | in 29 | "encrypt_with_ad_low" >::: 30 | [ "RFC 7539 2.8.2" >:: test 31 | ~plaintext: 32 | ( Cstruct.of_string 33 | ( String.concat "" 34 | [ "Ladies and Gentlemen of the class of '99: " 35 | ; "If I could offer you only one tip for the " 36 | ; "future, sunscreen would be it." 37 | ] 38 | ) 39 | ) 40 | ~ad:(of_hex "50515253c0c1c2c3c4c5c6c7") 41 | ~key:( 42 | Noise.Private_key.of_bytes 43 | ( of_hexdump 44 | [ "808182838485868788898a8b8c8d8e8f" 45 | ; "909192939495969798999a9b9c9d9e9f" 46 | ] 47 | ) 48 | ) 49 | ~iv:(of_hex "4041424344454647") 50 | ~fixed:(of_hex "07000000") 51 | ~expected_ciphertext:( 52 | of_hexdump 53 | [ "d31a8d34648e60db7b86afbc53ef7ec2" 54 | ; "a4aded51296e08fea9e2b5a736ee62d6" 55 | ; "3dbea45e8ca9671282fafb69da92728b" 56 | ; "1a71de0a9e060b2905d6a5b67ecd3b36" 57 | ; "92ddbd7f2d778b8c9803aee328091b58" 58 | ; "fab324e4fad675945585808b4831d7bc" 59 | ; "3ff4def08e4b7a9de576d26586cec64b" 60 | ; "6116" 61 | ] 62 | ) 63 | ~expected_tag:( 64 | of_hex "1ae10b594f09e26a7e902ecbd0600691" 65 | ) 66 | ] 67 | 68 | let suite = 69 | "Cipher_chacha_poly" >::: 70 | [ test_encrypt 71 | ] 72 | -------------------------------------------------------------------------------- /test/unit/test_cipher_chacha_poly.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_cipher_state.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | module Data = struct 4 | let key = Noise.Private_key.of_bytes @@ Cstruct.of_hex "12" 5 | 6 | let make nonce = 7 | Noise.Cipher_state.create 8 | ~unsafe_nonce:nonce 9 | key 10 | 11 | let other_key = Noise.Private_key.of_bytes @@ Cstruct.of_hex "34" 12 | end 13 | 14 | let test_with_ = 15 | let test cipher_state expected ctxt = 16 | let got = 17 | Noise.Cipher_state.with_ 18 | cipher_state 19 | (fun ~key:_ ~nonce:_ b -> Ok (not b)) 20 | true 21 | in 22 | assert_equal 23 | ~ctxt 24 | ~cmp:[%eq: (Noise.Cipher_state.t * bool, string) result] 25 | ~printer:[%show: (Noise.Cipher_state.t * bool, string) result] 26 | expected 27 | got 28 | in 29 | let open Data in 30 | let test_ready cipher_state ~expected_nonce_used ~expected_state = 31 | fun ctxt -> 32 | let other_nonce = 1L in 33 | let got = 34 | Noise.Cipher_state.with_ 35 | cipher_state 36 | (fun ~key ~nonce (_, _, b) -> Ok (key, nonce, not b)) 37 | (other_key, other_nonce, true) 38 | in 39 | let expected = Ok (expected_state, (key, expected_nonce_used, false)) in 40 | assert_equal 41 | ~ctxt 42 | ~cmp:[%eq: (Noise.Cipher_state.t * (Noise.Private_key.t * int64 * bool), string) result] 43 | ~printer:[%show: (Noise.Cipher_state.t * (Noise.Private_key.t * int64 * bool), string) result] 44 | expected 45 | got 46 | in 47 | "with_" >::: 48 | [ "When empty, it does not apply the function" >:: test 49 | Noise.Cipher_state.empty 50 | (Ok (Noise.Cipher_state.empty, true)) 51 | ; "When depleted, it returns an error" >:: test 52 | Noise.Cipher_state.depleted 53 | (Error "Nonce depleted") 54 | ; "When ready, it passes the state and increments the nonce" >::: 55 | [ "Normal" >:: test_ready 56 | (make 3L) 57 | ~expected_nonce_used:3L 58 | ~expected_state:(make 4L) 59 | ; "Overflow" >:: test_ready 60 | (make 0x7f_ff_ff_ff_ff_ff_ff_ffL) 61 | ~expected_nonce_used:0x7f_ff_ff_ff_ff_ff_ff_ffL 62 | ~expected_state:(make 0x80_00_00_00_00_00_00_00L) 63 | ; "End" >:: test_ready 64 | (make 0xff_ff_ff_ff_ff_ff_ff_feL) 65 | ~expected_nonce_used:0xff_ff_ff_ff_ff_ff_ff_feL 66 | ~expected_state:Noise.Cipher_state.depleted 67 | ] 68 | ] 69 | 70 | let test_has_key = 71 | let test cipher_state expected ctxt = 72 | let got = Noise.Cipher_state.has_key cipher_state in 73 | assert_equal 74 | ~ctxt 75 | ~cmp:[%eq: bool] 76 | ~printer:[%show: bool] 77 | expected 78 | got 79 | in 80 | "has_key" >::: 81 | [ "Empty" >:: test Noise.Cipher_state.empty false 82 | ; "Ready" >:: test (Data.make 0L) true 83 | ; "Depleted: we still expect to be able to decrypt" >:: test 84 | Noise.Cipher_state.depleted true 85 | ] 86 | 87 | let suite = 88 | "Cipher_state" >::: 89 | [ test_with_ 90 | ; test_has_key 91 | ] 92 | -------------------------------------------------------------------------------- /test/unit/test_cipher_state.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_dh.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers.Infix 3 | 4 | let test_of_string = 5 | let should_be expected s ctxt = 6 | let got = Noise.Dh.of_string s in 7 | assert_equal 8 | ~ctxt 9 | ~cmp:[%eq: (Noise.Dh.t, string) result] 10 | ~printer:[%show: (Noise.Dh.t, string) result] 11 | expected 12 | got 13 | in 14 | "of_string" >::: 15 | [ "25519" >:= should_be (Ok Curve_25519) 16 | ; "448" >:= should_be (Ok Curve_448) 17 | ] 18 | 19 | let test_len = 20 | let test dh expected ctxt = 21 | let got = Noise.Dh.len dh in 22 | assert_equal 23 | ~ctxt 24 | ~cmp:[%eq: int] 25 | ~printer:[%show: int] 26 | expected 27 | got 28 | in 29 | "len" >::: 30 | [ "25519" >:: test Noise.Dh.Curve_25519 32 31 | ; "448" >:: test Noise.Dh.Curve_448 56 32 | ] 33 | 34 | let suite = 35 | "Dh" >::: 36 | [ test_of_string 37 | ; test_len 38 | ] 39 | -------------------------------------------------------------------------------- /test/unit/test_dh.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_dh_25519.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | module Data = struct 4 | let of_hex s = 5 | Hex.to_cstruct (`Hex s) 6 | 7 | let pub_of_hex s = 8 | Noise.Public_key.of_bytes (of_hex s) 9 | 10 | let priv_of_hex s = 11 | Noise.Private_key.of_bytes (of_hex s) 12 | 13 | (* From https://cr.yp.to/highspeed/naclcrypto-20090310.pdf *) 14 | let alicesk = priv_of_hex "77076d0a7318a57d3c16c17251b26645df4c2f87ebc0992ab177fba51db92c2a" 15 | let bobpk = pub_of_hex "de9edb7d7b7dc1b4d35b61c2ece435373f8343c85b78674dadfc7e146f882b4f" 16 | let bobsk = priv_of_hex "5dab087e624a8a4b79e17f8b83800ee66f3bb1292618b6fd1c2f8b27ff88e0eb" 17 | let alicepk = pub_of_hex "8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a" 18 | let shared = of_hex "4a5d9d5ba4ce2de1728e3bf480350f25e07e21c947d19e3376f09b3c1e161742" 19 | 20 | let bytes31 = Cstruct.create 31 21 | end 22 | 23 | let test_key_exchange = 24 | let test priv pub expected ctxt = 25 | let got = Noise.Dh_25519.key_exchange ~priv ~pub in 26 | assert_equal 27 | ~ctxt 28 | ~cmp:[%eq: Test_helpers.Hex_string.t] 29 | ~printer:[%show: Test_helpers.Hex_string.t] 30 | expected 31 | got 32 | in 33 | let test_exn priv pub msg _ctxt = 34 | assert_raises (Invalid_argument msg) @@ fun () -> 35 | Noise.Dh_25519.key_exchange ~priv ~pub 36 | in 37 | let open Data in 38 | "key_exchange" >::: 39 | [ "Priv A, Pub B" >:: test alicesk bobpk shared 40 | ; "Priv B, Pub A" >:: test bobsk alicepk shared 41 | ; "Wrong size in priv" >:: test_exn 42 | (Noise.Private_key.of_bytes bytes31) 43 | alicepk 44 | "secret_key_of_string: invalid key" 45 | ; "Wrong size in pub" >:: test_exn 46 | alicesk 47 | (Noise.Public_key.of_bytes bytes31) 48 | "public_key_of_string: key should consist of 32 bytes" 49 | ] 50 | 51 | let test_corresponds = 52 | let test priv pub expected ctxt = 53 | let got = Noise.Dh_25519.corresponds ~priv ~pub in 54 | assert_equal 55 | ~ctxt 56 | ~cmp:[%eq: bool] 57 | ~printer:[%show: bool] 58 | expected 59 | got 60 | in 61 | let open Data in 62 | "corresponds" >::: 63 | [ "Priv A, Pub A" >:: test alicesk alicepk true 64 | ; "Priv A, Pub B" >:: test alicesk bobpk false 65 | ; "Priv B, Pub A" >:: test bobsk alicepk false 66 | ; "Priv B, Pub B" >:: test bobsk bobpk true 67 | ] 68 | 69 | let test_public_key = 70 | let test priv expected ctxt = 71 | let got = Noise.Dh_25519.public_key priv in 72 | assert_equal 73 | ~ctxt 74 | ~cmp:[%eq: Noise.Public_key.t] 75 | ~printer:[%show: Noise.Public_key.t] 76 | expected 77 | got 78 | in 79 | let open Data in 80 | "public_key" >::: 81 | [ "Alice" >:: test alicesk alicepk 82 | ; "Bob" >:: test bobsk bobpk 83 | ] 84 | 85 | let suite = 86 | "Dh_25519" >::: 87 | [ test_key_exchange 88 | ; test_corresponds 89 | ; test_public_key 90 | ] 91 | -------------------------------------------------------------------------------- /test/unit/test_dh_25519.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_hash.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers.Infix 3 | 4 | let test_of_string = 5 | let should_be expected s ctxt = 6 | let got = Noise.Hash.of_string s in 7 | assert_equal 8 | ~ctxt 9 | ~cmp:[%eq: (Noise.Hash.t, string) result] 10 | ~printer:[%show: (Noise.Hash.t, string) result] 11 | expected 12 | got 13 | in 14 | "of_string" >::: 15 | [ "SHA256" >:= should_be (Ok SHA256) 16 | ; "SHA512" >:= should_be (Ok SHA512) 17 | ; "BLAKE2s" >:= should_be (Ok BLAKE2s) 18 | ; "BLAKE2b" >:= should_be (Ok BLAKE2b) 19 | ] 20 | 21 | let test_len = 22 | let test h expected ctxt = 23 | let got = Noise.Hash.len h in 24 | assert_equal 25 | ~ctxt 26 | ~cmp:[%eq: int] 27 | ~printer:[%show: int] 28 | expected 29 | got 30 | in 31 | "len" >::: 32 | [ "SHA256" >:: test SHA256 32 33 | ; "SHA512" >:: test SHA512 64 34 | ; "BLAKE2s" >:: test BLAKE2s 32 35 | ; "BLAKE2b" >:: test BLAKE2b 64 36 | ] 37 | 38 | let suite = 39 | "Hash" >::: 40 | [ test_of_string 41 | ; test_len 42 | ] 43 | -------------------------------------------------------------------------------- /test/unit/test_hash.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_hkdf.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let hmac_sha1 ~key input = 4 | let key_string = Cstruct.to_string key in 5 | let digest = Digestif.SHA1.hmac_string ~key:key_string (Cstruct.to_string input) in 6 | let hex_digest = Digestif.SHA1.to_hex digest in 7 | Cstruct.of_hex hex_digest 8 | 9 | let hmac_sha256 ~key input = 10 | let key_string = Cstruct.to_string key in 11 | let digest = Digestif.SHA256.hmac_string ~key:key_string (Cstruct.to_string input) in 12 | let hex_digest = Digestif.SHA256.to_hex digest in 13 | Cstruct.of_hex hex_digest 14 | 15 | let test_extract = 16 | let test ~hmac ~salt ~ikm ~expected ctxt = 17 | let got = 18 | Noise.Hkdf.extract 19 | ~hmac 20 | ~salt:(Hex.to_cstruct salt) 21 | ~ikm:(Hex.to_cstruct ikm) 22 | in 23 | let expected = Hex.to_cstruct expected in 24 | assert_equal 25 | ~ctxt 26 | ~cmp:[%eq: Test_helpers.Hex_string.t] 27 | ~printer:[%show: Test_helpers.Hex_string.t] 28 | expected 29 | got 30 | in 31 | "extract" >::: 32 | [ "RFC Test Case 1" >:: 33 | test 34 | ~hmac:hmac_sha256 35 | ~ikm:(`Hex "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b") 36 | ~salt:(`Hex "000102030405060708090a0b0c") 37 | ~expected:(`Hex "077709362c2e32df0ddc3f0dc47bba6390b6c73bb50f9c3122ec844ad7c2b3e5") 38 | ; "RFC Test Case 2" >:: 39 | test 40 | ~hmac:hmac_sha256 41 | ~ikm: 42 | ( `Hex 43 | (String.concat "" 44 | [ "000102030405060708090a0b0c0d0e0f" 45 | ; "101112131415161718191a1b1c1d1e1f" 46 | ; "202122232425262728292a2b2c2d2e2f" 47 | ; "303132333435363738393a3b3c3d3e3f" 48 | ; "404142434445464748494a4b4c4d4e4f" 49 | ] 50 | ) 51 | ) 52 | ~salt: 53 | ( `Hex 54 | (String.concat "" 55 | [ "606162636465666768696a6b6c6d6e6f" 56 | ; "707172737475767778797a7b7c7d7e7f" 57 | ; "808182838485868788898a8b8c8d8e8f" 58 | ; "909192939495969798999a9b9c9d9e9f" 59 | ; "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" 60 | ] 61 | ) 62 | ) 63 | ~expected:(`Hex "06a6b88c5853361a06104c9ceb35b45cef760014904671014a193f40c15fc244") 64 | ] 65 | 66 | let test_hkdf2 = 67 | let test ~hmac ~ikm ~salt ~expected ctxt = 68 | let got = 69 | Noise.Hkdf.hkdf2 70 | ~hmac 71 | ~salt:(Hex.to_cstruct salt) 72 | ~ikm:(Hex.to_cstruct ikm) 73 | in 74 | let expected1, expected2 = expected in 75 | let expected = Hex.to_cstruct expected1, Hex.to_cstruct expected2 in 76 | assert_equal 77 | ~ctxt 78 | ~cmp:[%eq: Test_helpers.Hex_string.t * Test_helpers.Hex_string.t] 79 | ~printer:[%show: Test_helpers.Hex_string.t * Test_helpers.Hex_string.t] 80 | expected 81 | got 82 | in 83 | "hkdf2" >::: 84 | [ "test vector 7" >:: 85 | test 86 | ~hmac:hmac_sha1 87 | ~salt:(`Hex "0000000000000000000000000000000000000000") 88 | ~ikm:(`Hex "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c") 89 | ~expected: 90 | ( `Hex "2c91117204d745f3500d636a62f64f0ab3bae548" 91 | , `Hex "aa53d423b0d1f27ebba6f5e5673a081d70cce7ac" 92 | ) 93 | ] 94 | 95 | let suite = 96 | "HKDF" >::: 97 | [ test_extract 98 | ; test_hkdf2 99 | ] 100 | -------------------------------------------------------------------------------- /test/unit/test_hkdf.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/unit/test_pattern.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers.Infix 3 | 4 | let test_of_string = 5 | let should_be expected s ctxt = 6 | let got = Noise.Pattern.of_string s in 7 | assert_equal 8 | ~ctxt 9 | ~cmp:[%eq: (Noise.Pattern.t, string) result] 10 | ~printer:[%show: (Noise.Pattern.t, string) result] 11 | expected 12 | got 13 | in 14 | "of_string" >::: 15 | [ "N" >:= should_be (Ok N) 16 | ; "K" >:= should_be (Ok K) 17 | ; "X" >:= should_be (Ok X) 18 | ; "NN" >:= should_be (Ok NN) 19 | ; "NX" >:= should_be (Ok NX) 20 | ; "IN" >:= should_be (Ok IN) 21 | ; "XN" >:= should_be (Ok XN) 22 | ; "XX" >:= should_be (Ok XX) 23 | ; "IX" >:= should_be (Ok IX) 24 | ; "NK" >:= should_be (Ok NK) 25 | ; "IK" >:= should_be (Ok IK) 26 | ; "KN" >:= should_be (Ok KN) 27 | ; "KK" >:= should_be (Ok KK) 28 | ; "KX" >:= should_be (Ok KX) 29 | ; "XK" >:= should_be (Ok XK) 30 | ; "IKpsk1" >:= should_be (Ok IKpsk1) 31 | ; "IKpsk2" >:= should_be (Ok IKpsk2) 32 | ; "INpsk1" >:= should_be (Ok INpsk1) 33 | ; "INpsk2" >:= should_be (Ok INpsk2) 34 | ; "IXpsk2" >:= should_be (Ok IXpsk2) 35 | ; "KKpsk0" >:= should_be (Ok KKpsk0) 36 | ; "KKpsk2" >:= should_be (Ok KKpsk2) 37 | ; "KNpsk0" >:= should_be (Ok KNpsk0) 38 | ; "KNpsk2" >:= should_be (Ok KNpsk2) 39 | ; "KXpsk2" >:= should_be (Ok KXpsk2) 40 | ; "NKpsk0" >:= should_be (Ok NKpsk0) 41 | ; "NKpsk2" >:= should_be (Ok NKpsk2) 42 | ; "NNpsk0" >:= should_be (Ok NNpsk0) 43 | ; "NNpsk2" >:= should_be (Ok NNpsk2) 44 | ; "NXpsk2" >:= should_be (Ok NXpsk2) 45 | ; "XKpsk3" >:= should_be (Ok XKpsk3) 46 | ; "XNpsk3" >:= should_be (Ok XNpsk3) 47 | ; "XXpsk3" >:= should_be (Ok XXpsk3) 48 | ; "Npsk0" >:= should_be (Ok Npsk0) 49 | ; "Xpsk1" >:= should_be (Ok Xpsk1) 50 | ; "Kpsk0" >:= should_be (Ok Kpsk0) 51 | ] 52 | 53 | let suite = 54 | "Pattern" >::: 55 | [ test_of_string 56 | ] 57 | -------------------------------------------------------------------------------- /test/unit/test_pattern.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/vectors/README.md: -------------------------------------------------------------------------------- 1 | These test vectors come [the wiki](https://github.com/noiseprotocol/noise_wiki/wiki/Test-vectors). 2 | -------------------------------------------------------------------------------- /test/vectors/dune: -------------------------------------------------------------------------------- 1 | (alias 2 | (name runtest) 3 | (deps (glob_files *.txt)) 4 | (action 5 | (run ./test_vectors.exe) 6 | ) 7 | ) 8 | 9 | (executable 10 | (name test_vectors) 11 | (libraries 12 | hex 13 | noise 14 | oUnit 15 | ppx_deriving_yojson.runtime 16 | test_helpers 17 | yojson 18 | ) 19 | (preprocess 20 | (pps 21 | ppx_deriving.std 22 | ppx_deriving_yojson 23 | ppx_let 24 | )) 25 | (flags :standard -w -39) 26 | ) 27 | -------------------------------------------------------------------------------- /test/vectors/test_vectors.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Noise.Util 3 | 4 | let err_printf fmt = 5 | Printf.ksprintf 6 | (fun e -> Error e) 7 | fmt 8 | 9 | let unwrap what x = 10 | match x with 11 | | Ok y -> Ok y 12 | | Error s -> 13 | err_printf 14 | "Unknown %s: %s" 15 | what 16 | s 17 | 18 | let of_yojson_string what of_string json = 19 | let%map s = [%of_yojson: string] json in 20 | match of_string s with 21 | | Ok _ as r -> r 22 | | Error e -> 23 | err_printf 24 | "Unknown %s: %s" 25 | what 26 | e 27 | 28 | type pattern = (Noise.Pattern.t, string) result 29 | let pattern_of_yojson = of_yojson_string "pattern" Noise.Pattern.of_string 30 | type dh = (Noise.Dh.t, string) result 31 | let dh_of_yojson = of_yojson_string "dh" Noise.Dh.of_string 32 | type cipher = (Noise.Cipher.t, string) result 33 | let cipher_of_yojson = of_yojson_string "cipher" Noise.Cipher.of_string 34 | type hash = (Noise.Hash.t, string) result 35 | let hash_of_yojson = of_yojson_string "hash" Noise.Hash.of_string 36 | 37 | type message = 38 | { ciphertext : Test_helpers.Hex_string.t 39 | ; payload : Test_helpers.Hex_string.t 40 | } 41 | [@@deriving of_yojson] 42 | 43 | module Public_key = struct 44 | type t = Noise.Public_key.t 45 | 46 | let of_yojson json = 47 | let%map r = [%of_yojson: Test_helpers.Hex_string.t] json in 48 | Noise.Public_key.of_bytes r 49 | end 50 | 51 | module Private_key = struct 52 | type t = Noise.Private_key.t 53 | 54 | let of_yojson json = 55 | let%map r = [%of_yojson: Test_helpers.Hex_string.t] json in 56 | Noise.Private_key.of_bytes r 57 | end 58 | 59 | module Test_vector = struct 60 | type repr = 61 | { name : string option [@default None] 62 | ; protocol_name : string option [@default None] 63 | ; pattern : pattern option [@default None] 64 | ; dh : dh option [@default None] 65 | ; cipher: cipher option [@default None] 66 | ; hash : hash option [@default None] 67 | ; init_prologue : string 68 | ; init_ephemeral : Private_key.t 69 | ; init_remote_static : Public_key.t option [@default None] 70 | ; resp_prologue : Test_helpers.Hex_string.t 71 | ; resp_static : Private_key.t option [@default None] 72 | ; messages : message list 73 | ; handshake_hash : Test_helpers.Hex_string.t 74 | ; init_psk : Test_helpers.Hex_string.t option [@default None] 75 | ; init_static : Private_key.t option [@default None] 76 | ; resp_ephemeral : Private_key.t option [@default None] 77 | ; resp_psk : Test_helpers.Hex_string.t option [@default None] 78 | ; resp_remote_static : Public_key.t option [@default None] 79 | ; init_psks : Test_helpers.Hex_string.t list option [@default None] 80 | ; resp_psks : Test_helpers.Hex_string.t list option [@default None] 81 | } 82 | [@@deriving of_yojson] 83 | 84 | type t = 85 | { name : string 86 | ; pattern : pattern 87 | ; dh : dh 88 | ; cipher: cipher 89 | ; hash : hash 90 | ; init_prologue : string 91 | ; init_ephemeral : Private_key.t 92 | ; init_remote_static : Public_key.t option 93 | ; resp_prologue : Test_helpers.Hex_string.t 94 | ; resp_static : Private_key.t option 95 | ; messages : message list 96 | ; handshake_hash : Test_helpers.Hex_string.t 97 | ; psk : Test_helpers.Hex_string.t option 98 | ; init_static : Private_key.t option 99 | ; resp_ephemeral : Private_key.t option 100 | ; resp_remote_static : Public_key.t option 101 | } 102 | 103 | let name_of_repr (repr:repr) = 104 | match repr.name, repr.protocol_name with 105 | | None, None 106 | -> 107 | Error "no name" 108 | | Some n, None 109 | | None, Some n 110 | -> 111 | Ok n 112 | | Some _, Some _ 113 | -> 114 | Error "name and protocol_name are set" 115 | 116 | let parse_parameters name = 117 | match String.split_on_char '_' name with 118 | | ["Noise"; pattern; dh; cipher; hash] -> 119 | Ok (pattern, dh, cipher, hash) 120 | | _ -> 121 | Error "Cannot parse parameters" 122 | 123 | let hash_of_repr (repr:repr) name = 124 | match repr.hash with 125 | | Some h -> Ok h 126 | | None -> 127 | let%map (_, _, _, hash_name) = parse_parameters name in 128 | Noise.Hash.of_string hash_name 129 | 130 | let cipher_of_repr (repr:repr) name = 131 | match repr.cipher with 132 | | Some x -> Ok x 133 | | None -> 134 | let%map (_, _, cipher_name, _) = parse_parameters name in 135 | Noise.Cipher.of_string cipher_name 136 | 137 | let dh_of_repr (repr:repr) name = 138 | match repr.dh with 139 | | Some x -> Ok x 140 | | None -> 141 | let%map (_, dh_name, _, _) = parse_parameters name in 142 | Noise.Dh.of_string dh_name 143 | 144 | let pattern_of_repr (repr:repr) name = 145 | match repr.pattern with 146 | | Some x -> Ok x 147 | | None -> 148 | let%map (pattern_name, _, _, _) = parse_parameters name in 149 | Noise.Pattern.of_string pattern_name 150 | 151 | let wrap_error f json = 152 | match f json with 153 | | Ok _ as x -> x 154 | | Error e -> 155 | err_printf 156 | "Got error %s while parsing: %s" 157 | e 158 | (Yojson.Safe.pretty_to_string json) 159 | 160 | let psk_of_repr (repr:repr) = 161 | let from_psk = 162 | match repr.init_psk, repr.resp_psk with 163 | | Some a, Some b when Cstruct.equal a b 164 | -> 165 | Ok (Some a) 166 | | None, None 167 | -> 168 | Ok None 169 | | Some _, None 170 | | None, Some _ 171 | | Some _, Some _ 172 | -> 173 | Error "from_psk" 174 | in 175 | let from_psks = 176 | match repr.init_psks, repr.resp_psks with 177 | | Some [a], Some [b] when Cstruct.equal a b 178 | -> 179 | Ok (Some a) 180 | | None, None 181 | -> 182 | Ok None 183 | | Some _, None 184 | | None, Some _ 185 | | Some _, Some _ 186 | -> 187 | Error "from_psks" 188 | in 189 | let%bind from_psk = from_psk in (* XXX bind above *) 190 | let%bind from_psks = from_psks in 191 | match from_psk, from_psks with 192 | | None, None 193 | -> 194 | Ok None 195 | | None, Some a 196 | | Some a, None 197 | -> 198 | Ok (Some a) 199 | | Some _, Some _ 200 | -> 201 | Error "psk_of_repr" 202 | 203 | let of_yojson json = 204 | let%bind repr = wrap_error repr_of_yojson json in 205 | let%bind psk = psk_of_repr repr in 206 | let%bind name = name_of_repr repr in 207 | let%bind hash = hash_of_repr repr name in 208 | let%bind cipher = cipher_of_repr repr name in 209 | let%bind dh = dh_of_repr repr name in 210 | let%map pattern = pattern_of_repr repr name in 211 | { name 212 | ; pattern 213 | ; dh 214 | ; cipher 215 | ; hash 216 | ; init_prologue = repr.init_prologue 217 | ; init_ephemeral = repr.init_ephemeral 218 | ; init_remote_static = repr.init_remote_static 219 | ; resp_prologue = repr.resp_prologue 220 | ; resp_static = repr.resp_static 221 | ; messages = repr.messages 222 | ; handshake_hash = repr.handshake_hash 223 | ; psk 224 | ; init_static = repr.init_static 225 | ; resp_ephemeral = repr.resp_ephemeral 226 | ; resp_remote_static = repr.resp_remote_static 227 | } 228 | end 229 | 230 | type test_vector_file = 231 | { vectors : Test_vector.t list 232 | } 233 | [@@deriving of_yojson] 234 | 235 | let check_prefix s = 236 | let expected = "Noise_" in 237 | let start = String.sub s 0 (String.length expected) in 238 | if String.equal start expected then 239 | Ok () 240 | else 241 | Error "Wrong prefix" 242 | 243 | let params (vector:Test_vector.t) = 244 | let%bind () = check_prefix vector.name in 245 | let%bind pattern = unwrap "pattern" vector.pattern in 246 | let%bind dh = unwrap "DH" vector.dh in 247 | let%bind cipher = unwrap "cipher" vector.cipher in 248 | let%map hash = unwrap "hash" vector.hash in 249 | (pattern, dh, cipher, hash) 250 | 251 | let get_result_exn msg = function 252 | | Ok x -> x 253 | | Error e -> Printf.ksprintf invalid_arg "get_result_exn: %s (%s)" msg e 254 | 255 | let check_transport_message ~ctxt initiator responder message n = 256 | let (new_resp, recovered_plaintext) = 257 | get_result_exn 258 | "transport message, responder" 259 | ( Noise.State.receive_transport 260 | responder 261 | message.ciphertext 262 | ) 263 | in 264 | assert_equal 265 | ~ctxt 266 | ~cmp:[%eq: Test_helpers.Hex_string.t] 267 | ~printer:[%show: Test_helpers.Hex_string.t] 268 | ~msg:(Printf.sprintf "Transport message #%d decryption" n) 269 | message.payload 270 | recovered_plaintext; 271 | let (new_init, generated_ciphertext) = 272 | get_result_exn "transport 1, sender" 273 | ( Noise.State.send_transport 274 | initiator 275 | message.payload 276 | ) 277 | in 278 | assert_equal 279 | ~ctxt 280 | ~cmp:[%eq: Test_helpers.Hex_string.t] 281 | ~printer:[%show: Test_helpers.Hex_string.t] 282 | ~msg:(Printf.sprintf "Transport message #%d encryption" n) 283 | message.ciphertext 284 | generated_ciphertext; 285 | (new_init, new_resp) 286 | 287 | let concat_some a b = 288 | match a, b with 289 | | None, None -> [] 290 | | Some sa, None -> [sa] 291 | | None, Some sb -> [sb] 292 | | Some sa, Some sb -> [sa; sb] 293 | 294 | let make_responder_from_vector pattern dh cipher hash (vector:Test_vector.t) = 295 | let e = vector.resp_ephemeral in 296 | let s = vector.resp_static in 297 | let static_pub = vector.init_remote_static in 298 | let rs = vector.resp_remote_static in 299 | let psk = vector.psk in 300 | Noise.State.make 301 | ~name:vector.name 302 | ~pattern 303 | ~is_initiator:false 304 | ~s 305 | ~rs 306 | ~e 307 | ~dh 308 | ~cipher 309 | ~hash 310 | ~psk 311 | |> Noise.Protocol.initialize 312 | ~prologue:vector.resp_prologue 313 | ~public_keys:(concat_some rs static_pub) 314 | 315 | let make_initiator_from_vector pattern dh cipher hash (vector:Test_vector.t) = 316 | let rs = vector.init_remote_static in 317 | let e = vector.init_ephemeral in 318 | let s = vector.init_static in 319 | let s_pub = vector.resp_remote_static in 320 | let psk = vector.psk in 321 | Noise.State.make 322 | ~name:vector.name 323 | ~is_initiator:true 324 | ~pattern 325 | ~s 326 | ~rs 327 | ~e:(Some e) 328 | ~dh 329 | ~cipher 330 | ~hash 331 | ~psk 332 | |> Noise.Protocol.initialize 333 | ~prologue:vector.resp_prologue 334 | ~public_keys:(concat_some s_pub rs) 335 | 336 | let post_handshake pattern init0 resp0 msgs = 337 | match Noise.Pattern.all_steps pattern, msgs with 338 | | [_], msg1::msgs -> 339 | let%bind (init1, _) = Noise.Protocol.write_message init0 msg1.payload in 340 | let%map (resp1, _) = Noise.Protocol.read_message resp0 msg1.ciphertext in 341 | (init1, resp1, msgs) 342 | | [_; _], msg1::msg2::msgs -> 343 | let%bind (init1, _) = Noise.Protocol.write_message init0 msg1.payload in 344 | let%bind (resp1, _) = Noise.Protocol.read_message resp0 msg1.ciphertext in 345 | let%bind (resp2, _) = Noise.Protocol.write_message resp1 msg2.payload in 346 | let%map (init2, _) = Noise.Protocol.read_message init1 msg2.ciphertext in 347 | (init2, resp2, msgs) 348 | | [_; _; _], msg1::msg2::msg3::msgs -> 349 | let%bind (init1, _) = Noise.Protocol.write_message init0 msg1.payload in 350 | let%bind (resp1, _) = Noise.Protocol.read_message resp0 msg1.ciphertext in 351 | let%bind (resp2, _) = Noise.Protocol.write_message resp1 msg2.payload in 352 | let%bind (init2, _) = Noise.Protocol.read_message init1 msg2.ciphertext in 353 | let%bind (init3, _) = Noise.Protocol.write_message init2 msg3.payload in 354 | let%map (resp3, _) = Noise.Protocol.read_message resp2 msg3.ciphertext in 355 | (resp3, init3, msgs) 356 | | _ -> 357 | Error "Wrong number of messages" 358 | 359 | let build_test_case (vector:Test_vector.t) = 360 | vector.name >:: fun ctxt -> 361 | match params vector with 362 | | Error e -> 363 | skip_if true e 364 | | Ok (pattern, dh, cipher, hash) -> 365 | let responder = make_responder_from_vector pattern dh cipher hash vector in 366 | let initiator = make_initiator_from_vector pattern dh cipher hash vector in 367 | 368 | let (initiator_post_handshake, responder_post_handshake, transport_messages) = 369 | get_result_exn "post_handshake" @@ 370 | post_handshake pattern initiator responder vector.messages 371 | in 372 | let initiator_hash = 373 | Noise.State.handshake_hash initiator_post_handshake 374 | in 375 | let responder_hash = 376 | Noise.State.handshake_hash responder_post_handshake 377 | in 378 | 379 | assert_equal 380 | ~ctxt 381 | ~cmp:[%eq: Test_helpers.Hex_string.t option] 382 | ~printer:[%show: Test_helpers.Hex_string.t option] 383 | ~msg:"Handshake hashes should match" 384 | initiator_hash 385 | responder_hash; 386 | assert_equal 387 | ~cmp:[%eq: Test_helpers.Hex_string.t option] 388 | ~printer:[%show: Test_helpers.Hex_string.t option] 389 | ~msg:"Handshake hash should match the vector" 390 | (Some vector.handshake_hash) 391 | initiator_hash; 392 | 393 | let flip a b = 394 | match Noise.Pattern.transport pattern with 395 | | One_way -> 396 | (a, b) 397 | | Two_way -> 398 | (b, a) 399 | in 400 | let _ : Noise.State.t * Noise.State.t * int = 401 | List.fold_left 402 | (fun (init, resp, i) message -> 403 | let (new_init, new_resp) = 404 | check_transport_message ~ctxt init resp message i 405 | in 406 | let (new_init1, new_resp1) = flip new_init new_resp in 407 | (new_init1, new_resp1, i+1) 408 | ) 409 | ( initiator_post_handshake 410 | , responder_post_handshake 411 | , 1 412 | ) 413 | transport_messages 414 | in 415 | () 416 | 417 | let run path = 418 | let json = Yojson.Safe.from_file path in 419 | match test_vector_file_of_yojson json with 420 | | Ok { vectors } -> 421 | path >::: List.map build_test_case vectors 422 | | Error e -> 423 | Printf.ksprintf 424 | failwith 425 | "Cannot parse file %s: %s" 426 | path e 427 | 428 | let suite = 429 | "noise-c test vectors" >::: 430 | [ run "noise-c-basic.txt" 431 | ; run "cacophony.txt" 432 | ] 433 | 434 | let () = 435 | run_test_tt_main suite 436 | -------------------------------------------------------------------------------- /test/vectors/test_vectors.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emillon/ocaml-noise/d5a3e0f634fba1f8d948a91c70a1dad6470722b0/test/vectors/test_vectors.mli -------------------------------------------------------------------------------- /tweetnacl/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name tweetnacl) 3 | (public_name noise._tweetnacl) 4 | (libraries 5 | cstruct 6 | ) 7 | (c_names 8 | tweetnacl_stubs 9 | tweetnacl 10 | ) 11 | ) 12 | -------------------------------------------------------------------------------- /tweetnacl/lib/tweetnacl.c: -------------------------------------------------------------------------------- 1 | #include "tweetnacl.h" 2 | #define FOR(i,n) for (i = 0;i < n;++i) 3 | #define sv static void 4 | 5 | typedef unsigned char u8; 6 | typedef unsigned long u32; 7 | typedef unsigned long long u64; 8 | typedef long long i64; 9 | typedef i64 gf[16]; 10 | extern void randombytes(u8 *,u64); 11 | 12 | static const u8 13 | _0[16], 14 | _9[32] = {9}; 15 | static const gf 16 | gf0, 17 | gf1 = {1}, 18 | _121665 = {0xDB41,1}, 19 | D = {0x78a3, 0x1359, 0x4dca, 0x75eb, 0xd8ab, 0x4141, 0x0a4d, 0x0070, 0xe898, 0x7779, 0x4079, 0x8cc7, 0xfe73, 0x2b6f, 0x6cee, 0x5203}, 20 | D2 = {0xf159, 0x26b2, 0x9b94, 0xebd6, 0xb156, 0x8283, 0x149a, 0x00e0, 0xd130, 0xeef3, 0x80f2, 0x198e, 0xfce7, 0x56df, 0xd9dc, 0x2406}, 21 | X = {0xd51a, 0x8f25, 0x2d60, 0xc956, 0xa7b2, 0x9525, 0xc760, 0x692c, 0xdc5c, 0xfdd6, 0xe231, 0xc0a4, 0x53fe, 0xcd6e, 0x36d3, 0x2169}, 22 | Y = {0x6658, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666}, 23 | I = {0xa0b0, 0x4a0e, 0x1b27, 0xc4ee, 0xe478, 0xad2f, 0x1806, 0x2f43, 0xd7a7, 0x3dfb, 0x0099, 0x2b4d, 0xdf0b, 0x4fc1, 0x2480, 0x2b83}; 24 | 25 | static u32 L32(u32 x,int c) { return (x << c) | ((x&0xffffffff) >> (32 - c)); } 26 | 27 | static u32 ld32(const u8 *x) 28 | { 29 | u32 u = x[3]; 30 | u = (u<<8)|x[2]; 31 | u = (u<<8)|x[1]; 32 | return (u<<8)|x[0]; 33 | } 34 | 35 | static u64 dl64(const u8 *x) 36 | { 37 | u64 i,u=0; 38 | FOR(i,8) u=(u<<8)|x[i]; 39 | return u; 40 | } 41 | 42 | sv st32(u8 *x,u32 u) 43 | { 44 | int i; 45 | FOR(i,4) { x[i] = u; u >>= 8; } 46 | } 47 | 48 | sv ts64(u8 *x,u64 u) 49 | { 50 | int i; 51 | for (i = 7;i >= 0;--i) { x[i] = u; u >>= 8; } 52 | } 53 | 54 | static int vn(const u8 *x,const u8 *y,int n) 55 | { 56 | u32 i,d = 0; 57 | FOR(i,n) d |= x[i]^y[i]; 58 | return (1 & ((d - 1) >> 8)) - 1; 59 | } 60 | 61 | int crypto_verify_16(const u8 *x,const u8 *y) 62 | { 63 | return vn(x,y,16); 64 | } 65 | 66 | int crypto_verify_32(const u8 *x,const u8 *y) 67 | { 68 | return vn(x,y,32); 69 | } 70 | 71 | sv core(u8 *out,const u8 *in,const u8 *k,const u8 *c,int h) 72 | { 73 | u32 w[16],x[16],y[16],t[4]; 74 | int i,j,m; 75 | 76 | FOR(i,4) { 77 | x[5*i] = ld32(c+4*i); 78 | x[1+i] = ld32(k+4*i); 79 | x[6+i] = ld32(in+4*i); 80 | x[11+i] = ld32(k+16+4*i); 81 | } 82 | 83 | FOR(i,16) y[i] = x[i]; 84 | 85 | FOR(i,20) { 86 | FOR(j,4) { 87 | FOR(m,4) t[m] = x[(5*j+4*m)%16]; 88 | t[1] ^= L32(t[0]+t[3], 7); 89 | t[2] ^= L32(t[1]+t[0], 9); 90 | t[3] ^= L32(t[2]+t[1],13); 91 | t[0] ^= L32(t[3]+t[2],18); 92 | FOR(m,4) w[4*j+(j+m)%4] = t[m]; 93 | } 94 | FOR(m,16) x[m] = w[m]; 95 | } 96 | 97 | if (h) { 98 | FOR(i,16) x[i] += y[i]; 99 | FOR(i,4) { 100 | x[5*i] -= ld32(c+4*i); 101 | x[6+i] -= ld32(in+4*i); 102 | } 103 | FOR(i,4) { 104 | st32(out+4*i,x[5*i]); 105 | st32(out+16+4*i,x[6+i]); 106 | } 107 | } else 108 | FOR(i,16) st32(out + 4 * i,x[i] + y[i]); 109 | } 110 | 111 | int crypto_core_salsa20(u8 *out,const u8 *in,const u8 *k,const u8 *c) 112 | { 113 | core(out,in,k,c,0); 114 | return 0; 115 | } 116 | 117 | int crypto_core_hsalsa20(u8 *out,const u8 *in,const u8 *k,const u8 *c) 118 | { 119 | core(out,in,k,c,1); 120 | return 0; 121 | } 122 | 123 | static const u8 sigma[16] = "expand 32-byte k"; 124 | 125 | int crypto_stream_salsa20_xor(u8 *c,const u8 *m,u64 b,const u8 *n,const u8 *k) 126 | { 127 | u8 z[16],x[64]; 128 | u32 u,i; 129 | if (!b) return 0; 130 | FOR(i,16) z[i] = 0; 131 | FOR(i,8) z[i] = n[i]; 132 | while (b >= 64) { 133 | crypto_core_salsa20(x,z,k,sigma); 134 | FOR(i,64) c[i] = (m?m[i]:0) ^ x[i]; 135 | u = 1; 136 | for (i = 8;i < 16;++i) { 137 | u += (u32) z[i]; 138 | z[i] = u; 139 | u >>= 8; 140 | } 141 | b -= 64; 142 | c += 64; 143 | if (m) m += 64; 144 | } 145 | if (b) { 146 | crypto_core_salsa20(x,z,k,sigma); 147 | FOR(i,b) c[i] = (m?m[i]:0) ^ x[i]; 148 | } 149 | return 0; 150 | } 151 | 152 | int crypto_stream_salsa20(u8 *c,u64 d,const u8 *n,const u8 *k) 153 | { 154 | return crypto_stream_salsa20_xor(c,0,d,n,k); 155 | } 156 | 157 | int crypto_stream(u8 *c,u64 d,const u8 *n,const u8 *k) 158 | { 159 | u8 s[32]; 160 | crypto_core_hsalsa20(s,n,k,sigma); 161 | return crypto_stream_salsa20(c,d,n+16,s); 162 | } 163 | 164 | int crypto_stream_xor(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k) 165 | { 166 | u8 s[32]; 167 | crypto_core_hsalsa20(s,n,k,sigma); 168 | return crypto_stream_salsa20_xor(c,m,d,n+16,s); 169 | } 170 | 171 | sv add1305(u32 *h,const u32 *c) 172 | { 173 | u32 j,u = 0; 174 | FOR(j,17) { 175 | u += h[j] + c[j]; 176 | h[j] = u & 255; 177 | u >>= 8; 178 | } 179 | } 180 | 181 | static const u32 minusp[17] = { 182 | 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 252 183 | } ; 184 | 185 | int crypto_onetimeauth(u8 *out,const u8 *m,u64 n,const u8 *k) 186 | { 187 | u32 s,i,j,u,x[17],r[17],h[17],c[17],g[17]; 188 | 189 | FOR(j,17) r[j]=h[j]=0; 190 | FOR(j,16) r[j]=k[j]; 191 | r[3]&=15; 192 | r[4]&=252; 193 | r[7]&=15; 194 | r[8]&=252; 195 | r[11]&=15; 196 | r[12]&=252; 197 | r[15]&=15; 198 | 199 | while (n > 0) { 200 | FOR(j,17) c[j] = 0; 201 | for (j = 0;(j < 16) && (j < n);++j) c[j] = m[j]; 202 | c[j] = 1; 203 | m += j; n -= j; 204 | add1305(h,c); 205 | FOR(i,17) { 206 | x[i] = 0; 207 | FOR(j,17) x[i] += h[j] * ((j <= i) ? r[i - j] : 320 * r[i + 17 - j]); 208 | } 209 | FOR(i,17) h[i] = x[i]; 210 | u = 0; 211 | FOR(j,16) { 212 | u += h[j]; 213 | h[j] = u & 255; 214 | u >>= 8; 215 | } 216 | u += h[16]; h[16] = u & 3; 217 | u = 5 * (u >> 2); 218 | FOR(j,16) { 219 | u += h[j]; 220 | h[j] = u & 255; 221 | u >>= 8; 222 | } 223 | u += h[16]; h[16] = u; 224 | } 225 | 226 | FOR(j,17) g[j] = h[j]; 227 | add1305(h,minusp); 228 | s = -(h[16] >> 7); 229 | FOR(j,17) h[j] ^= s & (g[j] ^ h[j]); 230 | 231 | FOR(j,16) c[j] = k[j + 16]; 232 | c[16] = 0; 233 | add1305(h,c); 234 | FOR(j,16) out[j] = h[j]; 235 | return 0; 236 | } 237 | 238 | int crypto_onetimeauth_verify(const u8 *h,const u8 *m,u64 n,const u8 *k) 239 | { 240 | u8 x[16]; 241 | crypto_onetimeauth(x,m,n,k); 242 | return crypto_verify_16(h,x); 243 | } 244 | 245 | int crypto_secretbox(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k) 246 | { 247 | int i; 248 | if (d < 32) return -1; 249 | crypto_stream_xor(c,m,d,n,k); 250 | crypto_onetimeauth(c + 16,c + 32,d - 32,c); 251 | FOR(i,16) c[i] = 0; 252 | return 0; 253 | } 254 | 255 | int crypto_secretbox_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *k) 256 | { 257 | int i; 258 | u8 x[32]; 259 | if (d < 32) return -1; 260 | crypto_stream(x,32,n,k); 261 | if (crypto_onetimeauth_verify(c + 16,c + 32,d - 32,x) != 0) return -1; 262 | crypto_stream_xor(m,c,d,n,k); 263 | FOR(i,32) m[i] = 0; 264 | return 0; 265 | } 266 | 267 | sv set25519(gf r, const gf a) 268 | { 269 | int i; 270 | FOR(i,16) r[i]=a[i]; 271 | } 272 | 273 | sv car25519(gf o) 274 | { 275 | int i; 276 | i64 c; 277 | FOR(i,16) { 278 | o[i]+=(1LL<<16); 279 | c=o[i]>>16; 280 | o[(i+1)*(i<15)]+=c-1+37*(c-1)*(i==15); 281 | o[i]-=c<<16; 282 | } 283 | } 284 | 285 | sv sel25519(gf p,gf q,int b) 286 | { 287 | i64 t,i,c=~(b-1); 288 | FOR(i,16) { 289 | t= c&(p[i]^q[i]); 290 | p[i]^=t; 291 | q[i]^=t; 292 | } 293 | } 294 | 295 | sv pack25519(u8 *o,const gf n) 296 | { 297 | int i,j,b; 298 | gf m,t; 299 | FOR(i,16) t[i]=n[i]; 300 | car25519(t); 301 | car25519(t); 302 | car25519(t); 303 | FOR(j,2) { 304 | m[0]=t[0]-0xffed; 305 | for(i=1;i<15;i++) { 306 | m[i]=t[i]-0xffff-((m[i-1]>>16)&1); 307 | m[i-1]&=0xffff; 308 | } 309 | m[15]=t[15]-0x7fff-((m[14]>>16)&1); 310 | b=(m[15]>>16)&1; 311 | m[14]&=0xffff; 312 | sel25519(t,m,1-b); 313 | } 314 | FOR(i,16) { 315 | o[2*i]=t[i]&0xff; 316 | o[2*i+1]=t[i]>>8; 317 | } 318 | } 319 | 320 | static int neq25519(const gf a, const gf b) 321 | { 322 | u8 c[32],d[32]; 323 | pack25519(c,a); 324 | pack25519(d,b); 325 | return crypto_verify_32(c,d); 326 | } 327 | 328 | static u8 par25519(const gf a) 329 | { 330 | u8 d[32]; 331 | pack25519(d,a); 332 | return d[0]&1; 333 | } 334 | 335 | sv unpack25519(gf o, const u8 *n) 336 | { 337 | int i; 338 | FOR(i,16) o[i]=n[2*i]+((i64)n[2*i+1]<<8); 339 | o[15]&=0x7fff; 340 | } 341 | 342 | sv A(gf o,const gf a,const gf b) 343 | { 344 | int i; 345 | FOR(i,16) o[i]=a[i]+b[i]; 346 | } 347 | 348 | sv Z(gf o,const gf a,const gf b) 349 | { 350 | int i; 351 | FOR(i,16) o[i]=a[i]-b[i]; 352 | } 353 | 354 | sv M(gf o,const gf a,const gf b) 355 | { 356 | i64 i,j,t[31]; 357 | FOR(i,31) t[i]=0; 358 | FOR(i,16) FOR(j,16) t[i+j]+=a[i]*b[j]; 359 | FOR(i,15) t[i]+=38*t[i+16]; 360 | FOR(i,16) o[i]=t[i]; 361 | car25519(o); 362 | car25519(o); 363 | } 364 | 365 | sv S(gf o,const gf a) 366 | { 367 | M(o,a,a); 368 | } 369 | 370 | sv inv25519(gf o,const gf i) 371 | { 372 | gf c; 373 | int a; 374 | FOR(a,16) c[a]=i[a]; 375 | for(a=253;a>=0;a--) { 376 | S(c,c); 377 | if(a!=2&&a!=4) M(c,c,i); 378 | } 379 | FOR(a,16) o[a]=c[a]; 380 | } 381 | 382 | sv pow2523(gf o,const gf i) 383 | { 384 | gf c; 385 | int a; 386 | FOR(a,16) c[a]=i[a]; 387 | for(a=250;a>=0;a--) { 388 | S(c,c); 389 | if(a!=1) M(c,c,i); 390 | } 391 | FOR(a,16) o[a]=c[a]; 392 | } 393 | 394 | int crypto_scalarmult(u8 *q,const u8 *n,const u8 *p) 395 | { 396 | u8 z[32]; 397 | i64 x[80],r,i; 398 | gf a,b,c,d,e,f; 399 | FOR(i,31) z[i]=n[i]; 400 | z[31]=(n[31]&127)|64; 401 | z[0]&=248; 402 | unpack25519(x,p); 403 | FOR(i,16) { 404 | b[i]=x[i]; 405 | d[i]=a[i]=c[i]=0; 406 | } 407 | a[0]=d[0]=1; 408 | for(i=254;i>=0;--i) { 409 | r=(z[i>>3]>>(i&7))&1; 410 | sel25519(a,b,r); 411 | sel25519(c,d,r); 412 | A(e,a,c); 413 | Z(a,a,c); 414 | A(c,b,d); 415 | Z(b,b,d); 416 | S(d,e); 417 | S(f,a); 418 | M(a,c,a); 419 | M(c,b,e); 420 | A(e,a,c); 421 | Z(a,a,c); 422 | S(b,a); 423 | Z(c,d,f); 424 | M(a,c,_121665); 425 | A(a,a,d); 426 | M(c,c,a); 427 | M(a,d,f); 428 | M(d,b,x); 429 | S(b,e); 430 | sel25519(a,b,r); 431 | sel25519(c,d,r); 432 | } 433 | FOR(i,16) { 434 | x[i+16]=a[i]; 435 | x[i+32]=c[i]; 436 | x[i+48]=b[i]; 437 | x[i+64]=d[i]; 438 | } 439 | inv25519(x+32,x+32); 440 | M(x+16,x+16,x+32); 441 | pack25519(q,x+16); 442 | return 0; 443 | } 444 | 445 | int crypto_scalarmult_base(u8 *q,const u8 *n) 446 | { 447 | return crypto_scalarmult(q,n,_9); 448 | } 449 | 450 | int crypto_box_keypair(u8 *y,u8 *x) 451 | { 452 | randombytes(x,32); 453 | return crypto_scalarmult_base(y,x); 454 | } 455 | 456 | int crypto_box_beforenm(u8 *k,const u8 *y,const u8 *x) 457 | { 458 | u8 s[32]; 459 | crypto_scalarmult(s,x,y); 460 | return crypto_core_hsalsa20(k,_0,s,sigma); 461 | } 462 | 463 | int crypto_box_afternm(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k) 464 | { 465 | return crypto_secretbox(c,m,d,n,k); 466 | } 467 | 468 | int crypto_box_open_afternm(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *k) 469 | { 470 | return crypto_secretbox_open(m,c,d,n,k); 471 | } 472 | 473 | int crypto_box(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *y,const u8 *x) 474 | { 475 | u8 k[32]; 476 | crypto_box_beforenm(k,y,x); 477 | return crypto_box_afternm(c,m,d,n,k); 478 | } 479 | 480 | int crypto_box_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *y,const u8 *x) 481 | { 482 | u8 k[32]; 483 | crypto_box_beforenm(k,y,x); 484 | return crypto_box_open_afternm(m,c,d,n,k); 485 | } 486 | 487 | static u64 R(u64 x,int c) { return (x >> c) | (x << (64 - c)); } 488 | static u64 Ch(u64 x,u64 y,u64 z) { return (x & y) ^ (~x & z); } 489 | static u64 Maj(u64 x,u64 y,u64 z) { return (x & y) ^ (x & z) ^ (y & z); } 490 | static u64 Sigma0(u64 x) { return R(x,28) ^ R(x,34) ^ R(x,39); } 491 | static u64 Sigma1(u64 x) { return R(x,14) ^ R(x,18) ^ R(x,41); } 492 | static u64 sigma0(u64 x) { return R(x, 1) ^ R(x, 8) ^ (x >> 7); } 493 | static u64 sigma1(u64 x) { return R(x,19) ^ R(x,61) ^ (x >> 6); } 494 | 495 | static const u64 K[80] = 496 | { 497 | 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL, 498 | 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL, 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, 499 | 0xd807aa98a3030242ULL, 0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL, 500 | 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL, 501 | 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL, 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, 502 | 0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL, 503 | 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL, 504 | 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL, 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, 505 | 0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL, 506 | 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL, 507 | 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL, 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, 508 | 0xd192e819d6ef5218ULL, 0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL, 509 | 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL, 510 | 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL, 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, 511 | 0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL, 512 | 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL, 513 | 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL, 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, 514 | 0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL, 515 | 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL, 516 | 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL, 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL 517 | }; 518 | 519 | int crypto_hashblocks(u8 *x,const u8 *m,u64 n) 520 | { 521 | u64 z[8],b[8],a[8],w[16],t; 522 | int i,j; 523 | 524 | FOR(i,8) z[i] = a[i] = dl64(x + 8 * i); 525 | 526 | while (n >= 128) { 527 | FOR(i,16) w[i] = dl64(m + 8 * i); 528 | 529 | FOR(i,80) { 530 | FOR(j,8) b[j] = a[j]; 531 | t = a[7] + Sigma1(a[4]) + Ch(a[4],a[5],a[6]) + K[i] + w[i%16]; 532 | b[7] = t + Sigma0(a[0]) + Maj(a[0],a[1],a[2]); 533 | b[3] += t; 534 | FOR(j,8) a[(j+1)%8] = b[j]; 535 | if (i%16 == 15) 536 | FOR(j,16) 537 | w[j] += w[(j+9)%16] + sigma0(w[(j+1)%16]) + sigma1(w[(j+14)%16]); 538 | } 539 | 540 | FOR(i,8) { a[i] += z[i]; z[i] = a[i]; } 541 | 542 | m += 128; 543 | n -= 128; 544 | } 545 | 546 | FOR(i,8) ts64(x+8*i,z[i]); 547 | 548 | return n; 549 | } 550 | 551 | static const u8 iv[64] = { 552 | 0x6a,0x09,0xe6,0x67,0xf3,0xbc,0xc9,0x08, 553 | 0xbb,0x67,0xae,0x85,0x84,0xca,0xa7,0x3b, 554 | 0x3c,0x6e,0xf3,0x72,0xfe,0x94,0xf8,0x2b, 555 | 0xa5,0x4f,0xf5,0x3a,0x5f,0x1d,0x36,0xf1, 556 | 0x51,0x0e,0x52,0x7f,0xad,0xe6,0x82,0xd1, 557 | 0x9b,0x05,0x68,0x8c,0x2b,0x3e,0x6c,0x1f, 558 | 0x1f,0x83,0xd9,0xab,0xfb,0x41,0xbd,0x6b, 559 | 0x5b,0xe0,0xcd,0x19,0x13,0x7e,0x21,0x79 560 | } ; 561 | 562 | int crypto_hash(u8 *out,const u8 *m,u64 n) 563 | { 564 | u8 h[64],x[256]; 565 | u64 i,b = n; 566 | 567 | FOR(i,64) h[i] = iv[i]; 568 | 569 | crypto_hashblocks(h,m,n); 570 | m += n; 571 | n &= 127; 572 | m -= n; 573 | 574 | FOR(i,256) x[i] = 0; 575 | FOR(i,n) x[i] = m[i]; 576 | x[n] = 128; 577 | 578 | n = 256-128*(n<112); 579 | x[n-9] = b >> 61; 580 | ts64(x+n-8,b<<3); 581 | crypto_hashblocks(h,x,n); 582 | 583 | FOR(i,64) out[i] = h[i]; 584 | 585 | return 0; 586 | } 587 | 588 | sv add(gf p[4],gf q[4]) 589 | { 590 | gf a,b,c,d,t,e,f,g,h; 591 | 592 | Z(a, p[1], p[0]); 593 | Z(t, q[1], q[0]); 594 | M(a, a, t); 595 | A(b, p[0], p[1]); 596 | A(t, q[0], q[1]); 597 | M(b, b, t); 598 | M(c, p[3], q[3]); 599 | M(c, c, D2); 600 | M(d, p[2], q[2]); 601 | A(d, d, d); 602 | Z(e, b, a); 603 | Z(f, d, c); 604 | A(g, d, c); 605 | A(h, b, a); 606 | 607 | M(p[0], e, f); 608 | M(p[1], h, g); 609 | M(p[2], g, f); 610 | M(p[3], e, h); 611 | } 612 | 613 | sv cswap(gf p[4],gf q[4],u8 b) 614 | { 615 | int i; 616 | FOR(i,4) 617 | sel25519(p[i],q[i],b); 618 | } 619 | 620 | sv pack(u8 *r,gf p[4]) 621 | { 622 | gf tx, ty, zi; 623 | inv25519(zi, p[2]); 624 | M(tx, p[0], zi); 625 | M(ty, p[1], zi); 626 | pack25519(r, ty); 627 | r[31] ^= par25519(tx) << 7; 628 | } 629 | 630 | sv scalarmult(gf p[4],gf q[4],const u8 *s) 631 | { 632 | int i; 633 | set25519(p[0],gf0); 634 | set25519(p[1],gf1); 635 | set25519(p[2],gf1); 636 | set25519(p[3],gf0); 637 | for (i = 255;i >= 0;--i) { 638 | u8 b = (s[i/8]>>(i&7))&1; 639 | cswap(p,q,b); 640 | add(q,p); 641 | add(p,p); 642 | cswap(p,q,b); 643 | } 644 | } 645 | 646 | sv scalarbase(gf p[4],const u8 *s) 647 | { 648 | gf q[4]; 649 | set25519(q[0],X); 650 | set25519(q[1],Y); 651 | set25519(q[2],gf1); 652 | M(q[3],X,Y); 653 | scalarmult(p,q,s); 654 | } 655 | 656 | int crypto_sign_keypair(u8 *pk, u8 *sk) 657 | { 658 | u8 d[64]; 659 | gf p[4]; 660 | int i; 661 | 662 | randombytes(sk, 32); 663 | crypto_hash(d, sk, 32); 664 | d[0] &= 248; 665 | d[31] &= 127; 666 | d[31] |= 64; 667 | 668 | scalarbase(p,d); 669 | pack(pk,p); 670 | 671 | FOR(i,32) sk[32 + i] = pk[i]; 672 | return 0; 673 | } 674 | 675 | static const u64 L[32] = {0xed, 0xd3, 0xf5, 0x5c, 0x1a, 0x63, 0x12, 0x58, 0xd6, 0x9c, 0xf7, 0xa2, 0xde, 0xf9, 0xde, 0x14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0x10}; 676 | 677 | sv modL(u8 *r,i64 x[64]) 678 | { 679 | i64 carry,i,j; 680 | for (i = 63;i >= 32;--i) { 681 | carry = 0; 682 | for (j = i - 32;j < i - 12;++j) { 683 | x[j] += carry - 16 * x[i] * L[j - (i - 32)]; 684 | carry = (x[j] + 128) >> 8; 685 | x[j] -= carry << 8; 686 | } 687 | x[j] += carry; 688 | x[i] = 0; 689 | } 690 | carry = 0; 691 | FOR(j,32) { 692 | x[j] += carry - (x[31] >> 4) * L[j]; 693 | carry = x[j] >> 8; 694 | x[j] &= 255; 695 | } 696 | FOR(j,32) x[j] -= carry * L[j]; 697 | FOR(i,32) { 698 | x[i+1] += x[i] >> 8; 699 | r[i] = x[i] & 255; 700 | } 701 | } 702 | 703 | sv reduce(u8 *r) 704 | { 705 | i64 x[64],i; 706 | FOR(i,64) x[i] = (u64) r[i]; 707 | FOR(i,64) r[i] = 0; 708 | modL(r,x); 709 | } 710 | 711 | int crypto_sign(u8 *sm,u64 *smlen,const u8 *m,u64 n,const u8 *sk) 712 | { 713 | u8 d[64],h[64],r[64]; 714 | i64 i,j,x[64]; 715 | gf p[4]; 716 | 717 | crypto_hash(d, sk, 32); 718 | d[0] &= 248; 719 | d[31] &= 127; 720 | d[31] |= 64; 721 | 722 | *smlen = n+64; 723 | FOR(i,n) sm[64 + i] = m[i]; 724 | FOR(i,32) sm[32 + i] = d[32 + i]; 725 | 726 | crypto_hash(r, sm+32, n+32); 727 | reduce(r); 728 | scalarbase(p,r); 729 | pack(sm,p); 730 | 731 | FOR(i,32) sm[i+32] = sk[i+32]; 732 | crypto_hash(h,sm,n + 64); 733 | reduce(h); 734 | 735 | FOR(i,64) x[i] = 0; 736 | FOR(i,32) x[i] = (u64) r[i]; 737 | FOR(i,32) FOR(j,32) x[i+j] += h[i] * (u64) d[j]; 738 | modL(sm + 32,x); 739 | 740 | return 0; 741 | } 742 | 743 | static int unpackneg(gf r[4],const u8 p[32]) 744 | { 745 | gf t, chk, num, den, den2, den4, den6; 746 | set25519(r[2],gf1); 747 | unpack25519(r[1],p); 748 | S(num,r[1]); 749 | M(den,num,D); 750 | Z(num,num,r[2]); 751 | A(den,r[2],den); 752 | 753 | S(den2,den); 754 | S(den4,den2); 755 | M(den6,den4,den2); 756 | M(t,den6,num); 757 | M(t,t,den); 758 | 759 | pow2523(t,t); 760 | M(t,t,num); 761 | M(t,t,den); 762 | M(t,t,den); 763 | M(r[0],t,den); 764 | 765 | S(chk,r[0]); 766 | M(chk,chk,den); 767 | if (neq25519(chk, num)) M(r[0],r[0],I); 768 | 769 | S(chk,r[0]); 770 | M(chk,chk,den); 771 | if (neq25519(chk, num)) return -1; 772 | 773 | if (par25519(r[0]) == (p[31]>>7)) Z(r[0],gf0,r[0]); 774 | 775 | M(r[3],r[0],r[1]); 776 | return 0; 777 | } 778 | 779 | int crypto_sign_open(u8 *m,u64 *mlen,const u8 *sm,u64 n,const u8 *pk) 780 | { 781 | int i; 782 | u8 t[32],h[64]; 783 | gf p[4],q[4]; 784 | 785 | *mlen = -1; 786 | if (n < 64) return -1; 787 | 788 | if (unpackneg(q,pk)) return -1; 789 | 790 | FOR(i,n) m[i] = sm[i]; 791 | FOR(i,32) m[i+32] = pk[i]; 792 | crypto_hash(h,m,n); 793 | reduce(h); 794 | scalarmult(p,q,h); 795 | 796 | scalarbase(q,sm + 32); 797 | add(p,q); 798 | pack(t,p); 799 | 800 | n -= 64; 801 | if (crypto_verify_32(sm, t)) { 802 | FOR(i,n) m[i] = 0; 803 | return -1; 804 | } 805 | 806 | FOR(i,n) m[i] = sm[i + 64]; 807 | *mlen = n; 808 | return 0; 809 | } 810 | -------------------------------------------------------------------------------- /tweetnacl/lib/tweetnacl.h: -------------------------------------------------------------------------------- 1 | #ifndef TWEETNACL_H 2 | #define TWEETNACL_H 3 | #define crypto_auth_PRIMITIVE "hmacsha512256" 4 | #define crypto_auth crypto_auth_hmacsha512256 5 | #define crypto_auth_verify crypto_auth_hmacsha512256_verify 6 | #define crypto_auth_BYTES crypto_auth_hmacsha512256_BYTES 7 | #define crypto_auth_KEYBYTES crypto_auth_hmacsha512256_KEYBYTES 8 | #define crypto_auth_IMPLEMENTATION crypto_auth_hmacsha512256_IMPLEMENTATION 9 | #define crypto_auth_VERSION crypto_auth_hmacsha512256_VERSION 10 | #define crypto_auth_hmacsha512256_tweet_BYTES 32 11 | #define crypto_auth_hmacsha512256_tweet_KEYBYTES 32 12 | extern int crypto_auth_hmacsha512256_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *); 13 | extern int crypto_auth_hmacsha512256_tweet_verify(const unsigned char *,const unsigned char *,unsigned long long,const unsigned char *); 14 | #define crypto_auth_hmacsha512256_tweet_VERSION "-" 15 | #define crypto_auth_hmacsha512256 crypto_auth_hmacsha512256_tweet 16 | #define crypto_auth_hmacsha512256_verify crypto_auth_hmacsha512256_tweet_verify 17 | #define crypto_auth_hmacsha512256_BYTES crypto_auth_hmacsha512256_tweet_BYTES 18 | #define crypto_auth_hmacsha512256_KEYBYTES crypto_auth_hmacsha512256_tweet_KEYBYTES 19 | #define crypto_auth_hmacsha512256_VERSION crypto_auth_hmacsha512256_tweet_VERSION 20 | #define crypto_auth_hmacsha512256_IMPLEMENTATION "crypto_auth/hmacsha512256/tweet" 21 | #define crypto_box_PRIMITIVE "curve25519xsalsa20poly1305" 22 | #define crypto_box crypto_box_curve25519xsalsa20poly1305 23 | #define crypto_box_open crypto_box_curve25519xsalsa20poly1305_open 24 | #define crypto_box_keypair crypto_box_curve25519xsalsa20poly1305_keypair 25 | #define crypto_box_beforenm crypto_box_curve25519xsalsa20poly1305_beforenm 26 | #define crypto_box_afternm crypto_box_curve25519xsalsa20poly1305_afternm 27 | #define crypto_box_open_afternm crypto_box_curve25519xsalsa20poly1305_open_afternm 28 | #define crypto_box_PUBLICKEYBYTES crypto_box_curve25519xsalsa20poly1305_PUBLICKEYBYTES 29 | #define crypto_box_SECRETKEYBYTES crypto_box_curve25519xsalsa20poly1305_SECRETKEYBYTES 30 | #define crypto_box_BEFORENMBYTES crypto_box_curve25519xsalsa20poly1305_BEFORENMBYTES 31 | #define crypto_box_NONCEBYTES crypto_box_curve25519xsalsa20poly1305_NONCEBYTES 32 | #define crypto_box_ZEROBYTES crypto_box_curve25519xsalsa20poly1305_ZEROBYTES 33 | #define crypto_box_BOXZEROBYTES crypto_box_curve25519xsalsa20poly1305_BOXZEROBYTES 34 | #define crypto_box_IMPLEMENTATION crypto_box_curve25519xsalsa20poly1305_IMPLEMENTATION 35 | #define crypto_box_VERSION crypto_box_curve25519xsalsa20poly1305_VERSION 36 | #define crypto_box_curve25519xsalsa20poly1305_tweet_PUBLICKEYBYTES 32 37 | #define crypto_box_curve25519xsalsa20poly1305_tweet_SECRETKEYBYTES 32 38 | #define crypto_box_curve25519xsalsa20poly1305_tweet_BEFORENMBYTES 32 39 | #define crypto_box_curve25519xsalsa20poly1305_tweet_NONCEBYTES 24 40 | #define crypto_box_curve25519xsalsa20poly1305_tweet_ZEROBYTES 32 41 | #define crypto_box_curve25519xsalsa20poly1305_tweet_BOXZEROBYTES 16 42 | extern int crypto_box_curve25519xsalsa20poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *,const unsigned char *); 43 | extern int crypto_box_curve25519xsalsa20poly1305_tweet_open(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *,const unsigned char *); 44 | extern int crypto_box_curve25519xsalsa20poly1305_tweet_keypair(unsigned char *,unsigned char *); 45 | extern int crypto_box_curve25519xsalsa20poly1305_tweet_beforenm(unsigned char *,const unsigned char *,const unsigned char *); 46 | extern int crypto_box_curve25519xsalsa20poly1305_tweet_afternm(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 47 | extern int crypto_box_curve25519xsalsa20poly1305_tweet_open_afternm(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 48 | #define crypto_box_curve25519xsalsa20poly1305_tweet_VERSION "-" 49 | #define crypto_box_curve25519xsalsa20poly1305 crypto_box_curve25519xsalsa20poly1305_tweet 50 | #define crypto_box_curve25519xsalsa20poly1305_open crypto_box_curve25519xsalsa20poly1305_tweet_open 51 | #define crypto_box_curve25519xsalsa20poly1305_keypair crypto_box_curve25519xsalsa20poly1305_tweet_keypair 52 | #define crypto_box_curve25519xsalsa20poly1305_beforenm crypto_box_curve25519xsalsa20poly1305_tweet_beforenm 53 | #define crypto_box_curve25519xsalsa20poly1305_afternm crypto_box_curve25519xsalsa20poly1305_tweet_afternm 54 | #define crypto_box_curve25519xsalsa20poly1305_open_afternm crypto_box_curve25519xsalsa20poly1305_tweet_open_afternm 55 | #define crypto_box_curve25519xsalsa20poly1305_PUBLICKEYBYTES crypto_box_curve25519xsalsa20poly1305_tweet_PUBLICKEYBYTES 56 | #define crypto_box_curve25519xsalsa20poly1305_SECRETKEYBYTES crypto_box_curve25519xsalsa20poly1305_tweet_SECRETKEYBYTES 57 | #define crypto_box_curve25519xsalsa20poly1305_BEFORENMBYTES crypto_box_curve25519xsalsa20poly1305_tweet_BEFORENMBYTES 58 | #define crypto_box_curve25519xsalsa20poly1305_NONCEBYTES crypto_box_curve25519xsalsa20poly1305_tweet_NONCEBYTES 59 | #define crypto_box_curve25519xsalsa20poly1305_ZEROBYTES crypto_box_curve25519xsalsa20poly1305_tweet_ZEROBYTES 60 | #define crypto_box_curve25519xsalsa20poly1305_BOXZEROBYTES crypto_box_curve25519xsalsa20poly1305_tweet_BOXZEROBYTES 61 | #define crypto_box_curve25519xsalsa20poly1305_VERSION crypto_box_curve25519xsalsa20poly1305_tweet_VERSION 62 | #define crypto_box_curve25519xsalsa20poly1305_IMPLEMENTATION "crypto_box/curve25519xsalsa20poly1305/tweet" 63 | #define crypto_core_PRIMITIVE "salsa20" 64 | #define crypto_core crypto_core_salsa20 65 | #define crypto_core_OUTPUTBYTES crypto_core_salsa20_OUTPUTBYTES 66 | #define crypto_core_INPUTBYTES crypto_core_salsa20_INPUTBYTES 67 | #define crypto_core_KEYBYTES crypto_core_salsa20_KEYBYTES 68 | #define crypto_core_CONSTBYTES crypto_core_salsa20_CONSTBYTES 69 | #define crypto_core_IMPLEMENTATION crypto_core_salsa20_IMPLEMENTATION 70 | #define crypto_core_VERSION crypto_core_salsa20_VERSION 71 | #define crypto_core_salsa20_tweet_OUTPUTBYTES 64 72 | #define crypto_core_salsa20_tweet_INPUTBYTES 16 73 | #define crypto_core_salsa20_tweet_KEYBYTES 32 74 | #define crypto_core_salsa20_tweet_CONSTBYTES 16 75 | extern int crypto_core_salsa20_tweet(unsigned char *,const unsigned char *,const unsigned char *,const unsigned char *); 76 | #define crypto_core_salsa20_tweet_VERSION "-" 77 | #define crypto_core_salsa20 crypto_core_salsa20_tweet 78 | #define crypto_core_salsa20_OUTPUTBYTES crypto_core_salsa20_tweet_OUTPUTBYTES 79 | #define crypto_core_salsa20_INPUTBYTES crypto_core_salsa20_tweet_INPUTBYTES 80 | #define crypto_core_salsa20_KEYBYTES crypto_core_salsa20_tweet_KEYBYTES 81 | #define crypto_core_salsa20_CONSTBYTES crypto_core_salsa20_tweet_CONSTBYTES 82 | #define crypto_core_salsa20_VERSION crypto_core_salsa20_tweet_VERSION 83 | #define crypto_core_salsa20_IMPLEMENTATION "crypto_core/salsa20/tweet" 84 | #define crypto_core_hsalsa20_tweet_OUTPUTBYTES 32 85 | #define crypto_core_hsalsa20_tweet_INPUTBYTES 16 86 | #define crypto_core_hsalsa20_tweet_KEYBYTES 32 87 | #define crypto_core_hsalsa20_tweet_CONSTBYTES 16 88 | extern int crypto_core_hsalsa20_tweet(unsigned char *,const unsigned char *,const unsigned char *,const unsigned char *); 89 | #define crypto_core_hsalsa20_tweet_VERSION "-" 90 | #define crypto_core_hsalsa20 crypto_core_hsalsa20_tweet 91 | #define crypto_core_hsalsa20_OUTPUTBYTES crypto_core_hsalsa20_tweet_OUTPUTBYTES 92 | #define crypto_core_hsalsa20_INPUTBYTES crypto_core_hsalsa20_tweet_INPUTBYTES 93 | #define crypto_core_hsalsa20_KEYBYTES crypto_core_hsalsa20_tweet_KEYBYTES 94 | #define crypto_core_hsalsa20_CONSTBYTES crypto_core_hsalsa20_tweet_CONSTBYTES 95 | #define crypto_core_hsalsa20_VERSION crypto_core_hsalsa20_tweet_VERSION 96 | #define crypto_core_hsalsa20_IMPLEMENTATION "crypto_core/hsalsa20/tweet" 97 | #define crypto_hashblocks_PRIMITIVE "sha512" 98 | #define crypto_hashblocks crypto_hashblocks_sha512 99 | #define crypto_hashblocks_STATEBYTES crypto_hashblocks_sha512_STATEBYTES 100 | #define crypto_hashblocks_BLOCKBYTES crypto_hashblocks_sha512_BLOCKBYTES 101 | #define crypto_hashblocks_IMPLEMENTATION crypto_hashblocks_sha512_IMPLEMENTATION 102 | #define crypto_hashblocks_VERSION crypto_hashblocks_sha512_VERSION 103 | #define crypto_hashblocks_sha512_tweet_STATEBYTES 64 104 | #define crypto_hashblocks_sha512_tweet_BLOCKBYTES 128 105 | extern int crypto_hashblocks_sha512_tweet(unsigned char *,const unsigned char *,unsigned long long); 106 | #define crypto_hashblocks_sha512_tweet_VERSION "-" 107 | #define crypto_hashblocks_sha512 crypto_hashblocks_sha512_tweet 108 | #define crypto_hashblocks_sha512_STATEBYTES crypto_hashblocks_sha512_tweet_STATEBYTES 109 | #define crypto_hashblocks_sha512_BLOCKBYTES crypto_hashblocks_sha512_tweet_BLOCKBYTES 110 | #define crypto_hashblocks_sha512_VERSION crypto_hashblocks_sha512_tweet_VERSION 111 | #define crypto_hashblocks_sha512_IMPLEMENTATION "crypto_hashblocks/sha512/tweet" 112 | #define crypto_hashblocks_sha256_tweet_STATEBYTES 32 113 | #define crypto_hashblocks_sha256_tweet_BLOCKBYTES 64 114 | extern int crypto_hashblocks_sha256_tweet(unsigned char *,const unsigned char *,unsigned long long); 115 | #define crypto_hashblocks_sha256_tweet_VERSION "-" 116 | #define crypto_hashblocks_sha256 crypto_hashblocks_sha256_tweet 117 | #define crypto_hashblocks_sha256_STATEBYTES crypto_hashblocks_sha256_tweet_STATEBYTES 118 | #define crypto_hashblocks_sha256_BLOCKBYTES crypto_hashblocks_sha256_tweet_BLOCKBYTES 119 | #define crypto_hashblocks_sha256_VERSION crypto_hashblocks_sha256_tweet_VERSION 120 | #define crypto_hashblocks_sha256_IMPLEMENTATION "crypto_hashblocks/sha256/tweet" 121 | #define crypto_hash_PRIMITIVE "sha512" 122 | #define crypto_hash crypto_hash_sha512 123 | #define crypto_hash_BYTES crypto_hash_sha512_BYTES 124 | #define crypto_hash_IMPLEMENTATION crypto_hash_sha512_IMPLEMENTATION 125 | #define crypto_hash_VERSION crypto_hash_sha512_VERSION 126 | #define crypto_hash_sha512_tweet_BYTES 64 127 | extern int crypto_hash_sha512_tweet(unsigned char *,const unsigned char *,unsigned long long); 128 | #define crypto_hash_sha512_tweet_VERSION "-" 129 | #define crypto_hash_sha512 crypto_hash_sha512_tweet 130 | #define crypto_hash_sha512_BYTES crypto_hash_sha512_tweet_BYTES 131 | #define crypto_hash_sha512_VERSION crypto_hash_sha512_tweet_VERSION 132 | #define crypto_hash_sha512_IMPLEMENTATION "crypto_hash/sha512/tweet" 133 | #define crypto_hash_sha256_tweet_BYTES 32 134 | extern int crypto_hash_sha256_tweet(unsigned char *,const unsigned char *,unsigned long long); 135 | #define crypto_hash_sha256_tweet_VERSION "-" 136 | #define crypto_hash_sha256 crypto_hash_sha256_tweet 137 | #define crypto_hash_sha256_BYTES crypto_hash_sha256_tweet_BYTES 138 | #define crypto_hash_sha256_VERSION crypto_hash_sha256_tweet_VERSION 139 | #define crypto_hash_sha256_IMPLEMENTATION "crypto_hash/sha256/tweet" 140 | #define crypto_onetimeauth_PRIMITIVE "poly1305" 141 | #define crypto_onetimeauth crypto_onetimeauth_poly1305 142 | #define crypto_onetimeauth_verify crypto_onetimeauth_poly1305_verify 143 | #define crypto_onetimeauth_BYTES crypto_onetimeauth_poly1305_BYTES 144 | #define crypto_onetimeauth_KEYBYTES crypto_onetimeauth_poly1305_KEYBYTES 145 | #define crypto_onetimeauth_IMPLEMENTATION crypto_onetimeauth_poly1305_IMPLEMENTATION 146 | #define crypto_onetimeauth_VERSION crypto_onetimeauth_poly1305_VERSION 147 | #define crypto_onetimeauth_poly1305_tweet_BYTES 16 148 | #define crypto_onetimeauth_poly1305_tweet_KEYBYTES 32 149 | extern int crypto_onetimeauth_poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *); 150 | extern int crypto_onetimeauth_poly1305_tweet_verify(const unsigned char *,const unsigned char *,unsigned long long,const unsigned char *); 151 | #define crypto_onetimeauth_poly1305_tweet_VERSION "-" 152 | #define crypto_onetimeauth_poly1305 crypto_onetimeauth_poly1305_tweet 153 | #define crypto_onetimeauth_poly1305_verify crypto_onetimeauth_poly1305_tweet_verify 154 | #define crypto_onetimeauth_poly1305_BYTES crypto_onetimeauth_poly1305_tweet_BYTES 155 | #define crypto_onetimeauth_poly1305_KEYBYTES crypto_onetimeauth_poly1305_tweet_KEYBYTES 156 | #define crypto_onetimeauth_poly1305_VERSION crypto_onetimeauth_poly1305_tweet_VERSION 157 | #define crypto_onetimeauth_poly1305_IMPLEMENTATION "crypto_onetimeauth/poly1305/tweet" 158 | #define crypto_scalarmult_PRIMITIVE "curve25519" 159 | #define crypto_scalarmult crypto_scalarmult_curve25519 160 | #define crypto_scalarmult_base crypto_scalarmult_curve25519_base 161 | #define crypto_scalarmult_BYTES crypto_scalarmult_curve25519_BYTES 162 | #define crypto_scalarmult_SCALARBYTES crypto_scalarmult_curve25519_SCALARBYTES 163 | #define crypto_scalarmult_IMPLEMENTATION crypto_scalarmult_curve25519_IMPLEMENTATION 164 | #define crypto_scalarmult_VERSION crypto_scalarmult_curve25519_VERSION 165 | #define crypto_scalarmult_curve25519_tweet_BYTES 32 166 | #define crypto_scalarmult_curve25519_tweet_SCALARBYTES 32 167 | extern int crypto_scalarmult_curve25519_tweet(unsigned char *,const unsigned char *,const unsigned char *); 168 | extern int crypto_scalarmult_curve25519_tweet_base(unsigned char *,const unsigned char *); 169 | #define crypto_scalarmult_curve25519_tweet_VERSION "-" 170 | #define crypto_scalarmult_curve25519 crypto_scalarmult_curve25519_tweet 171 | #define crypto_scalarmult_curve25519_base crypto_scalarmult_curve25519_tweet_base 172 | #define crypto_scalarmult_curve25519_BYTES crypto_scalarmult_curve25519_tweet_BYTES 173 | #define crypto_scalarmult_curve25519_SCALARBYTES crypto_scalarmult_curve25519_tweet_SCALARBYTES 174 | #define crypto_scalarmult_curve25519_VERSION crypto_scalarmult_curve25519_tweet_VERSION 175 | #define crypto_scalarmult_curve25519_IMPLEMENTATION "crypto_scalarmult/curve25519/tweet" 176 | #define crypto_secretbox_PRIMITIVE "xsalsa20poly1305" 177 | #define crypto_secretbox crypto_secretbox_xsalsa20poly1305 178 | #define crypto_secretbox_open crypto_secretbox_xsalsa20poly1305_open 179 | #define crypto_secretbox_KEYBYTES crypto_secretbox_xsalsa20poly1305_KEYBYTES 180 | #define crypto_secretbox_NONCEBYTES crypto_secretbox_xsalsa20poly1305_NONCEBYTES 181 | #define crypto_secretbox_ZEROBYTES crypto_secretbox_xsalsa20poly1305_ZEROBYTES 182 | #define crypto_secretbox_BOXZEROBYTES crypto_secretbox_xsalsa20poly1305_BOXZEROBYTES 183 | #define crypto_secretbox_IMPLEMENTATION crypto_secretbox_xsalsa20poly1305_IMPLEMENTATION 184 | #define crypto_secretbox_VERSION crypto_secretbox_xsalsa20poly1305_VERSION 185 | #define crypto_secretbox_xsalsa20poly1305_tweet_KEYBYTES 32 186 | #define crypto_secretbox_xsalsa20poly1305_tweet_NONCEBYTES 24 187 | #define crypto_secretbox_xsalsa20poly1305_tweet_ZEROBYTES 32 188 | #define crypto_secretbox_xsalsa20poly1305_tweet_BOXZEROBYTES 16 189 | extern int crypto_secretbox_xsalsa20poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 190 | extern int crypto_secretbox_xsalsa20poly1305_tweet_open(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 191 | #define crypto_secretbox_xsalsa20poly1305_tweet_VERSION "-" 192 | #define crypto_secretbox_xsalsa20poly1305 crypto_secretbox_xsalsa20poly1305_tweet 193 | #define crypto_secretbox_xsalsa20poly1305_open crypto_secretbox_xsalsa20poly1305_tweet_open 194 | #define crypto_secretbox_xsalsa20poly1305_KEYBYTES crypto_secretbox_xsalsa20poly1305_tweet_KEYBYTES 195 | #define crypto_secretbox_xsalsa20poly1305_NONCEBYTES crypto_secretbox_xsalsa20poly1305_tweet_NONCEBYTES 196 | #define crypto_secretbox_xsalsa20poly1305_ZEROBYTES crypto_secretbox_xsalsa20poly1305_tweet_ZEROBYTES 197 | #define crypto_secretbox_xsalsa20poly1305_BOXZEROBYTES crypto_secretbox_xsalsa20poly1305_tweet_BOXZEROBYTES 198 | #define crypto_secretbox_xsalsa20poly1305_VERSION crypto_secretbox_xsalsa20poly1305_tweet_VERSION 199 | #define crypto_secretbox_xsalsa20poly1305_IMPLEMENTATION "crypto_secretbox/xsalsa20poly1305/tweet" 200 | #define crypto_sign_PRIMITIVE "ed25519" 201 | #define crypto_sign crypto_sign_ed25519 202 | #define crypto_sign_open crypto_sign_ed25519_open 203 | #define crypto_sign_keypair crypto_sign_ed25519_keypair 204 | #define crypto_sign_BYTES crypto_sign_ed25519_BYTES 205 | #define crypto_sign_PUBLICKEYBYTES crypto_sign_ed25519_PUBLICKEYBYTES 206 | #define crypto_sign_SECRETKEYBYTES crypto_sign_ed25519_SECRETKEYBYTES 207 | #define crypto_sign_IMPLEMENTATION crypto_sign_ed25519_IMPLEMENTATION 208 | #define crypto_sign_VERSION crypto_sign_ed25519_VERSION 209 | #define crypto_sign_ed25519_tweet_BYTES 64 210 | #define crypto_sign_ed25519_tweet_PUBLICKEYBYTES 32 211 | #define crypto_sign_ed25519_tweet_SECRETKEYBYTES 64 212 | extern int crypto_sign_ed25519_tweet(unsigned char *,unsigned long long *,const unsigned char *,unsigned long long,const unsigned char *); 213 | extern int crypto_sign_ed25519_tweet_open(unsigned char *,unsigned long long *,const unsigned char *,unsigned long long,const unsigned char *); 214 | extern int crypto_sign_ed25519_tweet_keypair(unsigned char *,unsigned char *); 215 | #define crypto_sign_ed25519_tweet_VERSION "-" 216 | #define crypto_sign_ed25519 crypto_sign_ed25519_tweet 217 | #define crypto_sign_ed25519_open crypto_sign_ed25519_tweet_open 218 | #define crypto_sign_ed25519_keypair crypto_sign_ed25519_tweet_keypair 219 | #define crypto_sign_ed25519_BYTES crypto_sign_ed25519_tweet_BYTES 220 | #define crypto_sign_ed25519_PUBLICKEYBYTES crypto_sign_ed25519_tweet_PUBLICKEYBYTES 221 | #define crypto_sign_ed25519_SECRETKEYBYTES crypto_sign_ed25519_tweet_SECRETKEYBYTES 222 | #define crypto_sign_ed25519_VERSION crypto_sign_ed25519_tweet_VERSION 223 | #define crypto_sign_ed25519_IMPLEMENTATION "crypto_sign/ed25519/tweet" 224 | #define crypto_stream_PRIMITIVE "xsalsa20" 225 | #define crypto_stream crypto_stream_xsalsa20 226 | #define crypto_stream_xor crypto_stream_xsalsa20_xor 227 | #define crypto_stream_KEYBYTES crypto_stream_xsalsa20_KEYBYTES 228 | #define crypto_stream_NONCEBYTES crypto_stream_xsalsa20_NONCEBYTES 229 | #define crypto_stream_IMPLEMENTATION crypto_stream_xsalsa20_IMPLEMENTATION 230 | #define crypto_stream_VERSION crypto_stream_xsalsa20_VERSION 231 | #define crypto_stream_xsalsa20_tweet_KEYBYTES 32 232 | #define crypto_stream_xsalsa20_tweet_NONCEBYTES 24 233 | extern int crypto_stream_xsalsa20_tweet(unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 234 | extern int crypto_stream_xsalsa20_tweet_xor(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 235 | #define crypto_stream_xsalsa20_tweet_VERSION "-" 236 | #define crypto_stream_xsalsa20 crypto_stream_xsalsa20_tweet 237 | #define crypto_stream_xsalsa20_xor crypto_stream_xsalsa20_tweet_xor 238 | #define crypto_stream_xsalsa20_KEYBYTES crypto_stream_xsalsa20_tweet_KEYBYTES 239 | #define crypto_stream_xsalsa20_NONCEBYTES crypto_stream_xsalsa20_tweet_NONCEBYTES 240 | #define crypto_stream_xsalsa20_VERSION crypto_stream_xsalsa20_tweet_VERSION 241 | #define crypto_stream_xsalsa20_IMPLEMENTATION "crypto_stream/xsalsa20/tweet" 242 | #define crypto_stream_salsa20_tweet_KEYBYTES 32 243 | #define crypto_stream_salsa20_tweet_NONCEBYTES 8 244 | extern int crypto_stream_salsa20_tweet(unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 245 | extern int crypto_stream_salsa20_tweet_xor(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *); 246 | #define crypto_stream_salsa20_tweet_VERSION "-" 247 | #define crypto_stream_salsa20 crypto_stream_salsa20_tweet 248 | #define crypto_stream_salsa20_xor crypto_stream_salsa20_tweet_xor 249 | #define crypto_stream_salsa20_KEYBYTES crypto_stream_salsa20_tweet_KEYBYTES 250 | #define crypto_stream_salsa20_NONCEBYTES crypto_stream_salsa20_tweet_NONCEBYTES 251 | #define crypto_stream_salsa20_VERSION crypto_stream_salsa20_tweet_VERSION 252 | #define crypto_stream_salsa20_IMPLEMENTATION "crypto_stream/salsa20/tweet" 253 | #define crypto_verify_PRIMITIVE "16" 254 | #define crypto_verify crypto_verify_16 255 | #define crypto_verify_BYTES crypto_verify_16_BYTES 256 | #define crypto_verify_IMPLEMENTATION crypto_verify_16_IMPLEMENTATION 257 | #define crypto_verify_VERSION crypto_verify_16_VERSION 258 | #define crypto_verify_16_tweet_BYTES 16 259 | extern int crypto_verify_16_tweet(const unsigned char *,const unsigned char *); 260 | #define crypto_verify_16_tweet_VERSION "-" 261 | #define crypto_verify_16 crypto_verify_16_tweet 262 | #define crypto_verify_16_BYTES crypto_verify_16_tweet_BYTES 263 | #define crypto_verify_16_VERSION crypto_verify_16_tweet_VERSION 264 | #define crypto_verify_16_IMPLEMENTATION "crypto_verify/16/tweet" 265 | #define crypto_verify_32_tweet_BYTES 32 266 | extern int crypto_verify_32_tweet(const unsigned char *,const unsigned char *); 267 | #define crypto_verify_32_tweet_VERSION "-" 268 | #define crypto_verify_32 crypto_verify_32_tweet 269 | #define crypto_verify_32_BYTES crypto_verify_32_tweet_BYTES 270 | #define crypto_verify_32_VERSION crypto_verify_32_tweet_VERSION 271 | #define crypto_verify_32_IMPLEMENTATION "crypto_verify/32/tweet" 272 | #endif 273 | -------------------------------------------------------------------------------- /tweetnacl/lib/tweetnacl.ml: -------------------------------------------------------------------------------- 1 | exception Wrong_key_size 2 | 3 | external caml_tweetnacl_poly1305 : 4 | Cstruct.buffer -> Cstruct.buffer -> int64 -> Cstruct.buffer -> unit 5 | = "caml_tweetnacl_poly1305" 6 | 7 | let poly1305 ~key msg = 8 | let poly1305_key_length = 32 in 9 | let poly1305_output_length = 16 in 10 | if Cstruct.len key <> poly1305_key_length then raise Wrong_key_size; 11 | let key_buffer = Cstruct.to_bigarray key in 12 | let result = Cstruct.create poly1305_output_length in 13 | let result_buffer = Cstruct.to_bigarray result in 14 | let msg_len = Int64.of_int @@ Cstruct.len msg in 15 | let msg_buffer = Cstruct.to_bigarray msg in 16 | caml_tweetnacl_poly1305 result_buffer msg_buffer msg_len key_buffer; 17 | result 18 | -------------------------------------------------------------------------------- /tweetnacl/lib/tweetnacl.mli: -------------------------------------------------------------------------------- 1 | exception Wrong_key_size 2 | 3 | val poly1305 : key:Cstruct.t -> Cstruct.t -> Cstruct.t 4 | -------------------------------------------------------------------------------- /tweetnacl/lib/tweetnacl_stubs.c: -------------------------------------------------------------------------------- 1 | #include "caml/memory.h" 2 | #include "caml/bigarray.h" 3 | 4 | #include "tweetnacl.h" 5 | 6 | void randombytes(unsigned char *buf, unsigned int n) 7 | { 8 | abort(); 9 | } 10 | 11 | CAMLprim value caml_tweetnacl_poly1305(value into, value m, value n, value k) 12 | { 13 | CAMLparam4(into, m, n, k); 14 | 15 | crypto_onetimeauth_poly1305( 16 | Caml_ba_data_val(into), 17 | Caml_ba_data_val(m), 18 | Int64_val(n), 19 | Caml_ba_data_val(k) 20 | ); 21 | 22 | CAMLreturn(Val_unit); 23 | } 24 | -------------------------------------------------------------------------------- /tweetnacl/test/.ocamlformat: -------------------------------------------------------------------------------- 1 | disable=true 2 | -------------------------------------------------------------------------------- /tweetnacl/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_all) 3 | (libraries oUnit hex tweetnacl) 4 | (preprocess 5 | (pps ppx_deriving.std) 6 | ) 7 | ) 8 | -------------------------------------------------------------------------------- /tweetnacl/test/test_all.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let equal_cstruct = Cstruct.equal 4 | let pp_cstruct = Cstruct.hexdump_pp 5 | 6 | let test_poly1305 = 7 | let test ~key ~msg expected ctxt = 8 | let got = 9 | match Tweetnacl.poly1305 ~key msg with 10 | | x -> Some x 11 | | exception Tweetnacl.Wrong_key_size -> None 12 | in 13 | assert_equal 14 | ~ctxt 15 | ~cmp:[%eq: cstruct option] 16 | ~printer:[%show: cstruct option] 17 | expected 18 | got 19 | in 20 | let msg = Cstruct.of_string "Cryptographic Forum Research Group" in 21 | "poly1305" >::: 22 | [ "RFC 7539 2.5.2" >:: test 23 | ~key: 24 | ( Hex.to_cstruct 25 | ( `Hex 26 | (String.concat "" 27 | [ "85d6be7857556d337f4452fe42d506a8" 28 | ; "0103808afb0db2fd4abff6af4149f51b" 29 | ] 30 | ) 31 | ) 32 | ) 33 | ~msg 34 | (Some (Hex.to_cstruct (`Hex "a8061dc1305136c6c22b8baf0c0127a9"))) 35 | ; "Key with wrong size" >:: test 36 | ~key:(Cstruct.create 3) 37 | ~msg 38 | None 39 | ] 40 | 41 | let suite = 42 | "Tweetnacl" >::: 43 | [ test_poly1305 44 | ] 45 | 46 | 47 | let () = run_test_tt_main suite 48 | -------------------------------------------------------------------------------- /tweetnacl/test/test_all.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emillon/ocaml-noise/d5a3e0f634fba1f8d948a91c70a1dad6470722b0/tweetnacl/test/test_all.mli --------------------------------------------------------------------------------