Implement the CubeHash cryptographic hashing function.

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)