├── .gitignore ├── .ocamlformat ├── .travis.yml ├── LICENSE.md ├── README.md ├── bench ├── bench.ml ├── curve25519-donna.c ├── donna.ml └── dune ├── callipyge.opam ├── dune-project ├── lib ├── callipyge.ml ├── callipyge.mli ├── dune ├── ma.ml └── ma.mli └── test ├── dune ├── oracle.ml └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | setup.data 3 | setup.log 4 | *.native 5 | *.byte 6 | *.docdir 7 | *.tar.gz 8 | *.install 9 | _tests 10 | .merlin 11 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | module-item-spacing=compact 2 | break-struct=natural 3 | break-infix=fit-or-vertical 4 | parens-tuple=multi-line-only 5 | wrap-comments=true 6 | if-then-else=keyword-first -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: 3 | - wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh 4 | - wget https://raw.githubusercontent.com/dinosaure/ocaml-travisci-skeleton/master/.travis-docgen.sh 5 | script: bash -ex .travis-opam.sh 6 | sudo: true 7 | env: 8 | global: 9 | - PINS="eqaf.dev:https://github.com/dinosaure/eqaf.git" 10 | matrix: 11 | - PACKAGE="callipyge" OCAML_VERSION=4.03 TESTS=true 12 | - PACKAGE="callipyge" OCAML_VERSION=4.04 TESTS=true 13 | - PACKAGE="callipyge" OCAML_VERSION=4.05 TESTS=true 14 | - PACKAGE="callipyge" OCAML_VERSION=4.06 TESTS=true 15 | - PACKAGE="callipyge" OCAML_VERSION=4.07 TESTS=true 16 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2014 Cumulus 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Callipyge 2 | ========= 3 | 4 | [![Build Status](https://travis-ci.org/oklm-wsh/Callipyge.svg?branch=master)](https://travis-ci.org/oklm-wsh/Callipyge) 5 | 6 | Pure OCaml implementation of Curve25519. 7 | 8 | Documentation 9 | ============= 10 | 11 | Documentation is available [here](https://oklm-wsh.github.io/Callipyge/index.html) 12 | 13 | Build Requirements 14 | ================== 15 | 16 | * OCaml >= 4.03.0 17 | * fmt 18 | * eqaf 19 | 20 | -------------------------------------------------------------------------------- /bench/bench.ml: -------------------------------------------------------------------------------- 1 | let random_key len = 2 | let ic = open_in_bin "/dev/urandom" in 3 | let rs = really_input_string ic len in 4 | close_in ic; rs 5 | 6 | let bench () = 7 | let secret = random_key 32 in 8 | let public = random_key 32 in 9 | 10 | let f () = 11 | let _ = Callipyge.shared 12 | ~secret:(Callipyge.secret_key_of_string secret) 13 | ~public:(Callipyge.public_key_of_string public) in 14 | () in 15 | let g () = 16 | let _ = Donna.shared ~secret ~public in 17 | () in 18 | 19 | Benchmark.throughputN 1 [ "callipyge", f, () 20 | ; "donna", g, () ] 21 | 22 | let () = 23 | let open Benchmark.Tree in 24 | 25 | register @@ "benchmark" @>>> [ "ECDH" @> lazy (bench ()) ] 26 | 27 | let () = Benchmark.Tree.run_global () 28 | -------------------------------------------------------------------------------- /bench/curve25519-donna.c: -------------------------------------------------------------------------------- 1 | /* Copyright 2008, Google Inc. 2 | * All rights reserved. 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions are 6 | * met: 7 | * 8 | * * Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * * Redistributions in binary form must reproduce the above 11 | * copyright notice, this list of conditions and the following disclaimer 12 | * in the documentation and/or other materials provided with the 13 | * distribution. 14 | * * Neither the name of Google Inc. nor the names of its 15 | * contributors may be used to endorse or promote products derived from 16 | * this software without specific prior written permission. 17 | * 18 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 24 | * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 25 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 26 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 27 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 28 | * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | * 30 | * curve25519-donna: Curve25519 elliptic curve, public key function 31 | * 32 | * http://code.google.com/p/curve25519-donna/ 33 | * 34 | * Adam Langley 35 | * 36 | * Derived from public domain C code by Daniel J. Bernstein 37 | * 38 | * More information about curve25519 can be found here 39 | * http://cr.yp.to/ecdh.html 40 | * 41 | * djb's sample implementation of curve25519 is written in a special assembly 42 | * language called qhasm and uses the floating point registers. 43 | * 44 | * This is, almost, a clean room reimplementation from the curve25519 paper. It 45 | * uses many of the tricks described therein. Only the crecip function is taken 46 | * from the sample implementation. */ 47 | 48 | #include 49 | #include 50 | 51 | #ifdef _MSC_VER 52 | #define inline __inline 53 | #endif 54 | 55 | typedef uint8_t u8; 56 | typedef int32_t s32; 57 | typedef int64_t limb; 58 | 59 | /* Field element representation: 60 | * 61 | * Field elements are written as an array of signed, 64-bit limbs, least 62 | * significant first. The value of the field element is: 63 | * x[0] + 2^26·x[1] + x^51·x[2] + 2^102·x[3] + ... 64 | * 65 | * i.e. the limbs are 26, 25, 26, 25, ... bits wide. */ 66 | 67 | /* Sum two numbers: output += in */ 68 | static void fsum(limb *output, const limb *in) { 69 | unsigned i; 70 | for (i = 0; i < 10; i += 2) { 71 | output[0+i] = output[0+i] + in[0+i]; 72 | output[1+i] = output[1+i] + in[1+i]; 73 | } 74 | } 75 | 76 | /* Find the difference of two numbers: output = in - output 77 | * (note the order of the arguments!). */ 78 | static void fdifference(limb *output, const limb *in) { 79 | unsigned i; 80 | for (i = 0; i < 10; ++i) { 81 | output[i] = in[i] - output[i]; 82 | } 83 | } 84 | 85 | /* Multiply a number by a scalar: output = in * scalar */ 86 | static void fscalar_product(limb *output, const limb *in, const limb scalar) { 87 | unsigned i; 88 | for (i = 0; i < 10; ++i) { 89 | output[i] = in[i] * scalar; 90 | } 91 | } 92 | 93 | /* Multiply two numbers: output = in2 * in 94 | * 95 | * output must be distinct to both inputs. The inputs are reduced coefficient 96 | * form, the output is not. 97 | * 98 | * output[x] <= 14 * the largest product of the input limbs. */ 99 | static void fproduct(limb *output, const limb *in2, const limb *in) { 100 | output[0] = ((limb) ((s32) in2[0])) * ((s32) in[0]); 101 | output[1] = ((limb) ((s32) in2[0])) * ((s32) in[1]) + 102 | ((limb) ((s32) in2[1])) * ((s32) in[0]); 103 | output[2] = 2 * ((limb) ((s32) in2[1])) * ((s32) in[1]) + 104 | ((limb) ((s32) in2[0])) * ((s32) in[2]) + 105 | ((limb) ((s32) in2[2])) * ((s32) in[0]); 106 | output[3] = ((limb) ((s32) in2[1])) * ((s32) in[2]) + 107 | ((limb) ((s32) in2[2])) * ((s32) in[1]) + 108 | ((limb) ((s32) in2[0])) * ((s32) in[3]) + 109 | ((limb) ((s32) in2[3])) * ((s32) in[0]); 110 | output[4] = ((limb) ((s32) in2[2])) * ((s32) in[2]) + 111 | 2 * (((limb) ((s32) in2[1])) * ((s32) in[3]) + 112 | ((limb) ((s32) in2[3])) * ((s32) in[1])) + 113 | ((limb) ((s32) in2[0])) * ((s32) in[4]) + 114 | ((limb) ((s32) in2[4])) * ((s32) in[0]); 115 | output[5] = ((limb) ((s32) in2[2])) * ((s32) in[3]) + 116 | ((limb) ((s32) in2[3])) * ((s32) in[2]) + 117 | ((limb) ((s32) in2[1])) * ((s32) in[4]) + 118 | ((limb) ((s32) in2[4])) * ((s32) in[1]) + 119 | ((limb) ((s32) in2[0])) * ((s32) in[5]) + 120 | ((limb) ((s32) in2[5])) * ((s32) in[0]); 121 | output[6] = 2 * (((limb) ((s32) in2[3])) * ((s32) in[3]) + 122 | ((limb) ((s32) in2[1])) * ((s32) in[5]) + 123 | ((limb) ((s32) in2[5])) * ((s32) in[1])) + 124 | ((limb) ((s32) in2[2])) * ((s32) in[4]) + 125 | ((limb) ((s32) in2[4])) * ((s32) in[2]) + 126 | ((limb) ((s32) in2[0])) * ((s32) in[6]) + 127 | ((limb) ((s32) in2[6])) * ((s32) in[0]); 128 | output[7] = ((limb) ((s32) in2[3])) * ((s32) in[4]) + 129 | ((limb) ((s32) in2[4])) * ((s32) in[3]) + 130 | ((limb) ((s32) in2[2])) * ((s32) in[5]) + 131 | ((limb) ((s32) in2[5])) * ((s32) in[2]) + 132 | ((limb) ((s32) in2[1])) * ((s32) in[6]) + 133 | ((limb) ((s32) in2[6])) * ((s32) in[1]) + 134 | ((limb) ((s32) in2[0])) * ((s32) in[7]) + 135 | ((limb) ((s32) in2[7])) * ((s32) in[0]); 136 | output[8] = ((limb) ((s32) in2[4])) * ((s32) in[4]) + 137 | 2 * (((limb) ((s32) in2[3])) * ((s32) in[5]) + 138 | ((limb) ((s32) in2[5])) * ((s32) in[3]) + 139 | ((limb) ((s32) in2[1])) * ((s32) in[7]) + 140 | ((limb) ((s32) in2[7])) * ((s32) in[1])) + 141 | ((limb) ((s32) in2[2])) * ((s32) in[6]) + 142 | ((limb) ((s32) in2[6])) * ((s32) in[2]) + 143 | ((limb) ((s32) in2[0])) * ((s32) in[8]) + 144 | ((limb) ((s32) in2[8])) * ((s32) in[0]); 145 | output[9] = ((limb) ((s32) in2[4])) * ((s32) in[5]) + 146 | ((limb) ((s32) in2[5])) * ((s32) in[4]) + 147 | ((limb) ((s32) in2[3])) * ((s32) in[6]) + 148 | ((limb) ((s32) in2[6])) * ((s32) in[3]) + 149 | ((limb) ((s32) in2[2])) * ((s32) in[7]) + 150 | ((limb) ((s32) in2[7])) * ((s32) in[2]) + 151 | ((limb) ((s32) in2[1])) * ((s32) in[8]) + 152 | ((limb) ((s32) in2[8])) * ((s32) in[1]) + 153 | ((limb) ((s32) in2[0])) * ((s32) in[9]) + 154 | ((limb) ((s32) in2[9])) * ((s32) in[0]); 155 | output[10] = 2 * (((limb) ((s32) in2[5])) * ((s32) in[5]) + 156 | ((limb) ((s32) in2[3])) * ((s32) in[7]) + 157 | ((limb) ((s32) in2[7])) * ((s32) in[3]) + 158 | ((limb) ((s32) in2[1])) * ((s32) in[9]) + 159 | ((limb) ((s32) in2[9])) * ((s32) in[1])) + 160 | ((limb) ((s32) in2[4])) * ((s32) in[6]) + 161 | ((limb) ((s32) in2[6])) * ((s32) in[4]) + 162 | ((limb) ((s32) in2[2])) * ((s32) in[8]) + 163 | ((limb) ((s32) in2[8])) * ((s32) in[2]); 164 | output[11] = ((limb) ((s32) in2[5])) * ((s32) in[6]) + 165 | ((limb) ((s32) in2[6])) * ((s32) in[5]) + 166 | ((limb) ((s32) in2[4])) * ((s32) in[7]) + 167 | ((limb) ((s32) in2[7])) * ((s32) in[4]) + 168 | ((limb) ((s32) in2[3])) * ((s32) in[8]) + 169 | ((limb) ((s32) in2[8])) * ((s32) in[3]) + 170 | ((limb) ((s32) in2[2])) * ((s32) in[9]) + 171 | ((limb) ((s32) in2[9])) * ((s32) in[2]); 172 | output[12] = ((limb) ((s32) in2[6])) * ((s32) in[6]) + 173 | 2 * (((limb) ((s32) in2[5])) * ((s32) in[7]) + 174 | ((limb) ((s32) in2[7])) * ((s32) in[5]) + 175 | ((limb) ((s32) in2[3])) * ((s32) in[9]) + 176 | ((limb) ((s32) in2[9])) * ((s32) in[3])) + 177 | ((limb) ((s32) in2[4])) * ((s32) in[8]) + 178 | ((limb) ((s32) in2[8])) * ((s32) in[4]); 179 | output[13] = ((limb) ((s32) in2[6])) * ((s32) in[7]) + 180 | ((limb) ((s32) in2[7])) * ((s32) in[6]) + 181 | ((limb) ((s32) in2[5])) * ((s32) in[8]) + 182 | ((limb) ((s32) in2[8])) * ((s32) in[5]) + 183 | ((limb) ((s32) in2[4])) * ((s32) in[9]) + 184 | ((limb) ((s32) in2[9])) * ((s32) in[4]); 185 | output[14] = 2 * (((limb) ((s32) in2[7])) * ((s32) in[7]) + 186 | ((limb) ((s32) in2[5])) * ((s32) in[9]) + 187 | ((limb) ((s32) in2[9])) * ((s32) in[5])) + 188 | ((limb) ((s32) in2[6])) * ((s32) in[8]) + 189 | ((limb) ((s32) in2[8])) * ((s32) in[6]); 190 | output[15] = ((limb) ((s32) in2[7])) * ((s32) in[8]) + 191 | ((limb) ((s32) in2[8])) * ((s32) in[7]) + 192 | ((limb) ((s32) in2[6])) * ((s32) in[9]) + 193 | ((limb) ((s32) in2[9])) * ((s32) in[6]); 194 | output[16] = ((limb) ((s32) in2[8])) * ((s32) in[8]) + 195 | 2 * (((limb) ((s32) in2[7])) * ((s32) in[9]) + 196 | ((limb) ((s32) in2[9])) * ((s32) in[7])); 197 | output[17] = ((limb) ((s32) in2[8])) * ((s32) in[9]) + 198 | ((limb) ((s32) in2[9])) * ((s32) in[8]); 199 | output[18] = 2 * ((limb) ((s32) in2[9])) * ((s32) in[9]); 200 | } 201 | 202 | /* Reduce a long form to a short form by taking the input mod 2^255 - 19. 203 | * 204 | * On entry: |output[i]| < 14*2^54 205 | * On exit: |output[0..8]| < 280*2^54 */ 206 | static void freduce_degree(limb *output) { 207 | /* Each of these shifts and adds ends up multiplying the value by 19. 208 | * 209 | * For output[0..8], the absolute entry value is < 14*2^54 and we add, at 210 | * most, 19*14*2^54 thus, on exit, |output[0..8]| < 280*2^54. */ 211 | output[8] += output[18] << 4; 212 | output[8] += output[18] << 1; 213 | output[8] += output[18]; 214 | output[7] += output[17] << 4; 215 | output[7] += output[17] << 1; 216 | output[7] += output[17]; 217 | output[6] += output[16] << 4; 218 | output[6] += output[16] << 1; 219 | output[6] += output[16]; 220 | output[5] += output[15] << 4; 221 | output[5] += output[15] << 1; 222 | output[5] += output[15]; 223 | output[4] += output[14] << 4; 224 | output[4] += output[14] << 1; 225 | output[4] += output[14]; 226 | output[3] += output[13] << 4; 227 | output[3] += output[13] << 1; 228 | output[3] += output[13]; 229 | output[2] += output[12] << 4; 230 | output[2] += output[12] << 1; 231 | output[2] += output[12]; 232 | output[1] += output[11] << 4; 233 | output[1] += output[11] << 1; 234 | output[1] += output[11]; 235 | output[0] += output[10] << 4; 236 | output[0] += output[10] << 1; 237 | output[0] += output[10]; 238 | } 239 | 240 | #if (-1 & 3) != 3 241 | #error "This code only works on a two's complement system" 242 | #endif 243 | 244 | /* return v / 2^26, using only shifts and adds. 245 | * 246 | * On entry: v can take any value. */ 247 | static inline limb 248 | div_by_2_26(const limb v) 249 | { 250 | /* High word of v; no shift needed. */ 251 | const uint32_t highword = (uint32_t) (((uint64_t) v) >> 32); 252 | /* Set to all 1s if v was negative; else set to 0s. */ 253 | const int32_t sign = ((int32_t) highword) >> 31; 254 | /* Set to 0x3ffffff if v was negative; else set to 0. */ 255 | const int32_t roundoff = ((uint32_t) sign) >> 6; 256 | /* Should return v / (1<<26) */ 257 | return (v + roundoff) >> 26; 258 | } 259 | 260 | /* return v / (2^25), using only shifts and adds. 261 | * 262 | * On entry: v can take any value. */ 263 | static inline limb 264 | div_by_2_25(const limb v) 265 | { 266 | /* High word of v; no shift needed*/ 267 | const uint32_t highword = (uint32_t) (((uint64_t) v) >> 32); 268 | /* Set to all 1s if v was negative; else set to 0s. */ 269 | const int32_t sign = ((int32_t) highword) >> 31; 270 | /* Set to 0x1ffffff if v was negative; else set to 0. */ 271 | const int32_t roundoff = ((uint32_t) sign) >> 7; 272 | /* Should return v / (1<<25) */ 273 | return (v + roundoff) >> 25; 274 | } 275 | 276 | /* Reduce all coefficients of the short form input so that |x| < 2^26. 277 | * 278 | * On entry: |output[i]| < 280*2^54 */ 279 | static void freduce_coefficients(limb *output) { 280 | unsigned i; 281 | 282 | output[10] = 0; 283 | 284 | for (i = 0; i < 10; i += 2) { 285 | limb over = div_by_2_26(output[i]); 286 | /* The entry condition (that |output[i]| < 280*2^54) means that over is, at 287 | * most, 280*2^28 in the first iteration of this loop. This is added to the 288 | * next limb and we can approximate the resulting bound of that limb by 289 | * 281*2^54. */ 290 | output[i] -= over << 26; 291 | output[i+1] += over; 292 | 293 | /* For the first iteration, |output[i+1]| < 281*2^54, thus |over| < 294 | * 281*2^29. When this is added to the next limb, the resulting bound can 295 | * be approximated as 281*2^54. 296 | * 297 | * For subsequent iterations of the loop, 281*2^54 remains a conservative 298 | * bound and no overflow occurs. */ 299 | over = div_by_2_25(output[i+1]); 300 | output[i+1] -= over << 25; 301 | output[i+2] += over; 302 | } 303 | /* Now |output[10]| < 281*2^29 and all other coefficients are reduced. */ 304 | output[0] += output[10] << 4; 305 | output[0] += output[10] << 1; 306 | output[0] += output[10]; 307 | 308 | output[10] = 0; 309 | 310 | /* Now output[1..9] are reduced, and |output[0]| < 2^26 + 19*281*2^29 311 | * So |over| will be no more than 2^16. */ 312 | { 313 | limb over = div_by_2_26(output[0]); 314 | output[0] -= over << 26; 315 | output[1] += over; 316 | } 317 | 318 | /* Now output[0,2..9] are reduced, and |output[1]| < 2^25 + 2^16 < 2^26. The 319 | * bound on |output[1]| is sufficient to meet our needs. */ 320 | } 321 | 322 | /* A helpful wrapper around fproduct: output = in * in2. 323 | * 324 | * On entry: |in[i]| < 2^27 and |in2[i]| < 2^27. 325 | * 326 | * output must be distinct to both inputs. The output is reduced degree 327 | * (indeed, one need only provide storage for 10 limbs) and |output[i]| < 2^26. */ 328 | static void 329 | fmul(limb *output, const limb *in, const limb *in2) { 330 | limb t[19]; 331 | fproduct(t, in, in2); 332 | /* |t[i]| < 14*2^54 */ 333 | freduce_degree(t); 334 | freduce_coefficients(t); 335 | /* |t[i]| < 2^26 */ 336 | memcpy(output, t, sizeof(limb) * 10); 337 | } 338 | 339 | /* Square a number: output = in**2 340 | * 341 | * output must be distinct from the input. The inputs are reduced coefficient 342 | * form, the output is not. 343 | * 344 | * output[x] <= 14 * the largest product of the input limbs. */ 345 | static void fsquare_inner(limb *output, const limb *in) { 346 | output[0] = ((limb) ((s32) in[0])) * ((s32) in[0]); 347 | output[1] = 2 * ((limb) ((s32) in[0])) * ((s32) in[1]); 348 | output[2] = 2 * (((limb) ((s32) in[1])) * ((s32) in[1]) + 349 | ((limb) ((s32) in[0])) * ((s32) in[2])); 350 | output[3] = 2 * (((limb) ((s32) in[1])) * ((s32) in[2]) + 351 | ((limb) ((s32) in[0])) * ((s32) in[3])); 352 | output[4] = ((limb) ((s32) in[2])) * ((s32) in[2]) + 353 | 4 * ((limb) ((s32) in[1])) * ((s32) in[3]) + 354 | 2 * ((limb) ((s32) in[0])) * ((s32) in[4]); 355 | output[5] = 2 * (((limb) ((s32) in[2])) * ((s32) in[3]) + 356 | ((limb) ((s32) in[1])) * ((s32) in[4]) + 357 | ((limb) ((s32) in[0])) * ((s32) in[5])); 358 | output[6] = 2 * (((limb) ((s32) in[3])) * ((s32) in[3]) + 359 | ((limb) ((s32) in[2])) * ((s32) in[4]) + 360 | ((limb) ((s32) in[0])) * ((s32) in[6]) + 361 | 2 * ((limb) ((s32) in[1])) * ((s32) in[5])); 362 | output[7] = 2 * (((limb) ((s32) in[3])) * ((s32) in[4]) + 363 | ((limb) ((s32) in[2])) * ((s32) in[5]) + 364 | ((limb) ((s32) in[1])) * ((s32) in[6]) + 365 | ((limb) ((s32) in[0])) * ((s32) in[7])); 366 | output[8] = ((limb) ((s32) in[4])) * ((s32) in[4]) + 367 | 2 * (((limb) ((s32) in[2])) * ((s32) in[6]) + 368 | ((limb) ((s32) in[0])) * ((s32) in[8]) + 369 | 2 * (((limb) ((s32) in[1])) * ((s32) in[7]) + 370 | ((limb) ((s32) in[3])) * ((s32) in[5]))); 371 | output[9] = 2 * (((limb) ((s32) in[4])) * ((s32) in[5]) + 372 | ((limb) ((s32) in[3])) * ((s32) in[6]) + 373 | ((limb) ((s32) in[2])) * ((s32) in[7]) + 374 | ((limb) ((s32) in[1])) * ((s32) in[8]) + 375 | ((limb) ((s32) in[0])) * ((s32) in[9])); 376 | output[10] = 2 * (((limb) ((s32) in[5])) * ((s32) in[5]) + 377 | ((limb) ((s32) in[4])) * ((s32) in[6]) + 378 | ((limb) ((s32) in[2])) * ((s32) in[8]) + 379 | 2 * (((limb) ((s32) in[3])) * ((s32) in[7]) + 380 | ((limb) ((s32) in[1])) * ((s32) in[9]))); 381 | output[11] = 2 * (((limb) ((s32) in[5])) * ((s32) in[6]) + 382 | ((limb) ((s32) in[4])) * ((s32) in[7]) + 383 | ((limb) ((s32) in[3])) * ((s32) in[8]) + 384 | ((limb) ((s32) in[2])) * ((s32) in[9])); 385 | output[12] = ((limb) ((s32) in[6])) * ((s32) in[6]) + 386 | 2 * (((limb) ((s32) in[4])) * ((s32) in[8]) + 387 | 2 * (((limb) ((s32) in[5])) * ((s32) in[7]) + 388 | ((limb) ((s32) in[3])) * ((s32) in[9]))); 389 | output[13] = 2 * (((limb) ((s32) in[6])) * ((s32) in[7]) + 390 | ((limb) ((s32) in[5])) * ((s32) in[8]) + 391 | ((limb) ((s32) in[4])) * ((s32) in[9])); 392 | output[14] = 2 * (((limb) ((s32) in[7])) * ((s32) in[7]) + 393 | ((limb) ((s32) in[6])) * ((s32) in[8]) + 394 | 2 * ((limb) ((s32) in[5])) * ((s32) in[9])); 395 | output[15] = 2 * (((limb) ((s32) in[7])) * ((s32) in[8]) + 396 | ((limb) ((s32) in[6])) * ((s32) in[9])); 397 | output[16] = ((limb) ((s32) in[8])) * ((s32) in[8]) + 398 | 4 * ((limb) ((s32) in[7])) * ((s32) in[9]); 399 | output[17] = 2 * ((limb) ((s32) in[8])) * ((s32) in[9]); 400 | output[18] = 2 * ((limb) ((s32) in[9])) * ((s32) in[9]); 401 | } 402 | 403 | /* fsquare sets output = in^2. 404 | * 405 | * On entry: The |in| argument is in reduced coefficients form and |in[i]| < 406 | * 2^27. 407 | * 408 | * On exit: The |output| argument is in reduced coefficients form (indeed, one 409 | * need only provide storage for 10 limbs) and |out[i]| < 2^26. */ 410 | static void 411 | fsquare(limb *output, const limb *in) { 412 | limb t[19]; 413 | fsquare_inner(t, in); 414 | /* |t[i]| < 14*2^54 because the largest product of two limbs will be < 415 | * 2^(27+27) and fsquare_inner adds together, at most, 14 of those 416 | * products. */ 417 | freduce_degree(t); 418 | freduce_coefficients(t); 419 | /* |t[i]| < 2^26 */ 420 | memcpy(output, t, sizeof(limb) * 10); 421 | } 422 | 423 | /* Take a little-endian, 32-byte number and expand it into polynomial form */ 424 | static void 425 | fexpand(limb *output, const u8 *input) { 426 | #define F(n,start,shift,mask) \ 427 | output[n] = ((((limb) input[start + 0]) | \ 428 | ((limb) input[start + 1]) << 8 | \ 429 | ((limb) input[start + 2]) << 16 | \ 430 | ((limb) input[start + 3]) << 24) >> shift) & mask; 431 | F(0, 0, 0, 0x3ffffff); 432 | F(1, 3, 2, 0x1ffffff); 433 | F(2, 6, 3, 0x3ffffff); 434 | F(3, 9, 5, 0x1ffffff); 435 | F(4, 12, 6, 0x3ffffff); 436 | F(5, 16, 0, 0x1ffffff); 437 | F(6, 19, 1, 0x3ffffff); 438 | F(7, 22, 3, 0x1ffffff); 439 | F(8, 25, 4, 0x3ffffff); 440 | F(9, 28, 6, 0x1ffffff); 441 | #undef F 442 | } 443 | 444 | #if (-32 >> 1) != -16 445 | #error "This code only works when >> does sign-extension on negative numbers" 446 | #endif 447 | 448 | /* s32_eq returns 0xffffffff iff a == b and zero otherwise. */ 449 | static s32 s32_eq(s32 a, s32 b) { 450 | a = ~(a ^ b); 451 | a &= a << 16; 452 | a &= a << 8; 453 | a &= a << 4; 454 | a &= a << 2; 455 | a &= a << 1; 456 | return a >> 31; 457 | } 458 | 459 | /* s32_gte returns 0xffffffff if a >= b and zero otherwise, where a and b are 460 | * both non-negative. */ 461 | static s32 s32_gte(s32 a, s32 b) { 462 | a -= b; 463 | /* a >= 0 iff a >= b. */ 464 | return ~(a >> 31); 465 | } 466 | 467 | /* Take a fully reduced polynomial form number and contract it into a 468 | * little-endian, 32-byte array. 469 | * 470 | * On entry: |input_limbs[i]| < 2^26 */ 471 | static void 472 | fcontract(u8 *output, limb *input_limbs) { 473 | int i; 474 | int j; 475 | s32 input[10]; 476 | s32 mask; 477 | 478 | /* |input_limbs[i]| < 2^26, so it's valid to convert to an s32. */ 479 | for (i = 0; i < 10; i++) { 480 | input[i] = input_limbs[i]; 481 | } 482 | 483 | for (j = 0; j < 2; ++j) { 484 | for (i = 0; i < 9; ++i) { 485 | if ((i & 1) == 1) { 486 | /* This calculation is a time-invariant way to make input[i] 487 | * non-negative by borrowing from the next-larger limb. */ 488 | const s32 mask = input[i] >> 31; 489 | const s32 carry = -((input[i] & mask) >> 25); 490 | input[i] = input[i] + (carry << 25); 491 | input[i+1] = input[i+1] - carry; 492 | } else { 493 | const s32 mask = input[i] >> 31; 494 | const s32 carry = -((input[i] & mask) >> 26); 495 | input[i] = input[i] + (carry << 26); 496 | input[i+1] = input[i+1] - carry; 497 | } 498 | } 499 | 500 | /* There's no greater limb for input[9] to borrow from, but we can multiply 501 | * by 19 and borrow from input[0], which is valid mod 2^255-19. */ 502 | { 503 | const s32 mask = input[9] >> 31; 504 | const s32 carry = -((input[9] & mask) >> 25); 505 | input[9] = input[9] + (carry << 25); 506 | input[0] = input[0] - (carry * 19); 507 | } 508 | 509 | /* After the first iteration, input[1..9] are non-negative and fit within 510 | * 25 or 26 bits, depending on position. However, input[0] may be 511 | * negative. */ 512 | } 513 | 514 | /* The first borrow-propagation pass above ended with every limb 515 | except (possibly) input[0] non-negative. 516 | 517 | If input[0] was negative after the first pass, then it was because of a 518 | carry from input[9]. On entry, input[9] < 2^26 so the carry was, at most, 519 | one, since (2**26-1) >> 25 = 1. Thus input[0] >= -19. 520 | 521 | In the second pass, each limb is decreased by at most one. Thus the second 522 | borrow-propagation pass could only have wrapped around to decrease 523 | input[0] again if the first pass left input[0] negative *and* input[1] 524 | through input[9] were all zero. In that case, input[1] is now 2^25 - 1, 525 | and this last borrow-propagation step will leave input[1] non-negative. */ 526 | { 527 | const s32 mask = input[0] >> 31; 528 | const s32 carry = -((input[0] & mask) >> 26); 529 | input[0] = input[0] + (carry << 26); 530 | input[1] = input[1] - carry; 531 | } 532 | 533 | /* All input[i] are now non-negative. However, there might be values between 534 | * 2^25 and 2^26 in a limb which is, nominally, 25 bits wide. */ 535 | for (j = 0; j < 2; j++) { 536 | for (i = 0; i < 9; i++) { 537 | if ((i & 1) == 1) { 538 | const s32 carry = input[i] >> 25; 539 | input[i] &= 0x1ffffff; 540 | input[i+1] += carry; 541 | } else { 542 | const s32 carry = input[i] >> 26; 543 | input[i] &= 0x3ffffff; 544 | input[i+1] += carry; 545 | } 546 | } 547 | 548 | { 549 | const s32 carry = input[9] >> 25; 550 | input[9] &= 0x1ffffff; 551 | input[0] += 19*carry; 552 | } 553 | } 554 | 555 | /* If the first carry-chain pass, just above, ended up with a carry from 556 | * input[9], and that caused input[0] to be out-of-bounds, then input[0] was 557 | * < 2^26 + 2*19, because the carry was, at most, two. 558 | * 559 | * If the second pass carried from input[9] again then input[0] is < 2*19 and 560 | * the input[9] -> input[0] carry didn't push input[0] out of bounds. */ 561 | 562 | /* It still remains the case that input might be between 2^255-19 and 2^255. 563 | * In this case, input[1..9] must take their maximum value and input[0] must 564 | * be >= (2^255-19) & 0x3ffffff, which is 0x3ffffed. */ 565 | mask = s32_gte(input[0], 0x3ffffed); 566 | for (i = 1; i < 10; i++) { 567 | if ((i & 1) == 1) { 568 | mask &= s32_eq(input[i], 0x1ffffff); 569 | } else { 570 | mask &= s32_eq(input[i], 0x3ffffff); 571 | } 572 | } 573 | 574 | /* mask is either 0xffffffff (if input >= 2^255-19) and zero otherwise. Thus 575 | * this conditionally subtracts 2^255-19. */ 576 | input[0] -= mask & 0x3ffffed; 577 | 578 | for (i = 1; i < 10; i++) { 579 | if ((i & 1) == 1) { 580 | input[i] -= mask & 0x1ffffff; 581 | } else { 582 | input[i] -= mask & 0x3ffffff; 583 | } 584 | } 585 | 586 | input[1] <<= 2; 587 | input[2] <<= 3; 588 | input[3] <<= 5; 589 | input[4] <<= 6; 590 | input[6] <<= 1; 591 | input[7] <<= 3; 592 | input[8] <<= 4; 593 | input[9] <<= 6; 594 | #define F(i, s) \ 595 | output[s+0] |= input[i] & 0xff; \ 596 | output[s+1] = (input[i] >> 8) & 0xff; \ 597 | output[s+2] = (input[i] >> 16) & 0xff; \ 598 | output[s+3] = (input[i] >> 24) & 0xff; 599 | output[0] = 0; 600 | output[16] = 0; 601 | F(0,0); 602 | F(1,3); 603 | F(2,6); 604 | F(3,9); 605 | F(4,12); 606 | F(5,16); 607 | F(6,19); 608 | F(7,22); 609 | F(8,25); 610 | F(9,28); 611 | #undef F 612 | } 613 | 614 | /* Input: Q, Q', Q-Q' 615 | * Output: 2Q, Q+Q' 616 | * 617 | * x2 z3: long form 618 | * x3 z3: long form 619 | * x z: short form, destroyed 620 | * xprime zprime: short form, destroyed 621 | * qmqp: short form, preserved 622 | * 623 | * On entry and exit, the absolute value of the limbs of all inputs and outputs 624 | * are < 2^26. */ 625 | static void fmonty(limb *x2, limb *z2, /* output 2Q */ 626 | limb *x3, limb *z3, /* output Q + Q' */ 627 | limb *x, limb *z, /* input Q */ 628 | limb *xprime, limb *zprime, /* input Q' */ 629 | const limb *qmqp /* input Q - Q' */) { 630 | limb origx[10], origxprime[10], zzz[19], xx[19], zz[19], xxprime[19], 631 | zzprime[19], zzzprime[19], xxxprime[19]; 632 | 633 | memcpy(origx, x, 10 * sizeof(limb)); 634 | fsum(x, z); 635 | /* |x[i]| < 2^27 */ 636 | fdifference(z, origx); /* does x - z */ 637 | /* |z[i]| < 2^27 */ 638 | 639 | memcpy(origxprime, xprime, sizeof(limb) * 10); 640 | fsum(xprime, zprime); 641 | /* |xprime[i]| < 2^27 */ 642 | fdifference(zprime, origxprime); 643 | /* |zprime[i]| < 2^27 */ 644 | fproduct(xxprime, xprime, z); 645 | /* |xxprime[i]| < 14*2^54: the largest product of two limbs will be < 646 | * 2^(27+27) and fproduct adds together, at most, 14 of those products. 647 | * (Approximating that to 2^58 doesn't work out.) */ 648 | fproduct(zzprime, x, zprime); 649 | /* |zzprime[i]| < 14*2^54 */ 650 | freduce_degree(xxprime); 651 | freduce_coefficients(xxprime); 652 | /* |xxprime[i]| < 2^26 */ 653 | freduce_degree(zzprime); 654 | freduce_coefficients(zzprime); 655 | /* |zzprime[i]| < 2^26 */ 656 | memcpy(origxprime, xxprime, sizeof(limb) * 10); 657 | fsum(xxprime, zzprime); 658 | /* |xxprime[i]| < 2^27 */ 659 | fdifference(zzprime, origxprime); 660 | /* |zzprime[i]| < 2^27 */ 661 | fsquare(xxxprime, xxprime); 662 | /* |xxxprime[i]| < 2^26 */ 663 | fsquare(zzzprime, zzprime); 664 | /* |zzzprime[i]| < 2^26 */ 665 | fproduct(zzprime, zzzprime, qmqp); 666 | /* |zzprime[i]| < 14*2^52 */ 667 | freduce_degree(zzprime); 668 | freduce_coefficients(zzprime); 669 | /* |zzprime[i]| < 2^26 */ 670 | memcpy(x3, xxxprime, sizeof(limb) * 10); 671 | memcpy(z3, zzprime, sizeof(limb) * 10); 672 | 673 | fsquare(xx, x); 674 | /* |xx[i]| < 2^26 */ 675 | fsquare(zz, z); 676 | /* |zz[i]| < 2^26 */ 677 | fproduct(x2, xx, zz); 678 | /* |x2[i]| < 14*2^52 */ 679 | freduce_degree(x2); 680 | freduce_coefficients(x2); 681 | /* |x2[i]| < 2^26 */ 682 | fdifference(zz, xx); // does zz = xx - zz 683 | /* |zz[i]| < 2^27 */ 684 | memset(zzz + 10, 0, sizeof(limb) * 9); 685 | fscalar_product(zzz, zz, 121665); 686 | /* |zzz[i]| < 2^(27+17) */ 687 | /* No need to call freduce_degree here: 688 | fscalar_product doesn't increase the degree of its input. */ 689 | freduce_coefficients(zzz); 690 | /* |zzz[i]| < 2^26 */ 691 | fsum(zzz, xx); 692 | /* |zzz[i]| < 2^27 */ 693 | fproduct(z2, zz, zzz); 694 | /* |z2[i]| < 14*2^(26+27) */ 695 | freduce_degree(z2); 696 | freduce_coefficients(z2); 697 | /* |z2|i| < 2^26 */ 698 | } 699 | 700 | /* Conditionally swap two reduced-form limb arrays if 'iswap' is 1, but leave 701 | * them unchanged if 'iswap' is 0. Runs in data-invariant time to avoid 702 | * side-channel attacks. 703 | * 704 | * NOTE that this function requires that 'iswap' be 1 or 0; other values give 705 | * wrong results. Also, the two limb arrays must be in reduced-coefficient, 706 | * reduced-degree form: the values in a[10..19] or b[10..19] aren't swapped, 707 | * and all all values in a[0..9],b[0..9] must have magnitude less than 708 | * INT32_MAX. */ 709 | static void 710 | swap_conditional(limb a[19], limb b[19], limb iswap) { 711 | unsigned i; 712 | const s32 swap = (s32) -iswap; 713 | 714 | for (i = 0; i < 10; ++i) { 715 | const s32 x = swap & ( ((s32)a[i]) ^ ((s32)b[i]) ); 716 | a[i] = ((s32)a[i]) ^ x; 717 | b[i] = ((s32)b[i]) ^ x; 718 | } 719 | } 720 | 721 | /* Calculates nQ where Q is the x-coordinate of a point on the curve 722 | * 723 | * resultx/resultz: the x coordinate of the resulting curve point (short form) 724 | * n: a little endian, 32-byte number 725 | * q: a point of the curve (short form) */ 726 | static void 727 | cmult(limb *resultx, limb *resultz, const u8 *n, const limb *q) { 728 | limb a[19] = {0}, b[19] = {1}, c[19] = {1}, d[19] = {0}; 729 | limb *nqpqx = a, *nqpqz = b, *nqx = c, *nqz = d, *t; 730 | limb e[19] = {0}, f[19] = {1}, g[19] = {0}, h[19] = {1}; 731 | limb *nqpqx2 = e, *nqpqz2 = f, *nqx2 = g, *nqz2 = h; 732 | 733 | unsigned i, j; 734 | 735 | memcpy(nqpqx, q, sizeof(limb) * 10); 736 | 737 | for (i = 0; i < 32; ++i) { 738 | u8 byte = n[31 - i]; 739 | for (j = 0; j < 8; ++j) { 740 | const limb bit = byte >> 7; 741 | 742 | swap_conditional(nqx, nqpqx, bit); 743 | swap_conditional(nqz, nqpqz, bit); 744 | fmonty(nqx2, nqz2, 745 | nqpqx2, nqpqz2, 746 | nqx, nqz, 747 | nqpqx, nqpqz, 748 | q); 749 | swap_conditional(nqx2, nqpqx2, bit); 750 | swap_conditional(nqz2, nqpqz2, bit); 751 | 752 | t = nqx; 753 | nqx = nqx2; 754 | nqx2 = t; 755 | t = nqz; 756 | nqz = nqz2; 757 | nqz2 = t; 758 | t = nqpqx; 759 | nqpqx = nqpqx2; 760 | nqpqx2 = t; 761 | t = nqpqz; 762 | nqpqz = nqpqz2; 763 | nqpqz2 = t; 764 | 765 | byte <<= 1; 766 | } 767 | } 768 | 769 | memcpy(resultx, nqx, sizeof(limb) * 10); 770 | memcpy(resultz, nqz, sizeof(limb) * 10); 771 | } 772 | 773 | // ----------------------------------------------------------------------------- 774 | // Shamelessly copied from djb's code 775 | // ----------------------------------------------------------------------------- 776 | static void 777 | crecip(limb *out, const limb *z) { 778 | limb z2[10]; 779 | limb z9[10]; 780 | limb z11[10]; 781 | limb z2_5_0[10]; 782 | limb z2_10_0[10]; 783 | limb z2_20_0[10]; 784 | limb z2_50_0[10]; 785 | limb z2_100_0[10]; 786 | limb t0[10]; 787 | limb t1[10]; 788 | int i; 789 | 790 | /* 2 */ fsquare(z2,z); 791 | /* 4 */ fsquare(t1,z2); 792 | /* 8 */ fsquare(t0,t1); 793 | /* 9 */ fmul(z9,t0,z); 794 | /* 11 */ fmul(z11,z9,z2); 795 | /* 22 */ fsquare(t0,z11); 796 | /* 2^5 - 2^0 = 31 */ fmul(z2_5_0,t0,z9); 797 | 798 | /* 2^6 - 2^1 */ fsquare(t0,z2_5_0); 799 | /* 2^7 - 2^2 */ fsquare(t1,t0); 800 | /* 2^8 - 2^3 */ fsquare(t0,t1); 801 | /* 2^9 - 2^4 */ fsquare(t1,t0); 802 | /* 2^10 - 2^5 */ fsquare(t0,t1); 803 | /* 2^10 - 2^0 */ fmul(z2_10_0,t0,z2_5_0); 804 | 805 | /* 2^11 - 2^1 */ fsquare(t0,z2_10_0); 806 | /* 2^12 - 2^2 */ fsquare(t1,t0); 807 | /* 2^20 - 2^10 */ for (i = 2;i < 10;i += 2) { fsquare(t0,t1); fsquare(t1,t0); } 808 | /* 2^20 - 2^0 */ fmul(z2_20_0,t1,z2_10_0); 809 | 810 | /* 2^21 - 2^1 */ fsquare(t0,z2_20_0); 811 | /* 2^22 - 2^2 */ fsquare(t1,t0); 812 | /* 2^40 - 2^20 */ for (i = 2;i < 20;i += 2) { fsquare(t0,t1); fsquare(t1,t0); } 813 | /* 2^40 - 2^0 */ fmul(t0,t1,z2_20_0); 814 | 815 | /* 2^41 - 2^1 */ fsquare(t1,t0); 816 | /* 2^42 - 2^2 */ fsquare(t0,t1); 817 | /* 2^50 - 2^10 */ for (i = 2;i < 10;i += 2) { fsquare(t1,t0); fsquare(t0,t1); } 818 | /* 2^50 - 2^0 */ fmul(z2_50_0,t0,z2_10_0); 819 | 820 | /* 2^51 - 2^1 */ fsquare(t0,z2_50_0); 821 | /* 2^52 - 2^2 */ fsquare(t1,t0); 822 | /* 2^100 - 2^50 */ for (i = 2;i < 50;i += 2) { fsquare(t0,t1); fsquare(t1,t0); } 823 | /* 2^100 - 2^0 */ fmul(z2_100_0,t1,z2_50_0); 824 | 825 | /* 2^101 - 2^1 */ fsquare(t1,z2_100_0); 826 | /* 2^102 - 2^2 */ fsquare(t0,t1); 827 | /* 2^200 - 2^100 */ for (i = 2;i < 100;i += 2) { fsquare(t1,t0); fsquare(t0,t1); } 828 | /* 2^200 - 2^0 */ fmul(t1,t0,z2_100_0); 829 | 830 | /* 2^201 - 2^1 */ fsquare(t0,t1); 831 | /* 2^202 - 2^2 */ fsquare(t1,t0); 832 | /* 2^250 - 2^50 */ for (i = 2;i < 50;i += 2) { fsquare(t0,t1); fsquare(t1,t0); } 833 | /* 2^250 - 2^0 */ fmul(t0,t1,z2_50_0); 834 | 835 | /* 2^251 - 2^1 */ fsquare(t1,t0); 836 | /* 2^252 - 2^2 */ fsquare(t0,t1); 837 | /* 2^253 - 2^3 */ fsquare(t1,t0); 838 | /* 2^254 - 2^4 */ fsquare(t0,t1); 839 | /* 2^255 - 2^5 */ fsquare(t1,t0); 840 | /* 2^255 - 21 */ fmul(out,t1,z11); 841 | } 842 | 843 | int 844 | curve25519_donna(u8 *mypublic, const u8 *secret, const u8 *basepoint) { 845 | limb bp[10], x[10], z[11], zmone[10]; 846 | uint8_t e[32]; 847 | int i; 848 | 849 | for (i = 0; i < 32; ++i) e[i] = secret[i]; 850 | e[0] &= 248; 851 | e[31] &= 127; 852 | e[31] |= 64; 853 | 854 | fexpand(bp, basepoint); 855 | cmult(x, z, e, bp); 856 | crecip(zmone, z); 857 | fmul(z, x, zmone); 858 | fcontract(mypublic, z); 859 | return 0; 860 | } 861 | 862 | #include "caml/mlvalues.h" 863 | 864 | #define _st_uint8_off(st, off) ((uint8_t*) String_val (st) + Long_val (off)) 865 | #define _st_uint8(st) _st_uint8_off (st, 0) 866 | 867 | CAMLprim value 868 | caml_curve25519_donna(value mypublic, value secret, value basepoint) 869 | { 870 | curve25519_donna(_st_uint8(mypublic), _st_uint8(secret), _st_uint8(basepoint)); 871 | 872 | return Val_unit; 873 | } 874 | -------------------------------------------------------------------------------- /bench/donna.ml: -------------------------------------------------------------------------------- 1 | external ecdh: bytes -> string -> string -> unit = "caml_curve25519_donna" [@@noalloc] 2 | 3 | let shared ~secret ~public = 4 | let rs = Bytes.create 32 in 5 | ecdh rs secret public 6 | ; Bytes.unsafe_to_string rs 7 | -------------------------------------------------------------------------------- /bench/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name donna) 3 | (modules donna) 4 | (c_names curve25519-donna)) 5 | 6 | (executable 7 | (name bench) 8 | (modules bench) 9 | (libraries callipyge donna benchmark)) 10 | -------------------------------------------------------------------------------- /callipyge.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | name: "callipyge" 3 | maintainer: "Romain Calascibetta " 4 | authors: "Romain Calascibetta " 5 | homepage: "https://github.com/oklm-wsh/callipyge" 6 | bug-reports: "https://github.com/oklm-wsh/callipyge/issues" 7 | dev-repo: "https://github.com/oklm-wsh/callipyge.git" 8 | doc: "https://oklm-wsh.github.io/callipyge/" 9 | license: "MIT" 10 | 11 | build: [ 12 | ["dune" "subst"] {pinned} 13 | ["dune" "build" "-p" name "-j" jobs] 14 | ] 15 | build-test: [["jbuilder" "runtest" "-p" name "-j" jobs]] 16 | 17 | depends: [ 18 | "jbuilder" {build} 19 | "fmt" 20 | "eqaf" 21 | "alcotest" {test} 22 | ] 23 | 24 | available: [ocaml-version >= "4.03.0"] 25 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | (name callipyge) 3 | (version dev) 4 | -------------------------------------------------------------------------------- /lib/callipyge.ml: -------------------------------------------------------------------------------- 1 | module Array = Ma 2 | 3 | let basev = Array.init 32 (function 0 -> 9 | _ -> 0) 4 | let minusp = Array.init 32 (function 0 -> 19 | 31 -> 128 | _ -> 0) 5 | 6 | let pp ppf arr = 7 | for i = 0 to Array.length arr - 1 do 8 | Fmt.pf ppf "%02X" arr.(i) 9 | done 10 | 11 | let add outv outv_offset a a_offset b b_offset = 12 | let u = ref 0 in 13 | for j = 0 to 30 do 14 | u := !u + a.(a_offset + j) + b.(b_offset + j) ; 15 | outv.(outv_offset + j) <- !u land 255 ; 16 | u := !u lsr 8 17 | done ; 18 | u := !u + a.(a_offset + 31) + b.(b_offset + 31) ; 19 | outv.(outv_offset + 31) <- !u 20 | 21 | let sub outv outv_offset a a_offset b b_offset = 22 | let u = ref 218 in 23 | for j = 0 to 30 do 24 | u := !u + a.(a_offset + j) + 65280 - b.(b_offset + j) ; 25 | outv.(outv_offset + j) <- !u land 255 ; 26 | u := !u lsr 8 27 | done ; 28 | u := !u + a.(a_offset + 31) - b.(b_offset + 31) ; 29 | outv.(outv_offset + 31) <- !u 30 | 31 | let squeeze a a_offset = 32 | let u = ref 0 in 33 | for j = 0 to 30 do 34 | u := !u + a.(a_offset + j) ; 35 | a.(a_offset + j) <- !u land 255 ; 36 | u := !u lsr 8 37 | done ; 38 | u := !u + a.(a_offset + 31) ; 39 | a.(a_offset + 31) <- !u land 127 ; 40 | u := 19 * (!u lsr 7) ; 41 | for j = 0 to 30 do 42 | u := !u + a.(a_offset + j) ; 43 | a.(a_offset + j) <- !u land 255 ; 44 | u := !u lsr 8 45 | done ; 46 | u := !u + a.(a_offset + 31) ; 47 | a.(a_offset + 31) <- !u 48 | 49 | let freeze a a_offset = 50 | let a_orig = Array.init 32 (fun j -> a.(a_offset + j)) in 51 | add a 0 a 0 minusp 0 ; 52 | let negative = -((a.(a_offset + 31) lsr 7) land 1) in 53 | for j = 0 to 31 do 54 | a.(a_offset + j) 55 | <- a.(a_offset + j) lxor (negative land (a_orig.(j) lxor a.(a_offset + j))) 56 | done 57 | 58 | let mult outv outv_offset a a_offset b b_offset = 59 | for i = 0 to 31 do 60 | let u = ref 0 in 61 | for j = 0 to i do 62 | u := !u + (a.(a_offset + j) * b.(b_offset + i - j)) 63 | done ; 64 | for j = i + 1 to 31 do 65 | u := !u + (38 * a.(a_offset + j) * b.(b_offset + i + 32 - j)) 66 | done ; 67 | outv.(outv_offset + i) <- !u 68 | done ; 69 | squeeze outv outv_offset 70 | 71 | let mult21665 outv a = 72 | let u = ref 0 in 73 | for j = 0 to 30 do 74 | u := !u + (121665 * a.(j)) ; 75 | outv.(j) <- !u land 255 ; 76 | u := !u lsr 8 77 | done ; 78 | u := !u + (121665 * a.(31)) ; 79 | outv.(31) <- !u land 127 ; 80 | u := 19 * (!u lsr 7) ; 81 | for j = 0 to 30 do 82 | u := !u + outv.(j) ; 83 | outv.(j) <- !u land 255 ; 84 | u := !u lsr 8 85 | done ; 86 | u := !u + outv.(31) ; 87 | outv.(31) <- !u 88 | 89 | let square outv outv_offset a a_offset = 90 | for i = 0 to 31 do 91 | let u = ref 0 in 92 | let j = ref 0 in 93 | while !j < i - !j do 94 | u := !u + (a.(a_offset + !j) * a.(a_offset + i - !j)) ; 95 | incr j 96 | done ; 97 | j := i + 1 ; 98 | while !j < i + 32 - !j do 99 | u := !u + (38 * a.(a_offset + !j) * a.(a_offset + i + 32 - !j)) ; 100 | incr j 101 | done ; 102 | u := !u * 2 ; 103 | if i land 1 = 0 104 | then ( 105 | u := !u + (a.(a_offset + (i / 2)) * a.(a_offset + (i / 2))) ; 106 | u := !u + (38 * a.(a_offset + (i / 2) + 16) * a.(a_offset + (i / 2) + 16)) ) ; 107 | outv.(outv_offset + i) <- !u 108 | done ; 109 | squeeze outv outv_offset 110 | 111 | let select p q r s b = 112 | let bminus1 = b - 1 in 113 | for j = 0 to 63 do 114 | let t = bminus1 land (r.(j) lxor s.(j)) in 115 | p.(j) <- s.(j) lxor t ; 116 | q.(j) <- r.(j) lxor t 117 | done 118 | 119 | let main_loop work e = 120 | let xzm1 = Array.make 64 0 in 121 | let xzm = Array.make 64 0 in 122 | let xzmb = Array.make 64 0 in 123 | let xzm1b = Array.make 64 0 in 124 | let xznb = Array.make 64 0 in 125 | let xzn1b = Array.make 64 0 in 126 | let a0 = Array.make 64 0 in 127 | let a1 = Array.make 64 0 in 128 | let b0 = Array.make 64 0 in 129 | let b1 = Array.make 64 0 in 130 | let c1 = Array.make 64 0 in 131 | let r = Array.make 32 0 in 132 | let s = Array.make 32 0 in 133 | let t = Array.make 32 0 in 134 | let u = Array.make 32 0 in 135 | for j = 0 to 31 do 136 | xzm1.(j) <- work.(j) 137 | done ; 138 | xzm1.(32) <- 1 ; 139 | xzm.(0) <- 1 ; 140 | for pos = 254 downto 0 do 141 | let b = (e.(pos / 8) land 0xFF) lsr (pos land 7) in 142 | let b = b land 1 in 143 | select xzmb xzm1b xzm xzm1 b ; 144 | add a0 0 xzmb 0 xzmb 32 ; 145 | sub a0 32 xzmb 0 xzmb 32 ; 146 | add a1 0 xzm1b 0 xzm1b 32 ; 147 | sub a1 32 xzm1b 0 xzm1b 32 ; 148 | square b0 0 a0 0 ; 149 | square b0 32 a0 32 ; 150 | mult b1 0 a1 0 a0 32 ; 151 | mult b1 32 a1 32 a0 0 ; 152 | add c1 0 b1 0 b1 32 ; 153 | sub c1 32 b1 0 b1 32 ; 154 | square r 0 c1 32 ; 155 | sub s 0 b0 0 b0 32 ; 156 | mult21665 t s ; 157 | add u 0 t 0 b0 0 ; 158 | mult xznb 0 b0 0 b0 32 ; 159 | mult xznb 32 s 0 u 0 ; 160 | square xzn1b 0 c1 0 ; 161 | mult xzn1b 32 r 0 work 0 ; 162 | select xzm xzm1 xznb xzn1b b 163 | done ; 164 | for j = 0 to 63 do 165 | work.(j) <- xzm.(j) 166 | done 167 | 168 | let recip outv outv_offset z z_offset = 169 | let z2 = Array.make 32 0 in 170 | let z9 = Array.make 32 0 in 171 | let z11 = Array.make 32 0 in 172 | let z2_5_0 = Array.make 32 0 in 173 | let z2_10_0 = Array.make 32 0 in 174 | let z2_20_0 = Array.make 32 0 in 175 | let z2_50_0 = Array.make 32 0 in 176 | let z2_100_0 = Array.make 32 0 in 177 | let t0 = Array.make 32 0 in 178 | let t1 = Array.make 32 0 in 179 | square z2 0 z z_offset ; 180 | (* 2 *) 181 | square t1 0 z2 0 ; 182 | (* 4 *) 183 | square t0 0 t1 0 ; 184 | (* 8 *) 185 | mult z9 0 t0 0 z z_offset ; 186 | (* 9 *) 187 | mult z11 0 z9 0 z2 0 ; 188 | (* 11 *) 189 | square t0 0 z11 0 ; 190 | (* 22 *) 191 | mult z2_5_0 0 t0 0 z9 0 ; 192 | (* 2^5 - 2^0 = 31 *) 193 | square t0 0 z2_5_0 0 ; 194 | (* 2^6 - 2^1 *) 195 | square t1 0 t0 0 ; 196 | (* 2^7 - 2^2 *) 197 | square t0 0 t1 0 ; 198 | (* 2^8 - 2^3 *) 199 | square t1 0 t0 0 ; 200 | (* 2^9 - 2^4 *) 201 | square t0 0 t1 0 ; 202 | (* 2^10 - 2^5 *) 203 | mult z2_10_0 0 t0 0 z2_5_0 0 ; 204 | (* 2^10 - 2^0 *) 205 | square t0 0 z2_10_0 0 ; 206 | (* 2^11 - 2^1 *) 207 | square t1 0 t0 0 ; 208 | (* 2^12 - 2^2 *) 209 | 210 | (* 2^20 - 2^10 *) 211 | for _ = 1 to 4 do 212 | square t0 0 t1 0 ; square t1 0 t0 0 213 | done ; 214 | mult z2_20_0 0 t1 0 z2_10_0 0 ; 215 | (* 2^20 - 2^0 *) 216 | square t0 0 z2_20_0 0 ; 217 | (* 2^21 - 2^1 *) 218 | square t1 0 t0 0 ; 219 | (* 2^22 - 2^2 *) 220 | 221 | (* 2^40 - 2^40 *) 222 | for _ = 1 to 9 do 223 | square t0 0 t1 0 ; square t1 0 t0 0 224 | done ; 225 | mult t0 0 t1 0 z2_20_0 0 ; 226 | (* 2^40 - 2^0 *) 227 | square t1 0 t0 0 ; 228 | (* 2^41 - 2^1 *) 229 | square t0 0 t1 0 ; 230 | (* 2^42 - 2^2 *) 231 | 232 | (* 2^50 - 2^10 *) 233 | for _ = 1 to 4 do 234 | square t1 0 t0 0 ; square t0 0 t1 0 235 | done ; 236 | mult z2_50_0 0 t0 0 z2_10_0 0 ; 237 | (* 2^50 - 2^0 *) 238 | square t0 0 z2_50_0 0 ; 239 | (* 2^51 - 2^1 *) 240 | square t1 0 t0 0 ; 241 | (* 2^52 - 2^2 *) 242 | 243 | (* 2^100 - 2^50 *) 244 | for _ = 1 to 24 do 245 | square t0 0 t1 0 ; square t1 0 t0 0 246 | done ; 247 | mult z2_100_0 0 t1 0 z2_50_0 0 ; 248 | (* 2^100 - 2^0 *) 249 | square t1 0 z2_100_0 0 ; 250 | (* 2^101 - 2^1 *) 251 | square t0 0 t1 0 ; 252 | (* 2^102 - 2^2 *) 253 | 254 | (* 2^200 - 2^100 *) 255 | for _ = 1 to 49 do 256 | square t1 0 t0 0 ; square t0 0 t1 0 257 | done ; 258 | mult t1 0 t0 0 z2_100_0 0 ; 259 | (* 2^200 - 2^0 *) 260 | square t0 0 t1 0 ; 261 | (* 2^201 - 2^1 *) 262 | square t1 0 t0 0 ; 263 | (* 2^202 - 2^2 *) 264 | 265 | (* 2^250 - 2^50 *) 266 | for _ = 1 to 24 do 267 | square t0 0 t1 0 ; square t1 0 t0 0 268 | done ; 269 | mult t0 0 t1 0 z2_50_0 0 ; 270 | (* 2^250 - 2^0 *) 271 | square t1 0 t0 0 ; 272 | (* 2^251 - 2^1 *) 273 | square t0 0 t1 0 ; 274 | (* 2^252 - 2^2 *) 275 | square t1 0 t0 0 ; 276 | (* 2^253 - 2^3 *) 277 | square t0 0 t1 0 ; 278 | (* 2^254 - 2^4 *) 279 | square t1 0 t0 0 ; 280 | (* 2^255 - 2^5 *) 281 | mult outv outv_offset t1 0 z11 0 282 | 283 | (* 2^255 - 21 *) 284 | 285 | let curve25519 q n p = 286 | let work = Array.make 96 0 in 287 | let e = Array.make 32 0 in 288 | for i = 0 to 31 do 289 | e.(i) <- n.(i) 290 | done ; 291 | e.(0) <- e.(0) land 248 ; 292 | e.(31) <- e.(31) land 127 ; 293 | e.(31) <- e.(31) lor 64 ; 294 | for i = 0 to 31 do 295 | work.(i) <- p.(i) land 0xFF 296 | done ; 297 | main_loop work e ; 298 | recip work 32 work 32 ; 299 | mult work 64 work 0 work 32 ; 300 | freeze work 64 ; 301 | for i = 0 to 31 do 302 | q.(i) <- work.(64 + i) 303 | done ; 304 | () 305 | 306 | let curve25519_base q n = 307 | let basevp = basev in 308 | curve25519 q n basevp 309 | 310 | type _ key = int array 311 | type public 312 | type secret 313 | type shared 314 | 315 | external identity : 'a -> 'a = "%identity" 316 | 317 | let ( <.> ) f g x = f (g x) 318 | let base = basev 319 | 320 | let secret_key_of_string : string -> secret key = 321 | fun x -> 322 | if String.length x <> 32 323 | then Fmt.invalid_arg "secret_key_of_string: invalid key" ; 324 | Array.init 32 (Char.code <.> String.get x) 325 | 326 | let secret_key_of_int_array : int array -> secret key = 327 | fun x -> 328 | if Array.length x <> 32 || Array.exists (fun x -> x > 0xFF) x 329 | then 330 | Fmt.invalid_arg "public_key_of_int_array: key should consist of 32 bytes" ; 331 | identity x 332 | 333 | let null = String.make 32 '\x00' 334 | 335 | let public_key_of_string : string -> public key = 336 | fun x -> 337 | if String.length x <> 32 338 | then Fmt.invalid_arg "public_key_of_string: key should consist of 32 bytes" ; 339 | if String.equal x null 340 | then Fmt.invalid_arg "public_key_of_string: null public key" ; 341 | Array.init 32 (Char.code <.> String.get x) 342 | 343 | let public_key_of_int_array : int array -> public key = 344 | fun x -> 345 | if Array.length x <> 32 || Array.exists (fun x -> x > 0xFF) x 346 | then 347 | Fmt.invalid_arg "public_key_of_int_array: key should consist of 32 bytes" ; 348 | if Array.for_all (( = ) 0) x 349 | then Fmt.invalid_arg "public_key_of_int_array: null public key" ; 350 | identity x 351 | 352 | let string_of_key : _ key -> string = 353 | fun x -> 354 | (* assert (Array.length x = 32); *) 355 | String.init 32 (Char.chr <.> Array.get x) 356 | 357 | let ecdh_base_inplace : out:int array -> secret:secret key -> unit = 358 | fun ~out ~secret -> curve25519_base out secret 359 | 360 | let ecdh_inplace : 361 | out:int array -> secret:secret key -> public:public key -> unit = 362 | fun ~out ~secret ~public -> curve25519 out secret public 363 | 364 | let public_of_secret : secret key -> public key = 365 | fun secret -> 366 | let out = Array.make 32 0 in 367 | ecdh_base_inplace ~out ~secret ; 368 | out 369 | 370 | let shared : secret:secret key -> public:public key -> public key = 371 | fun ~secret ~public -> 372 | let out = Array.make 32 0 in 373 | ecdh_inplace ~out ~secret ~public ; 374 | out 375 | 376 | let[@noalloc] [@inline] public_key_of_shared x = identity x 377 | let[@noalloc] [@inline] secret_key_of_shared x = identity x 378 | let pp_public_key : public key Fmt.t = fun ppf key -> pp ppf key 379 | let pp_shared_key : shared key Fmt.t = fun ppf key -> pp ppf key 380 | 381 | let equal_key : _ key -> _ key -> bool = 382 | fun a b -> 383 | (* assert (Array.length a = 32 && Array.length b = 32); *) 384 | Eqaf.equal (string_of_key a) (string_of_key b) 385 | -------------------------------------------------------------------------------- /lib/callipyge.mli: -------------------------------------------------------------------------------- 1 | (** Type of keys. *) 2 | type _ key = private int array 3 | 4 | and public 5 | 6 | and secret 7 | 8 | and shared 9 | 10 | val base : public key 11 | (** The base point 9. *) 12 | 13 | val secret_key_of_string : string -> secret key 14 | (** [secret_key_of_string v] is secret key of a 32-bytes [string] [v]. It makes 15 | a fresh allocated {!secret key}. *) 16 | 17 | val secret_key_of_int_array : int array -> secret key 18 | (** [secret_key_of_string v] is secret key of a 32-bytes [int array] [v]. It 19 | only verifies [v] (no allocation). *) 20 | 21 | val public_key_of_string : string -> public key 22 | (** [public_key_of_string v] is public key of 32-bytes [string] [v]. Null 23 | public key ([String.make 32 '\x00']) is not allowed. It makes a fresh 24 | allocated {!public key}. *) 25 | 26 | val public_key_of_int_array : int array -> public key 27 | (** [public_key_of_int_array v] is public key of 32-bytes [int array] [v]. It 28 | only verifies [v] (no allocation). Null public key ([Array.make 32 0]) is 29 | not allowed. *) 30 | 31 | val string_of_key : _ key -> string 32 | (** [string_of_key k] makes a fresh allocated [string] of [k]. *) 33 | 34 | val ecdh_inplace : 35 | out:int array -> secret:secret key -> public:public key -> unit 36 | (** [ecdh_inplace ~out ~secret ~public] computes the shared secret between 37 | secret key [secret] and public key [public]. The result is stored in [out]. *) 38 | 39 | val ecdh_base_inplace : out:int array -> secret:secret key -> unit 40 | (** [ecdh_base_inplace ~out ~secret] is eqauivalent to {!ecdh} with the secret 41 | key [secret] and the base point {!base}, with the resulting public key 42 | stored in [out]. *) 43 | 44 | val public_of_secret : secret key -> public key 45 | (** [public_of_secret k] is public key of [k]. It makes a fresh allocated 46 | public key. *) 47 | 48 | val shared : secret:secret key -> public:public key -> shared key 49 | (** [shared ~secret ~public] computes the shared secret between secret key 50 | [secret] and public key [public]. It makes a fresh allocated result. *) 51 | 52 | val public_key_of_shared : shared key -> public key 53 | (** [public_key_of_shared k] maps [k] to be a public key. *) 54 | 55 | val secret_key_of_shared : shared key -> secret key 56 | (** [secret_key_of_shared k] maps [k] to be a secret key. *) 57 | 58 | val pp_public_key : public key Fmt.t 59 | (** [pp_public_key ppf v] prints public key [v] on [ppf]. *) 60 | 61 | val pp_shared_key : shared key Fmt.t 62 | (** [pp_shared_key ppf v] prints shared key [v] on [ppf]. *) 63 | 64 | val equal_key : 'a key -> 'a key -> bool 65 | (** [equal_key k1 k2] returns [true] iff [k1 = k2]. Otherwise, it returns 66 | [false]. *) 67 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name callipyge) 3 | (public_name callipyge) 4 | (libraries fmt eqaf)) 5 | -------------------------------------------------------------------------------- /lib/ma.ml: -------------------------------------------------------------------------------- 1 | type t = int array 2 | 3 | external make : int -> int -> t = "caml_make_vect" 4 | 5 | external get : t -> int -> int = "%array_unsafe_get" 6 | external set : t -> int -> int -> unit = "%array_unsafe_set" 7 | 8 | let init l f = 9 | let r = make l (f 0) in 10 | 11 | for i = 1 to pred l 12 | do set r i (f i) done; r 13 | 14 | external length : t -> int = "%array_length" 15 | 16 | let exists f a = Array.exists f a 17 | let for_all f a = Array.for_all f a 18 | -------------------------------------------------------------------------------- /lib/ma.mli: -------------------------------------------------------------------------------- 1 | type t = int array 2 | 3 | val init: int -> (int -> int) -> t 4 | val make: int -> int -> t 5 | 6 | val get: t -> int -> int 7 | val set: t -> int -> int -> unit 8 | 9 | val length: t -> int 10 | 11 | val exists: (int -> bool) -> t -> bool 12 | val for_all: (int -> bool) -> t -> bool 13 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name oracle) 3 | (modules oracle) 4 | (c_names curve25519-donna)) 5 | 6 | (executable 7 | (name test) 8 | (modules test) 9 | (libraries callipyge oracle fmt alcotest)) 10 | 11 | (rule (copy# ../bench/curve25519-donna.c curve25519-donna.c)) 12 | 13 | (alias 14 | (name runtest) 15 | (deps (:test test.exe)) 16 | (action (run %{test} --color=always))) 17 | -------------------------------------------------------------------------------- /test/oracle.ml: -------------------------------------------------------------------------------- 1 | external ecdh : bytes -> string -> string -> unit = "caml_curve25519_donna" 2 | [@@noalloc] 3 | 4 | let base = String.init 32 (function 0 -> '\x09' | _ -> '\x00') 5 | 6 | let public ~secret = 7 | let rs = Bytes.create 32 in 8 | ecdh rs secret base ; Bytes.unsafe_to_string rs 9 | 10 | let shared ~secret ~public = 11 | let rs = Bytes.create 32 in 12 | ecdh rs secret public ; Bytes.unsafe_to_string rs 13 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | let pp_base ppf arr = 2 | for i = 0 to Array.length arr - 1 do 3 | Fmt.pf ppf "%02X" arr.(i) 4 | done 5 | 6 | type public_key = Callipyge.public Callipyge.key 7 | type secret_key = Callipyge.secret Callipyge.key 8 | 9 | let pp_secret ppf (arr : secret_key) = pp_base ppf (arr :> int array) 10 | 11 | let doit ek (e : secret_key) (k : public_key) = 12 | Fmt.pr "%a %a " pp_secret e Callipyge.pp_public_key k ; 13 | Callipyge.ecdh_inplace ~out:ek ~secret:e ~public:k ; 14 | Fmt.pr "%a\n%!" pp_base ek 15 | 16 | let ecdh (e1 : secret_key) (e2 : secret_key) (k : public_key) e1k e2k = 17 | let equal e1e2k e2e1k = 18 | let result = 19 | assert (Array.length e1e2k = 32 && Array.length e2e1k = 32) ; 20 | let rt = ref 0 in 21 | for i = 0 to 31 do 22 | rt := !rt lor (e1e2k.(i) lxor e2e1k.(i)) 23 | done ; 24 | !rt = 0 25 | in 26 | Fmt.epr "%a equal %a: %b.\n%!" pp_base e1e2k pp_base e2e1k result ; 27 | if result 28 | then ( 29 | Array.iteri 30 | (fun i x -> (e1 :> int array).(i) <- x lxor (e2k :> int array).(i)) 31 | (e1 :> int array) ; 32 | Array.iteri 33 | (fun i x -> (e2 :> int array).(i) <- x lxor (e1k :> int array).(i)) 34 | (e2 :> int array) ; 35 | Array.iteri 36 | (fun i x -> (k :> int array).(i) <- x lxor e1e2k.(i)) 37 | (k :> int array) ; 38 | result ) 39 | else result 40 | in 41 | let pp = pp_base in 42 | Alcotest.testable pp equal 43 | 44 | let step (e1 : secret_key) (e2 : secret_key) (k : public_key) = 45 | let ecdh = ecdh e1 e2 k in 46 | ( "ecdh(e2, ecdh(e1, k)) = ecdh(e1, ecdh(e2, k))" 47 | , `Quick 48 | , fun () -> 49 | let e1k = Array.make 32 0 in 50 | let e2k = Array.make 32 0 in 51 | let e1e2k = Array.make 32 0 in 52 | let e2e1k = Array.make 32 0 in 53 | let () = doit e1k e1 k in 54 | let () = doit e2e1k e2 (Callipyge.public_key_of_int_array e1k) in 55 | let () = doit e2k e2 k in 56 | let () = doit e1e2k e1 (Callipyge.public_key_of_int_array e2k) in 57 | Alcotest.(check (ecdh e1k e2k)) "equal" e1e2k e2e1k ) 58 | 59 | let e1 = 60 | "\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" 61 | 62 | let e2 = 63 | "\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" 64 | 65 | let k = 66 | "\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" 67 | 68 | let ( <.> ) f g x = f (g x) 69 | 70 | let tests n = 71 | let e1 = Callipyge.secret_key_of_string e1 in 72 | let e2 = Callipyge.secret_key_of_string e2 in 73 | let k = Callipyge.public_key_of_string k in 74 | let step = step e1 e2 k in 75 | let rec go acc = function 0 -> acc | n -> go (step :: acc) (pred n) in 76 | go [] n 77 | 78 | let public = Alcotest.testable Callipyge.pp_public_key Callipyge.equal_key 79 | 80 | let shared = 81 | let equal a b = 82 | Fmt.pr "a: %a.\n%!" Callipyge.pp_shared_key a ; 83 | Fmt.pr "b: %a.\n%!" Callipyge.pp_shared_key b ; 84 | Callipyge.equal_key a b 85 | in 86 | Alcotest.testable Callipyge.pp_shared_key equal 87 | 88 | let pp_key ppf x = 89 | for i = 0 to String.length x - 1 do 90 | Fmt.pf ppf "%02X" (Char.code (String.unsafe_get x i)) 91 | done 92 | 93 | let key = 94 | let equal a b = 95 | Fmt.pr "a: %a.\n%!" pp_key a ; 96 | Fmt.pr "b: %a.\n%!" pp_key b ; 97 | String.equal a b 98 | in 99 | Alcotest.testable pp_key equal 100 | 101 | let nacl = 102 | let p_a = 103 | Callipyge.public_key_of_string 104 | "\x85\x20\xf0\x09\x89\x30\xa7\x54\x74\x8b\x7d\xdc\xb4\x3e\xf7\x5a\x0d\xbf\x3a\x0d\x26\x38\x1a\xf4\xeb\xa4\xa9\x8e\xaa\x9b\x4e\x6a" 105 | in 106 | let s_a = 107 | Callipyge.secret_key_of_string 108 | "\x77\x07\x6d\x0a\x73\x18\xa5\x7d\x3c\x16\xc1\x72\x51\xb2\x66\x45\xdf\x4c\x2f\x87\xeb\xc0\x99\x2a\xb1\x77\xfb\xa5\x1d\xb9\x2c\x2a" 109 | in 110 | let p_b = 111 | Callipyge.public_key_of_string 112 | "\xde\x9e\xdb\x7d\x7b\x7d\xc1\xb4\xd3\x5b\x61\xc2\xec\xe4\x35\x37\x3f\x83\x43\xc8\x5b\x78\x67\x4d\xad\xfc\x7e\x14\x6f\x88\x2b\x4f" 113 | in 114 | let s_b = 115 | Callipyge.secret_key_of_string 116 | "\x5d\xab\x08\x7e\x62\x4a\x8a\x4b\x79\xe1\x7f\x8b\x83\x80\x0e\xe6\x6f\x3b\xb1\x29\x26\x18\xb6\xfd\x1c\x2f\x8b\x27\xff\x88\xe0\xeb" 117 | in 118 | let p_alice () = 119 | Alcotest.(check public) "equal" (Callipyge.public_of_secret s_a) p_a 120 | in 121 | let p_bob () = 122 | Alcotest.(check public) "equal" (Callipyge.public_of_secret s_b) p_b 123 | in 124 | let p_shared () = 125 | let s_ab = Callipyge.shared ~secret:s_a ~public:p_b in 126 | let s_ba = Callipyge.shared ~secret:s_b ~public:p_a in 127 | Alcotest.(check shared) "equal" s_ab s_ba 128 | in 129 | ["alice", `Quick, p_alice; "bob", `Quick, p_bob; "shared", `Quick, p_shared] 130 | 131 | let random_key () = 132 | let ic = open_in_bin "/dev/urandom" in 133 | let rs = really_input_string ic 32 in 134 | close_in ic ; rs 135 | 136 | let list_init f n = 137 | let rec go acc = function 138 | | 0 -> List.rev acc 139 | | n -> go (f () :: acc) (pred n) 140 | in 141 | go [] n 142 | 143 | let oracle = 144 | let test () = 145 | let donna_s_a = random_key () in 146 | let donna_s_b = random_key () in 147 | let donna_p_a = Oracle.public ~secret:donna_s_a in 148 | let donna_p_b = Oracle.public ~secret:donna_s_b in 149 | let donna_s_ab = Oracle.shared ~secret:donna_s_a ~public:donna_p_b in 150 | let donna_s_ba = Oracle.shared ~secret:donna_s_b ~public:donna_p_a in 151 | let callipyge_s_a = Callipyge.secret_key_of_string donna_s_a in 152 | let callipyge_s_b = Callipyge.secret_key_of_string donna_s_b in 153 | let callipyge_p_a = Callipyge.public_of_secret callipyge_s_a in 154 | let callipyge_p_b = Callipyge.public_of_secret callipyge_s_b in 155 | let callipyge_s_ab = 156 | Callipyge.shared ~secret:callipyge_s_a ~public:callipyge_p_b 157 | in 158 | let callipyge_s_ba = 159 | Callipyge.shared ~secret:callipyge_s_b ~public:callipyge_p_a 160 | in 161 | Fmt.pr "a: %a.\n%!" pp_base (callipyge_s_a :> int array) ; 162 | Fmt.pr "a: %a.\n%!" pp_key donna_s_a ; 163 | Fmt.pr "b: %a.\n%!" pp_base (callipyge_s_b :> int array) ; 164 | Fmt.pr "b: %a.\n%!" pp_key donna_s_b ; 165 | Alcotest.(check shared) 166 | "equal shared (callipyge)" callipyge_s_ab callipyge_s_ba ; 167 | Alcotest.(check key) "equal shared (oracle)" donna_s_ab donna_s_ba ; 168 | Alcotest.(check key) 169 | "equal public alice" 170 | (Callipyge.string_of_key callipyge_p_a) 171 | donna_p_a ; 172 | Alcotest.(check key) 173 | "equal public bob" 174 | (Callipyge.string_of_key callipyge_p_b) 175 | donna_p_b 176 | in 177 | list_init (fun () -> "oracle", `Quick, test) 64 178 | 179 | let () = 180 | Alcotest.run "ECDH" 181 | [ "5 steps", tests 5 182 | ; "10 steps", tests 10 183 | ; "20 steps", tests 20 184 | ; "40 steps", tests 40 185 | ; "80 steps", tests 80 186 | ; "160 steps", tests 160 187 | ; "nacl", nacl 188 | ; "oracle", oracle ] 189 | --------------------------------------------------------------------------------