summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hmac.rkt5
-rw-r--r--salsa-chacha.rkt186
-rw-r--r--typed-stream.rkt12
-rw-r--r--util.rkt28
-rw-r--r--whirlpool.rkt2
5 files changed, 225 insertions, 8 deletions
diff --git a/hmac.rkt b/hmac.rkt
index 314ab88..b618537 100644
--- a/hmac.rkt
+++ b/hmac.rkt
@@ -36,7 +36,7 @@
[ipad (make-bytes blocksize #x36)]
[padded-key
(pad-bytes (if (> (bytes-length key) blocksize)
- (integer->bytes (hashfn key))
+ (integer->bytes (hashfn key) 'big-endian)
key)
blocksize
#x0
@@ -44,6 +44,7 @@
(hashfn (bytes-append (integer->bytes/size
(bitwise-xor (bytes->integer opad)
(bytes->integer padded-key))
+ 'big-endian
blocksize)
(integer->bytes/size
(hashfn
@@ -51,8 +52,10 @@
(integer->bytes/size
(bitwise-xor (bytes->integer ipad)
(bytes->integer padded-key))
+ 'big-endian
blocksize)
msg))
+ 'big-endian
hashsize)))))
;; According to Ironclad:
diff --git a/salsa-chacha.rkt b/salsa-chacha.rkt
new file mode 100644
index 0000000..17af9c8
--- /dev/null
+++ b/salsa-chacha.rkt
@@ -0,0 +1,186 @@
+#lang typed/racket
+;;; Copyright 2011, Matthias Andreas Benkard.
+;;;
+;;;-----------------------------------------------------------------------------
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;;-----------------------------------------------------------------------------
+;;;
+
+(require "util.rkt")
+
+(provide salsa20)
+
+(require/typed racket/stream
+ [empty-stream #;(All (a) (Sequenceof a))
+ (Sequenceof Byte)])
+
+(require/typed racket
+ [sequence-generate (All (a)
+ (Sequenceof a)
+ -> (values (-> Boolean)
+ (-> a)))])
+
+(require/typed "typed-stream.rkt"
+ [lazy-functional-stream-append (All (a)
+ ((Sequenceof a)
+ (-> (Sequenceof a))
+ -> (Sequenceof a)))])
+
+(define-type Word Exact-Nonnegative-Integer)
+(define-type 4words (Vector Word Word Word Word))
+(define-type 16words (Vector Word Word Word Word
+ Word Word Word Word
+ Word Word Word Word
+ Word Word Word Word))
+
+(: w+ (Word Word -> Word))
+(define (w+ a b)
+ (bitwise-and (+ a b) #xffffffff))
+
+(: wxor (Word Word -> Word))
+(define wxor bitwise-xor)
+
+(: wrot (Word Exact-Positive-Integer -> Word))
+(define (wrot a e)
+ (let ([ash (arithmetic-shift a e)])
+ (bitwise-ior (bitwise-and ash #xffffffff)
+ (arithmetic-shift ash -32))))
+
+
+(: quarterround (4words -> 4words))
+(define (quarterround y)
+ (match y
+ [(vector y0 y1 y2 y3)
+ (let* ([z1 (wxor y1 (wrot (w+ y0 y3) 7))]
+ [z2 (wxor y2 (wrot (w+ z1 y0) 9))]
+ [z3 (wxor y3 (wrot (w+ z2 z1) 13))]
+ [z0 (wxor y0 (wrot (w+ z3 z2) 18))])
+ (vector z0 z1 z2 z3))]))
+
+(: chacha-quarterround (4words -> 4words))
+(define (chacha-quarterround y)
+ (match y
+ [(vector a b c d)
+ (let* ([a2 (w+ a b)] [d2 (wrot (wxor a2 d) 16)]
+ [c2 (w+ c d2)] [b2 (wrot (wxor b c2) 12)]
+ [a3 (w+ a2 b2)] [d3 (wrot (wxor d2 a3) 8)]
+ [c3 (w+ c2 d3)] [b3 (wrot (wxor b2 c2) 7)])
+ (vector a3 b3 c3 d3))]))
+
+(: rowround (16words -> 16words))
+(define (rowround y)
+ (match y
+ [(vector y0 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 y11 y12 y13 y14 y15)
+ (match (vector (quarterround (vector y0 y1 y2 y3))
+ (quarterround (vector y5 y6 y7 y4))
+ (quarterround (vector y10 y11 y8 y9))
+ (quarterround (vector y15 y12 y13 y14)))
+ [(vector (vector z0 z1 z2 z3) (vector z5 z6 z7 z4)
+ (vector z10 z11 z8 z9) (vector z15 z12 z13 z14))
+ (vector z0 z1 z2 z3 z4 z5 z6 z7 z8 z9 z10 z11 z12 z13 z14 z15)])]))
+
+(: columnround (16words -> 16words))
+(define (columnround y)
+ (match y
+ [(vector y0 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 y11 y12 y13 y14 y15)
+ (match (vector (quarterround (vector y0 y4 y8 y12))
+ (quarterround (vector y5 y9 y13 y1))
+ (quarterround (vector y10 y14 y2 y6))
+ (quarterround (vector y15 y3 y7 y11)))
+ [(vector (vector z0 z4 z8 z12) (vector z5 z9 z13 z1)
+ (vector z10 z14 z2 z6) (vector z15 z3 z7 z11))
+ (vector z0 z1 z2 z3 z4 z5 z6 z7 z8 z9 z10 z11 z12 z13 z14 z15)])]))
+
+(: doubleround (16words -> 16words))
+(define doubleround (compose rowround columnround))
+
+#;
+(: 16words? (Any -> Boolean : 16words))
+#;
+(define (16words? x)
+ (match x
+ [(vector y0 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 y11 y12 y13 y14 y15)
+ #t]
+ [_
+ #f]))
+
+(: little-endian (Bytes -> Word))
+(define (little-endian b)
+ (match (bytes->list b)
+ [(list b0 b1 b2 b3)
+ (+ (arithmetic-shift b3 24)
+ (arithmetic-shift b2 16)
+ (arithmetic-shift b1 8)
+ b0)]))
+
+(: anti-little-endian (Word -> Bytes))
+(define (anti-little-endian w)
+ (integer->bytes/size w 'little-endian 4))
+
+(: times (All (a) ((a -> a) Integer -> (a -> a))))
+(define (times fn n)
+ (for/fold ([acc (inst identity a)])
+ ([i (in-range 0 n)])
+ (compose fn acc)))
+
+(: salsa20h (Bytes -> Bytes))
+(define (salsa20h x)
+ (let*: ([xwords : 16words (vector 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)])
+ (for ([i (in-range 0 16)])
+ (vector-set! (ann xwords (Vectorof Word))
+ i
+ (little-endian (subbytes x (* i 4) (* (add1 i) 4)))))
+ (let ([zwords ((times doubleround 10) xwords)])
+ (bytes-append* (vector->list
+ (vector-map (λ: ([a : Word] [b : Word])
+ (anti-little-endian (w+ a b)))
+ (ann xwords (Vectorof Word))
+ (ann zwords (Vectorof Word))))))))
+
+(: salsa20k (Bytes Bytes -> Bytes))
+(define (salsa20k k n)
+ (let* ([s0 (list->bytes '(101 120 112 97))]
+ [s1 (list->bytes '(110 100 32 51))]
+ [s2 (list->bytes '( 50 45 98 121))]
+ [s3 (list->bytes '(116 101 32 107))]
+ [t0 s0]
+ [t1 (list->bytes '(110 100 32 49))]
+ [t2 s2]
+ [t3 s3])
+ (if (= (bytes-length k) 32)
+ (let ([k0 (subbytes k 0 16)]
+ [k1 (subbytes k 16)])
+ (salsa20h (bytes-append s0 k0 s1 n s2 k1 s3)))
+ (salsa20h (bytes-append t0 k t1 n t2 k t3)))))
+
+(: salsa20 (Bytes Bytes (Sequenceof Byte) -> (Sequenceof Byte)))
+(define (salsa20 k v m)
+ (let-values ([(next? next) (sequence-generate m)])
+ (let: loop : (Sequenceof Byte)
+ ([i : Word 0])
+ (if (next?)
+ (let ([64bytes
+ (let: inner-loop : Bytes
+ ([k : Integer 0]
+ [bytes : (Listof Byte) (list)])
+ (if (and (next?) (< k 64))
+ (inner-loop (add1 k) (cons (next) bytes))
+ (list->bytes bytes)))]
+ [i-code
+ (integer->bytes/size i 'little-endian 8)])
+ (lazy-functional-stream-append (ann (bytes-xor 64bytes
+ (salsa20k k (bytes-append v i-code)))
+ (Sequenceof Byte))
+ (λ () (loop (add1 i)))))
+ empty-stream))))
diff --git a/typed-stream.rkt b/typed-stream.rkt
new file mode 100644
index 0000000..b674750
--- /dev/null
+++ b/typed-stream.rkt
@@ -0,0 +1,12 @@
+#lang racket
+(require racket/stream)
+
+(provide lazy-functional-stream-append)
+
+(define (lazy-functional-stream-append seq thunk)
+ (let-values ([(next? next) (sequence-generate seq)])
+ (let loop ()
+ (if (next?)
+ (let ([x (next)])
+ (stream-cons x (loop)))
+ (thunk)))))
diff --git a/util.rkt b/util.rkt
index 43dbe01..c1325a6 100644
--- a/util.rkt
+++ b/util.rkt
@@ -21,23 +21,31 @@
integer->bytes/size
bytes->integer
pad-bytes
- Justification)
+ Justification
+ Endianness
+ bytes-xor)
(define-type Justification (U 'left 'right))
+(define-type Endianness (U 'little-endian 'big-endian))
-(define: (integer->bytes [x : Exact-Nonnegative-Integer]) : Bytes
+(define: (integer->bytes [x : Exact-Nonnegative-Integer]
+ [endianness : Endianness])
+ : Bytes
(let: loop : Bytes
([acc : (Listof Byte) (list)]
[x : Exact-Nonnegative-Integer x])
(if (zero? x)
- (list->bytes acc)
+ (list->bytes (if (eq? endianness 'big-endian)
+ acc
+ (reverse acc)))
(loop (cons (bitwise-and #xff x) acc)
(arithmetic-shift x -8)))))
-(define: (integer->bytes/size [x : Exact-Nonnegative-Integer]
- [size : Exact-Nonnegative-Integer])
+(define: (integer->bytes/size [x : Exact-Nonnegative-Integer]
+ [endianness : Endianness]
+ [size : Exact-Nonnegative-Integer])
: Bytes
- (pad-bytes (integer->bytes x) size #x0 'right))
+ (pad-bytes (integer->bytes x endianness) size #x0 'right))
(define: (bytes->integer [b : Bytes]) : Exact-Nonnegative-Integer
(for/fold: ([n : Exact-Nonnegative-Integer 0])
@@ -58,3 +66,11 @@
(bytes-append b padding)
(bytes-append padding b)))))
+(define: (bytes-xor [a : Bytes] [b : Bytes]) : Bytes
+ (list->bytes
+ (reverse
+ (for/fold: ([acc : (Listof Byte) (list)])
+ ([x : Byte (in-bytes a)]
+ [y : Byte (in-bytes b)])
+ (cons (bitwise-xor x y) acc)))))
+
diff --git a/whirlpool.rkt b/whirlpool.rkt
index 5d436aa..222f9df 100644
--- a/whirlpool.rkt
+++ b/whirlpool.rkt
@@ -204,7 +204,7 @@
(+ (arithmetic-shift acc 8) byte)))
(define: (length->bytes [n : Exact-Nonnegative-Integer]) : Bytes
- (let ([b (integer->bytes n)])
+ (let ([b (integer->bytes n 'big-endian)])
(bytes-append (make-bytes (- 32 (bytes-length b)) 0) b)))
(define: (pad-whirlpool-bytes [b : Bytes]) : Bytes