summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--cubehash.rkt149
-rw-r--r--main.rkt13
2 files changed, 160 insertions, 2 deletions
diff --git a/cubehash.rkt b/cubehash.rkt
new file mode 100644
index 0000000..3aed1f3
--- /dev/null
+++ b/cubehash.rkt
@@ -0,0 +1,149 @@
+#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/>.
+;;;-----------------------------------------------------------------------------
+;;;
+
+;;;
+;;; NOTE: The original version of CubeHash defaulted to
+;;; init-rounds = fin-rounds = (* 10 rounds/block). Therefore, if you see
+;;; references to “Cubehash r/b-h” variants, you can instantiate those by using
+;;; something like the following:
+;;;
+;;; (cubehash (* 10 r) r b (* 10 r) h)
+;;;
+
+
+(require "util.rkt")
+
+(provide: [cubehash (Exact-Nonnegative-Integer Exact-Nonnegative-Integer
+ Exact-Nonnegative-Integer Exact-Nonnegative-Integer
+ Exact-Nonnegative-Integer ->
+ Bytes -> Exact-Nonnegative-Integer)]
+ [cubehash-128 (Bytes -> Exact-Nonnegative-Integer)]
+ [cubehash-160 (Bytes -> Exact-Nonnegative-Integer)]
+ [cubehash-224 (Bytes -> Exact-Nonnegative-Integer)]
+ [cubehash-256 (Bytes -> Exact-Nonnegative-Integer)]
+ [cubehash-384 (Bytes -> Exact-Nonnegative-Integer)]
+ [cubehash-512 (Bytes -> Exact-Nonnegative-Integer)]
+ [cubehash-512x (Bytes -> Exact-Nonnegative-Integer)]
+ #;[cubemac-128 (Bytes Bytes -> Exact-Nonnegative-Integer)])
+
+
+(define-type Word Exact-Nonnegative-Integer)
+(define-type Bit (U Zero One))
+
+(: 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))))
+
+
+(define (cubehash init-rounds rounds/block block-size fin-rounds output-bits)
+ (λ: ([msg : Bytes])
+ (let*: ([state : (Vectorof Word)
+ (make-vector 32 #x0)]
+ [msg-pad : Bytes
+ (bytes-append msg
+ (list->bytes '(#x80))
+ (make-bytes (modulo (- (+ 1 (bytes-length msg)))
+ block-size)
+ #x0))]
+ [x : (Integer Integer Integer Integer Integer -> Word)
+ (λ (i j k l m)
+ (vector-ref state (+ (* i 16) (* j 8) (* k 4) (* l 2) m)))]
+ [set-x! : (Integer Integer Integer Integer Integer Word -> Void)
+ (λ (i j k l m v)
+ (vector-set! state (+ (* i 16) (* j 8) (* k 4) (* l 2) m) v))]
+ [round! : (-> Void)
+ (λ ()
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (set-x! 1 j k l m (w+ (x 0 j k l m)
+ (x 1 j k l m))))
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (set-x! 0 j k l m (wrot (x 0 j k l m) 7)))
+ (for*: ([k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (let ([tmp (x 0 0 k l m)])
+ (set-x! 0 0 k l m (x 0 1 k l m))
+ (set-x! 0 1 k l m tmp)))
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (set-x! 0 j k l m (wxor (x 0 j k l m)
+ (x 1 j k l m))))
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [m : Bit '(0 1)])
+ (let ([tmp (x 1 j k 0 m)])
+ (set-x! 1 j k 0 m (x 1 j k 1 m))
+ (set-x! 1 j k 1 m tmp)))
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (set-x! 1 j k l m (w+ (x 0 j k l m)
+ (x 1 j k l m))))
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (set-x! 0 j k l m (wrot (x 0 j k l m) 11)))
+ (for*: ([j : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (let ([tmp (x 0 j 0 l m)])
+ (set-x! 0 j 0 l m (x 0 j 1 l m))
+ (set-x! 0 j 1 l m tmp)))
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
+ (set-x! 0 j k l m (wxor (x 0 j k l m)
+ (x 1 j k l m))))
+ (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)])
+ (let ([tmp (x 1 j k l 0)])
+ (set-x! 1 j k l 0 (x 1 j k l 1))
+ (set-x! 1 j k l 1 tmp))))])
+ (vector-set! state 0 (quotient output-bits 8))
+ (vector-set! state 1 block-size)
+ (vector-set! state 2 rounds/block)
+ (for ([i (in-range 0 init-rounds)])
+ (round!))
+ (for ([i (in-range 0 (quotient (bytes-length msg-pad) block-size))])
+ (let ([block (subbytes msg-pad (* i block-size) (* (add1 i) block-size))])
+ (for: ([byte : Byte block]
+ [i : Exact-Nonnegative-Integer (in-naturals)])
+ (let ([s (vector-ref state (quotient i 4))])
+ (vector-set! state
+ (quotient i 4)
+ (bitwise-xor s (arithmetic-shift byte
+ (* (remainder i 4) 8))))))
+ (for ([i (in-range 0 rounds/block)])
+ (round!))))
+ (vector-set! state 31 (bitwise-xor (vector-ref state 31) 1))
+ (for ([i (in-range 0 fin-rounds)])
+ (round!))
+ (bytes->integer
+ (subbytes (bytes-append* (vector->list
+ (vector-map (λ: ([w : Word])
+ (integer->bytes/size w 'little-endian 4))
+ state)))
+ 0
+ (quotient output-bits 8))))))
+
+
+(define cubehash-128 (cubehash 16 16 32 32 128))
+(define cubehash-160 (cubehash 16 16 32 32 160))
+(define cubehash-224 (cubehash 16 16 32 32 224))
+(define cubehash-256 (cubehash 16 16 32 32 256))
+(define cubehash-384 (cubehash 16 16 32 32 384))
+(define cubehash-512 (cubehash 16 16 32 32 512))
+(define cubehash-512x (cubehash 16 16 1 32 512))
+
+#;(define cubemac-128 ...)
diff --git a/main.rkt b/main.rkt
index 6fbf663..aadd079 100644
--- a/main.rkt
+++ b/main.rkt
@@ -1,8 +1,17 @@
#lang typed/racket
(require "hmac.rkt"
"whirlpool.rkt"
- "salsa-chacha.rkt")
+ "salsa-chacha.rkt"
+ "cubehash.rkt")
(provide hmac
whirlpool
- salsa20)
+ salsa20
+ cubehash
+ cubehash-128
+ cubehash-160
+ cubehash-224
+ cubehash-256
+ cubehash-384
+ cubehash-512
+ cubehash-512x)